Commit 018e9365 authored by Andres Löh's avatar Andres Löh
Browse files

Add the current goal to the initial conflict set while backjumping.

This is relevant for unknown packages. Without the current
goal in the initial conflict set, the unknown package itself
does not end up in its own conflict set.

But we want it to, if only to make sure that the error slicing
machinery keeps the message about the unknown goal around.

It is also the correct thing to do. The initial conflict set
corresponds to a virtual "avoid" choice underneath the package
goal. That choice corresponds to avoiding assigning any proper
value to the goal at all, which might be possible if the goal
was not needed. The conflict set for this "avoid" goal is always
between the current package and its immediate goal reason.

I have added comments to the code explaining this as well.
parent 162d2580
......@@ -360,12 +360,18 @@ goalVarToConflictSet (Goal g _gr) = varToConflictSet g
varToConflictSet :: Var qpn -> ConflictSet qpn
varToConflictSet = CS.singleton
goalReasonToVars :: Ord qpn => GoalReason qpn -> ConflictSet qpn
goalReasonToVars UserGoal = CS.empty
goalReasonToVars (PDependency (PI qpn _)) = CS.singleton (P qpn)
goalReasonToVars (FDependency qfn _) = CS.singleton (F qfn)
goalReasonToVars (SDependency qsn) = CS.singleton (S qsn)
goalReasonToVars Unknown = CS.empty
-- | A goal reason is mostly just a variable paired with the
-- decision we made for that variable (except for user goals,
-- where we cannot really point to a solver variable). This
-- function drops the decision and recovers the list of
-- variables (which will be empty or contain one element).
--
goalReasonToVars :: Ord qpn => GoalReason qpn -> [Var qpn]
goalReasonToVars UserGoal = []
goalReasonToVars (PDependency (PI qpn _)) = [P qpn]
goalReasonToVars (FDependency qfn _) = [F qfn]
goalReasonToVars (SDependency qsn) = [S qsn]
goalReasonToVars Unknown = []
{-------------------------------------------------------------------------------
Open goals
......
......@@ -17,7 +17,7 @@ import Distribution.Client.Dependency.Modular.Tree
import qualified Distribution.Client.Dependency.Types as T
-- | This function takes the variable we're currently considering, an
-- initial conflict set (the goal reason for the current goal) and a
-- initial conflict set and a
-- list of children's logs. Each log yields either a solution or a
-- conflict set. The result is a combined log for the parent node that
-- has explored a prefix of the children.
......@@ -32,6 +32,13 @@ import qualified Distribution.Client.Dependency.Types as T
-- If any of the children might contain a successful solution, we can
-- return it immediately. If all children contain conflict sets, we can
-- take the union as the combined conflict set.
--
-- The initial conflict set corresponds to the justification that we
-- have to choose this goal at all. There is a reason why we have
-- introduced the goal in the first place, and this reason is in conflict
-- with the (virtual) option not to choose anything for the current
-- variable. See also the comments for 'avoidSet'.
--
backjump :: F.Foldable t => Var QPN -> ConflictSet QPN -> t (ConflictSetLog a) -> ConflictSetLog a
backjump var initial xs = F.foldr combine logBackjump xs initial
where
......@@ -59,19 +66,19 @@ exploreLog = cata go
go (FailF c fr) _ = failWith (Failure c fr) c
go (DoneF rdm) a = succeedWith Success (a, rdm)
go (PChoiceF qpn gr ts) (A pa fa sa) =
backjump (P qpn) (goalReasonToVars gr) $ -- try children in order,
backjump (P qpn) (avoidSet (P qpn) gr) $ -- try children in order,
P.mapWithKey -- when descending ...
(\ i@(POption k _) r -> tryWith (TryP qpn i) $ -- log and ...
r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice
ts
go (FChoiceF qfn gr _ _ ts) (A pa fa sa) =
backjump (F qfn) (goalReasonToVars gr) $ -- try children in order,
backjump (F qfn) (avoidSet (F qfn) gr) $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> tryWith (TryF qfn k) $ -- log and ...
r (A pa (M.insert qfn k fa) sa)) -- record the pkg choice
ts
go (SChoiceF qsn gr _ ts) (A pa fa sa) =
backjump (S qsn) (goalReasonToVars gr) $ -- try children in order,
backjump (S qsn) (avoidSet (S qsn) gr) $ -- try children in order,
P.mapWithKey -- when descending ...
(\ k r -> tryWith (TryS qsn k) $ -- log and ...
r (A pa fa (M.insert qsn k sa))) -- record the pkg choice
......@@ -81,6 +88,33 @@ exploreLog = cata go
(failWith (Failure CS.empty EmptyGoalChoice) CS.empty) -- empty goal choice is an internal error
(\ k v _xs -> continueWith (Next (close k)) (v a)) -- commit to the first goal choice
-- | Build a conflict set corresponding to the (virtual) option not to
-- choose a solution for a goal at all.
--
-- In the solver, the set of goals is not statically determined, but depends
-- on the choices we make. Therefore, when dealing with conflict sets, we
-- always have to consider that we could perhaps make choices that would
-- avoid the existence of the goal completely.
--
-- Whenever we actual introduce a choice in the tree, we have already established
-- that the goal cannot be avoided. This is tracked in the "goal reason".
-- The choice to avoid the goal therefore is a conflict between the goal itself
-- and its goal reason. We build this set here, and pass it to the 'backjump'
-- function as the initial conflict set.
--
-- This has two effects:
--
-- - In a situation where there are no choices available at all (this happens
-- if an unknown package is requested), the initial conflict set becomes the
-- actual conflict set.
--
-- - In a situation where we backjump past the current node, the goal reason
-- of the current node will be added to the conflict set.
--
avoidSet :: Var QPN -> QGoalReason -> ConflictSet QPN
avoidSet var gr =
CS.fromList (var : goalReasonToVars gr)
-- | Interface.
backjumpAndExplore :: Tree QGoalReason -> Log Message (Assignment, RevDepMap)
backjumpAndExplore t = toLog $ exploreLog t (A M.empty M.empty M.empty)
......
......@@ -38,7 +38,8 @@ tests = [
, runTest $ mkTest db1 "buildDepAgainstOld" ["F"] (Just [("B", 1), ("E", 1), ("F", 1)])
, runTest $ mkTest db1 "buildDepAgainstNew" ["G"] (Just [("B", 2), ("E", 1), ("G", 1)])
, runTest $ indep $ mkTest db1 "multipleInstances" ["F", "G"] Nothing
, runTest $ mkTest db21 "unknownPackage" ["A"] (Just [("A", 1), ("B", 1)])
, runTest $ mkTest db21 "unknownPackage1" ["A"] (Just [("A", 1), ("B", 1)])
, runTest $ mkTest db22 "unknownPackage1" ["A"] Nothing
]
, testGroup "Flagged dependencies" [
runTest $ mkTest db3 "forceFlagOn" ["C"] (Just [("A", 1), ("B", 1), ("C", 1)])
......@@ -133,8 +134,8 @@ tests = [
, runTest $ indep $ mkTest db17 "indepGoals2" ["A", "B"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1)])
, runTest $ indep $ mkTest db19 "indepGoals3" ["D", "E", "F"] Nothing -- The target order is important.
, runTest $ indep $ mkTest db20 "indepGoals4" ["C", "A", "B"] (Just [("A", 1), ("B", 1), ("C", 1), ("D", 1), ("D", 2)])
, runTest $ indep $ mkTest db22 "indepGoals5" ["X", "Y"] (Just [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)])
, runTest $ indep $ mkTest db23 "indepGoals6" ["X", "Y"] (Just [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)])
, runTest $ indep $ mkTest db23 "indepGoals5" ["X", "Y"] (Just [("A", 1), ("A", 2), ("B", 1), ("C", 1), ("C", 2), ("X", 1), ("Y", 1)])
, runTest $ indep $ mkTest db24 "indepGoals6" ["X", "Y"] (Just [("A", 1), ("A", 2), ("B", 1), ("B", 2), ("X", 1), ("Y", 1)])
]
]
where
......@@ -683,6 +684,13 @@ db21 = [
, Right $ exAv "B" 1 []
]
-- | A variant of 'db21'. The same TODO applies.
db22 :: ExampleDb
db22 = [
Right $ exAv "A" 1 [ExAny "B"]
, Right $ exAv "A" 2 [ExAny "C"]
]
-- | Database for (unsuccessfully) trying to expose a bug in the handling
-- of implied linking constraints. The question is whether an implied linking
-- constraint should only have the introducing package in its conflict set,
......@@ -696,8 +704,8 @@ db21 = [
-- be found, because without the SIR, linking is always optional, but never
-- necessary.
--
db22 :: ExampleDb
db22 = [
db23 :: ExampleDb
db23 = [
Right $ exAv "X" 1 [ExFix "C" 2, ExAny "A"]
, Right $ exAv "Y" 1 [ExFix "C" 1, ExFix "A" 2]
, Right $ exAv "A" 1 []
......@@ -708,8 +716,8 @@ db22 = [
]
-- | A simplified version of 'db23'.
db23 :: ExampleDb
db23 = [
db24 :: ExampleDb
db24 = [
Right $ exAv "X" 1 [ExFix "B" 2, ExAny "A"]
, Right $ exAv "Y" 1 [ExFix "B" 1, ExFix "A" 2]
, Right $ exAv "A" 1 []
......
Supports Markdown
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