@@ -71,10 +71,10 @@ solve maxUniverseLevel ucs =
7171 rhs _ = Nothing
7272
7373 -- | a map from variables to the list of constraints the variable occurs in. (in the LHS of a constraint)
74− constraintsLHS :: M.Map Var (S.Set (UConstraint, FC))
74+ constraintsLHS :: M.Map Var (S.Set ConstraintFC)
7575 constraintsLHS = M.fromListWith S.union
76− [ (v, S.singleton (c,fc))
77− | (c, fc) <- inpConstraints
76+ [ (v, S.singleton (ConstraintFC c fc))
77+ | (ConstraintFC c fc) <- inpConstraints
7878 , let vars = varsIn c
7979 , length vars > 1 -- do not register unary constraints
8080 , v <- vars
@@ -82,10 +82,10 @@ solve maxUniverseLevel ucs =
8282 ]
8383
8484 -- | a map from variables to the list of constraints the variable occurs in. (in the RHS of a constraint)
85− constraintsRHS :: M.Map Var (S.Set (UConstraint, FC))
85+ constraintsRHS :: M.Map Var (S.Set ConstraintFC)
8686 constraintsRHS = M.fromListWith S.union
87− [ (v, S.singleton (c,fc))
88− | (c, fc) <- inpConstraints
87+ [ (v, S.singleton (ConstraintFC c fc))
88+ | (ConstraintFC c fc) <- inpConstraints
8989 , let vars = varsIn c
9090 , length vars > 1 -- do not register unary constraints
9191 , v <- vars
@@ -107,15 +107,15 @@ solve maxUniverseLevel ucs =
107107 ULE a b -> do
108108 Domain lowerA upperA <- domainOf a
109109 Domain lowerB upperB <- domainOf b
110− when (upperB < upperA) $ updateUpperBoundOf (cons, fc) a upperB
111− when (lowerA > lowerB) $ updateLowerBoundOf (cons, fc) b lowerA
110+ when (upperB < upperA) $ updateUpperBoundOf (ConstraintFC cons fc) a upperB
111+ when (lowerA > lowerB) $ updateLowerBoundOf (ConstraintFC cons fc) b lowerA
112112 ULT a b -> do
113113 Domain lowerA upperA <- domainOf a
114114 Domain lowerB upperB <- domainOf b
115115 let upperB_pred = pred upperB
116116 let lowerA_succ = succ lowerA
117− when (upperB_pred < upperA) $ updateUpperBoundOf (cons, fc) a upperB_pred
118− when (lowerA_succ > lowerB) $ updateLowerBoundOf (cons, fc) b lowerA_succ
117+ when (upperB_pred < upperA) $ updateUpperBoundOf (ConstraintFC cons fc) a upperB_pred
118+ when (lowerA_succ > lowerB) $ updateLowerBoundOf (ConstraintFC cons fc) b lowerA_succ
119119 propagate
120120
121121 -- | extract a solution from the state.
@@ -141,12 +141,12 @@ solve maxUniverseLevel ucs =
141141 domainOf (UVar var) = gets (fst . (M.! Var var) . domainStore)
142142 domainOf (UVal val) = return (Domain val val)
143143
144− updateUpperBoundOf :: (UConstraint, FC) -> UExp -> Int -> StateT SolverState TC ()
144+ updateUpperBoundOf :: ConstraintFC -> UExp -> Int -> StateT SolverState TC ()
145145 updateUpperBoundOf suspect (UVar var) upper = do
146146 doms <- gets domainStore
147147 let (oldDom@(Domain lower _), suspects) = doms M.! Var var
148148 let newDom = Domain lower upper
149− when (wipeOut newDom) $ lift $ Error $ At (snd suspect) $ Msg $ unlines
149+ when (wipeOut newDom) $ lift $ Error $ At (ufc suspect) $ Msg $ unlines
150150 $ "Universe inconsistency."
151151 : ("Working on: " ++ show (UVar var))
152152 : ("Old domain: " ++ show oldDom)
@@ -154,15 +154,15 @@ solve maxUniverseLevel ucs =
154154 : "Involved constraints: "
155155 : map (("\t"++) . show) (suspect : S.toList suspects)
156156 modify $ \ st -> st { domainStore = M.insert (Var var) (newDom, S.insert suspect suspects) doms }
157− addToQueueRHS (fst suspect) (Var var)
157+ addToQueueRHS (uconstraint suspect) (Var var)
158158 updateUpperBoundOf _ UVal{} _ = return ()
159159
160− updateLowerBoundOf :: (UConstraint, FC) -> UExp -> Int -> StateT SolverState TC ()
160+ updateLowerBoundOf :: ConstraintFC -> UExp -> Int -> StateT SolverState TC ()
161161 updateLowerBoundOf suspect (UVar var) lower = do
162162 doms <- gets domainStore
163163 let (oldDom@(Domain _ upper), suspects) = doms M.! Var var
164164 let newDom = Domain lower upper
165− when (wipeOut newDom) $ lift $ Error $ At (snd suspect) $ Msg $ unlines
165+ when (wipeOut newDom) $ lift $ Error $ At (ufc suspect) $ Msg $ unlines
166166 $ "Universe inconsistency."
167167 : ("Working on: " ++ show (UVar var))
168168 : ("Old domain: " ++ show oldDom)
@@ -170,7 +170,7 @@ solve maxUniverseLevel ucs =
170170 : "Involved constraints: "
171171 : map (("\t"++) . show) (suspect : S.toList suspects)
172172 modify $ \ st -> st { domainStore = M.insert (Var var) (newDom, S.insert suspect suspects) doms }
173− addToQueueLHS (fst suspect) (Var var)
173+ addToQueueLHS (uconstraint suspect) (Var var)
174174 updateLowerBoundOf _ UVal{} _ = return ()
175175
176176 -- | add all constraints (with the given var on the lhs) to the queue
@@ -181,11 +181,11 @@ solve maxUniverseLevel ucs =
181181 Just cs -> do
182182 Queue list set <- gets queue
183183 let set' = S.insert thisCons set
184− let newCons = [ c | c <- S.toList cs, fst c `S.notMember` set' ]
184+ let newCons = [ c | c <- S.toList cs, uconstraint c `S.notMember` set' ]
185185 if null newCons
186186 then return ()
187187 else modify $ \ st -> st { queue = Queue (list ++ newCons)
188− (S.union set (S.fromList (map fst newCons))) }
188+ (S.union set (S.fromList (map uconstraint newCons))) }
189189
190190 -- | add all constraints (with the given var on the rhs) to the queue
191191 addToQueueRHS :: MonadState SolverState m => UConstraint -> Var -> m ()
@@ -195,7 +195,7 @@ solve maxUniverseLevel ucs =
195195 Just cs -> do
196196 Queue list set <- gets queue
197197 let set' = S.insert thisCons set
198− let newCons = [ c | c <- S.toList cs, fst c `S.notMember` set' ]
198+ let newCons = [ c | c <- S.toList cs, uconstraint c `S.notMember` set' ]
199199 if null newCons
200200 then return ()
201201 else modify $ \ st -> st { queue = Queue (list ++ newCons)