git.iko.soy/elk
on master help sign in
cosmetic: clean up Type.State quite a bit
5a33259Evan Czaplicki
src/Type/Solve.hs+2−4
compare with master
unifiedsplit
@@ -3,8 +3,7 @@
3module Type.Solve (solve) where
3module Type.Solve (solve) where
4
4
5import Control.Monad
5import Control.Monad
6−import Control.Monad.State (execStateT, liftIO)
7−import Control.Monad.Except (ExceptT, throwError)
6+import Control.Monad.Except (ExceptT, liftIO, throwError)
8import qualified Data.Foldable as F
7import qualified Data.Foldable as F
9import qualified Data.Map as Map
8import qualified Data.Map as Map
10import qualified Data.Text as Text
9import qualified Data.Text as Text
@@ -153,8 +152,7 @@ adjustRankContent youngMark visitedMark groupRank content =
153
152
154solve :: TypeConstraint -> ExceptT [A.Located Error.Error] IO TS.SolverState
153solve :: TypeConstraint -> ExceptT [A.Located Error.Error] IO TS.SolverState
155solve constraint =
154solve constraint =
156− do state <-
155+ do state <- liftIO (TS.run (actuallySolve constraint))
157− liftIO (execStateT (actuallySolve constraint) TS.initialState)
158 case TS.sError state of
156 case TS.sError state of
159 [] ->
157 [] ->
160 return state
158 return state
src/Type/State.hs+49−27
@@ -1,5 +1,25 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−module Type.State where
2+module Type.State
3+ ( Solver
4+ , run
5+ , SolverState(..)
6+ , Pool(..)
7+ , Env
8+ , modifyEnv
9+ , addError
10+ , switchToPool
11+ , getPool
12+ , getEnv
13+ , saveLocalEnv
14+ , uniqueMark
15+ , nextRankPool
16+ , register
17+ , introduce
18+ , flatten
19+ , makeInstance
20+ , makeCopy
21+ )
22+ where
3
23
4import qualified Control.Monad.State as State
24import qualified Control.Monad.State as State
5import qualified Data.Map as Map
25import qualified Data.Map as Map
@@ -13,33 +33,28 @@ import qualified Reporting.Region as R
13import Type.Type
33import Type.Type
14
34
15
35
16−-- Pool
36+-- SOLVER
17−-- Holds a bunch of variables
18−-- The rank of each variable is less than or equal to the pool's "maxRank"
19−-- The young pool exists to make it possible to identify these vars in constant time.
20
37
21−data Pool =
22− Pool
23− { maxRank :: Int
24− , inhabitants :: [Variable]
25− }
26
38
39+type Solver = State.StateT SolverState IO
27
40
28−emptyPool :: Pool
29−emptyPool =
30− Pool
31− { maxRank = outermostRank
32− , inhabitants = []
33− }
34
41
42+run :: Solver () -> IO SolverState
43+run solver =
44+ State.execStateT solver $
45+ SS
46+ { sEnv = Map.empty
47+ , sSavedEnv = Map.empty
48+ , sPool = Pool outermostRank []
49+ , sMark = noMark + 1 -- The mark must never be equal to noMark!
50+ , sError = []
51+ }
35
52
36−type Env = Map.Map Text (A.Located Variable)
37
53
38
54
39−type Solver = State.StateT SolverState IO
55+-- SOLVER STATE
40
56
41
57
42−-- Keeps track of the environment, type variable pool, and a list of errors
43data SolverState =
58data SolverState =
44 SS
59 SS
45 { sEnv :: Env
60 { sEnv :: Env
@@ -50,17 +65,24 @@ data SolverState =
50 }
65 }
51
66
52
67
53−initialState :: SolverState
68+{-| A pool holds a bunch of variables
54−initialState =
69+The rank of each variable is less than or equal to the pool's "maxRank"
55− SS
70+The young pool exists to make it possible to identify these vars in constant time.
56− { sEnv = Map.empty
71+-}
57− , sSavedEnv = Map.empty
72+data Pool =
58− , sPool = emptyPool
73+ Pool
59− , sMark = noMark + 1 -- The mark must never be equal to noMark!
74+ { maxRank :: Int
60− , sError = []
75+ , inhabitants :: [Variable]
61 }
76 }
62
77
63
78
79+type Env = Map.Map Text (A.Located Variable)
80+
81+
82+
83+-- HELPERS
84+
85+
64modifyEnv :: (Env -> Env) -> Solver ()
86modifyEnv :: (Env -> Env) -> Solver ()
65modifyEnv f =
87modifyEnv f =
66 State.modify $ \state -> state { sEnv = f (sEnv state) }
88 State.modify $ \state -> state { sEnv = f (sEnv state) }