ding
authorMart Lubbers <mart@martlubbers.net>
Wed, 25 May 2016 11:16:04 +0000 (13:16 +0200)
committerMart Lubbers <mart@martlubbers.net>
Wed, 25 May 2016 11:16:04 +0000 (13:16 +0200)
git push o

gen.icl

diff --git a/gen.icl b/gen.icl
index bc40cdc..83af153 100644 (file)
--- a/gen.icl
+++ b/gen.icl
@@ -180,6 +180,7 @@ instance g Expr where
     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" [] ""
@@ -190,6 +191,7 @@ instance g Expr where
                                >>| 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 
@@ -197,28 +199,9 @@ instance g Expr where
                                        ,Instr "ldr" [Raw "RR"] ""])
                //Identifier points to variable, thus higher order function
                Just (ADDR t arity) = if (arity <> (length es))
-                       ( 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 )
+                       //Function is still  not complete
+                       ( liftT (Left $ Error "Nope not implemented yet..."))
+                       //Function is complete
                        ( fresh >>= \finish->
                          fresh >>= \start->
                          tell