HIGHER ORDER FUNCTIONSgit add .git add .!

diff --git a/examples/high.spl b/examples/high.spl
index 1445e6f..dd7a7f7 100644 (file)
--- a/examples/high.spl
+++ b/examples/high.spl
@@ -3,9 +3,7 @@ plus(x, y, z) {
 }
 
 main (){
-       var a = plus();
-       var b = plus(1);
-       var c = plus(1, 2);
-       var d = plus(1, 2, 3);
-//     d(3, 4);
+       var b = plus(2, 3);
+       var c = b(4);
+       print(c);
 }

diff --git a/gen.icl b/gen.icl
index 3a86ba3..bc40cdc 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -72,11 +72,12 @@ programContext x = [Lab "1func"
                fS :: [String] Int -> SSMProgram
                fS [] _ = []
                fS [k:xs] n = [
-                        Instr "lds" [Lit 0] ""
+                        Lab $ "1next" +++ toString n
+                       ,Instr "ldr" [Raw "R5"] ""
                        ,Instr "ldc" [Lit n] $ "branch to: " +++ k
                        ,Instr "eq" [] ""
-                       ,Instr "ajs" [Lit -1] ""
-                       ,Instr "bsr" [L k] ""
+                       ,Instr "brf" [L $ "1next" +++ (toString $ n + 1)] ""
+                       ,Instr "bra" [L k] ""
                        :fS xs $ n+1]
                context :: SSMProgram
                context =   [Lab "1printint"
@@ -196,8 +197,73 @@ instance g Expr where
                                        ,Instr "ldr" [Raw "RR"] ""])
                //Identifier points to variable, thus higher order function
                Just (ADDR t arity) = if (arity <> (length es))
-                       ( liftT (Left $ Error "Variable is function and still not complete"))
-                       ( liftT (Left $ Error "Variable is function and can be executed"))
+                       ( fresh >>= \finish->
+                         fresh >>= \start->
+                               tell
+                               [Instr "ldl" [Lit t] ""
+                               ,Instr "ldma" [Lit 0, Lit 2] "Load funcall and arity"
+                               ,Instr "ldc" [Lit $ length es] "Push extra arity on stack"
+                               ,Instr "add" [] "Increase arity"
+                               ,Instr "ldl" [Lit t] ""
+                               ,Instr "ldh" [Lit 1] "Load available arguments"
+                               ,Instr "str" [Raw "R5"] "Save available arguments"
+                               ,Lab start
+                               ,Instr "ldr" [Raw "R5"] "Load available arguments"
+                               ,Instr "ldc" [Lit 0] ""
+                               ,Instr "eq" [] ""
+                               ,Instr "brt" [L finish] ""
+                               ,Instr "ldc" [Lit 1] "Decrement available arguments"
+                               ,Instr "sub" [] ""
+                               ,Instr "str" [Raw "R5"] "Push available arguments"
+                               ,Instr "bra" [L start] ""
+                               ,Lab finish
+                               ]
+                         >>| mapM_ g es )
+                       ( fresh >>= \finish->
+                         fresh >>= \start->
+                         tell 
+                               [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"
+                               //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 "ldl" [Lit t] ""
+                               ,Instr "ldh" [Lit 0] "Get function number"
+                               ,Instr "str" [Raw "R5"] ""
+                               ,Instr "bsr" [L "1func"] ""
+                               ,Instr "ldr" [Raw "MP"] ""
+                               ,Instr "ldc" [Lit t] ""
+                               ,Instr "add" [] ""
+                               ,Instr "str" [Raw "SP"] ""
+                               ,Instr "ldr" [Raw "RR"] ""
+                               ]
+                       )
                Nothing = liftT (Left $ Error "Undefined function!!!")
 
 jump :: String String -> Gen ()
@@ -255,7 +321,9 @@ arity _ = 0
 addVars :: Type [String] -> (Addressbook -> Addressbook)
 addVars _ [] = id
 addVars (t ->> ts) [x:xs] = \ab->
-       extend x (ADDR (-2 - (length xs)) (arity t)) (addVars t xs ab)
+       extend x (ADDR (-2 - (length xs)) (arity t)) (addVars ts xs ab)
+addVars t [x] = \ab->
+       extend x (ADDR -2 0) ab
 
 instance g FunDecl where
     g (FunDecl _ k args mt vds stms) =