Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Remove debug-conflict-sets flag from solver package #9432

Merged
merged 1 commit into from
Nov 19, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion bootstrap/linux-8.10.7.json
Original file line number Diff line number Diff line change
Expand Up @@ -337,7 +337,6 @@
"cabal_sha256": null,
"component": "lib:cabal-install-solver",
"flags": [
"-debug-conflict-sets",
"-debug-expensive-assertions",
"-debug-tracetree"
],
Expand Down
1 change: 0 additions & 1 deletion bootstrap/linux-9.0.2.json
Original file line number Diff line number Diff line change
Expand Up @@ -337,7 +337,6 @@
"cabal_sha256": null,
"component": "lib:cabal-install-solver",
"flags": [
"-debug-conflict-sets",
"-debug-expensive-assertions",
"-debug-tracetree"
],
Expand Down
1 change: 0 additions & 1 deletion bootstrap/linux-9.2.7.json
Original file line number Diff line number Diff line change
Expand Up @@ -300,7 +300,6 @@
"cabal_sha256": null,
"component": "lib:cabal-install-solver",
"flags": [
"-debug-conflict-sets",
"-debug-expensive-assertions",
"-debug-tracetree"
],
Expand Down
1 change: 0 additions & 1 deletion bootstrap/linux-9.4.4.json
Original file line number Diff line number Diff line change
Expand Up @@ -290,7 +290,6 @@
"cabal_sha256": null,
"component": "lib:cabal-install-solver",
"flags": [
"-debug-conflict-sets",
"-debug-expensive-assertions",
"-debug-tracetree"
],
Expand Down
9 changes: 0 additions & 9 deletions cabal-install-solver/cabal-install-solver.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
99 changes: 10 additions & 89 deletions cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,3 @@
{-# LANGUAGE CPP #-}
#ifdef DEBUG_CONFLICT_SETS
{-# LANGUAGE ImplicitParams #-}
#endif
-- | Conflict sets
--
-- Intended for double import
Expand All @@ -13,9 +9,6 @@ module Distribution.Solver.Modular.ConflictSet (
, Conflict(..)
, ConflictMap
, OrderedVersionRange(..)
#ifdef DEBUG_CONFLICT_SETS
, conflictSetOrigin
#endif
, showConflictSet
, showCSSortedByFrequency
, showCSWithFrequency
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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

14 changes: 1 addition & 13 deletions cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs
Original file line number Diff line number Diff line change
@@ -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.
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
Loading