X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=gen.icl;h=a37fedf060fc18e27eabf4bf4617e20c4ec8143d;hb=d5239ed85ef46f3ada3857103dd63a1853da918c;hp=be2c3ce839adfe58a2b7b68e8024879fcd1eafd6;hpb=6f22285a7309dce751de352f92632ce2b40742ae;p=cc1516.git diff --git a/gen.icl b/gen.icl index be2c3ce..a37fedf 100644 --- a/gen.icl +++ b/gen.icl @@ -1,14 +1,12 @@ implementation module gen - import StdMisc import StdList import StdOverloaded import StdString -from StdFunc import id +from StdFunc import id, const import StdTuple import StdEnum -from StdEnv import const import Data.Func import qualified Data.Map as Map @@ -26,8 +24,6 @@ from Text import class Text(concat), instance Text String import AST import RWST -//Instruction is an instruction, with possible arguments and a possible comment -//Or is a label TRUE :== -1 FALSE :== 0 :: Instr = Instr String [Arg] String @@ -44,26 +40,34 @@ FALSE :== 0 :: Gen a :== RWST Label SSMProgram (GenMap, [Label]) (Either GenError) a labelStream :: [Label] -labelStream = map (\i-> concat ["lab_", toString i]) [1..] +labelStream = ["lbl_" +++ toString i\\i<-[1..]] -gen :: AST -> String -gen _ = prog +gen :: AST -> Either String String +gen (AST fds) = case evalRWST prog "" ('Map'.newMap, labelStream) of + Left (Error e) = Left e + Right (_, p) = Right $ toString p where - expr = (Op2Expr zero (Op1Expr zero UnMinus (IntExpr zero 4)) BiPlus (IntExpr zero 7)) - expr2 = (FunExpr zero "test" [IntExpr zero 4] []) - stmt = (IfStmt (BoolExpr zero True) [] []) - prog = case evalRWST (g stmt) "end" ('Map'.newMap, labelStream) of - Left (Error e) = abort e - Right (_, prog) = toString prog -//gen _ = toString [Lab "Test" -// ,Instr "ldc" [Lit 1] "Eerste instructie" -// ,Instr "ldc" [Lit 2] "Tweede instructie"] + prog = tell [Instr "bra" [L "main"] ""] >>| mapM_ g fds +//Current issues: +//All VarDecls are added as function, how to deal with assignments? +// (And when we deal with assignments, how to deal with assignments to higher order functions?) +//Dealing with arguments +//Dealing with types that do not fit on the Stack +// Probably completely change LoadPlace to a Type and a position relative to *something* +// And where the type determines if this position is a pointer to the heap or an +// unboxed value //helper functions for the gen monad genMap :: Gen GenMap genMap = gets fst +changeGenMap :: (GenMap -> GenMap) -> Gen GenMap +changeGenMap f = modify (appFst f) >>| genMap + +extend :: String LoadPlace GenMap -> GenMap +extend k pl g = 'Map'.put k pl g + fresh :: Gen Label fresh = gets snd >>= \vars-> modify (appSnd $ const $ tail vars) >>| @@ -74,7 +78,7 @@ class g a :: a -> Gen () 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) = undef //how to deal with strings? + 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) [] ""] @@ -82,8 +86,11 @@ instance g Expr where 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 >>| jump "bsr" k >>= \instr-> tell [instr] - //bra is probably not right, figure out function call way + 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) = @@ -108,14 +115,37 @@ instance g Stmt where g (AssStmt (VarDef k fs) e) = g e >>| abort "Shit, an assignment, figure out something with storing vars or something" - g (FunStmt _ _) = abort "CodeGen FunStmt unused" //not used - g (ReturnStmt Nothing) = tell [Instr "ret" [] ""] + //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" [] ""] + + +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)) >>| + //then generate functions for the VarDecls + genMap >>= \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 @@ -154,7 +184,7 @@ where 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 + 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") @@ -171,6 +201,7 @@ instance print [Arg] where instance toString Arg where toString (L l) = l toString (Lit int) = toString int + toString (Raw s) = s instance toString SSMProgram where - toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p \ No newline at end of file + toString p = concat $ intersperse " " $ map (\i-> concat $ intersperse " " $ print i) p