git.iko.soy/elk
on master help sign in
Change the representation of SolverState to have a "saved environment", recognize the "Save the Environment" variable
4c0f716Evan Czaplicki
compiler/Type/Constrain/Expression.hs+7−4
compare with master
unifiedsplit
@@ -38,8 +38,9 @@ test str =
38 print (pretty expr)
38 print (pretty expr)
39 constraint <- constrain env expr (VarN var)
39 constraint <- constrain env expr (VarN var)
40 print =<< extraPretty constraint
40 print =<< extraPretty constraint
41− (env,_,_,errors) <- execStateT (solve constraint) TS.initialState
41+ state <- execStateT (solve constraint) TS.initialState
42+ let errors = TS.sErrors state
42− forM (Map.toList env) $ \(n,t) -> do
43+ forM (Map.toList (TS.sSavedEnv state)) $ \(n,t) -> do
43 pt <- extraPretty t
44 pt <- extraPretty t
44 print $ P.text n <+> P.text ":" <+> pt
45 print $ P.text n <+> P.text ":" <+> pt
45 if null errors then return () else do
46 if null errors then return () else do
@@ -53,7 +54,7 @@ constrain env (L _ _ expr) tipe =
53 case expr of
54 case expr of
54 Literal lit -> return $ Literal.constrain env lit tipe
55 Literal lit -> return $ Literal.constrain env lit tipe
55
56
56− Var name -> return $ name <? tipe
57+ Var name -> return (name <? tipe)
57
58
58 Range lo hi ->
59 Range lo hi ->
59 exists $ \x -> do
60 exists $ \x -> do
@@ -167,7 +168,9 @@ constrain env (L _ _ expr) tipe =
167 return $ tipe === Env.get env Env.types "Element"
168 return $ tipe === Env.get env Env.types "Element"
168
169
169 Let defs body ->
170 Let defs body ->
171+ do c <- case body of
172+ L _ _ (Var name) | name == saveEnvName -> return CSaveEnv
170− do c <- constrain env body tipe
173+ _ -> constrain env body tipe
171 (schemes, rqs, fqs, header, c2, c1) <-
174 (schemes, rqs, fqs, header, c2, c1) <-
172 Monad.foldM (constrainDef env)
175 Monad.foldM (constrainDef env)
173 ([], [], [], Map.empty, CTrue, CTrue)
176 ([], [], [], Map.empty, CTrue, CTrue)
compiler/Type/State.hs+29−16
@@ -25,15 +25,26 @@ data Pool = Pool {
25emptyPool = Pool { maxRank = outermostRank, inhabitants = [] }
25emptyPool = Pool { maxRank = outermostRank, inhabitants = [] }
26
26
27-- Keeps track of the environment, type variable pool, and a list of errors
27-- Keeps track of the environment, type variable pool, and a list of errors
28+data SolverState = SS {
28−type SolverState = (Map.Map String Variable, Pool, Int, [IO P.Doc])
29+ sEnv :: Map.Map String Variable,
29−
30+ sSavedEnv :: Map.Map String Variable,
31+ sPool :: Pool,
32+ sMark :: Int,
33+ sErrors :: [IO P.Doc]
34+}
35+
36+initialState = SS {
37+ sEnv = Map.empty,
38+ sSavedEnv = Map.empty,
39+ sPool = emptyPool,
30−-- The mark must never be equal to noMark!
40+ sMark = noMark + 1, -- The mark must never be equal to noMark!
31−initialState = (Map.empty, emptyPool, noMark + 1, [])
41+ sErrors = []
32−
42+}
33−modifyEnv f = modify $ \(env, pool, mark, errors) -> (f env, pool, mark, errors)
43+
34−modifyPool f = modify $ \(env, pool, mark, errors) -> (env, f pool, mark, errors)
44+modifyEnv f = modify $ \state -> state { sEnv = f (sEnv state) }
45+modifyPool f = modify $ \state -> state { sPool = f (sPool state) }
35addError message t1 t2 =
46addError message t1 t2 =
36− modify $ \(env, pool, mark, errors) -> (env, pool, mark, err : errors)
47+ modify $ \state -> state { sErrors = err : sErrors state }
37 where
48 where
38 wordify = P.fsep . map P.text . words
49 wordify = P.fsep . map P.text . words
39 msg = wordify message
50 msg = wordify message
@@ -53,19 +64,21 @@ addError message t1 t2 =
53switchToPool pool = modifyPool (\_ -> pool)
64switchToPool pool = modifyPool (\_ -> pool)
54
65
55getPool :: StateT SolverState IO Pool
66getPool :: StateT SolverState IO Pool
56−getPool = do
67+getPool = sPool <$> get
57− (_, pool, _, _) <- get
58− return pool
59
68
60getEnv :: StateT SolverState IO (Map.Map String Variable)
69getEnv :: StateT SolverState IO (Map.Map String Variable)
61−getEnv = do
70+getEnv = sEnv <$> get
62− (env, _, _, _) <- get
71+
63− return env
72+saveLocalEnv :: StateT SolverState IO ()
73+saveLocalEnv = do
74+ env <- sEnv <$> get
75+ modify $ \state -> state { sSavedEnv = env }
64
76
65uniqueMark :: StateT SolverState IO Int
77uniqueMark :: StateT SolverState IO Int
66uniqueMark = do
78uniqueMark = do
67− (env, pool, mark, errs) <- get
79+ state <- get
80+ let mark = sMark state
68− put (env, pool, mark+1, errs)
81+ put $ state { sMark = mark + 1 }
69 return mark
82 return mark
70
83
71nextRankPool :: StateT SolverState IO Pool
84nextRankPool :: StateT SolverState IO Pool