opslaan van higher order functions aangepast

diff --git a/examples/high.spl b/examples/high.spl
index af750ab..233dc4c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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])] []]]
                        ,