1 implementation module gen
12 import qualified Data.Map as Map
18 import Control.Applicative
20 import Control.Monad.Trans
21 from Text import class Text(concat), instance Text String
26 //Instruction is an instruction, with possible arguments and a possible comment
30 :: Instr = Instr String [Arg] String
33 :: Arg = L Label | Lit Int
34 :: SSMProgram :== [Instr]
38 gen _ = toString [Lab "Test"
39 ,Instr "ldc" [Lit 1] "Eerste instructie"
40 ,Instr "ldc" [Lit 2] "Tweede instructie"]
43 //Scrap this, we'll need shared state when generating
44 //i.e. to figure out the positions of vars relative to the
45 //SP/MP/whatever or in which register they are
46 //and to supply with fresh labels
48 //The generation monad
49 :: GenError = Error String
50 :: GenMap :== 'Map'.Map String LoadPlace
51 :: LoadPlace = LDA Int | LDC Int | LDH Int | LDL Int
54 :: Gen a :== RWST [Int] SSMProgram (GenMap, [Label]) (Either GenError) a
59 class g a :: a -> Gen ()
62 g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. []
63 g (IntExpr _ i) = loadP (LDC i) >>= \instr-> tell [instr]
64 g (CharExpr _ c) = undef //how to deal with strings?
65 g (BoolExpr _ True) = loadP (LDC TRUE) >>= \instr-> tell [instr]
66 g (BoolExpr _ False) = loadP (LDC FALSE) >>= \instr-> tell [instr]
67 g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| tell [Instr (op2ins op) [] ""]
68 g (Op1Expr _ UnNegation e) = g e >>| tell [Instr "not" [] ""]
69 g (Op1Expr _ UnMinus e) = g e >>| tell [Instr "neg" [] ""]
70 g (EmptyListExpr _) = abort "Shit, empty list expr"
71 g (TupleExpr p (e1,e2)) = abort "How to deal with tuples?"
72 g (FunExpr _ k es fs) = mapM g es >>| jump "bra" k >>= \instr-> tell [instr]
74 op2ins :: Op2 -> String
75 op2ins op = case op of
89 BiCons = abort "Shit, Cons, how to deal with this?"
91 load :: String -> Gen Instr
92 load k = genMap >>= \g-> case 'Map'.member k g of
93 False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"])
94 True = loadP $ 'Map'.find k g
96 loadP :: LoadPlace -> Gen Instr
97 loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] ""
99 dec (LDA i) = pure ("lda", Lit i)
100 dec (LDC i) = pure ("ldc", Lit i)
101 dec (LDH i) = pure ("ldh", Lit i)
102 dec (LDL i) = pure ("ldl", Lit i)
103 dec (LDR i) = pure ("ldr", Lit i)
104 dec (LDS i) = pure ("lds", Lit i)
105 dec _ = liftT (Left $ Error "PANIC: trying to load non adres")
107 //Instruction (String), key of function to jump to
108 jump :: String String -> Gen Instr
109 jump instr k = genMap >>= \g-> case 'Map'.member k g of
110 False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"])
111 True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] k
113 dec (FUNC l) = pure (L l)
114 dec _ = liftT (Left $ Error "PANIC: trying to jump to non label")
116 class print a :: a -> [String]
118 instance print Instr where
119 print (Lab l) = [l, ":", "\n"]
120 print (Instr i args com) = ["\t", i] ++ print args ++ [" ;", com, "\n"]
122 instance print [Arg] where
123 print args = (map toString args)
125 instance toString Arg where
127 toString (Lit int) = toString int
129 instance toString SSMProgram where
130 toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p