Blame


1 fab3f1f6 2022-04-27 op -- This is free and unencumbered software released into the public domain.
2 fab3f1f6 2022-04-27 op --
3 fab3f1f6 2022-04-27 op -- Anyone is free to copy, modify, publish, use, compile, sell, or
4 fab3f1f6 2022-04-27 op -- distribute this software, either in source code form or as a compiled
5 fab3f1f6 2022-04-27 op -- binary, for any purpose, commercial or non-commercial, and by any
6 fab3f1f6 2022-04-27 op -- means.
7 fab3f1f6 2022-04-27 op --
8 fab3f1f6 2022-04-27 op -- In jurisdictions that recognize copyright laws, the author or authors
9 fab3f1f6 2022-04-27 op -- of this software dedicate any and all copyright interest in the
10 fab3f1f6 2022-04-27 op -- software to the public domain. We make this dedication for the benefit
11 fab3f1f6 2022-04-27 op -- of the public at large and to the detriment of our heirs and
12 fab3f1f6 2022-04-27 op -- successors. We intend this dedication to be an overt act of
13 fab3f1f6 2022-04-27 op -- relinquishment in perpetuity of all present and future rights to this
14 fab3f1f6 2022-04-27 op -- software under copyright law.
15 fab3f1f6 2022-04-27 op --
16 fab3f1f6 2022-04-27 op -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
17 fab3f1f6 2022-04-27 op -- EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
18 fab3f1f6 2022-04-27 op -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
19 fab3f1f6 2022-04-27 op -- IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
20 fab3f1f6 2022-04-27 op -- OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
21 fab3f1f6 2022-04-27 op -- ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
22 fab3f1f6 2022-04-27 op -- OTHER DEALINGS IN THE SOFTWARE.
23 fab3f1f6 2022-04-27 op --
24 fab3f1f6 2022-04-27 op -- For more information, please refer to <http://unlicense.org/>
25 fab3f1f6 2022-04-27 op
26 fab3f1f6 2022-04-27 op module Main where
27 fab3f1f6 2022-04-27 op
28 fab3f1f6 2022-04-27 op import Text.Printf
29 fab3f1f6 2022-04-27 op import System.Environment as E
30 fab3f1f6 2022-04-27 op
31 fab3f1f6 2022-04-27 op data Token = Plus
32 fab3f1f6 2022-04-27 op | Minus
33 fab3f1f6 2022-04-27 op | Lesser
34 fab3f1f6 2022-04-27 op | Greater
35 fab3f1f6 2022-04-27 op | Point
36 fab3f1f6 2022-04-27 op | Comma
37 fab3f1f6 2022-04-27 op | BracketOpen
38 fab3f1f6 2022-04-27 op | BracketClose
39 fab3f1f6 2022-04-27 op deriving (Eq, Show)
40 fab3f1f6 2022-04-27 op
41 fab3f1f6 2022-04-27 op tokenize :: String -> [Token]
42 fab3f1f6 2022-04-27 op tokenize (x:xs) =
43 fab3f1f6 2022-04-27 op let table = [ ('-', Minus), ('+', Plus)
44 fab3f1f6 2022-04-27 op , ('<', Lesser), ('>', Greater)
45 fab3f1f6 2022-04-27 op , ('.', Point), (',', Comma)
46 fab3f1f6 2022-04-27 op , ('[', BracketOpen), (']', BracketClose) ]
47 fab3f1f6 2022-04-27 op token = lookup x table in
48 fab3f1f6 2022-04-27 op case token of
49 fab3f1f6 2022-04-27 op Just x -> x:(tokenize xs)
50 fab3f1f6 2022-04-27 op Nothing -> tokenize xs
51 fab3f1f6 2022-04-27 op tokenize _ = []
52 fab3f1f6 2022-04-27 op
53 fab3f1f6 2022-04-27 op data Expr = Inc
54 fab3f1f6 2022-04-27 op | Dec
55 fab3f1f6 2022-04-27 op | ShiftLeft
56 fab3f1f6 2022-04-27 op | ShiftRight
57 fab3f1f6 2022-04-27 op | Input
58 fab3f1f6 2022-04-27 op | Output
59 fab3f1f6 2022-04-27 op | Loop [Expr]
60 fab3f1f6 2022-04-27 op deriving (Eq, Show)
61 fab3f1f6 2022-04-27 op
62 fab3f1f6 2022-04-27 op type AST = [Expr]
63 fab3f1f6 2022-04-27 op
64 158f51d5 2022-04-28 op pushexpr expr (y:ys) = (expr:y):ys
65 fab3f1f6 2022-04-27 op
66 158f51d5 2022-04-28 op parser :: [Token] -> [AST] -> Either String AST
67 158f51d5 2022-04-28 op parser (x:xs) stack =
68 fab3f1f6 2022-04-27 op case x of
69 158f51d5 2022-04-28 op BracketOpen -> parser xs ([]:stack)
70 fab3f1f6 2022-04-27 op BracketClose -> case stack of
71 1254ecec 2022-04-28 op (y:(z:zs)) -> parser xs $ pushexpr (Loop (reverse y)) (z:zs)
72 1254ecec 2022-04-28 op _ -> Left "unexpected end of loop"
73 158f51d5 2022-04-28 op _ -> parser xs $ pushexpr expr stack
74 158f51d5 2022-04-28 op where expr = case x of
75 158f51d5 2022-04-28 op Plus -> Inc
76 158f51d5 2022-04-28 op Minus -> Dec
77 158f51d5 2022-04-28 op Lesser -> ShiftLeft
78 158f51d5 2022-04-28 op Greater -> ShiftRight
79 158f51d5 2022-04-28 op Point -> Output
80 158f51d5 2022-04-28 op Comma -> Input
81 158f51d5 2022-04-28 op parser _ [x] = return (reverse x)
82 158f51d5 2022-04-28 op parser _ _ = Left "unterminated loop"
83 fab3f1f6 2022-04-27 op
84 158f51d5 2022-04-28 op parse toks = parser toks [[]]
85 fab3f1f6 2022-04-27 op
86 fab3f1f6 2022-04-27 op prologue = "export function w $main() {\n" ++
87 fab3f1f6 2022-04-27 op "@start\n" ++
88 fab3f1f6 2022-04-27 op " %.1 =l alloc8 8\n" ++
89 fab3f1f6 2022-04-27 op " storel $tape, %.1"
90 fab3f1f6 2022-04-27 op epilogue = " ret 0\n" ++
91 fab3f1f6 2022-04-27 op "}\n" ++
92 fab3f1f6 2022-04-27 op "data $tape = align 8 { z 4096 }"
93 fab3f1f6 2022-04-27 op
94 fab3f1f6 2022-04-27 op -- subset of QBE that I need to convert the AST to
95 fab3f1f6 2022-04-27 op data Instruction = StoreW (Int, Int) -- storew a, b
96 fab3f1f6 2022-04-27 op | StoreL (Int, Int) -- storel a, b
97 fab3f1f6 2022-04-27 op | LoadW (Int, Int) -- a =w loadw b
98 fab3f1f6 2022-04-27 op | LoadL (Int, Int) -- a =w loadl b
99 fab3f1f6 2022-04-27 op | AddW (Int, Int, Int) -- a =w add b, c
100 fab3f1f6 2022-04-27 op | AddL (Int, Int, Int) -- a =l add b, c
101 fab3f1f6 2022-04-27 op | SubW (Int, Int, Int) -- a =w sub b, c
102 fab3f1f6 2022-04-27 op | SubL (Int, Int, Int) -- a =l sub b, c
103 fab3f1f6 2022-04-27 op | Call0 (Int, String) -- a =w call $b()
104 fab3f1f6 2022-04-27 op | Call1 (Int, String, Int) -- a =w call $b(w c)
105 fab3f1f6 2022-04-27 op | Jmp (Int) -- jmp a
106 fab3f1f6 2022-04-27 op | Jnz (Int, Int, Int) -- jnz a, @loop.b, @loop.c
107 fab3f1f6 2022-04-27 op | Label (Int) -- @loop.a
108 fab3f1f6 2022-04-27 op deriving (Eq)
109 fab3f1f6 2022-04-27 op
110 fab3f1f6 2022-04-27 op instance Show Instruction where
111 fab3f1f6 2022-04-27 op show x =
112 fab3f1f6 2022-04-27 op case x of
113 fab3f1f6 2022-04-27 op StoreW (a, b) -> printf " storew %%.%d, %%.%d" a b
114 fab3f1f6 2022-04-27 op StoreL (a, b) -> printf " storel %%.%d, %%.%d" a b
115 fab3f1f6 2022-04-27 op LoadW (a, b) -> printf " %%.%d =w loadw %%.%d" a b
116 fab3f1f6 2022-04-27 op LoadL (a, b) -> printf " %%.%d =l loadl %%.%d" a b
117 fab3f1f6 2022-04-27 op AddW (a, b, c) -> printf " %%.%d =w add %%.%d, %d" a b c
118 fab3f1f6 2022-04-27 op AddL (a, b, c) -> printf " %%.%d =l add %%.%d, %d" a b c
119 fab3f1f6 2022-04-27 op SubW (a, b, c) -> printf " %%.%d =w sub %%.%d, %d" a b c
120 fab3f1f6 2022-04-27 op SubL (a, b, c) -> printf " %%.%d =l sub %%.%d, %d" a b c
121 fab3f1f6 2022-04-27 op Call0 (a, fn) -> printf " %%.%d =w call $%s()" a fn
122 fab3f1f6 2022-04-27 op Call1 (a, fn, b) -> printf " %%.%d =w call $%s(w %%.%d)" a fn b
123 fab3f1f6 2022-04-27 op Jmp (a) -> printf " jmp @loop.%d" a
124 fab3f1f6 2022-04-27 op Jnz (a, b, c) -> printf " jnz %%.%d, @loop.%d, @loop.%d" a b c
125 fab3f1f6 2022-04-27 op Label (a) -> printf "@loop.%d" a
126 fab3f1f6 2022-04-27 op
127 fab3f1f6 2022-04-27 op -- I'm keeping the pointer to the current cell in the "%.1"
128 fab3f1f6 2022-04-27 op -- intermediary. It's always there because qbe allows to
129 fab3f1f6 2022-04-27 op -- storel %.X %.1
130 fab3f1f6 2022-04-27 op -- even if it's a SSA.
131 fab3f1f6 2022-04-27 op cell = 1
132 fab3f1f6 2022-04-27 op
133 2b2bebb2 2022-04-28 op compile' :: Int -> Int -> [AST] -> [Int] -> [Instruction]
134 fab3f1f6 2022-04-27 op compile' n h ((x:xs):ys) trail =
135 fab3f1f6 2022-04-27 op case x of
136 fab3f1f6 2022-04-27 op Inc -> LoadL(n+1, cell) :
137 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
138 fab3f1f6 2022-04-27 op AddW(n+3, n+2, 1) :
139 fab3f1f6 2022-04-27 op StoreW(n+3, n+1) :
140 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
141 fab3f1f6 2022-04-27 op Dec -> LoadL(n+1, cell) :
142 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
143 fab3f1f6 2022-04-27 op SubW(n+3, n+2, 1) :
144 fab3f1f6 2022-04-27 op StoreW(n+3, n+1) :
145 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
146 fab3f1f6 2022-04-27 op ShiftLeft -> LoadL(n+1, cell) :
147 fab3f1f6 2022-04-27 op SubL(n+2, n+1, 4) :
148 fab3f1f6 2022-04-27 op StoreL(n+2, cell) :
149 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
150 fab3f1f6 2022-04-27 op ShiftRight -> LoadL(n+1, cell) :
151 fab3f1f6 2022-04-27 op AddL(n+2, n+1, 4) :
152 fab3f1f6 2022-04-27 op StoreL(n+2, cell) :
153 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
154 fab3f1f6 2022-04-27 op Input -> Call0(n+1, "getchar") :
155 fab3f1f6 2022-04-27 op LoadL(n+2, cell) :
156 fab3f1f6 2022-04-27 op StoreW(n+1, n+2) :
157 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
158 fab3f1f6 2022-04-27 op Output -> LoadL(n+1, cell) :
159 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
160 fab3f1f6 2022-04-27 op Call1(n+3, "putchar", n+2) :
161 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
162 fab3f1f6 2022-04-27 op Loop (ast) -> Label(h) :
163 fab3f1f6 2022-04-27 op LoadL(n+1, cell) :
164 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
165 fab3f1f6 2022-04-27 op Jnz(n+2, h+1, h+2) :
166 fab3f1f6 2022-04-27 op Label(h+1) :
167 2b2bebb2 2022-04-28 op compile' (n+3) (h+3) (ast:(xs:ys)) (h:trail)
168 2b2bebb2 2022-04-28 op compile' n h ([]:ys) (t:ts) = Jmp(t) : Label(t+2) : compile' n h ys ts
169 fab3f1f6 2022-04-27 op compile' _ _ _ _ = []
170 fab3f1f6 2022-04-27 op
171 fab3f1f6 2022-04-27 op compile ast = compile' 1 1 [ast] []
172 fab3f1f6 2022-04-27 op
173 fab3f1f6 2022-04-27 op compileProg program = do
174 fab3f1f6 2022-04-27 op let t = parse $ tokenize program in
175 fab3f1f6 2022-04-27 op case t of
176 158f51d5 2022-04-28 op Right ast -> do putStrLn prologue
177 158f51d5 2022-04-28 op mapM_ print (compile ast)
178 158f51d5 2022-04-28 op putStrLn epilogue
179 158f51d5 2022-04-28 op Left err -> error err
180 fab3f1f6 2022-04-27 op
181 fab3f1f6 2022-04-27 op parseArgs [] = getContents
182 fab3f1f6 2022-04-27 op parseArgs path = concat `fmap` mapM readFile path
183 fab3f1f6 2022-04-27 op
184 fab3f1f6 2022-04-27 op main = E.getArgs >>= parseArgs >>= compileProg