git.iko.soy/Idris-dev
on master help sign in
getting rid of InfInt, turned out not to be needed
ebac3cbOzgur Akgun
src/Idris/Core/Constraints.hs+8−27
compare with master
unifiedsplit
@@ -28,23 +28,9 @@ newtype Var = Var Int
28data SolverState =
28data SolverState =
29 SolverState
29 SolverState
30 { queue :: [(UConstraint, FC)]
30 { queue :: [(UConstraint, FC)]
31− , domainStore :: M.Map Var (InfInt, InfInt)
31+ , domainStore :: M.Map Var (Int, Int)
32 }
32 }
33
33
34−data InfInt = NegInf | I Int | PosInf
35− deriving (Eq, Ord, Show)
36−
37−instance Enum InfInt where
38− succ (I x) = I (succ x)
39− succ x = x
40− pred (I x) = I (pred x)
41− pred x = x
42− toEnum = I
43− fromEnum (I x) = x
44− fromEnum NegInf = minBound
45− fromEnum PosInf = maxBound
46−
47−
48solve :: [(UConstraint, FC)] -> TC (M.Map Var Int)
34solve :: [(UConstraint, FC)] -> TC (M.Map Var Int)
49solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
35solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
50
36
@@ -54,7 +40,7 @@ solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
54 initSolverState = SolverState
40 initSolverState = SolverState
55 { queue = inpConstraints
41 { queue = inpConstraints
56 , domainStore = M.fromList
42 , domainStore = M.fromList
57− [ (v, (I 0, I 10))
43+ [ (v, (0, 10))
58 | v <- ordNub [ v
44 | v <- ordNub [ v
59 | (c, _) <- inpConstraints
45 | (c, _) <- inpConstraints
60 , v <- varsIn c
46 , v <- varsIn c
@@ -93,12 +79,7 @@ solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
93 propagate
79 propagate
94
80
95 extractSolution :: (MonadState SolverState m, Functor m) => m (M.Map Var Int)
81 extractSolution :: (MonadState SolverState m, Functor m) => m (M.Map Var Int)
96− extractSolution = M.map extractVal <$> gets domainStore
82+ extractSolution = M.map fst <$> gets domainStore
97−
98− extractVal :: (InfInt, InfInt) -> Int
99− extractVal (_, I x) = x
100− extractVal (I x, _) = x
101− extractVal _ = 0
102
83
103 nextConstraint :: MonadState SolverState m => m (Maybe (UConstraint, FC))
84 nextConstraint :: MonadState SolverState m => m (Maybe (UConstraint, FC))
104 nextConstraint = do
85 nextConstraint = do
@@ -109,11 +90,11 @@ solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
109 modify $ \ st -> st { queue = qs \\ [q] }
90 modify $ \ st -> st { queue = qs \\ [q] }
110 return (Just q)
91 return (Just q)
111
92
112− domainOf :: MonadState SolverState m => UExp -> m (InfInt, InfInt)
93+ domainOf :: MonadState SolverState m => UExp -> m (Int, Int)
113 domainOf (UVar var) = gets ((M.! Var var) . domainStore)
94 domainOf (UVar var) = gets ((M.! Var var) . domainStore)
114− domainOf (UVal val) = return (I val, I val)
95+ domainOf (UVal val) = return (val, val)
115
96
116− -- updateDomainOf :: MonadState SolverState m => UExp -> (InfInt, InfInt) -> m ()
97+ -- updateDomainOf :: MonadState SolverState m => UExp -> (Int, Int) -> m ()
117 updateDomainOf (UVar var) dom = do
98 updateDomainOf (UVar var) dom = do
118 doms <- gets domainStore
99 doms <- gets domainStore
119 let oldDom = doms M.! Var var
100 let oldDom = doms M.! Var var
@@ -129,10 +110,10 @@ solve inpConstraints = evalStateT (propagate >> extractSolution) initSolverState
129 let cs = constraints M.! var
110 let cs = constraints M.! var
130 modify $ \ st -> st { queue = queue st ++ ordNub cs }
111 modify $ \ st -> st { queue = queue st ++ ordNub cs }
131
112
132− domainIntersect :: (InfInt, InfInt) -> (InfInt, InfInt) -> (InfInt, InfInt)
113+ domainIntersect :: (Int, Int) -> (Int, Int) -> (Int, Int)
133 domainIntersect (a,b) (c,d) = (max a c, min b d)
114 domainIntersect (a,b) (c,d) = (max a c, min b d)
134
115
135− wipeOut :: (InfInt, InfInt) -> Bool
116+ wipeOut :: (Int, Int) -> Bool
136 wipeOut (l, u) = l > u
117 wipeOut (l, u) = l > u
137
118
138ordNub :: Ord a => [a] -> [a]
119ordNub :: Ord a => [a] -> [a]