From: pimjager <pim@pimjager.nl>
Date: Thu, 14 Apr 2016 09:24:05 +0000 (+0200)
Subject: Merge branch 'master' of https://github.com/dopefishh/cc1516
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=3d569407ede8e77c5809a1076735dc3c58ab1922;hp=158fb0cf298aaae42c8460f92bb7d797d5def9bd;p=cc1516.git

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

diff --git a/examples/Markus/overloading.spl b/examples/Markus/overloading.spl
index 754da17..4d8c615 100644
--- a/examples/Markus/overloading.spl
+++ b/examples/Markus/overloading.spl
@@ -1,6 +1,8 @@
 // At this point you maybe don't see what the problem is.
 // Wait until you try to implement your code generator.
 
+var a = equal(1, 2);
+
 equal(x, y)
 {
   return x == y;
diff --git a/sem.icl b/sem.icl
index 06200b1..820e45d 100644
--- 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,19 +59,36 @@ 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`->
+	unify returntype` tres >>= \returntype->
 	case mt of
-		Nothing = inferReturnType stmts
-			>>= \returntype->reconstructType args tres 
+		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 
-			>>| pure (FunDecl p f args mt 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)
 
 inferReturnType :: [Stmt] -> Env Type
 inferReturnType [] = pure VoidType
-inferReturnType [ReturnStmt (Just t):rest] = typeExpr t
-inferReturnType [ReturnStmt _:rest] = pure VoidType
+inferReturnType [ReturnStmt (Just t):rest] = typeExpr t 
+	>>= \tx->inferReturnType rest >>= \ty->unify tx ty
+inferReturnType [ReturnStmt _:rest] = 
+	inferReturnType rest >>= \tx-> unify VoidType tx
 inferReturnType [_:rest] = inferReturnType rest
 
 reconstructType :: [String] Type -> Env Type
@@ -200,6 +217,8 @@ instance unify Type where
     unify (ListType t1) (ListType t2) = unify t1 t2 >>| (pure $ ListType t1)
     unify (ta1 ->> ta2) (tb1 ->> tb2) = unify ta1 tb1 >>= \ta-> unify ta2 tb2 
         >>= \tb-> pure (ta ->> tb)
+    unify VoidType t = pure t
+    unify t VoidType = pure t
     unify VoidType VoidType = pure VoidType
 	unify t1 t2 = liftT $ Left $ UnifyError zero t1 t2