small update so that retyping works
authorMart Lubbers <mart@martlubbers.net>
Thu, 14 Apr 2016 06:45:01 +0000 (08:45 +0200)
committerMart Lubbers <mart@martlubbers.net>
Thu, 14 Apr 2016 06:45:01 +0000 (08:45 +0200)
sem.icl

diff --git a/sem.icl b/sem.icl
index e894784..e2227d1 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -41,10 +41,15 @@ sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 1) of
     Right ((vds, fds), gamma) = Right ((AST vds fds), gamma)
 where 
     m :: Env ([VarDecl], [FunDecl])
-    m = mapM semVarDecl vd >>= \vds ->
-        mapM semFunDecl fd >>= \fds1 -> 
-        mapM semFunDecl fds1 >>= \fds2 -> 
-        pure (vds, fds2)
+    m = mapM semVarDecl vd >>= \vd1 ->
+        mapM semFunDecl fd >>= \fd1 -> 
+       mapM semVarDecl vd1 >>= \vd2 ->
+        mapM semFunDecl fd1 >>= \fd2 -> 
+       mapM semVarDecl vd2 >>= \vd3 ->
+        mapM semFunDecl fd2 >>= \fd3 -> 
+       mapM semVarDecl vd3 >>= \vd4 ->
+        mapM semFunDecl fd3 >>= \fd4 ->  //Dit is puur om te proberen
+        pure (vd4, fd4)
 
 semFunDecl :: FunDecl -> Env FunDecl
 semFunDecl fd=:(FunDecl p f args mt vds stmts) = 
@@ -58,7 +63,7 @@ semFunDecl fd=:(FunDecl p f args mt vds stmts) =
        case mt of
                Nothing = inferReturnType stmts
                        >>= \returntype->reconstructType args tres 
-                       >>= \ftype->pure Void//restoreGamma gamma 
+                       >>= \ftype->restoreGamma gamma 
                        >>| putIdent f ftype >>| pure (
                        FunDecl p f args (Just ftype) newvds newstmts)
                Just t = restoreGamma gamma 
@@ -176,6 +181,8 @@ instance unify Expr where
 //                     "Expression cannot be an polymorf type."
     unify VarType e = typeExpr e
     //we have to cheat to decorate the error, can be done nicer?
+       unify t=:(IdType id) e = typeExpr e >>= \tex->unify t tex
+               >>= \type->putIdent id type >>| pure type
     unify t e = StateT $ \s0 -> let res = runStateT m s0 in case res of
         Left err = Left $ decErr e err
         Right t = Right t //note, t :: (Type, Gamma)