git @ Cat's Eye Technologies Burro / master src / Language / Kondey / Compiler.hs
master

Tree @master (Download .tar.gz)

Compiler.hs @master — raw · history · blame 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
-- Copyright (c) 2025, Chris Pressey, Cat's Eye Technologies.
-- This file is distributed under a 2-clause BSD license, see LICENSES/ dir.
-- SPDX-License-Identifier: LicenseRef-BSD-2-Clause-X-Burro

module Language.Kondey.Compiler where

import qualified Language.Kondey.Definition as Kondey
import Language.Kondey.Definition (Kondey)
import Language.Burro.Definition


compile :: String -> Burro
compile kondeyText = genBurro $ Kondey.parse kondeyText

genBurro :: Kondey -> Burro
genBurro Kondey.Null = Null
genBurro Kondey.ToggleHalt = ToggleHalt
genBurro Kondey.Inc = Inc
genBurro Kondey.Dec = Dec
genBurro Kondey.GoLeft = GoLeft
genBurro Kondey.GoRight = GoRight
genBurro (Kondey.Test t f) = Test (genBurro t) (genBurro f)
genBurro (Kondey.Seq k1 k2) = Seq (genBurro k1) (genBurro k2)
genBurro (Kondey.Cond ks) = genCond ks

genCond :: [Kondey] -> Burro
genCond (kbranch:kbranches) =
    let
        counter = 0
        fore = Seq (makeBranch counter (genBurro kbranch)) (Test Null Null)
        rest = genCondRest kbranches kbranch (counter + 1)
    in
        Seq fore rest

genCondRest :: [Kondey] -> Kondey -> Int -> Burro
genCondRest [] _prev _counter = Null
genCondRest (kbranch:kbranches) prev counter =
    let
        b = genBurro kbranch
        invB = inverse (genBurro prev)
        branch = makeBranch counter (catBurros invB b)
        coda = repl (counter * 2) Dec (Test Null Null)
        fore = repl (counter * 2) Dec (Seq branch coda)
        rest = genCondRest kbranches kbranch (counter + 1)
    in
        Seq fore rest

makeBranch :: Int -> Burro -> Burro
makeBranch counter b =
    let
        -- We construct a Test where the "then" side is b, with
        -- counter <'s added in front, and counter+1 >'s added behind.
        thenSide = repl counter GoLeft $ Seq b $ repl counter GoRight GoRight
        elseSide = GoRight
    in
        Test thenSide elseSide

catBurros :: Burro -> Burro -> Burro
catBurros b1 b2 =
    Seq b1 b2

repl :: Int -> Burro -> Burro -> Burro
repl 0 _head tail = tail
repl n head tail = Seq head (repl (n-1) head tail)