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) =
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
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