X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=sem.icl;h=7f7cdf43622f7307030a256bb7a51f369dda145d;hb=d81ba67093ba9f7a9c2f6d47ec51651f99b4b5b3;hp=791ae69a46b3601530d02822edf315404df53a67;hpb=51921a9587d60b6411610845f56d62ebd73f80cb;p=cc1516.git

diff --git a/sem.icl b/sem.icl
index 791ae69..7f7cdf4 100644
--- a/sem.icl
+++ b/sem.icl
@@ -222,7 +222,6 @@ instance infer Expr where
         pure ((compose s3 $ compose s2 s1), subst s3 tv)
 
     Op1Expr _ op e1 =
-        abort "infereing op1" >>|
         infer e1 >>= \(s1, t1) -> 
         fresh >>= \tv ->
         let given = t1 ->> tv in 
@@ -230,10 +229,9 @@ instance infer Expr where
         lift (unify expected given) >>= \s2 ->
         pure (compose s2 s1, subst s2 tv)
 
-    EmptyListExpr _ = abort "infereing []" >>| (\tv->(zero,tv)) <$> fresh
+    EmptyListExpr _ = (\tv->(zero,tv)) <$> fresh
 
     TupleExpr _ (e1, e2) = 
-        abort "infereing (,)" >>|
         infer e1 >>= \(s1, t1) -> 
         infer e2 >>= \(s2, t2) ->
         pure (compose s2 s1, TupleType (t1,t2))
@@ -242,7 +240,6 @@ instance infer Expr where
         lookup f >>= \expected ->
         let accST = (\(s,ts) e->infer e >>= \(s_,et)->pure (compose s_ s,ts++[et])) in
         foldM accST (zero,[]) args >>= \(s1, argTs)->
-        //abort (concat (["argsTs: "] ++ (map toString argTs))) >>|
         fresh >>= \tv->
         let given = foldr (->>) tv argTs in
         lift (unify expected given) >>= \s2->
@@ -327,15 +324,17 @@ class type a :: a -> Typing a
 
 instance type VarDecl where
     type (VarDecl p expected k e) = 
-        infer e >>= \(s, given) ->
-        applySubst s >>| 
+        infer e >>= \(s1, given) ->
+        applySubst s1 >>| 
         case expected of
             Nothing = pure zero
             Just expected_ = lift (unify expected_ given)
-        >>|
-        generalize given >>= \t ->
+        >>= \s2->
+        applySubst s2 >>|
+        let vtype = subst (compose s2 s1) given in
+        generalize vtype >>= \t ->
         changeGamma (extend k t) >>| 
-        pure (VarDecl p (Just given) k e)
+        pure (VarDecl p (Just vtype) k e)
 
 instance type FunDecl where
     type (FunDecl p f args expected vds stmts) =