1 implementation module gen
7 from StdFunc import id, const
12 import qualified Data.Map as Map
19 import Control.Applicative
21 import Control.Monad.Trans
22 from Text import class Text(concat), instance Text String
27 //Instruction is an instruction, with possible arguments and a possible comment
31 :: Instr = Instr String [Arg] String
34 :: Arg = L Label | Lit Int | Raw String
35 :: SSMProgram :== [Instr]
36 :: GenError = Error String
37 :: GenMap :== 'Map'.Map String LoadPlace
38 //completely change to either Stack, Heap, Register?
39 :: LoadPlace = LDA Int | LDC Int | LDH Int | LDL Int
42 :: Gen a :== RWST Label SSMProgram (GenMap, [Label]) (Either GenError) a
44 labelStream :: [Label]
45 labelStream = ["lbl_" +++ toString i\\i<-[1..]]
47 gen :: AST -> Either String String
48 gen (AST fds) = case evalRWST prog "" ('Map'.newMap, labelStream) of
49 Left (Error e) = Left e
50 Right (_, p) = Right $ toString p
52 prog = tell [Instr "bra" [L "main"] ""] >>| mapM_ g fds
55 // expr = (Op2Expr zero (Op1Expr zero UnMinus (IntExpr zero 4)) BiPlus (IntExpr zero 7))
56 // expr2 = (FunExpr zero "test" [IntExpr zero 4] [])
57 // stmt = (IfStmt (BoolExpr zero True) [] [])
58 // prog = case evalRWST (g stmt) 0 ('Map'.newMap, labelStream) of
59 // Left (Error e) = abort e
60 // Right (_, prog) = toString prog
61 //gen _ = toString [Lab "Test"
62 // ,Instr "ldc" [Lit 1] "Eerste instructie"
63 // ,Instr "ldc" [Lit 2] "Tweede instructie"]
66 //All VarDecls are added as function, how to deal with assignments?
67 // (And when we deal with assignments, how to deal with assignments to higher order functions?)
68 //Dealing with arguments
69 //Dealing with types that do not fit on the Stack
70 // Probably completely change LoadPlace to a Type and a position relative to *something*
71 // And where the type determines if this position is a pointer to the heap or an
74 //helper functions for the gen monad
78 changeGenMap :: (GenMap -> GenMap) -> Gen GenMap
79 changeGenMap f = modify (appFst f) >>| genMap
81 extend :: String LoadPlace GenMap -> GenMap
82 extend k pl g = 'Map'.put k pl g
85 fresh = gets snd >>= \vars->
86 modify (appSnd $ const $ tail vars) >>|
89 class g a :: a -> Gen ()
92 g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. []
93 g (IntExpr _ i) = loadP (LDC i) >>= \instr-> tell [instr]
94 g (CharExpr _ c) = abort "How to deal with chars?"
95 g (BoolExpr _ True) = loadP (LDC TRUE) >>= \instr-> tell [instr]
96 g (BoolExpr _ False) = loadP (LDC FALSE) >>= \instr-> tell [instr]
97 g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| tell [Instr (op2ins op) [] ""]
98 g (Op1Expr _ UnNegation e) = g e >>| tell [Instr "not" [] ""]
99 g (Op1Expr _ UnMinus e) = g e >>| tell [Instr "neg" [] ""]
100 g (EmptyListExpr _) = abort "Shit, empty list expr"
101 g (TupleExpr p (e1,e2)) = abort "How to deal with tuples?"
102 g (FunExpr _ k es fs) =
103 mapM g es >>| //put all arguments on the stack (todo: fix argument handling!)
104 jump "bsr" k >>= \instr->
105 tell [instr] >>| //actually branch to function
106 tell [Instr "ldr" [Raw "RR"] ""] //push return value on stack, todo: check for VOID
108 instance g Stmt where
109 g (IfStmt cond th el) =
110 fresh >>= \elseLabel->
111 fresh >>= \endLabel->
113 tell [Instr "brf" [L elseLabel] "branch else"] >>|
115 tell [Instr "bra" [L endLabel] "branch end if"] >>|
116 tell [Lab elseLabel] >>|
119 g (WhileStmt cond th) =
120 fresh >>= \startLabel->
121 fresh >>= \endLabel ->
122 tell [Lab startLabel] >>|
124 tell [Instr "brf" [L endLabel] "branch end while"] >>|
126 tell [Instr "bra" [L startLabel] "branch start while"] >>|
128 g (AssStmt (VarDef k fs) e) =
130 abort "Shit, an assignment, figure out something with storing vars or something"
131 //vars will be on stack in locals (possible pointers to heap)
132 g (FunStmt _ _) = abort "CodeGen, FunStmt unused" //not used
133 g (ReturnStmt Nothing) = tell [Instr "ret" [] ""] //NOTE! Assumes only return address on stack, safe?
134 g (ReturnStmt (Just e)) =
136 tell [Instr "str" [Raw "RR"] ""] >>|
137 g (ReturnStmt Nothing)
139 instance g VarDecl where
140 g (VarDecl _ Nothing _ _) = liftT (Left $ Error "PANIC: untyped vardecl")
141 g (VarDecl _ (Just t) k e) =
142 (\l->k+++"_"+++l) <$> fresh >>= \lbl->
143 changeGenMap (extend k (FUNC lbl)) >>|
146 tell [Instr "str" [Raw "RR"] ""] >>|
147 tell [Instr "ret" [] ""]
150 instance g FunDecl where
151 g (FunDecl _ k _ _ vds stms) =
152 //varDecls can call the enclosing function, so first reserve a label for it
153 (\l-> if (k=="main") "main" (l+++"_"+++k)) <$> fresh >>= \lbl->
154 changeGenMap (extend k (FUNC lbl)) >>|
155 //then generate functions for the VarDecls
156 genMap >>= \oldMap ->
158 //then the main function
161 changeGenMap (const oldMap) >>| pure ()
163 op2ins :: Op2 -> String
164 op2ins op = case op of
178 BiCons = abort "Shit, Cons, how to deal with this?"
180 load :: String -> Gen Instr
181 load k = genMap >>= \g-> case 'Map'.member k g of
182 False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
183 True = loadP $ 'Map'.find k g
185 loadP :: LoadPlace -> Gen Instr
186 loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] ""
188 dec (LDA i) = pure ("lda", Lit i)
189 dec (LDC i) = pure ("ldc", Lit i)
190 dec (LDH i) = pure ("ldh", Lit i)
191 dec (LDL i) = pure ("ldl", Lit i)
192 dec (LDR i) = pure ("ldr", Lit i)
193 dec (LDS i) = pure ("lds", Lit i)
194 dec _ = liftT (Left $ Error "PANIC: trying to load non adres")
196 //Instruction (String), key of function to jump to
197 jump :: String String -> Gen Instr
198 jump instr k = genMap >>= \g-> case 'Map'.member k g of
199 False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"])
200 True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] (k +++"()")
202 dec (FUNC l) = pure (L l)
203 dec _ = liftT (Left $ Error "PANIC: trying to jump to non label")
205 class print a :: a -> [String]
207 instance print Instr where
208 print (Lab l) = [l, ":", "\n"]
209 print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]
211 instance print [Arg] where
212 print args = (map toString args)
214 instance toString Arg where
216 toString (Lit int) = toString int
219 instance toString SSMProgram where
220 toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p