from Text import class Text(concat), instance Text String
import AST
-from parse import :: ParserOutput, :: Error
:: Gamma :== ('Map'.Map String Type, [String])
:: Env a :== StateT Gamma (Either SemError) a
inferReturnType :: [Stmt] -> Env Type
inferReturnType [] = pure VoidType
-inferReturnType [ReturnStmt (Just t):rest] = typeExpr t
+inferReturnType [ReturnStmt (Just t):rest] = typeExpr t
+ >>= \tx->inferReturnType rest >>= \ty->unify tx ty
inferReturnType [ReturnStmt _:rest] = pure VoidType
inferReturnType [_:rest] = inferReturnType rest
(genType xs)
matchFunctions :: [String] Type -> Env Type
-matchFunctions [] (_ ->> _) = liftT $ Left $ Error "Not enough arguments"
-matchFunctions _ (VoidType ->> _) = liftT $ Left $ Error "Cannot have a void type in the middle of the function definition"
+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 $ Error "Too much argumnts"
+matchFunctions _ t = liftT $ Left $
+ ArgumentMisMatchError zero "Too much argumnts"
semVarDecl :: VarDecl -> Env VarDecl
semVarDecl (VarDecl pos type ident ex) = unify type ex
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
itupdate _ _ k = k
instance toString SemError where
- toString (ParseError p e) = concat [
- toString p,"SemError: ParseError: ", e]
- toString (Error e) = "SemError: " +++ e
- toString (UnifyError p t1 t2) = concat [
- toString p,
+ toString (ParseError p e) = concat [toString p,
+ "SemError: ParseError: ", e]
+ toString (UnifyError p t1 t2) = concat [ toString p,
"SemError: Cannot unify types. Expected: ",
toString t1, ". Given: ", toString t2]
- toString (FieldSelectorError p t fs) = concat [
- toString p,
+ toString (FieldSelectorError p t fs) = concat [ toString p,
"SemError: Cannot select ", toString fs, " from type: ",
toString t]
toString (OperatorError p o t) = concat [
toString t]
toString (UndeclaredVariableError p ident) = concat [
toString p, "SemError: identifier: ", ident, " undefined."]
+ toString (ArgumentMisMatchError p s) = concat [toString p,
+ "SemError: Argument mismatch: ", s]
+ toString (Error e) = "SemError: " +++ e
saveGamma :: Env Gamma
saveGamma = get