Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
84727b76
Commit
84727b76
authored
May 31, 2016
by
Andres Löh
Browse files
Add flag to selectively disable count-conflicts.
parent
fba4b252
Changes
13
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
)
++
"
\n
strategy: "
++
show
(
depResolverPreferenceDefault
p
)
++
"
\n
reorder goals: "
++
show
(
depResolverReorderGoals
p
)
++
"
\n
count conflicts: "
++
show
(
depResolverCountConflicts
p
)
++
"
\n
independent goals: "
++
show
(
depResolverIndependentGoals
p
)
++
"
\n
avoid reinstalls: "
++
show
(
depResolverAvoidReinstalls
p
)
++
"
\n
shadow 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
cm
0
=
let
(
l
,
cm
1
)
=
x
cm
0
in
case
l
of
P
.
Done
x
->
(
P
.
Done
x
,
cm
'
)
P
.
Done
d
->
(
P
.
Done
d
,
cm
1
)
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
cm
1
|
otherwise
->
f
(
csAcc
`
CS
.
union
`
cs
)
cm
1
P
.
Step
m
ms
->
let
(
l'
,
cm
''
)
=
combine
(
\
x
->
(
ms
,
x
))
f
csAcc
cm
'
in
(
P
.
Step
m
l'
,
cm
''
)
let
(
l'
,
cm
2
)
=
combine
(
\
y
->
(
ms
,
y
))
f
csAcc
cm
1
in
(
P
.
Step
m
l'
,
cm
2
)
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
cm
0
->
let
(
l
,
cm
1
)
=
r
(
A
(
M
.
insert
qpn
k
pa
)
fa
sa
)
cm
0
in
(
tryWith
(
TryP
qpn
i
)
l
,
cm
1
)
)
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
cm
0
->
let
(
l
,
cm
1
)
=
r
(
A
pa
(
M
.
insert
qfn
k
fa
)
sa
)
cm
0
in
(
tryWith
(
TryF
qfn
k
)
l
,
cm
1
)
)
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
cm
0
->
let
(
l
,
cm
1
)
=
r
(
A
pa
fa
(
M
.
insert
qsn
k
sa
))
cm
0
in
(
tryWith
(
TryS
qsn
k
)
l
,
cm
1
)
)
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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment