1 fab3f1f6 2022-04-27 op -- This is free and unencumbered software released into the public domain.
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
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.
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.
24 fab3f1f6 2022-04-27 op -- For more information, please refer to <http://unlicense.org/>
26 fab3f1f6 2022-04-27 op module Main where
28 fab3f1f6 2022-04-27 op import Text.Printf
29 fab3f1f6 2022-04-27 op import System.Environment as E
31 fab3f1f6 2022-04-27 op data Token = Plus
38 fab3f1f6 2022-04-27 op | BracketClose
39 fab3f1f6 2022-04-27 op deriving (Eq, Show)
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
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 _ = []
53 fab3f1f6 2022-04-27 op data Expr = Inc
60 fab3f1f6 2022-04-27 op deriving (Eq, Show)
62 fab3f1f6 2022-04-27 op type AST = [Expr]
64 fab3f1f6 2022-04-27 op data State = State ([AST], [Token]) deriving (Show)
66 fab3f1f6 2022-04-27 op initialState tokens = State ([[]], tokens)
68 fab3f1f6 2022-04-27 op finalize (State ([x], _)) = Just x
69 fab3f1f6 2022-04-27 op finalize _ = Nothing
71 fab3f1f6 2022-04-27 op simplexpr :: Expr -> [AST] -> [Token] -> State
72 fab3f1f6 2022-04-27 op simplexpr e (x:xs) tokens = State ((x ++ [e]):xs, tokens)
74 fab3f1f6 2022-04-27 op translate :: Token -> Expr
75 fab3f1f6 2022-04-27 op translate x = case x of
78 fab3f1f6 2022-04-27 op Lesser -> ShiftLeft
79 fab3f1f6 2022-04-27 op Greater -> ShiftRight
80 fab3f1f6 2022-04-27 op Point -> Output
81 fab3f1f6 2022-04-27 op Comma -> Input
83 fab3f1f6 2022-04-27 op parser :: State -> Maybe State
84 fab3f1f6 2022-04-27 op parser (State (stack, (x:xs))) =
86 fab3f1f6 2022-04-27 op BracketOpen -> parser $ State ([]:stack, xs)
87 fab3f1f6 2022-04-27 op BracketClose -> case stack of
88 fab3f1f6 2022-04-27 op (y:ys) -> parser $ simplexpr (Loop y) (ys) xs
90 fab3f1f6 2022-04-27 op _ -> parser $ simplexpr (translate x) stack xs
91 fab3f1f6 2022-04-27 op parser state = Just state
93 fab3f1f6 2022-04-27 op parse :: [Token] -> Maybe AST
94 fab3f1f6 2022-04-27 op parse tokens = parser (initialState tokens) >>= finalize
96 fab3f1f6 2022-04-27 op prologue = "export function w $main() {\n" ++
98 fab3f1f6 2022-04-27 op " %.1 =l alloc8 8\n" ++
99 fab3f1f6 2022-04-27 op " storel $tape, %.1"
100 fab3f1f6 2022-04-27 op epilogue = " ret 0\n" ++
102 fab3f1f6 2022-04-27 op "data $tape = align 8 { z 4096 }"
104 fab3f1f6 2022-04-27 op -- subset of QBE that I need to convert the AST to
105 fab3f1f6 2022-04-27 op data Instruction = StoreW (Int, Int) -- storew a, b
106 fab3f1f6 2022-04-27 op | StoreL (Int, Int) -- storel a, b
107 fab3f1f6 2022-04-27 op | LoadW (Int, Int) -- a =w loadw b
108 fab3f1f6 2022-04-27 op | LoadL (Int, Int) -- a =w loadl b
109 fab3f1f6 2022-04-27 op | AddW (Int, Int, Int) -- a =w add b, c
110 fab3f1f6 2022-04-27 op | AddL (Int, Int, Int) -- a =l add b, c
111 fab3f1f6 2022-04-27 op | SubW (Int, Int, Int) -- a =w sub b, c
112 fab3f1f6 2022-04-27 op | SubL (Int, Int, Int) -- a =l sub b, c
113 fab3f1f6 2022-04-27 op | Call0 (Int, String) -- a =w call $b()
114 fab3f1f6 2022-04-27 op | Call1 (Int, String, Int) -- a =w call $b(w c)
115 fab3f1f6 2022-04-27 op | Jmp (Int) -- jmp a
116 fab3f1f6 2022-04-27 op | Jnz (Int, Int, Int) -- jnz a, @loop.b, @loop.c
117 fab3f1f6 2022-04-27 op | Label (Int) -- @loop.a
118 fab3f1f6 2022-04-27 op deriving (Eq)
120 fab3f1f6 2022-04-27 op instance Show Instruction where
123 fab3f1f6 2022-04-27 op StoreW (a, b) -> printf " storew %%.%d, %%.%d" a b
124 fab3f1f6 2022-04-27 op StoreL (a, b) -> printf " storel %%.%d, %%.%d" a b
125 fab3f1f6 2022-04-27 op LoadW (a, b) -> printf " %%.%d =w loadw %%.%d" a b
126 fab3f1f6 2022-04-27 op LoadL (a, b) -> printf " %%.%d =l loadl %%.%d" a b
127 fab3f1f6 2022-04-27 op AddW (a, b, c) -> printf " %%.%d =w add %%.%d, %d" a b c
128 fab3f1f6 2022-04-27 op AddL (a, b, c) -> printf " %%.%d =l add %%.%d, %d" a b c
129 fab3f1f6 2022-04-27 op SubW (a, b, c) -> printf " %%.%d =w sub %%.%d, %d" a b c
130 fab3f1f6 2022-04-27 op SubL (a, b, c) -> printf " %%.%d =l sub %%.%d, %d" a b c
131 fab3f1f6 2022-04-27 op Call0 (a, fn) -> printf " %%.%d =w call $%s()" a fn
132 fab3f1f6 2022-04-27 op Call1 (a, fn, b) -> printf " %%.%d =w call $%s(w %%.%d)" a fn b
133 fab3f1f6 2022-04-27 op Jmp (a) -> printf " jmp @loop.%d" a
134 fab3f1f6 2022-04-27 op Jnz (a, b, c) -> printf " jnz %%.%d, @loop.%d, @loop.%d" a b c
135 fab3f1f6 2022-04-27 op Label (a) -> printf "@loop.%d" a
137 fab3f1f6 2022-04-27 op -- I'm keeping the pointer to the current cell in the "%.1"
138 fab3f1f6 2022-04-27 op -- intermediary. It's always there because qbe allows to
139 fab3f1f6 2022-04-27 op -- storel %.X %.1
140 fab3f1f6 2022-04-27 op -- even if it's a SSA.
143 fab3f1f6 2022-04-27 op compile' :: Int -> Int -> [AST] -> [[Instruction]] -> [Instruction]
144 fab3f1f6 2022-04-27 op compile' n h ((x:xs):ys) trail =
146 fab3f1f6 2022-04-27 op Inc -> LoadL(n+1, cell) :
147 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
148 fab3f1f6 2022-04-27 op AddW(n+3, n+2, 1) :
149 fab3f1f6 2022-04-27 op StoreW(n+3, n+1) :
150 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
151 fab3f1f6 2022-04-27 op Dec -> LoadL(n+1, cell) :
152 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
153 fab3f1f6 2022-04-27 op SubW(n+3, n+2, 1) :
154 fab3f1f6 2022-04-27 op StoreW(n+3, n+1) :
155 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
156 fab3f1f6 2022-04-27 op ShiftLeft -> LoadL(n+1, cell) :
157 fab3f1f6 2022-04-27 op SubL(n+2, n+1, 4) :
158 fab3f1f6 2022-04-27 op StoreL(n+2, cell) :
159 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
160 fab3f1f6 2022-04-27 op ShiftRight -> LoadL(n+1, cell) :
161 fab3f1f6 2022-04-27 op AddL(n+2, n+1, 4) :
162 fab3f1f6 2022-04-27 op StoreL(n+2, cell) :
163 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
164 fab3f1f6 2022-04-27 op Input -> Call0(n+1, "getchar") :
165 fab3f1f6 2022-04-27 op LoadL(n+2, cell) :
166 fab3f1f6 2022-04-27 op StoreW(n+1, n+2) :
167 fab3f1f6 2022-04-27 op compile' (n+2) h (xs:ys) trail
168 fab3f1f6 2022-04-27 op Output -> LoadL(n+1, cell) :
169 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
170 fab3f1f6 2022-04-27 op Call1(n+3, "putchar", n+2) :
171 fab3f1f6 2022-04-27 op compile' (n+3) h (xs:ys) trail
172 fab3f1f6 2022-04-27 op Loop (ast) -> Label(h) :
173 fab3f1f6 2022-04-27 op LoadL(n+1, cell) :
174 fab3f1f6 2022-04-27 op LoadW(n+2, n+1) :
175 fab3f1f6 2022-04-27 op Jnz(n+2, h+1, h+2) :
177 fab3f1f6 2022-04-27 op compile' (n+3) (h+3) (ast:(xs:ys)) ([Jmp(h), Label(h+2)]:trail)
178 fab3f1f6 2022-04-27 op compile' n h ([]:ys) (t:ts) = t ++ (compile' n h ys ts)
179 fab3f1f6 2022-04-27 op compile' _ _ _ _ = []
181 fab3f1f6 2022-04-27 op compile ast = compile' 1 1 [ast] []
183 fab3f1f6 2022-04-27 op compileProg program = do
184 fab3f1f6 2022-04-27 op let t = parse $ tokenize program in
186 fab3f1f6 2022-04-27 op Just ast -> do putStrLn prologue
187 fab3f1f6 2022-04-27 op mapM_ print (compile ast)
188 fab3f1f6 2022-04-27 op putStrLn epilogue
189 fab3f1f6 2022-04-27 op Nothing -> error "Compilation failed"
191 fab3f1f6 2022-04-27 op parseArgs [] = getContents
192 fab3f1f6 2022-04-27 op parseArgs path = concat `fmap` mapM readFile path
194 fab3f1f6 2022-04-27 op main = E.getArgs >>= parseArgs >>= compileProg
