From 7d96685ae468c2ee1288b9970210e24a3132e3a2 Mon Sep 17 00:00:00 2001
From: pimjager <pim@pimjager.nl>
Date: Thu, 26 May 2016 18:07:47 +0200
Subject: [PATCH] Fixed printing from lambdas

---
 examples/tempTest.spl | 27 +++++++++++++++++----------
 gen.icl               |  2 +-
 sem.icl               | 23 ++++++++++++-----------
 3 files changed, 30 insertions(+), 22 deletions(-)

diff --git a/examples/tempTest.spl b/examples/tempTest.spl
index cf339cf..a5ac57d 100644
--- a/examples/tempTest.spl
+++ b/examples/tempTest.spl
@@ -10,18 +10,25 @@ map(f, xs) {
     }
 }
 
-//foldr(f, acc, xs) {
-//    if(isEmpty(xs)) {
-//        return acc;
-//    } else {
-//        return foldr(f, f(xs.hd, acc), xs.tl);
-//    }
-//}
+foldr(f, acc, xs) {
+    if(isEmpty(xs)) {
+        return acc;
+    } else {
+        return foldr(f, f(xs.hd, acc), xs.tl);
+    }
+}
+
+l2(x) :: Int -> Void {
+    //return print(3);
+    var y = print(3);
+    return;
+}
 
 main() {
-    var f = \x -> x+1;
-    var z = map(\x->x+1, 1:2:[]);
-    //var x = foldr(plus, 0, 1:2:[]);
+    //var f = \x->print(x);
+    var z = map(\x->print(3), 1:2:[]);
+    var x = print(3);
+    //var x = foldr(\x y->x+y, 0, 1:2:[]);
     //print(x);
     return;
 }
\ No newline at end of file
diff --git a/gen.icl b/gen.icl
index ebc4754..e9d6cac 100644
--- a/gen.icl
+++ b/gen.icl
@@ -304,7 +304,7 @@ funnyStuff k es fs = getAdressbook >>= \ab->case 'Map'.get k ab of
 			,Instr "ldr" [Raw "RR"] ""
 			]
 		)
-	Nothing = liftT (Left $ Error "Undefined function!!!")
+	Nothing = liftT (Left $ Error $ "PANIC: Undefined function: " +++ k)
 
 instance g Stmt where
     g (IfStmt cond th el) = 
diff --git a/sem.icl b/sem.icl
index 4f4e874..47b6c1a 100644
--- a/sem.icl
+++ b/sem.icl
@@ -126,7 +126,7 @@ instance unfoldL_ Stmt where
 instance unfoldL_ Expr where
     unfoldL_ (LambdaExpr p args e) = 
         fresh >>= \(IdType n) ->
-        let f = ("lambda_"+++n) in
+        let f = ("2lambda_"+++n) in
         let fd = FunDecl p f args Nothing [] [ReturnStmt $ Just e] in 
         let fe = FunExpr p f [] [] in
         pure ([fd], fe)
@@ -283,20 +283,21 @@ instance infer Expr where
         lookup f >>= \expected ->
         let accST = (\(s,ts,es) e->infer e >>= \(s_,et,e_)-> pure (compose s_ s,ts++[et],es++[e_])) in
         foldM accST (zero,[],[]) args >>= \(s1, argTs, args_)->
+        (case f of
+            "print" = case head argTs of
+                IntType = pure "1printint"
+                CharType = pure "1printchar"
+                BoolType = pure "1printbool"
+                ListType (CharType) = pure "1printstr"
+                t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
+            _ = pure f
+        ) >>= \newF->
         fresh >>= \tv->case expected of
-            FuncType t = pure (s1, t, e)
+            FuncType t = pure (s1, t, (FunExpr p newF args fs))
             _ = (let given = foldr (->>) tv argTs in
                 lift (unify expected given) >>= \s2->
                 let fReturnType = subst s2 tv in
                 foldM foldFieldSelectors fReturnType fs >>= \returnType ->
-                (case f of
-                    "print" = case head argTs of
-                        IntType = pure "1printint"
-                        CharType = pure "1printchar"
-                        BoolType = pure "1printbool"
-                        ListType (CharType) = pure "1printstr"
-                        t = liftT $ Left $ SanityError p ("can not print " +++ toString t)
-                    _ = pure f) >>= \newF->
                 pure (compose s2 s1, returnType, FunExpr p newF args_ fs))
 
     IntExpr _ _ = pure $ (zero, IntType, e)
@@ -382,7 +383,7 @@ instance infer Stmt where
         pure (compose s2 s1, VoidType, FunStmt newF args_ fs)
 
     ReturnStmt Nothing = pure (zero, VoidType, s)
-    ReturnStmt (Just e) = infer e >>= \(sub, t, _)-> pure (sub, t, s)
+    ReturnStmt (Just e) = infer e >>= \(sub, t, e_)-> pure (sub, t, ReturnStmt (Just e_))
 
 reverseFs :: Type FieldSelector -> Typing Type 
 reverseFs t FieldHd = pure $ ListType t
-- 
2.20.1