get = gets id
-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 (Error e) = "SemError: " +++ 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."]
-
sem :: AST -> SemOutput
sem (AST vd fd) = case runStateT m ('Map'.newMap, getRandomStream 1) of
Left e = Left [e]
pure (vds, fds)
semFunDecl :: FunDecl -> Env FunDecl
-semFunDecl fd=:(FunDecl p f args mt vds stmts) = (case mt of
- Nothing = let t = IdType f in putIdent f t >>| pure t
- Just t = putIdent f t >>| pure t) >>= \ft ->
+semFunDecl fd=:(FunDecl p f args mt vds stmts) =
+ saveGamma >>= \gamma ->
+ (case mt of
+ Nothing = let t = IdType f in putIdent f t >>| pure t
+ Just t = putIdent f t >>| pure t) >>= \ft ->
+ mapM_ (\a-> putIdent a (IdType <$> freshIdent)) args >>|
mapM_ semVarDecl vds >>|
- mapM_ (checkStmt $ resultType ft) stmts >>| pure fd
+ mapM_ (checkStmt $ resultType ft) stmts >>|
+ restoreGamma gamma >>| pure fd
semVarDecl :: VarDecl -> Env VarDecl
semVarDecl (VarDecl pos type ident ex) = unify type ex
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 (Error e) = "SemError: " +++ 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."]
+
+saveGamma :: Env Gamma
+saveGamma = get
+
+restoreGamma :: Gamma -> Env Void
+restoreGamma g = put g
\ No newline at end of file