X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=gen.icl;h=7ad917653ffa777479976215c029f43445e2be56;hb=a5c9b65860f9af03a7c999f7abd6ab5f12f63523;hp=a37fedf060fc18e27eabf4bf4617e20c4ec8143d;hpb=d5239ed85ef46f3ada3857103dd63a1853da918c;p=cc1516.git diff --git a/gen.icl b/gen.icl index a37fedf..7ad9176 100644 --- a/gen.icl +++ b/gen.icl @@ -32,22 +32,22 @@ 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 - prog = tell [Instr "bra" [L "main"] ""] >>| mapM_ g fds + prog = tell [ + Instr "bsr" [L "main"] "", + Instr "halt" [] "" + ] >>| mapM_ g fds //Current issues: //All VarDecls are added as function, how to deal with assignments? @@ -59,13 +59,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 @@ -75,119 +75,115 @@ fresh = gets snd >>= \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 (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 (VarExpr _ (VarDef k fs)) = getAdressbook >>= \ab->case 'Map'.get k ab of + Nothing = liftT (Left $ Error "PANIC: undefined variable") + Just (ADDR t) = tell [Instr "ldl" [Lit t] ""] + Just (LAB t) = liftT (Left $ Error "PANIC: variable and function name clash") + //load k >>= \instr-> tell [instr] //note: pure is pure for list, i.e. [] 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 +// tell [Instr "ldr" [Raw "MP"] ("old frame pointer")] + mapM g es + >>| jump "bsr" k + >>| tell [Instr "ldr" [Raw "RR"] ""] -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" [] ""] +jump :: String String -> Gen () +jump instr k = getAdressbook >>= \ab->case 'Map'.get k ab of + Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as function"]) + Just (LAB t) = tell [Instr instr [L t] (k +++"()")] + Just (ADDR t) = liftT (Left $ Error $ "PANIC: jump should go to label") +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 "unlink" [] ""] + >>| tell [Instr "ret" [] ""] + g (ReturnStmt (Just e)) = g e + >>| tell [Instr "str" [Raw "RR"] ""] + >>| g (ReturnStmt Nothing) + +foldVarDecl :: Int VarDecl -> Gen Int +foldVarDecl x (VarDecl _ _ k e) = g e + >>| updateAdressbook (extend k (ADDR x)) >>| pure (x + 1) + +addVars :: [String] -> (Addressbook -> Addressbook) +addVars [] = id +addVars [x:xs] = \ab->extend x (ADDR (-2 - (length xs))) (addVars xs ab) instance g FunDecl where - g (FunDecl _ k _ _ vds stms) = + g (FunDecl _ k args _ 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)) >>| + getAdressbook >>= \oldMap -> + updateAdressbook (addVars args) >>| + tell [Lab k] >>| + tell [Instr "link" [Lit 0] ""] >>| //then generate functions for the VarDecls - genMap >>= \oldMap -> - mapM_ g vds >>| + foldM foldVarDecl 1 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") + updateAdressbook (const oldMap) >>| pure () class print a :: a -> [String]