getRandomStream :: Int -> [String]
getRandomStream i = genIdents $ filter (isAlpha o toChar) (genRandInt i)
where
- genIdents r = let (ic, r) = splitAt 5 r in [toString ic: genIdents r]
+ genIdents r = let (ic, r2) = splitAt 5 r in [toString ic: genIdents r2]
freshIdent :: Env String
freshIdent = get >>= \(st, [ident:rest])-> put (st, rest)
toString t1, ". Given: ", toString t2]
sem :: AST -> SemOutput
-sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 0) of
+sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 1) of
Left e = Left [e]
Right ((vds, fds), gamma) = Right ((AST vds fds), gamma)
where
- m :: Env (([VarDecl], [FunDecl]))
+ m :: Env ([VarDecl], [FunDecl])
m = (mapM semVarDecl vd) >>= \vds ->
mapM semFunDecl fd >>= \fds ->
pure (vds, fds)
//a
typeExpr (Op2Expr p e1 BiCons e2) = typeExpr e1 >>= \t1-> typeExpr e2
>>= \t2-> unify (ListType t1) t2
-//typeExpr (FunExpr p FunCall) = undef
-typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in
+typeExpr (EmptyListExpr p) = freshIdent >>= \frsh-> let t = IdType frsh in
putIdent frsh t >>| pure t
+//typeExpr (FunExpr p FunCall) = undef
//typeExpr (VarExpr Pos VarDef) = undef //when checking var-expr, be sure to
//put the infered type in the context
unify (IdType _) e = liftT $ Left $ ParseError (extrPos e)
"Expression cannot be an polymorf type."
unify VarType e = typeExpr e
+ unify (IdType i) e = undef
//we have to cheat to decorate the error, can be done nicer?
unify t e = StateT $ \s0 -> let res = runStateT m s0 in case res of
Left err = Left $ decErr e err
Right t = Right t //note, t :: (Type, Gamma)
where m = typeExpr e >>= \tex-> unify t tex
+replace :: String Type -> Env Void
+replace ident type = get >>= \(st, fr)->put ('Map'.fromList $
+ map (itupdate ident type) ('Map'.toList st), fr)
+ where
+ itupdate :: String Type (String, Type) -> (String, Type)
+ itupdate ident newtype ov=:(key, IdType type) = if (ident == type)
+ (key, newtype) ov
+ itupdate ident newtype (key, TupleType (t1, t2))
+ # (_, t1) = itupdate ident newtype (key, t1)
+ # (_, t2) = itupdate ident newtype (key, t2)
+ = (key, TupleType (t1, t2))
+ itupdate ident newtype (key, ListType t1)
+ # (_, t1) = itupdate ident newtype (key, t1)
+ = (key, ListType t1)
+ itupdate _ _ k = k
+
instance unify Type where
unify IntType IntType = pure IntType
unify BoolType BoolType = pure BoolType
unify CharType CharType = pure CharType
- unify (ListType t1) (ListType t2) = unify t1 t2
+ unify (IdType i) t=:(IdType j) = replace i t >>| pure t
+ unify t (IdType i) = unify (IdType i) t
+ unify (IdType i) t = replace i t >>| pure t
+ //unify (ListType t1) (ListType t2) = unify t1 t2
unify t1 t2 = liftT $ Left $ UnifyError zero t1 t2
instance zero Pos where