Skip to content

GitLab

Commit 84727b76 authored by Andres Löh's avatar Andres Löh
Browse files

Add flag to selectively disable count-conflicts.

parent fba4b252
Hide whitespace changes
Inline Side-by-side
cabal-install/Distribution/Client/Config.hs
View file @ 84727b76
......@@ -239,6 +239,7 @@ instance Semigroup SavedConfig where
installDryRun = combine installDryRun,
installMaxBackjumps = combine installMaxBackjumps,
installReorderGoals = combine installReorderGoals,
installCountConflicts = combine installCountConflicts,
installIndependentGoals = combine installIndependentGoals,
installShadowPkgs = combine installShadowPkgs,
installStrongFlags = combine installStrongFlags,
......
cabal-install/Distribution/Client/Dependency.hs
View file @ 84727b76
......@@ -48,6 +48,7 @@ module Distribution.Client.Dependency (
addPreferences,
setPreferenceDefault,
setReorderGoals,
setCountConflicts,
setIndependentGoals,
setAvoidReinstalls,
setShadowPkgs,
......@@ -159,6 +160,7 @@ data DepResolverParams = DepResolverParams {
depResolverInstalledPkgIndex :: InstalledPackageIndex,
depResolverSourcePkgIndex :: PackageIndex.PackageIndex UnresolvedSourcePackage,
depResolverReorderGoals :: ReorderGoals,
depResolverCountConflicts :: CountConflicts,
depResolverIndependentGoals :: IndependentGoals,
depResolverAvoidReinstalls :: AvoidReinstalls,
depResolverShadowPkgs :: ShadowPkgs,
......@@ -181,6 +183,7 @@ showDepResolverParams p =
(depResolverPreferences p)
++ "\nstrategy: " ++ show (depResolverPreferenceDefault p)
++ "\nreorder goals: " ++ show (depResolverReorderGoals p)
++ "\ncount conflicts: " ++ show (depResolverCountConflicts p)
++ "\nindependent goals: " ++ show (depResolverIndependentGoals p)
++ "\navoid reinstalls: " ++ show (depResolverAvoidReinstalls p)
++ "\nshadow packages: " ++ show (depResolverShadowPkgs p)
......@@ -234,6 +237,7 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex =
depResolverInstalledPkgIndex = installedPkgIndex,
depResolverSourcePkgIndex = sourcePkgIndex,
depResolverReorderGoals = ReorderGoals False,
depResolverCountConflicts = CountConflicts True,
depResolverIndependentGoals = IndependentGoals False,
depResolverAvoidReinstalls = AvoidReinstalls False,
depResolverShadowPkgs = ShadowPkgs False,
......@@ -279,6 +283,12 @@ setReorderGoals reorder params =
depResolverReorderGoals = reorder
}
setCountConflicts :: CountConflicts -> DepResolverParams -> DepResolverParams
setCountConflicts count params =
params {
depResolverCountConflicts = count
}
setIndependentGoals :: IndependentGoals -> DepResolverParams -> DepResolverParams
setIndependentGoals indep params =
params {
......@@ -621,7 +631,8 @@ resolveDependencies platform comp pkgConfigDB solver params =
Step (showDepResolverParams finalparams)
$ fmap (validateSolverResult platform comp indGoals)
$ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls
$ runSolver solver (SolverConfig reordGoals cntConflicts
indGoals noReinstalls
shadowing strFlags maxBkjumps enableBj order)
platform comp installedPkgIndex sourcePkgIndex
pkgConfigDB preferences constraints targets
......@@ -632,7 +643,8 @@ resolveDependencies platform comp pkgConfigDB solver params =
prefs defpref
installedPkgIndex
sourcePkgIndex
reorderGoals
reordGoals
cntConflicts
indGoals
noReinstalls
shadowing
......@@ -873,7 +885,7 @@ resolveWithoutDependencies :: DepResolverParams
-> Either [ResolveNoDepsError] [UnresolvedSourcePackage]
resolveWithoutDependencies (DepResolverParams targets constraints
prefs defpref installedPkgIndex sourcePkgIndex
_reorderGoals _indGoals _avoidReinstalls
_reorderGoals _countConflicts _indGoals _avoidReinstalls
_shadowing _strFlags _maxBjumps _enableBj _order) =
collectEithers (map selectPackage targets)
where
......
cabal-install/Distribution/Client/Fetch.hs
View file @ 84727b76
......@@ -158,6 +158,8 @@ planPackages verbosity comp platform fetchFlags
. setReorderGoals reorderGoals
. setCountConflicts countConflicts
. setShadowPkgs shadowPkgs
. setStrongFlags strongFlags
......@@ -174,6 +176,7 @@ planPackages verbosity comp platform fetchFlags
logMsg message rest = debug verbosity message >> rest
reorderGoals = fromFlag (fetchReorderGoals fetchFlags)
countConflicts = fromFlag (fetchCountConflicts fetchFlags)
independentGoals = fromFlag (fetchIndependentGoals fetchFlags)
shadowPkgs = fromFlag (fetchShadowPkgs fetchFlags)
strongFlags = fromFlag (fetchStrongFlags fetchFlags)
......
cabal-install/Distribution/Client/Freeze.hs
View file @ 84727b76
......@@ -179,6 +179,8 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
. setReorderGoals reorderGoals
. setCountConflicts countConflicts
. setShadowPkgs shadowPkgs
. setStrongFlags strongFlags
......@@ -201,6 +203,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
benchmarksEnabled = fromFlagOrDefault False $ freezeBenchmarks freezeFlags
reorderGoals = fromFlag (freezeReorderGoals freezeFlags)
countConflicts = fromFlag (freezeCountConflicts freezeFlags)
independentGoals = fromFlag (freezeIndependentGoals freezeFlags)
shadowPkgs = fromFlag (freezeShadowPkgs freezeFlags)
strongFlags = fromFlag (freezeStrongFlags freezeFlags)
......
cabal-install/Distribution/Client/Install.hs
View file @ 84727b76
......@@ -379,6 +379,8 @@ planPackages comp platform mSandboxPkgInfo solver
. setReorderGoals reorderGoals
. setCountConflicts countConflicts
. setAvoidReinstalls avoidReinstalls
. setShadowPkgs shadowPkgs
......@@ -431,6 +433,7 @@ planPackages comp platform mSandboxPkgInfo solver
reinstall = fromFlag (installOverrideReinstall installFlags) ||
fromFlag (installReinstall installFlags)
reorderGoals = fromFlag (installReorderGoals installFlags)
countConflicts = fromFlag (installCountConflicts installFlags)
independentGoals = fromFlag (installIndependentGoals installFlags)
avoidReinstalls = fromFlag (installAvoidReinstalls installFlags)
shadowPkgs = fromFlag (installShadowPkgs installFlags)
......
cabal-install/Distribution/Client/ProjectConfig.hs
View file @ 84727b76
......@@ -196,6 +196,7 @@ resolveSolverSettings ProjectConfig{
n | n < 0 -> Nothing
| otherwise -> Just n
solverSettingReorderGoals = fromFlag projectConfigReorderGoals
solverSettingCountConflicts = fromFlag projectConfigCountConflicts
solverSettingStrongFlags = fromFlag projectConfigStrongFlags
--solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals
--solverSettingShadowPkgs = fromFlag projectConfigShadowPkgs
......@@ -211,6 +212,7 @@ resolveSolverSettings ProjectConfig{
projectConfigAllowNewer = Just AllowNewerNone,
projectConfigMaxBackjumps = Flag defaultMaxBackjumps,
projectConfigReorderGoals = Flag (ReorderGoals False),
projectConfigCountConflicts = Flag (CountConflicts True),
projectConfigStrongFlags = Flag (StrongFlags False)
--projectConfigIndependentGoals = Flag False,
--projectConfigShadowPkgs = Flag False,
......
cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
View file @ 84727b76
......@@ -303,6 +303,7 @@ convertLegacyAllPackageFlags globalFlags configFlags
installMaxBackjumps = projectConfigMaxBackjumps,
--installUpgradeDeps = projectConfigUpgradeDeps,
installReorderGoals = projectConfigReorderGoals,
installCountConflicts = projectConfigCountConflicts,
--installIndependentGoals = projectConfigIndependentGoals,
--installShadowPkgs = projectConfigShadowPkgs,
installStrongFlags = projectConfigStrongFlags
......@@ -495,6 +496,7 @@ convertToLegacySharedConfig
installMaxBackjumps = projectConfigMaxBackjumps,
installUpgradeDeps = mempty, --projectConfigUpgradeDeps,
installReorderGoals = projectConfigReorderGoals,
installCountConflicts = projectConfigCountConflicts,
installIndependentGoals = mempty, --projectConfigIndependentGoals,
installShadowPkgs = mempty, --projectConfigShadowPkgs,
installStrongFlags = projectConfigStrongFlags,
......@@ -827,7 +829,7 @@ legacySharedConfigFieldDescrs =
, "remote-build-reporting", "report-planning-failure"
, "one-shot", "jobs", "keep-going", "offline"
-- solver flags:
, "max-backjumps", "reorder-goals", "strong-flags"
, "max-backjumps", "reorder-goals", "count-conflicts", "strong-flags"
]
. commandOptionsToFields
) (installOptions ParseArgs)
......
cabal-install/Distribution/Client/ProjectConfig/Types.hs
View file @ 84727b76
......@@ -165,6 +165,7 @@ data ProjectConfigShared
projectConfigAllowNewer :: Maybe AllowNewer,
projectConfigMaxBackjumps :: Flag Int,
projectConfigReorderGoals :: Flag ReorderGoals,
projectConfigCountConflicts :: Flag CountConflicts,
projectConfigStrongFlags :: Flag StrongFlags
-- More things that only make sense for manual mode, not --local mode
......@@ -319,6 +320,7 @@ data SolverSettings
solverSettingAllowNewer :: AllowNewer,
solverSettingMaxBackjumps :: Maybe Int,
solverSettingReorderGoals :: ReorderGoals,
solverSettingCountConflicts :: CountConflicts,
solverSettingStrongFlags :: StrongFlags
-- Things that only make sense for manual mode, not --local mode
-- too much control!
......
cabal-install/Distribution/Client/ProjectPlanning.hs
View file @ 84727b76
......@@ -865,6 +865,8 @@ planPackages comp platform solver SolverSettings{..}
. setReorderGoals solverSettingReorderGoals
. setCountConflicts solverSettingCountConflicts
--TODO: [required eventually] should only be configurable for custom installs
-- . setAvoidReinstalls solverSettingAvoidReinstalls
......
cabal-install/Distribution/Client/Setup.hs
View file @ 84727b76
......@@ -606,6 +606,7 @@ data FetchFlags = FetchFlags {
fetchSolver :: Flag PreSolver,
fetchMaxBackjumps :: Flag Int,
fetchReorderGoals :: Flag ReorderGoals,
fetchCountConflicts :: Flag CountConflicts,
fetchIndependentGoals :: Flag IndependentGoals,
fetchShadowPkgs :: Flag ShadowPkgs,
fetchStrongFlags :: Flag StrongFlags,
......@@ -620,6 +621,7 @@ defaultFetchFlags = FetchFlags {
fetchSolver = Flag defaultSolver,
fetchMaxBackjumps = Flag defaultMaxBackjumps,
fetchReorderGoals = Flag (ReorderGoals False),
fetchCountConflicts = Flag (CountConflicts False),
fetchIndependentGoals = Flag (IndependentGoals False),
fetchShadowPkgs = Flag (ShadowPkgs False),
fetchStrongFlags = Flag (StrongFlags False),
......@@ -666,6 +668,7 @@ fetchCommand = CommandUI {
optionSolverFlags showOrParseArgs
fetchMaxBackjumps (\v flags -> flags { fetchMaxBackjumps = v })
fetchReorderGoals (\v flags -> flags { fetchReorderGoals = v })
fetchCountConflicts (\v flags -> flags { fetchCountConflicts = v })
fetchIndependentGoals (\v flags -> flags { fetchIndependentGoals = v })
fetchShadowPkgs (\v flags -> flags { fetchShadowPkgs = v })
fetchStrongFlags (\v flags -> flags { fetchStrongFlags = v })
......@@ -683,6 +686,7 @@ data FreezeFlags = FreezeFlags {
freezeSolver :: Flag PreSolver,
freezeMaxBackjumps :: Flag Int,
freezeReorderGoals :: Flag ReorderGoals,
freezeCountConflicts :: Flag CountConflicts,
freezeIndependentGoals :: Flag IndependentGoals,
freezeShadowPkgs :: Flag ShadowPkgs,
freezeStrongFlags :: Flag StrongFlags,
......@@ -697,6 +701,7 @@ defaultFreezeFlags = FreezeFlags {
freezeSolver = Flag defaultSolver,
freezeMaxBackjumps = Flag defaultMaxBackjumps,
freezeReorderGoals = Flag (ReorderGoals False),
freezeCountConflicts = Flag (CountConflicts False),
freezeIndependentGoals = Flag (IndependentGoals False),
freezeShadowPkgs = Flag (ShadowPkgs False),
freezeStrongFlags = Flag (StrongFlags False),
......@@ -742,6 +747,7 @@ freezeCommand = CommandUI {
optionSolverFlags showOrParseArgs
freezeMaxBackjumps (\v flags -> flags { freezeMaxBackjumps = v })
freezeReorderGoals (\v flags -> flags { freezeReorderGoals = v })
freezeCountConflicts (\v flags -> flags { freezeCountConflicts = v })
freezeIndependentGoals (\v flags -> flags { freezeIndependentGoals = v })
freezeShadowPkgs (\v flags -> flags { freezeShadowPkgs = v })
freezeStrongFlags (\v flags -> flags { freezeStrongFlags = v })
......@@ -1144,6 +1150,7 @@ data InstallFlags = InstallFlags {
installDryRun :: Flag Bool,
installMaxBackjumps :: Flag Int,
installReorderGoals :: Flag ReorderGoals,
installCountConflicts :: Flag CountConflicts,
installIndependentGoals :: Flag IndependentGoals,
installShadowPkgs :: Flag ShadowPkgs,
installStrongFlags :: Flag StrongFlags,
......@@ -1176,6 +1183,7 @@ defaultInstallFlags = InstallFlags {
installDryRun = Flag False,
installMaxBackjumps = Flag defaultMaxBackjumps,
installReorderGoals = Flag (ReorderGoals False),
installCountConflicts = Flag (CountConflicts True),
installIndependentGoals= Flag (IndependentGoals False),
installShadowPkgs = Flag (ShadowPkgs False),
installStrongFlags = Flag (StrongFlags False),
......@@ -1321,6 +1329,7 @@ installOptions showOrParseArgs =
optionSolverFlags showOrParseArgs
installMaxBackjumps (\v flags -> flags { installMaxBackjumps = v })
installReorderGoals (\v flags -> flags { installReorderGoals = v })
installCountConflicts (\v flags -> flags { installCountConflicts = v })
installIndependentGoals (\v flags -> flags { installIndependentGoals = v })
installShadowPkgs (\v flags -> flags { installShadowPkgs = v })
installStrongFlags (\v flags -> flags { installStrongFlags = v }) ++
......@@ -2085,11 +2094,12 @@ optionSolver get set =
optionSolverFlags :: ShowOrParseArgs
-> (flags -> Flag Int ) -> (Flag Int -> flags -> flags)
-> (flags -> Flag ReorderGoals) -> (Flag ReorderGoals -> flags -> flags)
-> (flags -> Flag CountConflicts) -> (Flag CountConflicts -> flags -> flags)
-> (flags -> Flag IndependentGoals) -> (Flag IndependentGoals -> flags -> flags)
-> (flags -> Flag ShadowPkgs) -> (Flag ShadowPkgs -> flags -> flags)
-> (flags -> Flag StrongFlags) -> (Flag StrongFlags -> flags -> flags)
-> [OptionField flags]
optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip setsip getstrfl setstrfl =
optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc _getig _setig getsip setsip getstrfl setstrfl =
[ option [] ["max-backjumps"]
("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.")
getmbj setmbj
......@@ -2100,6 +2110,11 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg _getig _setig getsip
(fmap asBool . getrg)
(setrg . fmap ReorderGoals)
(yesNoOpt showOrParseArgs)
, option [] ["count-conflicts"]
"Try to speed up solving by preferring goals that are involved in a lot of conflicts (default)."
(fmap asBool . getcc)
(setcc . fmap CountConflicts)
(yesNoOpt showOrParseArgs)
-- TODO: Disabled for now because it does not work as advertised (yet).
{-
, option [] ["independent-goals"]
......
cabal-install/Distribution/Solver/Modular/Explore.hs
View file @ 84727b76
{-# LANGUAGE BangPatterns #-}
module Distribution.Solver.Modular.Explore
( backjump
, backjumpAndExplore
......@@ -15,9 +16,8 @@ import qualified Distribution.Solver.Modular.PSQ as P
import qualified Distribution.Solver.Modular.ConflictSet as CS
import Distribution.Solver.Modular.Tree
import Distribution.Solver.Types.PackagePath
import Distribution.Solver.Types.Settings (EnableBackjumping(..))
import Distribution.Solver.Types.Settings (EnableBackjumping(..), CountConflicts(..))
import qualified Distribution.Solver.Types.Progress as P
import Distribution.Solver.Modular.Var
-- | This function takes the variable we're currently considering, an
-- initial conflict set and a
......@@ -45,22 +45,22 @@ import Distribution.Solver.Modular.Var
backjump :: EnableBackjumping -> Var QPN
-> ConflictSet QPN -> ConflictMap -> P.PSQ k (ConflictMap -> (ConflictSetLog a, ConflictMap))
-> (ConflictSetLog a, ConflictMap)
backjump (EnableBackjumping enableBj) var initial cm xs =
backjump (EnableBackjumping enableBj) var initial !cm xs =
F.foldr combine logBackjump xs initial cm
where
combine :: (ConflictMap -> (ConflictSetLog a, ConflictMap))
-> (ConflictSet QPN -> ConflictMap -> (ConflictSetLog a, ConflictMap))
-> ConflictSet QPN -> ConflictMap -> (ConflictSetLog a, ConflictMap)
combine x f csAcc cm =
let (l, cm') = x cm
combine x f csAcc cm0 =
let (l, cm1) = x cm0
in case l of
P.Done x -> (P.Done x, cm')
P.Done d -> (P.Done d, cm1)
P.Fail cs
| enableBj && not (var `CS.member` cs) -> logBackjump cs cm'
| otherwise -> f (csAcc `CS.union` cs) cm'
| enableBj && not (var `CS.member` cs) -> logBackjump cs cm1
| otherwise -> f (csAcc `CS.union` cs) cm1
P.Step m ms ->
let (l', cm'') = combine (\ x -> (ms, x)) f csAcc cm'
in (P.Step m l', cm'')
let (l', cm2) = combine (\ y -> (ms, y)) f csAcc cm1
in (P.Step m l', cm2)
logBackjump :: ConflictSet QPN -> ConflictMap -> (ConflictSetLog a, ConflictMap)
logBackjump cs cm' = (failWith (Failure cs Backjump) cs, cm')
......@@ -76,6 +76,12 @@ getBestGoal cm =
. (\ (Goal v _) -> v)
)
getFirstGoal :: P.PSQ (Goal QPN) a -> (Goal QPN, a)
getFirstGoal ts =
P.casePSQ ts
(error "getFirstGoal: empty goal choice") -- empty goal choice is an internal error
(\ k v _xs -> (k, v)) -- commit to the first goal choice
updateCM :: ConflictSet QPN -> ConflictMap -> ConflictMap
updateCM cs cm =
L.foldl' (\ cmc k -> M.alter inc k cmc) cm (CS.toList cs)
......@@ -85,40 +91,50 @@ updateCM cs cm =
-- | A tree traversal that simultaneously propagates conflict sets up
-- the tree from the leaves and creates a log.
exploreLog :: EnableBackjumping -> Tree QGoalReason
exploreLog :: EnableBackjumping -> CountConflicts -> Tree QGoalReason
-> (Assignment -> ConflictMap -> (ConflictSetLog (Assignment, RevDepMap), ConflictMap))
exploreLog enableBj = cata go
exploreLog enableBj (CountConflicts countConflicts) = cata go
where
updateCM' :: ConflictSet QPN -> ConflictMap -> ConflictMap
updateCM'
| countConflicts = updateCM
| otherwise = const id
getBestGoal' :: ConflictMap -> P.PSQ (Goal QPN) a -> (Goal QPN, a)
getBestGoal'
| countConflicts = getBestGoal
| otherwise = const getFirstGoal
go :: TreeF QGoalReason (Assignment -> ConflictMap -> (ConflictSetLog (Assignment, RevDepMap), ConflictMap))
-> (Assignment -> ConflictMap -> (ConflictSetLog (Assignment, RevDepMap), ConflictMap))
go (FailF c fr) _ cm = (failWith (Failure c fr) c, updateCM c cm)
go (DoneF rdm) a cm = (succeedWith Success (a, rdm), cm)
go (PChoiceF qpn gr ts) (A pa fa sa) cm =
go (FailF c fr) _ !cm = (failWith (Failure c fr) c, updateCM' c cm)
go (DoneF rdm) a !cm = (succeedWith Success (a, rdm), cm)
go (PChoiceF qpn gr ts) (A pa fa sa) !cm =
backjump enableBj (P qpn) (avoidSet (P qpn) gr) cm $ -- try children in order,
P.mapWithKey -- when descending ...
(\ i@(POption k _) r cm ->
let (l, cm') = r (A (M.insert qpn k pa) fa sa) cm
in (tryWith (TryP qpn i) l, cm')
(\ i@(POption k _) r cm0 ->
let (l, cm1) = r (A (M.insert qpn k pa) fa sa) cm0
in (tryWith (TryP qpn i) l, cm1)
)
ts
go (FChoiceF qfn gr _ _ ts) (A pa fa sa) cm =
go (FChoiceF qfn gr _ _ ts) (A pa fa sa) !cm =
backjump enableBj (F qfn) (avoidSet (F qfn) gr) cm $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r cm ->
let (l, cm') = r (A pa (M.insert qfn k fa) sa) cm
in (tryWith (TryF qfn k) l, cm')
(\ k r cm0 ->
let (l, cm1) = r (A pa (M.insert qfn k fa) sa) cm0
in (tryWith (TryF qfn k) l, cm1)
)
ts
go (SChoiceF qsn gr _ ts) (A pa fa sa) cm =
go (SChoiceF qsn gr _ ts) (A pa fa sa) !cm =
backjump enableBj (S qsn) (avoidSet (S qsn) gr) cm $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r cm ->
let (l, cm') = r (A pa fa (M.insert qsn k sa)) cm
in (tryWith (TryS qsn k) l, cm')
(\ k r cm0 ->
let (l, cm1) = r (A pa fa (M.insert qsn k sa)) cm0
in (tryWith (TryS qsn k) l, cm1)
)
ts
go (GoalChoiceF ts) a cm =
let (k, v) = getBestGoal cm ts
go (GoalChoiceF ts) a !cm =
let (k, v) = getBestGoal' cm ts
(l, cm') = v a cm
in (continueWith (Next k) l, cm')
......@@ -151,9 +167,10 @@ avoidSet var gr =
-- | Interface.
backjumpAndExplore :: EnableBackjumping
-> CountConflicts
-> Tree QGoalReason -> Log Message (Assignment, RevDepMap)
backjumpAndExplore enableBj t =
toLog $ fst $ exploreLog enableBj t (A M.empty M.empty M.empty) M.empty
backjumpAndExplore enableBj countConflicts t =
toLog $ fst $ exploreLog enableBj countConflicts t (A M.empty M.empty M.empty) M.empty
where
toLog :: P.Progress step fail done -> Log step done
toLog = P.foldProgress P.Step (const (P.Fail ())) P.Done
cabal-install/Distribution/Solver/Modular/Solver.hs
View file @ 84727b76
......@@ -51,7 +51,8 @@ import Debug.Trace.Tree.Assoc (Assoc(..))
-- | Various options for the modular solver.
data SolverConfig = SolverConfig {
preferEasyGoalChoices :: ReorderGoals,
reorderGoals :: ReorderGoals,
countConflicts :: CountConflicts,
independentGoals :: IndependentGoals,
avoidReinstalls :: AvoidReinstalls,
shadowPkgs :: ShadowPkgs,
......@@ -103,14 +104,12 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
prunePhase $
buildPhase
where
explorePhase = backjumpAndExplore (enableBackjumping sc)
explorePhase = backjumpAndExplore (enableBackjumping sc) (countConflicts sc)
detectCycles = traceTree "cycles.json" id . detectCyclesPhase
heuristicsPhase =
let heuristicsTree = traceTree "heuristics.json" id
in case goalOrder sc of
Nothing -> (if asBool (preferEasyGoalChoices sc)
then P.preferEasyGoalChoices -- also leaves just one choice
else id) .
Nothing -> goalChoiceHeuristics .
heuristicsTree .
P.deferWeakFlagChoices .
P.deferSetupChoices .
......@@ -137,6 +136,19 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals =
$ addLinking
$ buildTree idx (independentGoals sc) userGoals
-- Counting conflicts and reordering goals interferes, as both are strategies to
-- change the order of goals. When count-conflicts is set, we therefore interpret
-- reorder-goals to only prefer goals with 0 or 1 enabled choice.
--
-- In the past, we used P.firstGoal to trim down the goal choice nodes to just a
-- single option. This was a way to work around a space leak that was unnecessary
-- and is now fixed, so we no longer do it.
--
goalChoiceHeuristics
| asBool (reorderGoals sc) && asBool (countConflicts sc) = P.preferReallyEasyGoalChoices
| asBool (reorderGoals sc) = P.preferEasyGoalChoices
| otherwise = id {- P.firstGoal -}
-- | Dump solver tree to a file (in debugging mode)
--
-- This only does something if the @debug-tracetree@ configure argument was
......
cabal-install/Distribution/Solver/Types/Settings.hs
View file @ 84727b76
......@@ -7,6 +7,7 @@ module Distribution.Solver.Types.Settings
, ShadowPkgs(..)
, StrongFlags(..)
, EnableBackjumping(..)
, CountConflicts(..)
) where
import Distribution.Simple.Setup ( BooleanFlag(..) )
......@@ -16,6 +17,9 @@ import GHC.Generics (Generic)
newtype ReorderGoals = ReorderGoals Bool
deriving (BooleanFlag, Eq, Generic, Show)
newtype CountConflicts = CountConflicts Bool
deriving (BooleanFlag, Eq, Generic, Show)
newtype IndependentGoals = IndependentGoals Bool
deriving (BooleanFlag, Eq, Generic, Show)
......@@ -32,6 +36,7 @@ newtype EnableBackjumping = EnableBackjumping Bool
deriving (BooleanFlag, Eq, Generic, Show)
instance Binary ReorderGoals
instance Binary CountConflicts
instance Binary IndependentGoals
instance Binary AvoidReinstalls
instance Binary ShadowPkgs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment