From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 25 May 2016 14:27:16 +0000 (+0200)
Subject: jo
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=7ee246446bf6ae681acfb828fd495ce573151f7f;p=cc1516.git

jo
---

diff --git a/examples/high.spl b/examples/high.spl
index dd7a7f7..847e64b 100644
--- a/examples/high.spl
+++ b/examples/high.spl
@@ -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
--- 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) =