From: Mart Lubbers Date: Thu, 19 May 2016 13:07:17 +0000 (+0200) Subject: Vardecl ftw` X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=a961d52fe0e9269af7d5581e07155f6701c09dbc;p=cc1516.git Vardecl ftw` --- diff --git a/examples/codeGen.spl b/examples/codeGen.spl index 658ea6e..53ed358 100644 --- a/examples/codeGen.spl +++ b/examples/codeGen.spl @@ -1,7 +1,8 @@ -f() { - return 2; -} main() { - var x = 3; - return 1 + 2 + x + f(); + Int x1 = 3; + Char x2 = '\n'; + Bool x3 = True; + (Int, Char) x4 = (4, '\n'); + [Bool] x5 = True : False : True : True : []; + return x5; } diff --git a/gen.icl b/gen.icl index a37fedf..4bf1bb8 100644 --- a/gen.icl +++ b/gen.icl @@ -32,18 +32,15 @@ FALSE :== 0 :: Arg = L Label | Lit Int | Raw String :: SSMProgram :== [Instr] :: GenError = Error String -:: GenMap :== 'Map'.Map String LoadPlace -//completely change to either Stack, Heap, Register? -:: LoadPlace = LDA Int | LDC Int | LDH Int | LDL Int - | LDR Int | LDS Int - | FUNC Label -:: Gen a :== RWST Label SSMProgram (GenMap, [Label]) (Either GenError) a +:: Addressbook :== 'Map'.Map String Address +:: Address = LAB String | ADDR Int +:: Gen a :== RWST () SSMProgram (Addressbook, [Label]) (Either GenError) a labelStream :: [Label] labelStream = ["lbl_" +++ toString i\\i<-[1..]] gen :: AST -> Either String String -gen (AST fds) = case evalRWST prog "" ('Map'.newMap, labelStream) of +gen (AST fds) = case evalRWST prog () ('Map'.newMap, labelStream) of Left (Error e) = Left e Right (_, p) = Right $ toString p where @@ -59,13 +56,13 @@ gen (AST fds) = case evalRWST prog "" ('Map'.newMap, labelStream) of // unboxed value //helper functions for the gen monad -genMap :: Gen GenMap -genMap = gets fst +getAdressbook :: Gen Addressbook +getAdressbook = gets fst -changeGenMap :: (GenMap -> GenMap) -> Gen GenMap -changeGenMap f = modify (appFst f) >>| genMap +updateAdressbook :: (Addressbook -> Addressbook) -> Gen Addressbook +updateAdressbook f = modify (appFst f) >>| getAdressbook -extend :: String LoadPlace GenMap -> GenMap +extend :: String Address Addressbook -> Addressbook extend k pl g = 'Map'.put k pl g fresh :: Gen Label @@ -74,120 +71,132 @@ fresh = gets snd >>= \vars-> pure (head vars) class g a :: a -> Gen () +// +instance g Op1 where + g UnNegation = tell [Instr "not" [] ""] + g UnMinus = tell [Instr "neg" [] ""] + +instance g Op2 where + g o = tell [Instr s [] ""] + where + s = case o of + BiPlus = "add" + BiMinus = "sub" + BiTimes = "mul" + BiDivide = "div" + BiMod = "mod" + BiEquals = "eq" + BiLesser = "lt" + BiGreater = "gt" + BiLesserEq = "le" + BiGreaterEq = "ge" + BiUnEqual = "ne" + BiAnd = "and" + BiOr = "or" + BiCons = abort "Shit, Cons, how to deal with this?" instance g Expr where - g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. [] - g (IntExpr _ i) = loadP (LDC i) >>= \instr-> tell [instr] - g (CharExpr _ c) = abort "How to deal with chars?" - g (BoolExpr _ True) = loadP (LDC TRUE) >>= \instr-> tell [instr] - g (BoolExpr _ False) = loadP (LDC FALSE) >>= \instr-> tell [instr] - g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| tell [Instr (op2ins op) [] ""] - g (Op1Expr _ UnNegation e) = g e >>| tell [Instr "not" [] ""] - g (Op1Expr _ UnMinus e) = g e >>| tell [Instr "neg" [] ""] - g (EmptyListExpr _) = abort "Shit, empty list expr" - g (TupleExpr p (e1,e2)) = abort "How to deal with tuples?" - g (FunExpr _ k es fs) = - mapM g es >>| //put all arguments on the stack (todo: fix argument handling!) - jump "bsr" k >>= \instr-> - tell [instr] >>| //actually branch to function - tell [Instr "ldr" [Raw "RR"] ""] //push return value on stack, todo: check for VOID - -instance g Stmt where - g (IfStmt cond th el) = - fresh >>= \elseLabel-> - fresh >>= \endLabel-> - g cond >>| - tell [Instr "brf" [L elseLabel] "branch else"] >>| - mapM_ g th >>| - tell [Instr "bra" [L endLabel] "branch end if"] >>| - tell [Lab elseLabel] >>| - mapM_ g el >>| - tell [Lab endLabel] - g (WhileStmt cond th) = - fresh >>= \startLabel-> - fresh >>= \endLabel -> - tell [Lab startLabel] >>| - g cond >>| - tell [Instr "brf" [L endLabel] "branch end while"] >>| - mapM_ g th >>| - tell [Instr "bra" [L startLabel] "branch start while"] >>| - tell [Lab endLabel] - g (AssStmt (VarDef k fs) e) = - g e >>| - abort "Shit, an assignment, figure out something with storing vars or something" - //vars will be on stack in locals (possible pointers to heap) - g (FunStmt _ _) = abort "CodeGen, FunStmt unused" //not used - g (ReturnStmt Nothing) = tell [Instr "ret" [] ""] //NOTE! Assumes only return address on stack, safe? - g (ReturnStmt (Just e)) = - g e >>| - tell [Instr "str" [Raw "RR"] ""] >>| - g (ReturnStmt Nothing) +// g (VarExpr _ (VarDef k fs)) = load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. [] + g (IntExpr _ i) = tell [Instr "ldc" [Lit i] ""] + g (CharExpr _ c) = tell [Instr "ldc" [Lit (toInt c)] ""] + g (BoolExpr _ b) = tell [Instr "ldc" [Lit (if b TRUE FALSE)] ""] + g (EmptyListExpr _) = tell [Instr "ldc" [Lit 0] ""] + >>| tell [Instr "sth" [] ""] + g (Op1Expr _ o e) = g e >>| g o + g (Op2Expr _ e1 BiCons e2) = g e2 >>| g e1 + >>| tell [Instr "sth" [] ""] + >>| tell [Instr "ajs" [Lit -1] ""] + >>| tell [Instr "sth" [] ""] + g (Op2Expr _ e1 op e2) = g e1 >>| g e2 >>| g op + g (TupleExpr _ (e1,e2)) = g e1 + >>| tell [Instr "sth" [] ""] + >>| g e2 + >>| tell [Instr "sth" [] ""] + >>| tell [Instr "ajs" [Lit -1] ""] + g _ = abort "hoi" + g (FunExpr _ k es fs) = abort "FunExpr unsupported modderfokker" + // mapM g es >>| //put all arguments on the stack (todo: fix argument handling!) + // jump "bsr" k >>= \instr-> + // tell [instr] >>| //actually branch to function + // tell [Instr "ldr" [Raw "RR"] ""] //push return value on stack, todo: check for VOID +// +//instance g Stmt where +// g (IfStmt cond th el) = +// fresh >>= \elseLabel-> +// fresh >>= \endLabel-> +// g cond >>| +// tell [Instr "brf" [L elseLabel] "branch else"] >>| +// mapM_ g th >>| +// tell [Instr "bra" [L endLabel] "branch end if"] >>| +// tell [Lab elseLabel] >>| +// mapM_ g el >>| +// tell [Lab endLabel] +// g (WhileStmt cond th) = +// fresh >>= \startLabel-> +// fresh >>= \endLabel -> +// tell [Lab startLabel] >>| +// g cond >>| +// tell [Instr "brf" [L endLabel] "branch end while"] >>| +// mapM_ g th >>| +// tell [Instr "bra" [L startLabel] "branch start while"] >>| +// tell [Lab endLabel] +// g (AssStmt (VarDef k fs) e) = +// g e >>| +// abort "Shit, an assignment, figure out something with storing vars or something" +// //vars will be on stack in locals (possible pointers to heap) +// g (FunStmt _ _) = abort "CodeGen, FunStmt unused" //not used +// g (ReturnStmt Nothing) = tell [Instr "ret" [] ""] //NOTE! Assumes only return address on stack, safe? +// g (ReturnStmt (Just e)) = +// g e >>| +// tell [Instr "str" [Raw "RR"] ""] >>| +// g (ReturnStmt Nothing) instance g VarDecl where g (VarDecl _ Nothing _ _) = liftT (Left $ Error "PANIC: untyped vardecl") - g (VarDecl _ (Just t) k e) = - (\l->k+++"_"+++l) <$> fresh >>= \lbl-> - changeGenMap (extend k (FUNC lbl)) >>| - tell [Lab lbl] >>| - g e >>| - tell [Instr "str" [Raw "RR"] ""] >>| - tell [Instr "ret" [] ""] - + g (VarDecl _ (Just t) k e) = g e +// TupleType (t1, t2) = g e +// ListType t = abort "listtype" +// IdType _ = liftT (Left $ Error "PANIC: unresolved typevariable") +// t1 ->> t2 = abort "funtype" +// VoidType = liftT (Left $ Error "PANIC: Void vardecl") +// _ = g e instance g FunDecl where g (FunDecl _ k _ _ vds stms) = //varDecls can call the enclosing function, so first reserve a label for it - (\l-> if (k=="main") "main" (l+++"_"+++k)) <$> fresh >>= \lbl-> - changeGenMap (extend k (FUNC lbl)) >>| + updateAdressbook (extend k (LAB k)) >>| + tell [Lab k] >>| //then generate functions for the VarDecls - genMap >>= \oldMap -> + getAdressbook >>= \oldMap -> mapM_ g vds >>| //then the main function - tell [Lab lbl] >>| - mapM_ g stms >>| - changeGenMap (const oldMap) >>| pure () - -op2ins :: Op2 -> String -op2ins op = case op of - BiPlus = "add" - BiMinus = "sub" - BiTimes = "mul" - BiDivide = "div" - BiMod = "mod" - BiEquals = "eq" - BiLesser = "lt" - BiGreater = "gt" - BiLesserEq = "le" - BiGreaterEq = "ge" - BiUnEqual = "ne" - BiAnd = "and" - BiOr = "or" - BiCons = abort "Shit, Cons, how to deal with this?" - -load :: String -> Gen Instr -load k = genMap >>= \g-> case 'Map'.member k g of - False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"]) - True = loadP $ 'Map'.find k g - -loadP :: LoadPlace -> Gen Instr -loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] "" -where - dec (LDA i) = pure ("lda", Lit i) - dec (LDC i) = pure ("ldc", Lit i) - dec (LDH i) = pure ("ldh", Lit i) - dec (LDL i) = pure ("ldl", Lit i) - dec (LDR i) = pure ("ldr", Lit i) - dec (LDS i) = pure ("lds", Lit i) - dec _ = liftT (Left $ Error "PANIC: trying to load non adres") - -//Instruction (String), key of function to jump to -jump :: String String -> Gen Instr -jump instr k = genMap >>= \g-> case 'Map'.member k g of - False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"]) - True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] (k +++"()") -where - dec (FUNC l) = pure (L l) - dec _ = liftT (Left $ Error "PANIC: trying to jump to non label") +// mapM_ g stms >>| + updateAdressbook (const oldMap) >>| pure () +// +//load :: String -> Gen Instr +//load k = genMap >>= \g-> case 'Map'.member k g of +// False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found in variable mapping"]) +// True = loadP $ 'Map'.find k g +// +//loadP :: LoadPlace -> Gen Instr +//loadP pl = dec pl >>= \(instr, arg)-> pure $ Instr instr [arg] "" +//where +// dec (LDA i) = pure ("lda", Lit i) +// dec (LDC i) = pure ("ldc", Lit i) +// dec (LDH i) = pure ("ldh", Lit i) +// dec (LDL i) = pure ("ldl", Lit i) +// dec (LDR i) = pure ("ldr", Lit i) +// dec (LDS i) = pure ("lds", Lit i) +// dec _ = liftT (Left $ Error "PANIC: trying to load non adres") +// +////Instruction (String), key of function to jump to +//jump :: String String -> Gen Instr +//jump instr k = genMap >>= \g-> case 'Map'.member k g of +// False = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"]) +// True = dec ('Map'.find k g) >>= \lbl-> pure $ Instr instr [lbl] (k +++"()") +//where +// dec (FUNC l) = pure (L l) +// dec _ = liftT (Left $ Error "PANIC: trying to jump to non label") class print a :: a -> [String]