GEEN MERGE CONFLICT
authorMart Lubbers <mart@martlubbers.net>
Thu, 26 May 2016 14:37:34 +0000 (16:37 +0200)
committerMart Lubbers <mart@martlubbers.net>
Thu, 26 May 2016 14:37:34 +0000 (16:37 +0200)
examples/test.spl
gen.icl

index c230ff3..4a4ec5c 100644 (file)
@@ -24,7 +24,5 @@ times(x, y){
 
 main(){
        [Int] l1 = 1 : 2 : 3 : 4 : 5 : [];
-       var c = foldr(times, 1, l1);
-       print(c);
-//     var d = map(plus(1), l1);
+       foldr(times, 1, l1);
 }
diff --git a/gen.icl b/gen.icl
index 3b32540..dad680f 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -178,131 +178,131 @@ instance g Expr where
                        ,Instr "ldc" [Lit 0] ""
                        ,Instr "sth" [] ""
                        ,Instr "ajs" [Lit -1] ""]
-    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))
-                       //Function is not complete
-                       (       tell
-                                       [Instr "ldc" [Lit fn] "Store function number"
-                                       ,Instr "sth" [] ""
-                                       ,Instr "ldc" [Lit $ length es] "Store arity"
-                                       ,Instr "sth" [] ""
-                                       ,Instr "ajs" [Lit -1] ""]
-                               >>| mapM_ g es
-                               >>| if (isEmpty es) (pure ()) (tell 
-                                       [Instr "stmh" [Lit $ length es] "Store arguments"
-                                       ,Instr "ajs" [Lit -1] ""]))
-                       //Function is complete
-                       (       mapM_ g es
-                               >>| jump "bsr" k
-                       >>| tell 
-                                       [Instr "ajs" [Lit $ ~(length es)] "Clean arguments"
-                                       ,Instr "ldr" [Raw "RR"] ""])
-               //Identifier points to variable, thus higher order function
-               Just (ADDR t arity) = if (arity <> (length es))
-                       //Function is still  not complete
-                       ( 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] "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"
-                               ,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"] "HIGHER ORDER END"
-                               ,Instr "ldl" [Lit t] ""
-                               ,Instr "ldh" [Lit 1] ""
-                               ,Instr "neg" [] ""
-                               ,Instr "ldr" [Raw "SP"] ""
-                               ,Instr "add" [] ""
-                               ,Instr "ldc" [Lit $ length es + 1] ""
-                               ,Instr "sub" [] ""
-                               ,Instr "str" [Raw "SP"] ""
-                               ,Instr "ldr" [Raw "RR"] ""
-                               ]
-                       )
-               Nothing = liftT (Left $ Error "Undefined function!!!")
+    g (FunExpr _ k es fs) = funnyStuff k es fs
 
-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) = abort "NO ADDRESS JUMPING FFS"
+funnyStuff :: String [Expr] [FieldSelector] -> Gen ()
+funnyStuff k es fs = getAdressbook >>= \ab->case 'Map'.get k ab of
+       //Identifier points to function
+       Just (LAB l arity fn) = if (arity <> (length es))
+               //Function is not complete
+               (       tell
+                               [Instr "ldc" [Lit fn] "Store function number"
+                               ,Instr "sth" [] ""
+                               ,Instr "ldc" [Lit $ length es] "Store arity"
+                               ,Instr "sth" [] ""
+                               ,Instr "ajs" [Lit -1] ""]
+                       >>| mapM_ g es
+                       >>| if (isEmpty es) (pure ()) (tell 
+                               [Instr "stmh" [Lit $ length es] "Store arguments"
+                               ,Instr "ajs" [Lit -1] ""]))
+               //Function is complete
+               (       mapM_ g es
+                       >>| 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) = lift (Left $ Error "NO ADDRESS JUMPING FFS")
+               >>| tell 
+                               [Instr "ajs" [Lit $ ~(length es)] "Clean arguments"
+                               ,Instr "ldr" [Raw "RR"] ""])
+       //Identifier points to variable, thus higher order function
+       Just (ADDR t arity) = if (arity <> (length es))
+               //Function is still  not complete
+               ( 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] "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"
+                       ,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"] "HIGHER ORDER END"
+                       ,Instr "ldl" [Lit t] ""
+                       ,Instr "ldh" [Lit 1] ""
+                       ,Instr "neg" [] ""
+                       ,Instr "ldr" [Raw "SP"] ""
+                       ,Instr "add" [] ""
+                       ,Instr "ldc" [Lit $ length es + 1] ""
+                       ,Instr "sub" [] ""
+                       ,Instr "str" [Raw "SP"] ""
+                       ,Instr "ldr" [Raw "RR"] ""
+                       ]
+               )
+       Nothing = liftT (Left $ Error "Undefined function!!!")
 
 instance g Stmt where
     g (IfStmt cond th el) = 
@@ -329,11 +329,7 @@ instance g Stmt where
             Nothing = liftT (Left $ Error $ concat ["PANIC: ", k, " not found as var"])
             Just (LAB t _ _) = liftT (Left $ Error $ "PANIC: cannot assign to function")
             Just (ADDR t ar) = tell [Instr "stl" [Lit t] ""]
-    g (FunStmt k es fs) = mapM_ g es 
-        >>| jump "bsr" k
-        >>| tell [Instr "ajs" [Lit (~(length es))] ""] //clean up args
-        >>| mapM_ g fs
-               >>| pure ()
+    g (FunStmt k es fs) = funnyStuff k es fs
     g (ReturnStmt Nothing) = tell [Instr "unlink" [] ""]
                >>| tell [Instr "ret" [] ""]
     g (ReturnStmt (Just e)) = g e