- mapM_ (checkStmt $ resultType ft) stmts >>|
- restoreGamma gamma >>|
- pure (FunDecl p f args mt newvds stmts)
-
-matchFunctions :: [String] Type -> Env Void
-matchFunctions [] (_ ->> _) = liftT $ Left $ Error "Niet genoeg argumentenerror"
-matchFunctions [] t = pure Void
+ mapM (checkStmt tres) stmts >>= \newstmts->
+ case mt of
+ Nothing = inferReturnType stmts
+ >>= \returntype->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)
+
+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 [_:rest] = inferReturnType rest
+
+reconstructType :: [String] Type -> Env Type
+reconstructType [] t = pure t
+reconstructType [x:xs] t = gets (\(st, r)->'Map'.get x st)
+ >>= \mtype->case mtype of
+ Nothing = liftT $ Left $ Error "Not used ????"
+ Just type = reconstructType xs t >>= \resttype->pure (type ->> resttype)
+
+genType :: [String] -> Env Type
+genType [] = freshIdent >>= \fi->pure $ IdType fi
+genType [x:xs] = liftM2 (->>) (freshIdent >>= \fi->pure $ IdType fi)
+ (genType xs)
+
+matchFunctions :: [String] Type -> Env Type
+matchFunctions [] (_ ->> _) = liftT $ Left $
+ ArgumentMisMatchError zero "Not enough arguments"
+matchFunctions _ (VoidType ->> _) = liftT $ Left $
+ ArgumentMisMatchError zero "Void can't be a non return type"