+extrPos (TupleExpr p _) = p
+
+instance toString Gamma where
+ toString (mp, _) = concat
+ [concat [k, ": ", toString v, "\n"]\\(k, v) <- 'Map'.toList mp]
+
+getRandomStream :: Int -> [String]
+getRandomStream i = genIdents $ filter (isAlpha o toChar) (genRandInt i)
+ where
+ genIdents r = let (ic, r2) = splitAt 5 r in [toString ic: genIdents r2]
+
+freshIdent :: Env String
+freshIdent = get >>= \(st, [ident:rest])-> put (st, rest)
+ >>| case 'Map'.get ident st of
+ Nothing = pure ident
+ _ = freshIdent
+
+putIdent :: String Type -> Env Void
+putIdent i t = gets (\(st, r)->'Map'.get i st) >>= \mt -> case mt of
+ Nothing = modify (\(st, r)->('Map'.put i t st, r))
+ Just t2 = unify t t2 >>= \t3-> modify (\(st, r)->('Map'.put i t3 st, r))
+
+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 toString SemError where
+ 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,
+ "SemError: Cannot select ", toString fs, " from type: ",
+ toString t]
+ toString (OperatorError p o t) = concat [
+ toString p,
+ "SemError: No ", toString o, " for type ",
+ 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
+
+restoreGamma :: Gamma -> Env Void
+restoreGamma (oldstate, _) = gets snd >>= \newr->put (oldstate, newr)
+
+derive gEq Type
+instance == Type where
+ (==) (IdType _) (IdType _) = True
+ (==) o1 o2 = gEq{|*|} o1 o2