Skip to content

Commit 32cae60

Browse files
23Skidoo23Skidoo
authored
Merge pull request #4151 from haskell/fmthoma/refactor-conflict-set
Migrate ConflictSet qpn ↦ ConflictSet
2 parents 1b8f375 + 6869504 commit 32cae60

File tree

11 files changed

+47
-51
lines changed

11 files changed

+47
-51
lines changed

‎cabal-install/Distribution/Solver/Modular/Assignment.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,12 +67,12 @@ extend :: (Extension -> Bool) -- ^ is a given extension supported
6767
-> (Language -> Bool) -- ^ is a given language supported
6868
-> (PkgconfigName -> VR -> Bool) -- ^ is a given pkg-config requirement satisfiable
6969
-> Var QPN
70-
-> PPreAssignment -> [Dep QPN] -> Either (ConflictSet QPN, [Dep QPN]) PPreAssignment
70+
-> PPreAssignment -> [Dep QPN] -> Either (ConflictSet, [Dep QPN]) PPreAssignment
7171
extend extSupported langSupported pkgPresent var = foldM extendSingle
7272
where
7373

7474
extendSingle :: PPreAssignment -> Dep QPN
75-
-> Either (ConflictSet QPN, [Dep QPN]) PPreAssignment
75+
-> Either (ConflictSet, [Dep QPN]) PPreAssignment
7676
extendSingle a (Ext ext ) =
7777
if extSupported ext then Right a
7878
else Left (varToConflictSet var, [Ext ext])

‎cabal-install/Distribution/Solver/Modular/ConflictSet.hs

Lines changed: 15 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,9 @@ import Distribution.Solver.Types.PackagePath
4848
--
4949
-- Since these variables should be preprocessed in some way, this type is
5050
-- kept abstract.
51-
data ConflictSet qpn = CS {
51+
data ConflictSet = CS {
5252
-- | The set of variables involved on the conflict
53-
conflictSetToSet :: Set (Var qpn)
53+
conflictSetToSet :: Set (Var QPN)
5454

5555
#ifdef DEBUG_CONFLICT_SETS
5656
-- | The origin of the conflict set
@@ -68,16 +68,16 @@ data ConflictSet qpn = CS {
6868
}
6969
deriving (Show)
7070

71-
instance Eq qpn => Eq (ConflictSet qpn) where
71+
instance Eq ConflictSet where
7272
(==) = (==) `on` conflictSetToSet
7373

74-
instance Ord qpn => Ord (ConflictSet qpn) where
74+
instance Ord ConflictSet where
7575
compare = compare `on` conflictSetToSet
7676

77-
showCS :: ConflictSet QPN -> String
77+
showCS :: ConflictSet -> String
7878
showCS = intercalate ", " . map showVar . toList
7979

80-
showCSWithFrequency :: ConflictMap -> ConflictSet QPN -> String
80+
showCSWithFrequency :: ConflictMap -> ConflictSet -> String
8181
showCSWithFrequency cm = intercalate ", " . map showWithFrequency . indexByFrequency
8282
where
8383
indexByFrequency = sortBy (flip compare `on` snd) . map (\c -> (c, M.lookup c cm)) . toList
@@ -89,14 +89,14 @@ showCSWithFrequency cm = intercalate ", " . map showWithFrequency . indexByFrequ
8989
Set-like operations
9090
-------------------------------------------------------------------------------}
9191

92-
toList :: ConflictSet qpn -> [Var qpn]
92+
toList :: ConflictSet -> [Var QPN]
9393
toList = S.toList . conflictSetToSet
9494

9595
union ::
9696
#ifdef DEBUG_CONFLICT_SETS
9797
(?loc :: CallStack) =>
9898
#endif
99-
Ord qpn => ConflictSet qpn -> ConflictSet qpn -> ConflictSet qpn
99+
ConflictSet -> ConflictSet -> ConflictSet
100100
union cs cs' = CS {
101101
conflictSetToSet = S.union (conflictSetToSet cs) (conflictSetToSet cs')
102102
#ifdef DEBUG_CONFLICT_SETS
@@ -108,7 +108,7 @@ unions ::
108108
#ifdef DEBUG_CONFLICT_SETS
109109
(?loc :: CallStack) =>
110110
#endif
111-
Ord qpn => [ConflictSet qpn] -> ConflictSet qpn
111+
[ConflictSet] -> ConflictSet
112112
unions css = CS {
113113
conflictSetToSet = S.unions (map conflictSetToSet css)
114114
#ifdef DEBUG_CONFLICT_SETS
@@ -120,7 +120,7 @@ insert ::
120120
#ifdef DEBUG_CONFLICT_SETS
121121
(?loc :: CallStack) =>
122122
#endif
123-
Ord qpn => Var qpn -> ConflictSet qpn -> ConflictSet qpn
123+
Var QPN -> ConflictSet -> ConflictSet
124124
insert var cs = CS {
125125
conflictSetToSet = S.insert (simplifyVar var) (conflictSetToSet cs)
126126
#ifdef DEBUG_CONFLICT_SETS
@@ -132,7 +132,7 @@ empty ::
132132
#ifdef DEBUG_CONFLICT_SETS
133133
(?loc :: CallStack) =>
134134
#endif
135-
ConflictSet qpn
135+
ConflictSet
136136
empty = CS {
137137
conflictSetToSet = S.empty
138138
#ifdef DEBUG_CONFLICT_SETS
@@ -144,25 +144,22 @@ singleton ::
144144
#ifdef DEBUG_CONFLICT_SETS
145145
(?loc :: CallStack) =>
146146
#endif
147-
Var qpn -> ConflictSet qpn
147+
Var QPN -> ConflictSet
148148
singleton var = CS {
149149
conflictSetToSet = S.singleton (simplifyVar var)
150150
#ifdef DEBUG_CONFLICT_SETS
151151
, conflictSetOrigin = Node ?loc []
152152
#endif
153153
}
154154

155-
member :: Ord qpn => Var qpn -> ConflictSet qpn -> Bool
155+
member :: Var QPN -> ConflictSet -> Bool
156156
member var = S.member (simplifyVar var) . conflictSetToSet
157157

158158
filter ::
159159
#ifdef DEBUG_CONFLICT_SETS
160160
(?loc :: CallStack) =>
161161
#endif
162-
#if !MIN_VERSION_containers(0,5,0)
163-
Ord qpn =>
164-
#endif
165-
(Var qpn -> Bool) -> ConflictSet qpn -> ConflictSet qpn
162+
(Var QPN -> Bool) -> ConflictSet -> ConflictSet
166163
filter p cs = CS {
167164
conflictSetToSet = S.filter p (conflictSetToSet cs)
168165
#ifdef DEBUG_CONFLICT_SETS
@@ -174,7 +171,7 @@ fromList ::
174171
#ifdef DEBUG_CONFLICT_SETS
175172
(?loc :: CallStack) =>
176173
#endif
177-
Ord qpn => [Var qpn] -> ConflictSet qpn
174+
[Var QPN] -> ConflictSet
178175
fromList vars = CS {
179176
conflictSetToSet = S.fromList (map simplifyVar vars)
180177
#ifdef DEBUG_CONFLICT_SETS

‎cabal-install/Distribution/Solver/Modular/Cycles.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ detectCyclesPhase = cata go
3434
-- | Given the reverse dependency map from a 'Done' node in the tree, check
3535
-- if the solution is cyclic. If it is, return the conflict set containing
3636
-- all decisions that could potentially break the cycle.
37-
findCycles :: RevDepMap -> Maybe (ConflictSet QPN)
37+
findCycles :: RevDepMap -> Maybe ConflictSet
3838
findCycles revDeps =
3939
case cycles of
4040
[] -> Nothing

‎cabal-install/Distribution/Solver/Modular/Dependency.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ merge ::
101101
#ifdef DEBUG_CONFLICT_SETS
102102
(?loc :: CallStack) =>
103103
#endif
104-
Ord qpn => CI qpn -> CI qpn -> Either (ConflictSet qpn, (CI qpn, CI qpn)) (CI qpn)
104+
CI QPN -> CI QPN -> Either (ConflictSet, (CI QPN, CI QPN)) (CI QPN)
105105
merge c@(Fixed i g1) d@(Fixed j g2)
106106
| i == j = Right c
107107
| otherwise = Left (CS.union (varToConflictSet g1) (varToConflictSet g2), (c, d))
@@ -378,11 +378,11 @@ goalToVar (Goal v _) = v
378378
--
379379
-- NOTE: This is just a call to 'varToConflictSet' under the hood;
380380
-- the 'GoalReason' is ignored.
381-
goalVarToConflictSet :: Goal qpn -> ConflictSet qpn
381+
goalVarToConflictSet :: Goal QPN -> ConflictSet
382382
goalVarToConflictSet (Goal g _gr) = varToConflictSet g
383383

384384
-- | Compute a singleton conflict set from a 'Var'
385-
varToConflictSet :: Var qpn -> ConflictSet qpn
385+
varToConflictSet :: Var QPN -> ConflictSet
386386
varToConflictSet = CS.singleton
387387

388388
-- | A goal reason is mostly just a variable paired with the

‎cabal-install/Distribution/Solver/Modular/Explore.hs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -45,28 +45,28 @@ import Distribution.Solver.Types.Settings (EnableBackjumping(..), CountConflicts
4545
-- variable. See also the comments for 'avoidSet'.
4646
--
4747
backjump :: EnableBackjumping -> Var QPN
48-
-> ConflictSet QPN -> W.WeightedPSQ w k (ConflictMap -> ConflictSetLog a)
48+
-> ConflictSet -> W.WeightedPSQ w k (ConflictMap -> ConflictSetLog a)
4949
-> ConflictMap -> ConflictSetLog a
5050
backjump (EnableBackjumping enableBj) var initial xs =
5151
F.foldr combine logBackjump xs initial
5252
where
5353
combine :: forall a . (ConflictMap -> ConflictSetLog a)
54-
-> (ConflictSet QPN -> ConflictMap -> ConflictSetLog a)
55-
-> ConflictSet QPN -> ConflictMap -> ConflictSetLog a
54+
-> (ConflictSet -> ConflictMap -> ConflictSetLog a)
55+
-> ConflictSet -> ConflictMap -> ConflictSetLog a
5656
combine x f csAcc cm = retry (x cm) next
5757
where
58-
next :: (ConflictSet QPN, ConflictMap) -> ConflictSetLog a
58+
next :: (ConflictSet, ConflictMap) -> ConflictSetLog a
5959
next (cs, cm')
6060
| enableBj && not (var `CS.member` cs) = logBackjump cs cm'
6161
| otherwise = f (csAcc `CS.union` cs) cm'
6262

63-
logBackjump :: ConflictSet QPN -> ConflictMap -> ConflictSetLog a
63+
logBackjump :: ConflictSet -> ConflictMap -> ConflictSetLog a
6464
logBackjump cs !cm = failWith (Failure cs Backjump) (cs, updateCM initial cm)
6565
-- 'intial' instead of 'cs' here ---^
6666
-- since we do not want to double-count the
6767
-- additionally accumulated conflicts.
6868

69-
type ConflictSetLog = RetryLog Message (ConflictSet QPN, ConflictMap)
69+
type ConflictSetLog = RetryLog Message (ConflictSet, ConflictMap)
7070

7171
getBestGoal :: ConflictMap -> P.PSQ (Goal QPN) a -> (Goal QPN, a)
7272
getBestGoal cm =
@@ -81,7 +81,7 @@ getFirstGoal ts =
8181
(error "getFirstGoal: empty goal choice") -- empty goal choice is an internal error
8282
(\ k v _xs -> (k, v)) -- commit to the first goal choice
8383

84-
updateCM :: ConflictSet QPN -> ConflictMap -> ConflictMap
84+
updateCM :: ConflictSet -> ConflictMap -> ConflictMap
8585
updateCM cs cm =
8686
L.foldl' (\ cmc k -> M.alter inc k cmc) cm (CS.toList cs)
8787
where
@@ -163,7 +163,7 @@ exploreLog enableBj (CountConflicts countConflicts) t = cata go t M.empty
163163
-- current variable, the goal reason of the current node will be added to the
164164
-- conflict set.
165165
--
166-
avoidSet :: Var QPN -> QGoalReason -> ConflictSet QPN
166+
avoidSet :: Var QPN -> QGoalReason -> ConflictSet
167167
avoidSet var gr =
168168
CS.fromList (var : goalReasonToVars gr)
169169

‎cabal-install/Distribution/Solver/Modular/Linking.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -125,7 +125,7 @@ validateLinking index = (`runReader` initVS) . cata go
125125
Updating the validation state
126126
-------------------------------------------------------------------------------}
127127

128-
type Conflict = (ConflictSet QPN, String)
128+
type Conflict = (ConflictSet, String)
129129

130130
newtype UpdateState a = UpdateState {
131131
unUpdateState :: StateT ValidateState (Either Conflict) a
@@ -425,7 +425,7 @@ data LinkGroup = LinkGroup {
425425
-- | The set of variables that should be added to the conflict set if
426426
-- something goes wrong with this link set (in addition to the members
427427
-- of the link group itself)
428-
, lgBlame :: ConflictSet QPN
428+
, lgBlame :: ConflictSet
429429
}
430430
deriving (Show, Eq)
431431

@@ -495,7 +495,7 @@ lgMerge blame lg lg' = do
495495
++ " and " ++ showLinkGroup lg'
496496
)
497497

498-
lgConflictSet :: LinkGroup -> ConflictSet QPN
498+
lgConflictSet :: LinkGroup -> ConflictSet
499499
lgConflictSet lg =
500500
CS.fromList (map aux (S.toList (lgMembers lg)))
501501
`CS.union` lgBlame lg

‎cabal-install/Distribution/Solver/Modular/Log.hs

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,6 @@ import Distribution.Client.Compat.Prelude
88

99
import Data.List as L
1010

11-
import Distribution.Solver.Types.PackagePath
1211
import Distribution.Solver.Types.Progress
1312

1413
import Distribution.Solver.Modular.Dependency
@@ -21,7 +20,7 @@ import qualified Distribution.Solver.Modular.ConflictSet as CS
2120
-- Represents the progress of a computation lazily.
2221
--
2322
-- Parameterized over the type of actual messages and the final result.
24-
type Log m a = Progress m (ConflictSet QPN, ConflictMap) a
23+
type Log m a = Progress m (ConflictSet, ConflictMap) a
2524

2625
messages :: Progress step fail done -> [step]
2726
messages = foldProgress (:) (const []) (const [])
@@ -43,7 +42,7 @@ logToProgress mbj l = let
4342
-- and ignores repeated backjumps. If proc reaches the backjump limit, it truncates
4443
-- the 'Progress' and ends it with the last conflict set. Otherwise, it leaves the
4544
-- original result.
46-
proc :: Maybe Int -> Log Message b -> Progress Message (Exhaustiveness, ConflictSet QPN, ConflictMap) b
45+
proc :: Maybe Int -> Log Message b -> Progress Message (Exhaustiveness, ConflictSet, ConflictMap) b
4746
proc _ (Done x) = Done x
4847
proc _ (Fail (cs, cm)) = Fail (Exhaustive, cs, cm)
4948
proc mbj' (Step x@(Failure cs Backjump) xs@(Step Leave (Step (Failure cs' Backjump) _)))
@@ -60,9 +59,9 @@ logToProgress mbj l = let
6059
--
6160
-- The third argument is the full log, ending with either the solution or the
6261
-- exhaustiveness and final conflict set.
63-
go :: Progress Message (Exhaustiveness, ConflictSet QPN, ConflictMap) b
64-
-> Progress Message (Exhaustiveness, ConflictSet QPN, ConflictMap) b
65-
-> Progress String (Exhaustiveness, ConflictSet QPN, ConflictMap) b
62+
go :: Progress Message (Exhaustiveness, ConflictSet, ConflictMap) b
63+
-> Progress Message (Exhaustiveness, ConflictSet, ConflictMap) b
64+
-> Progress String (Exhaustiveness, ConflictSet, ConflictMap) b
6665
-> Progress String String b
6766
go ms (Step _ ns) (Step x xs) = Step x (go ms ns xs)
6867
go ms r (Step x xs) = Step x (go ms r xs)

‎cabal-install/Distribution/Solver/Modular/Message.hs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ data Message =
2727
| TryS QSN Bool
2828
| Next (Goal QPN)
2929
| Success
30-
| Failure (ConflictSet QPN) FailReason
30+
| Failure ConflictSet FailReason
3131

3232
-- | Transforms the structured message type to actual messages (strings).
3333
--
@@ -88,7 +88,7 @@ showMessages p sl = go [] 0
8888
showPackageGoal :: QPN -> QGoalReason -> String
8989
showPackageGoal qpn gr = "next goal: " ++ showQPN qpn ++ showGR gr
9090

91-
showFailure :: ConflictSet QPN -> FailReason -> String
91+
showFailure :: ConflictSet -> FailReason -> String
9292
showFailure c fr = "fail" ++ showFR c fr
9393

9494
add :: Var QPN -> [Var QPN] -> [Var QPN]
@@ -99,7 +99,7 @@ showMessages p sl = go [] 0
9999
-> Int
100100
-> QPN
101101
-> [POption]
102-
-> ConflictSet QPN
102+
-> ConflictSet
103103
-> FailReason
104104
-> Progress Message a b
105105
-> Progress String a b
@@ -128,7 +128,7 @@ showGR (PDependency pi) = " (dependency of " ++ showPI pi ++ ")"
128128
showGR (FDependency qfn b) = " (dependency of " ++ showQFNBool qfn b ++ ")"
129129
showGR (SDependency qsn) = " (dependency of " ++ showQSNBool qsn True ++ ")"
130130

131-
showFR :: ConflictSet QPN -> FailReason -> String
131+
showFR :: ConflictSet -> FailReason -> String
132132
showFR _ InconsistentInitialConstraints = " (inconsistent initial constraints)"
133133
showFR _ (Conflicting ds) = " (conflict: " ++ L.intercalate ", " (map showDep ds) ++ ")"
134134
showFR _ CannotInstall = " (only already installed instances can be used)"

‎cabal-install/Distribution/Solver/Modular/Preference.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -147,7 +147,7 @@ preferPackageStanzaPreferences pcs = trav go
147147
-- tree-transformer that either leaves the subtree untouched, or replaces it
148148
-- with an appropriate failure node.
149149
processPackageConstraintP :: PackagePath
150-
-> ConflictSet QPN
150+
-> ConflictSet
151151
-> I
152152
-> LabeledPackageConstraint
153153
-> Tree d c
@@ -175,7 +175,7 @@ processPackageConstraintP _ c i (LabeledPackageConstraint pc src) r = go i pc
175175
-- tree-transformer that either leaves the subtree untouched, or replaces it
176176
-- with an appropriate failure node.
177177
processPackageConstraintF :: Flag
178-
-> ConflictSet QPN
178+
-> ConflictSet
179179
-> Bool
180180
-> LabeledPackageConstraint
181181
-> Tree d c
@@ -194,7 +194,7 @@ processPackageConstraintF f c b' (LabeledPackageConstraint pc src) r = go pc
194194
-- tree-transformer that either leaves the subtree untouched, or replaces it
195195
-- with an appropriate failure node.
196196
processPackageConstraintS :: OptionalStanza
197-
-> ConflictSet QPN
197+
-> ConflictSet
198198
-> Bool
199199
-> LabeledPackageConstraint
200200
-> Tree d c

‎cabal-install/Distribution/Solver/Modular/Solver.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -211,7 +211,7 @@ instance GSimpleTree (Tree d QGoalReason) where
211211
shortGR (SDependency nm) = showQSN nm
212212

213213
-- Show conflict set
214-
goCS :: ConflictSet QPN -> String
214+
goCS :: ConflictSet -> String
215215
goCS cs = "{" ++ (intercalate "," . L.map showVar . CS.toList $ cs) ++ "}"
216216
#endif
217217

‎cabal-install/Distribution/Solver/Modular/Tree.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ data Tree d c =
7272
| Done RevDepMap d
7373

7474
-- | We failed to find a solution in this path through the tree
75-
| Fail (ConflictSet QPN) FailReason
75+
| Fail ConflictSet FailReason
7676
deriving (Eq, Show)
7777

7878
-- | A package option is a package instance with an optional linking annotation
@@ -122,7 +122,7 @@ data TreeF d c a =
122122
| SChoiceF QSN c WeakOrTrivial (WeightedPSQ [Weight] Bool a)
123123
| GoalChoiceF (PSQ (Goal QPN) a)
124124
| DoneF RevDepMap d
125-
| FailF (ConflictSet QPN) FailReason
125+
| FailF ConflictSet FailReason
126126
deriving (Functor, Foldable, Traversable)
127127

128128
out :: Tree d c -> TreeF d c (Tree d c)

0 commit comments

Comments
 (0)