Merge pull request #9432 from grayjay/remove-debug-conflict-sets

Remove debug-conflict-sets flag from solver package
haskell · Nov 19, 2023 · c97092f · c97092f
2 parents 88e4b00 + 9c15880
commit c97092f
Show file tree

Hide file tree

Showing 7 changed files with 11 additions and 115 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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,76 +115,37 @@ 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
 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
@@ -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 =