+ saveGamma >>= \gamma ->
+ matchFunctions args ft >>= \tres->
+ mapM semVarDecl vds >>= \newvds->
+ mapM (checkStmt tres) stmts >>= \newstmts->
+ 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) t3 = updateFunType t2 t3 >>= \t2`->pure $ t1 ->> t2`
+updateFunType t1 t2 = unify t1 t2
+
+inferReturnType :: [Stmt] -> Env Type
+inferReturnType [] = 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
+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"
+matchFunctions [x:xs] (t1 ->> t2) =
+ modify (\(st, r)->('Map'.put x t1 st, r)) >>| matchFunctions xs t2
+matchFunctions [] t = pure t
+matchFunctions _ t = liftT $ Left $
+ ArgumentMisMatchError zero "Too much argumnts"