From: Mart Lubbers Date: Tue, 24 May 2016 12:59:33 +0000 (+0200) Subject: opslaan van higher order functions aangepast X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=2209f8174cc3316a42bd9c31241e98146441f997;p=cc1516.git opslaan van higher order functions aangepast --- diff --git a/examples/high.spl b/examples/high.spl index af750ab..233dc4c 100644 --- a/examples/high.spl +++ b/examples/high.spl @@ -1,9 +1,10 @@ -plus(x, y) { - return x + y; +plus(x, y, z) { + return x + y + z; } main (){ -// var c = plus; -// var d = plus(1); - return 5; + var a = plus(); + var b = plus(1); + var c = plus(1, 2); +// d(3, 4); } diff --git a/gen.icl b/gen.icl index ae1c829..f464013 100644 --- a/gen.icl +++ b/gen.icl @@ -64,21 +64,19 @@ gen (AST fds) = case evalRWST prog () (defaultAddressBook fds, labelStream) of programContext :: [FunDecl] -> SSMProgram programContext x = [Lab "1func" - ,Instr "link" [Lit 0] "" :fS ["1printint" ,"1printchar" ,"read" ,"1readint" - ,"isEmpty":map (\(FunDecl _ k _ _ _ _)->k) x] 0] ++ - [Instr "unlink" [] "" - ,Instr "ret" [] "":context] + ,"isEmpty":map (\(FunDecl _ k _ _ _ _)->k) x] 0] ++ context where fS :: [String] Int -> SSMProgram fS [] _ = [] fS [k:xs] n = [ - Instr "ldl" [Lit -2] "" + Instr "lds" [Lit 0] "" ,Instr "ldc" [Lit n] $ "branch to: " +++ k ,Instr "eq" [] "" - ,Instr "brt" [L k] "" + ,Instr "ajs" [Lit -1] "" + ,Instr "bsr" [L k] "" :fS xs $ n+1] context :: SSMProgram context = [Lab "1printint" @@ -152,8 +150,8 @@ instance g Op2 where BiCons = abort "Shit, Cons, how to deal with this?" instance g FieldSelector where - g FieldFst = tell [Instr "lda" [Lit 0] "fst"] - g FieldSnd = tell [Instr "lda" [Lit 1] "snd"] + g FieldFst = tell [Instr "lda" [Lit -1] "fst"] + g FieldSnd = tell [Instr "lda" [Lit 0] "snd"] g FieldHd = tell [Instr "lda" [Lit -1] "hd"] g FieldTl = tell [Instr "lda" [Lit 0] "tl"] @@ -170,27 +168,39 @@ instance g Expr where >>| 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] ""] + >>| tell [Instr "stmh" [Lit 2] ""] g (VarExpr _ (VarDef k fs)) = getAdressbook >>= \ab->case 'Map'.get k ab of Just (ADDR t) = tell [Instr "ldl" [Lit t] ""] >>| mapM_ g fs >>| pure () - _ = liftT (Left $ Error "Higher order functions not implemented") + Just (LAB l _ fn) = tell + [Instr "ldc" [Lit fn] "" + ,Instr "sth" [] "" + ,Instr "ldc" [Lit 0] "" + ,Instr "sth" [] ""] g (FunExpr _ k es fs) = getAdressbook >>= \ab->case 'Map'.get k ab of - Just (LAB l arity _) = if (arity <> (length es)) - (liftT $ Left $ Error "Higher order functions not implemented") + Just (LAB l arity fn) = if (arity <> (length es)) + ( tell + [Instr "ldc" [Lit fn] "" + ,Instr "sth" [] "" + ,Instr "ldc" [Lit $ length es] "" + ,Instr "sth" [] "" + ,Instr "ajs" [Lit -1] ""] + >>| mapM_ g es + >>| if (isEmpty es) (pure ()) (tell + [Instr "stmh" [Lit $ length es] "" + ,Instr "ajs" [Lit -1] ""])) ( mapM_ g es >>| jump "bsr" k >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args >>| tell [Instr "ldr" [Raw "RR"] ""]) - _ = liftT (Left $ Error "Funcall to variable?") + Nothing = liftT (Left $ Error "Undefined function!!!") + Just (ADDR t) = liftT (Left $ Error "FunExpr to addr") 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") + Just (ADDR t) = liftT (Left $ Error "Address as jump???") instance g Stmt where g (IfStmt cond th el) = @@ -219,7 +229,7 @@ instance g Stmt where Just (ADDR t) = tell [Instr "stl" [Lit t] ""] g (FunStmt k es fs) = mapM_ g es >>| jump "bsr" k - >>| mapM_ (const $ tell [Instr "ajs" [Lit -1] ""]) es //clean up args + >>| tell [Instr "ajs" [Lit (~(length es))] ""] //clean up args >>| mapM_ g fs >>| pure () g (ReturnStmt Nothing) = tell [Instr "unlink" [] ""] @@ -229,9 +239,10 @@ instance g Stmt where >>| g (ReturnStmt Nothing) foldVarDecl :: Int VarDecl -> Gen Int -foldVarDecl x (VarDecl _ _ k e) = g e +foldVarDecl x (VarDecl _ mt k e) = g e >>| annote x k - >>| updateAdressbook (extend k (ADDR x)) >>| pure (x + 1) + >>| updateAdressbook (extend k (ADDR x)) + >>| pure (x + 1) addVars :: [String] -> (Addressbook -> Addressbook) addVars [] = id diff --git a/ontwerpbesluiten.txt b/ontwerpbesluiten.txt index 71e02c2..3711dc8 100644 --- a/ontwerpbesluiten.txt +++ b/ontwerpbesluiten.txt @@ -33,9 +33,9 @@ List wordt opgeslagen dmv een pointer, als die 0 is dan is het het einde. Als het een plek op de heap is dan wijst die plek naar de waarde, de volgende plek wijst dan naar de tail. Incomplete functies sla je op dmv heap pointer, plek van de pointer is het - functieadres, plekken erna zijn de argumenten. Dit is poor-mans higher - order functions. Als we het pro willen doen is dat niet in de scope van het - project.(closure, lambda's nodig etc) + functieadres, plek erna is aantal gegeven argumenten, plekken erna zijn de + argumenten. Dit is poor-mans higher order functions. Als we het pro willen + doen is dat niet in de scope van het project.(closure, lambda's nodig etc) Functies callen gebeurt door eerst de oude frame pointer op de stack te duwen, dan omgekeert de argumenten van de functie. Bij afbraak herstel je gewoon de diff --git a/spl.icl b/spl.icl index 3e970a4..bdfccc8 100644 --- a/spl.icl +++ b/spl.icl @@ -40,7 +40,7 @@ preamble (AST fd) = AST (pre ++ fd) pre = [ FunDecl zero "1printstr" ["x"] Nothing [] [ IfStmt (FunExpr zero "isEmpty" [VarExpr zero (VarDef "x" [])] []) - [ReturnStmt Nothing] + [] [FunStmt "1printchar" [VarExpr zero (VarDef "x" [FieldHd])] [] ,FunStmt "1printstr" [VarExpr zero (VarDef "x" [FieldTl])] []]] ,