jo
authorMart Lubbers <mart@martlubbers.net>
Wed, 25 May 2016 14:27:16 +0000 (16:27 +0200)
committerMart Lubbers <mart@martlubbers.net>
Wed, 25 May 2016 14:27:16 +0000 (16:27 +0200)
examples/high.spl
gen.icl

index dd7a7f7..847e64b 100644 (file)
@@ -1,9 +1,11 @@
-plus(x, y, z) {
-       return x + y + z;
+plus(v, w, x, y, z) {
+       return v + w + x + y + z;
 }
 
 main (){
-       var b = plus(2, 3);
-       var c = b(4);
+       var a = 1 : 2 : 3 : 4 : 5 : [];
+       var a = plus(1, 2);
+       var b = a(3, 4);
+       var c = b(5);
        print(c);
 }
diff --git a/gen.icl b/gen.icl
index 83af153..e92954c 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -174,9 +174,8 @@ instance g Expr where
                Just (ADDR t arity) = tell [Instr "ldl" [Lit t] ""] >>| mapM_ g fs >>| pure ()
                Just (LAB l _ fn) = tell 
                        [Instr "ldc" [Lit fn] ""
-                       ,Instr "sth" [] ""
                        ,Instr "ldc" [Lit 0] ""
-                       ,Instr "sth" [] ""]
+                       ,Instr "stmh" [Lit 2] ""]
     g (FunExpr _ k es fs) = getAdressbook >>= \ab->case 'Map'.get k ab of
                //Identifier points to function
                Just (LAB l arity fn) = if (arity <> (length es))
@@ -200,12 +199,56 @@ instance g Expr where
                //Identifier points to variable, thus higher order function
                Just (ADDR t arity) = if (arity <> (length es))
                        //Function is still  not complete
-                       ( liftT (Left $ Error "Nope not implemented yet..."))
+                       ( fresh >>= \finish->fresh >>= \start->tell [
+                               //Store function number
+                                Instr "ldl" [Lit t] "STARTING HIGHER ORDER UPDATE"
+                               ,Instr "ldh" [Lit 0] "get function number"
+                               ,Instr "sth" [] "Store"
+                               //Store function arity
+                               ,Instr "ldl" [Lit t] "get pointer again"
+                               ,Instr "ldh" [Lit 1] "get function arity"
+                               ,Instr "ldc" [Lit $ length es] "add argument number"
+                               ,Instr "add" [] "add"
+                               ,Instr "sth" [] "Store"
+                               ,Instr "ajs" [Lit -1] "Adjust pointer"
+                               //load the arguments
+                               ,Instr "ldl" [Lit t] ""
+                               ,Instr "ldh" [Lit 1] "Load available arguments"
+                               ,Instr "str" [Raw "R5"] "Store available args in register"
+                               ,Instr "ldc" [Lit 0] "Store offset"
+                               ,Instr "str" [Raw "R6"] "Store offset in register"
+                               ,Lab start
+                               ,Instr "ldr" [Raw "R5"] ""
+                               ,Instr "ldc" [Lit 0] ""
+                               ,Instr "eq" [] ""
+                               ,Instr "brt" [L finish] "Done pushing arg, bye"
+                               //Load heapadress
+                               ,Instr "ldl" [Lit t] ""
+                               ,Instr "ldr" [Raw "R6"] ""
+                               ,Instr "add" [] "Corrected heapaddress"
+                               ,Instr "ldh" [Lit 2] "Load argument"
+                               ,Instr "sth" [] "And store it immediatly after"
+                               //Decrease available arguments
+                               ,Instr "ldr" [Raw "R5"] ""
+                               ,Instr "ldc" [Lit 1] ""
+                               ,Instr "sub" [] ""
+                               ,Instr "str" [Raw "R5"] ""
+                               //Increase available arguments
+                               ,Instr "ldr" [Raw "R6"] ""
+                               ,Instr "ldc" [Lit 1] ""
+                               ,Instr "add" [] ""
+                               ,Instr "str" [Raw "R6"] ""
+                               ,Instr "bra" [L start] ""
+                               ,Lab finish
+                               ]
+                         >>| mapM_ g es
+                         >>| tell 
+                                       [Instr "stmh" [Lit $ length es] "Store extra args"
+                                       ,Instr "ajs" [Lit -1] ""]
+                       )
                        //Function is complete
-                       ( fresh >>= \finish->
-                         fresh >>= \start->
-                         tell 
-                               [Instr "ldl" [Lit t] ""
+                       ( fresh >>= \finish->fresh >>= \start->tell [
+                                Instr "ldl" [Lit t] "STARTING HIGHER ORDER CALL"
                                ,Instr "ldh" [Lit 1] "Load available arguments"
                                ,Instr "str" [Raw "R5"] "Store available args in register"
                                ,Instr "ldc" [Lit 0] "Store offset"
@@ -253,7 +296,7 @@ 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 arity) = liftT (Left $ Error "Address as jump???")
+       Just (ADDR t arity) = abort "NO ADDRESS JUMPING FFS"
 
 instance g Stmt where
     g (IfStmt cond th el) =