X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=5cf0520adb2a8d68f50d664ae427a994e0052a0f;hb=74b900cf6db033a51e177f7f85d835dae44217e5;hp=f87e5bbda1aead96ff8ff08b0a2e2e7629f8dc94;hpb=8291939287baa496d368855c0bea1e6f30a8612d;p=cc1516.git

diff --git a/sem.icl b/sem.icl
index f87e5bb..5cf0520 100644
--- a/sem.icl
+++ b/sem.icl
@@ -110,7 +110,7 @@ instance Typeable Type where
     ftv _                       = []
     subst s (TupleType (t1, t2))= TupleType (subst s t1, subst s t2)
     subst s (ListType t1)       = ListType (subst s t1)
-    subst s (FuncType t)         = FuncType (subst s t)
+    subst s (FuncType t)        = FuncType (subst s t)
     subst s (t1 ->> t2)         = (subst s t1) ->> (subst s t2)
     subst s t1=:(IdType tvar)   = 'Map'.findWithDefault t1 tvar s
     subst s t                   = t
@@ -225,6 +225,8 @@ instance infer Expr where
         infer e2 >>= \(s2, t2, e2_) ->
         pure (compose s2 s1, TupleType (t1,t2), TupleExpr p (e1_,e2_))
 
+    LambdaExpr _ _ _ = liftT $ Left $ Error "PANIC: lambdas should be tasnformed"
+
     FunExpr p f args fs =
         lookup f >>= \expected ->
         let accST = (\(s,ts,es) e->infer e >>= \(s_,et,e_)-> pure (compose s_ s,ts++[et],es++[e_])) in
@@ -383,13 +385,18 @@ instance type FunDecl where
         let given = foldr (->>) result argTs_ in 
         (case expected of
             Nothing = pure zero
-            Just expected_ = lift (unify expected_ given))
-        >>= \s3 ->
+            Just (FuncType expected_) = lift (unify expected_ given)
+            Just expected_ = lift (unify expected_ given)
+        ) >>= \s3 ->
         let ftype = subst (compose s3 $ compose s2 s1) given in
-        generalize ftype >>= \t->
+        (case ftype of
+            _ ->> _ = pure ftype
+            _       = pure $ FuncType ftype
+        ) >>= \ftype_->
+        generalize ftype_ >>= \t->
         putGamma outerScope >>|
         changeGamma (extend f t) >>| 
-        pure (compose s3 $ compose s2 s1, FunDecl p f args (Just ftype) tVds stmts_)
+        pure (compose s3 $ compose s2 s1, FunDecl p f args (Just ftype_) tVds stmts_)
 
 instance type [a] | type a where
     type []     = pure (zero, [])