From 9c15880f66a61f2ad24be030b354bd8db2ea2e64 Mon Sep 17 00:00:00 2001 From: Kristen Kozak Date: Fri, 10 Nov 2023 19:26:45 -0800 Subject: [PATCH] Remove debug-conflict-sets flag from solver package Fixes #8937. The debug-conflict-sets build flag probably hasn't been used for a long time, and it isn't currently tested. This commit removes the flag, converts the ConflictSet type back to a newtype, and removes an unnecessary instance. --- bootstrap/linux-8.10.7.json | 1 - bootstrap/linux-9.0.2.json | 1 - bootstrap/linux-9.2.7.json | 1 - bootstrap/linux-9.4.4.json | 1 - .../cabal-install-solver.cabal | 9 -- .../Solver/Modular/ConflictSet.hs | 99 ++----------------- .../Distribution/Solver/Modular/Validate.hs | 14 +-- 7 files changed, 11 insertions(+), 115 deletions(-) diff --git a/bootstrap/linux-8.10.7.json b/bootstrap/linux-8.10.7.json index 4ef250fd0c2..52852989fe0 100644 --- a/bootstrap/linux-8.10.7.json +++ b/bootstrap/linux-8.10.7.json @@ -337,7 +337,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.0.2.json b/bootstrap/linux-9.0.2.json index 36613ac64ea..e870c3f507e 100644 --- a/bootstrap/linux-9.0.2.json +++ b/bootstrap/linux-9.0.2.json @@ -337,7 +337,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.2.7.json b/bootstrap/linux-9.2.7.json index 4cc8973f751..408cd0f322b 100644 --- a/bootstrap/linux-9.2.7.json +++ b/bootstrap/linux-9.2.7.json @@ -300,7 +300,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/bootstrap/linux-9.4.4.json b/bootstrap/linux-9.4.4.json index af00acf12af..7d266473342 100644 --- a/bootstrap/linux-9.4.4.json +++ b/bootstrap/linux-9.4.4.json @@ -290,7 +290,6 @@ "cabal_sha256": null, "component": "lib:cabal-install-solver", "flags": [ - "-debug-conflict-sets", "-debug-expensive-assertions", "-debug-tracetree" ], diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index 4157d98283b..b4bfa668702 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -27,11 +27,6 @@ flag debug-expensive-assertions default: False manual: True -flag debug-conflict-sets - description: Add additional information to ConflictSets - default: False - manual: True - flag debug-tracetree description: Compile in support for tracetree (used to debug the solver) default: False @@ -119,10 +114,6 @@ library if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS - if flag(debug-conflict-sets) - cpp-options: -DDEBUG_CONFLICT_SETS - build-depends: base >=4.9 - if flag(debug-tracetree) cpp-options: -DDEBUG_TRACETREE build-depends: tracetree ^>=0.1 diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs index 190e811f06f..00cf15b466f 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE CPP #-} -#ifdef DEBUG_CONFLICT_SETS -{-# LANGUAGE ImplicitParams #-} -#endif -- | Conflict sets -- -- Intended for double import @@ -13,9 +9,6 @@ module Distribution.Solver.Modular.ConflictSet ( , Conflict(..) , ConflictMap , OrderedVersionRange(..) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin -#endif , showConflictSet , showCSSortedByFrequency , showCSWithFrequency @@ -44,36 +37,17 @@ import Data.Function (on) import qualified Data.Map.Strict as M import qualified Data.Set as S -#ifdef DEBUG_CONFLICT_SETS -import Data.Tree -import GHC.Stack -#endif - import Distribution.Solver.Modular.Var import Distribution.Solver.Modular.Version import Distribution.Solver.Types.PackagePath -- | The set of variables involved in a solver conflict, each paired with -- details about the conflict. -data ConflictSet = CS { +newtype ConflictSet = CS { -- | The set of variables involved in the conflict - conflictSetToMap :: !(Map (Var QPN) (Set Conflict)) - -#ifdef DEBUG_CONFLICT_SETS - -- | The origin of the conflict set - -- - -- When @DEBUG_CONFLICT_SETS@ is defined @(-f debug-conflict-sets)@, - -- we record the origin of every conflict set. For new conflict sets - -- ('empty', 'fromVars', ..) we just record the 'CallStack'; for operations - -- that construct new conflict sets from existing conflict sets ('union', - -- 'filter', ..) we record the 'CallStack' to the call to the combinator - -- as well as the 'CallStack's of the input conflict sets. - -- - -- Requires @GHC >= 7.10@. - , conflictSetOrigin :: Tree CallStack -#endif + conflictSetToMap :: Map (Var QPN) (Set Conflict) } - deriving (Show) + deriving (Eq, Show) -- | More detailed information about how a conflict set variable caused a -- conflict. This information can be used to determine whether a second value @@ -112,12 +86,6 @@ newtype OrderedVersionRange = OrderedVersionRange VR instance Ord OrderedVersionRange where compare = compare `on` show -instance Eq ConflictSet where - (==) = (==) `on` conflictSetToMap - -instance Ord ConflictSet where - compare = compare `on` conflictSetToMap - showConflictSet :: ConflictSet -> String showConflictSet = intercalate ", " . map showVar . toList @@ -147,40 +115,19 @@ toSet = M.keysSet . conflictSetToMap toList :: ConflictSet -> [Var QPN] toList = M.keys . conflictSetToMap -union :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - ConflictSet -> ConflictSet -> ConflictSet +union :: ConflictSet -> ConflictSet -> ConflictSet union cs cs' = CS { conflictSetToMap = M.unionWith S.union (conflictSetToMap cs) (conflictSetToMap cs') -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc (map conflictSetOrigin [cs, cs']) -#endif } -unions :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - [ConflictSet] -> ConflictSet +unions :: [ConflictSet] -> ConflictSet unions css = CS { conflictSetToMap = M.unionsWith S.union (map conflictSetToMap css) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc (map conflictSetOrigin css) -#endif } -insert :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> ConflictSet -> ConflictSet +insert :: Var QPN -> ConflictSet -> ConflictSet insert var cs = CS { conflictSetToMap = M.insert var (S.singleton OtherConflict) (conflictSetToMap cs) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [conflictSetOrigin cs] -#endif } delete :: Var QPN -> ConflictSet -> ConflictSet @@ -188,35 +135,17 @@ delete var cs = CS { conflictSetToMap = M.delete var (conflictSetToMap cs) } -empty :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - ConflictSet +empty :: ConflictSet empty = CS { conflictSetToMap = M.empty -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } -singleton :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> ConflictSet +singleton :: Var QPN -> ConflictSet singleton var = singletonWithConflict var OtherConflict -singletonWithConflict :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - Var QPN -> Conflict -> ConflictSet +singletonWithConflict :: Var QPN -> Conflict -> ConflictSet singletonWithConflict var conflict = CS { conflictSetToMap = M.singleton var (S.singleton conflict) -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } size :: ConflictSet -> Int @@ -228,17 +157,9 @@ member var = M.member var . conflictSetToMap lookup :: Var QPN -> ConflictSet -> Maybe (Set Conflict) lookup var = M.lookup var . conflictSetToMap -fromList :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - [Var QPN] -> ConflictSet +fromList :: [Var QPN] -> ConflictSet fromList vars = CS { conflictSetToMap = M.fromList [(var, S.singleton OtherConflict) | var <- vars] -#ifdef DEBUG_CONFLICT_SETS - , conflictSetOrigin = Node ?loc [] -#endif } type ConflictMap = Map (Var QPN) Int - diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 54911f2c367..cbe6282b6d0 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -1,9 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE CPP #-} -#ifdef DEBUG_CONFLICT_SETS -{-# LANGUAGE ImplicitParams #-} -#endif module Distribution.Solver.Modular.Validate (validateTree) where -- Validation of the tree. @@ -40,10 +36,6 @@ import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent import Distribution.Types.LibraryName import Distribution.Types.PkgconfigVersionRange -#ifdef DEBUG_CONFLICT_SETS -import GHC.Stack (CallStack) -#endif - -- In practice, most constraints are implication constraints (IF we have made -- a number of choices, THEN we also have to ensure that). We call constraints -- that for which the preconditions are fulfilled ACTIVE. We maintain a set @@ -450,11 +442,7 @@ extendWithPackageChoice (PI qpn i) ppa = -- set in the sense the it contains variables that allow us to backjump -- further. We might apply some heuristics here, such as to change the -- order in which we check the constraints. -merge :: -#ifdef DEBUG_CONFLICT_SETS - (?loc :: CallStack) => -#endif - MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep +merge :: MergedPkgDep -> PkgDep -> Either (ConflictSet, (ConflictingDep, ConflictingDep)) MergedPkgDep merge (MergedDepFixed comp1 vs1 i1) (PkgDep vs2 (PkgComponent p comp2) ci@(Fixed i2)) | i1 == i2 = Right $ MergedDepFixed comp1 vs1 i1 | otherwise =