Merge branch 'master' of https://github.com/dopefishh/cc1516

[cc1516.git] / sem.icl

diff --git a/sem.icl b/sem.icl
index 3438810..820e45d 100644 (file)
--- a/sem.icl
+++ b/sem.icl
@@ -42,13 +42,13 @@ where
     m :: Env ([VarDecl], [FunDecl])
     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)
+//     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 (vd1, fd1)
 
 semFunDecl :: FunDecl -> Env FunDecl
 semFunDecl fd=:(FunDecl p f args mt vds stmts) = 
@@ -59,15 +59,26 @@ semFunDecl fd=:(FunDecl p f args mt vds stmts) =
        matchFunctions args ft >>= \tres->
     mapM semVarDecl vds >>= \newvds->
     mapM (checkStmt tres) stmts >>= \newstmts->
-       inferReturnType stmts >>= \returntype->
+       inferReturnType stmts >>= \returntype`->
+       unify returntype` tres >>= \returntype->
        case mt of
                Nothing = reconstructType args tres
+                       >>= \ftype`->recoverType ftype`
                        >>= \ftype->restoreGamma gamma 
                        >>| putIdent f ftype >>| pure (
                        FunDecl p f args (Just ftype) newvds newstmts)
                Just t = restoreGamma gamma >>| updateFunType t returntype
                        >>= \tt-> pure (FunDecl p f args (Just tt) newvds newstmts) 
 
+recoverType :: Type -> Env Type
+recoverType (IdType ident) = gets (\(st, r)->'Map'.get ident st)
+       >>= \mt->case mt of
+               Nothing = pure (IdType ident)
+               Just t = pure t
+recoverType (t1 ->> t2) = recoverType t1 >>= \t1`->recoverType t2 
+       >>= \t2`->pure (t1` ->> t2`) 
+recoverType t = pure t
+
 updateFunType :: Type Type -> Env Type
 updateFunType t1 t2 = unify t1 t2
 updateFunType (t1 ->> t2) t3 = t1 ->> (updateFunType t2 t3)