From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 25 May 2016 10:42:33 +0000 (+0200)
Subject: HIGHER ORDER FUNCTIONSgit add .git add .!
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=c05f484b53e5f88eec5c2cc8924e3bea7446360f;p=cc1516.git

HIGHER ORDER FUNCTIONSgit add .git add .!
---

diff --git a/examples/high.spl b/examples/high.spl
index 1445e6f..dd7a7f7 100644
--- 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
--- 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) =