From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 14 Apr 2016 07:56:33 +0000 (+0200)
Subject: hoi
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=bf8de26a347182ab0de1aa45a5cc3fdf6c320c21;p=cc1516.git

hoi
---

diff --git a/sem.icl b/sem.icl
index f3d28c2..3438810 100644
--- a/sem.icl
+++ b/sem.icl
@@ -59,20 +59,25 @@ 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->
 	case mt of
-		Nothing = inferReturnType stmts
-			>>= \returntype->reconstructType args tres 
+		Nothing = reconstructType args tres
 			>>= \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) 
+
+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 
 	>>= \tx->inferReturnType rest >>= \ty->unify tx ty
-inferReturnType [ReturnStmt _:rest] = pure VoidType
+inferReturnType [ReturnStmt _:rest] = 
+	inferReturnType rest >>= \tx-> unify VoidType tx
 inferReturnType [_:rest] = inferReturnType rest
 
 reconstructType :: [String] Type -> Env Type