+instance unify [FieldSelector] where
+ unify t [] = pure t
+ unify (ListType t) [FieldHd:fs] = unify t fs
+ unify t=:(ListType _) [FieldTl:fs] = unify t fs
+ unify (TupleType (t, _)) [FieldFst:fs] = unify t fs
+ unify (TupleType (_, t)) [FieldSnd:fs] = unify t fs
+ unify t [fs:_] = liftT $ Left $ FieldSelectorError zero t fs
+
+instance unify Expr where
+ unify (_ ->> _) e = liftT $ Left $ ParseError (extrPos e)
+ "Expression cannot be a higher order function. Yet..."
+ unify VoidType e = liftT $ Left $ ParseError (extrPos e)
+ "Expression cannot be a Void type."
+ 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
+