Commit efa85a39 authored by kristenk's avatar kristenk
Browse files

Remove D.Solver.Modular.Var.varPI.

This change is necessary to remove the package instance (I) from Var
(issue #4142).  One of the main uses of the package instance is when varPI is
called by the linking phase in order to get the dependencies introduced by flags
and stanzas.  The validation phase also needs to look up dependencies introduced
by flags and stanzas, but it does so by looking up the dependencies once when it
chooses a package and then storing the dependencies in a map.  I refactored the
linking phase to also store dependencies in a map.
parent d53b6e0d
......@@ -3,8 +3,8 @@
module Distribution.Solver.Modular.Dependency (
-- * Variables
Var(..)
, varPI
, showVar
, varPN
-- * Conflict sets
, ConflictSet
, ConflictMap
......
......@@ -59,6 +59,12 @@ data ValidateState = VS {
, vsFlags :: FAssignment
, vsStanzas :: SAssignment
, vsQualifyOptions :: QualifyOptions
-- Saved qualified dependencies. Every time 'validateLinking' makes a
-- package choice, it qualifies the package's dependencies and saves them in
-- this map. Then the qualified dependencies are available for subsequent
-- flag and stanza choices for the same package.
, vsSaved :: Map QPN (FlaggedDeps QPN)
}
type Validate = Reader ValidateState
......@@ -93,9 +99,10 @@ validateLinking index = (`runReader` initVS) . cata go
vs <- ask
let PInfo deps _ _ = vsIndex vs ! pn ! i
qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps
newSaved = M.insert qpn qdeps (vsSaved vs)
case execUpdateState (pickPOption qpn opt qdeps) vs of
Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err)
Right vs' -> local (const vs') r
Right vs' -> local (const vs' { vsSaved = newSaved }) r
-- Flag choices
goF :: QFN -> Bool -> Validate (Tree d c) -> Validate (Tree d c)
......@@ -120,6 +127,7 @@ validateLinking index = (`runReader` initVS) . cata go
, vsFlags = M.empty
, vsStanzas = M.empty
, vsQualifyOptions = defaultQualifyOptions index
, vsSaved = M.empty
}
{-------------------------------------------------------------------------------
......@@ -289,9 +297,8 @@ pickStanza qsn b = do
linkNewDeps :: Var QPN -> Bool -> UpdateState ()
linkNewDeps var b = do
vs <- get
let (qpn@(Q pp pn), Just i) = varPI var
PInfo deps _ _ = vsIndex vs ! pn ! i
qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps
let qpn@(Q pp pn) = varPN var
qdeps = vsSaved vs ! qpn
lg = vsLinks vs ! qpn
newDeps = findNewDeps vs qdeps
linkedTo = S.delete pp (lgMembers lg)
......
......@@ -2,7 +2,7 @@
module Distribution.Solver.Modular.Var (
Var(..)
, showVar
, varPI
, varPN
) where
import Prelude hiding (pi)
......@@ -28,8 +28,8 @@ showVar (P qpn) = showQPN qpn
showVar (F qfn) = showQFN qfn
showVar (S qsn) = showQSN qsn
-- | Extract the package instance from a Var
varPI :: Var QPN -> (QPN, Maybe I)
varPI (P qpn) = (qpn, Nothing)
varPI (F (FN (PI qpn i) _)) = (qpn, Just i)
varPI (S (SN (PI qpn i) _)) = (qpn, Just i)
-- | Extract the package name from a Var
varPN :: Var qpn -> qpn
varPN (P qpn) = qpn
varPN (F (FN (PI qpn _) _)) = qpn
varPN (S (SN (PI qpn _) _)) = qpn
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