Commit 680b4439 authored by Andres Löh's avatar Andres Löh
Browse files

Merge pull request #1956 from kosmikus/new-flag-fix

Treat all flags of a package as interdependent.
parents daf5cd6b 3f777568
......@@ -78,17 +78,21 @@ scopedExtendOpen qpn i gr fdeps fdefs s = extendOpen qpn gs s
qfdefs = (\ (fn, b) -> Flagged (FN (PI qpn i) fn) b [] []) $ M.toList fdefs
-- Combine new package and flag goals
gs = (flip OpenGoal gr) (qfdefs ++ qfdeps)
-- IMPORTANT AND SUBTLE: The order of the concatenation above is
-- important. Flags occur potentially multiple times: both via the
-- flag declaration ('qfdefs') and via dependencies ('qfdeps').
-- We want the information from qfdeps if it's present, because that
-- includes dependencies between flags. We use qfdefs mainly so that
-- we are forced to make choices for flags that don't affect
-- dependencies at all.
-- NOTE:
-- When goals are actually extended in 'extendOpen', later additions
-- override earlier additions, so it's important that the
-- lower-quality templates without dependency information come first.
-- In the expression @qfdefs ++ qfdeps@ above, flags occur potentially
-- multiple times, both via the flag declaration and via dependencies.
-- The order is potentially important, because the occurrences via
-- dependencies may record flag-dependency information. After a number
-- of bugs involving computing this information incorrectly, however,
-- we're currently not using carefully computed inter-flag dependencies
-- anymore, but instead use 'simplifyVar' when computing conflict sets
-- to map all flags of one package to a single flag for conflict set
-- purposes, thereby treating them all as interdependent.
-- If we ever move to a more clever algorithm again, then the line above
-- needs to be looked at very carefully, and probably be replaced by
-- more systematically computed flag dependency information.
-- | Datatype that encodes what to build next
data BuildType =
......@@ -22,6 +22,16 @@ import Distribution.Client.Dependency.Modular.Version
data Var qpn = P qpn | F (FN qpn) | S (SN qpn)
deriving (Eq, Ord, Show, Functor)
-- | For computing conflict sets, we map flag choice vars to a
-- single flag choice. This means that all flag choices are treated
-- as interdependent. So if one flag of a package ends up in a
-- conflict set, then all flags are being treated as being part of
-- the conflict set.
simplifyVar :: Var qpn -> Var qpn
simplifyVar (P qpn) = P qpn
simplifyVar (F (FN pi _)) = F (FN pi (mkFlag "flag"))
simplifyVar (S qsn) = S qsn
showVar :: Var QPN -> String
showVar (P qpn) = showQPN qpn
showVar (F qfn) = showQFN qfn
......@@ -149,7 +159,7 @@ type QGoalReasonChain = GoalReasonChain QPN
goalReasonToVars :: GoalReason qpn -> ConflictSet qpn
goalReasonToVars UserGoal = S.empty
goalReasonToVars (PDependency (PI qpn _)) = S.singleton (P qpn)
goalReasonToVars (FDependency qfn _) = S.singleton (F qfn)
goalReasonToVars (FDependency qfn _) = S.singleton (simplifyVar (F qfn))
goalReasonToVars (SDependency qsn) = S.singleton (S qsn)
goalReasonChainToVars :: Ord qpn => GoalReasonChain qpn -> ConflictSet qpn
......@@ -168,4 +178,4 @@ close (OpenGoal (Stanza qsn _) gr) = Goal (S qsn) gr
-- | Compute a conflic set from a goal. The conflict set contains the
-- closure of goal reasons as well as the variable of the goal itself.
toConflictSet :: Ord qpn => Goal qpn -> ConflictSet qpn
toConflictSet (Goal g grs) = S.insert g (goalReasonChainToVars grs)
toConflictSet (Goal g grs) = S.insert (simplifyVar g) (goalReasonChainToVars grs)
......@@ -66,9 +66,9 @@ combine :: Var QPN -> [(a, (Maybe (ConflictSet QPN), b))] ->
combine _ [] c = (Just c, [])
combine var ((k, ( d, v)) : xs) c = (\ ~(e, ys) -> (e, (k, v) : ys)) $
case d of
Just e | not (var `S.member` e) -> (Just e, [])
| otherwise -> combine var xs (e `S.union` c)
Nothing -> (Nothing, snd $ combine var xs S.empty)
Just e | not (simplifyVar var `S.member` e) -> (Just e, [])
| otherwise -> combine var xs (e `S.union` c)
Nothing -> (Nothing, snd $ combine var xs S.empty)
-- | Naive backtracking exploration of the search tree. This will yield correct
-- assignments only once the tree itself is validated.
......@@ -23,6 +23,9 @@ type Flag = FlagName
unFlag :: Flag -> String
unFlag (FlagName fn) = fn
mkFlag :: String -> Flag
mkFlag fn = FlagName fn
-- | Flag info. Default value, whether the flag is manual, and
-- whether the flag is weak. Manual flags can only be set explicitly.
-- Weak flags are typically deferred by the solver.
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