Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/33af02d2369ab88f5847629f971e65fe5647f3e3 >--------------------------------------------------------------- commit 33af02d2369ab88f5847629f971e65fe5647f3e3 Author: Thomas Tuegel <[email protected]> Date: Tue Feb 7 19:45:43 2012 +0000 Update types in modular dependency solver to compile with new test/benchmark dependency constraints. >--------------------------------------------------------------- .../Client/Dependency/Modular/Assignment.hs | 9 ++++++--- .../Client/Dependency/Modular/Configured.hs | 3 ++- .../Dependency/Modular/ConfiguredConversion.hs | 3 ++- .../Client/Dependency/Modular/Explore.hs | 20 ++++++++++---------- 4 files changed, 20 insertions(+), 15 deletions(-) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs index 3766eac..fc6a0b5 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs @@ -10,6 +10,7 @@ import Data.Graph import Prelude hiding (pi) import Distribution.PackageDescription (FlagAssignment) -- from Cabal +import Distribution.Client.Types (OptionalStanza) import Distribution.Client.Dependency.Modular.Configured import Distribution.Client.Dependency.Modular.Dependency @@ -28,9 +29,10 @@ type PAssignment = Map QPN I -- and in the extreme case fix a concrete instance. type PPreAssignment = Map QPN (CI QPN) type FAssignment = Map QFN Bool +type SAssignment = Map QPN [OptionalStanza] -- | A (partial) assignment of variables. -data Assignment = A PAssignment FAssignment +data Assignment = A PAssignment FAssignment SAssignment deriving (Show, Eq) -- | A preassignment comprises knowledge about variables, but not @@ -64,7 +66,7 @@ extend var pa qa = foldM (\ a (Dep qpn ci) -> -- of one package version chosen by the solver, which will lead to -- clashes. toCPs :: Assignment -> RevDepMap -> [CP QPN] -toCPs (A pa fa) rdm = +toCPs (A pa fa sa) rdm = let -- get hold of the graph g :: Graph @@ -99,6 +101,7 @@ toCPs (A pa fa) rdm = in L.map (\ pi@(PI qpn _) -> CP pi (M.findWithDefault [] qpn fapp) + (M.findWithDefault [] qpn sa) (depp qpn)) ps @@ -106,7 +109,7 @@ toCPs (A pa fa) rdm = -- -- This is preliminary, and geared towards output right now. finalize :: Index -> Assignment -> RevDepMap -> IO () -finalize idx (A pa fa) rdm = +finalize idx (A pa fa _) rdm = let -- get hold of the graph g :: Graph diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs b/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs index 191d160..d6f2bc2 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Configured.hs @@ -1,9 +1,10 @@ module Distribution.Client.Dependency.Modular.Configured where import Distribution.PackageDescription (FlagAssignment) -- from Cabal +import Distribution.Client.Types (OptionalStanza) import Distribution.Client.Dependency.Modular.Package -- | A configured package is a package instance together with -- a flag assignment and complete dependencies. -data CP qpn = CP (PI qpn) FlagAssignment [PI qpn] +data CP qpn = CP (PI qpn) FlagAssignment [OptionalStanza] [PI qpn] diff --git a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs index 25e2fc3..58e08a3 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs @@ -21,7 +21,7 @@ mkPlan plat comp iidx sidx cps = convCP :: SI.PackageIndex -> CI.PackageIndex SourcePackage -> CP QPN -> PlanPackage -convCP iidx sidx (CP qpi fa ds) = +convCP iidx sidx (CP qpi fa es ds) = case convPI qpi of Left pi -> PreExisting $ InstalledPackage (fromJust $ SI.lookupInstalledPackageId iidx pi) @@ -29,6 +29,7 @@ convCP iidx sidx (CP qpi fa ds) = Right pi -> Configured $ ConfiguredPackage (fromJust $ CI.lookupPackageId sidx pi) fa + es (map convPI' ds) convPI :: PI QPN -> Either InstalledPackageId PackageId diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs b/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs index 1f1b3ee..4d90123 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Explore.hs @@ -74,15 +74,15 @@ explore = cata go where go (FailF _ _) _ = A.empty go (DoneF rdm) a = pure (a, rdm) - go (PChoiceF qpn _ ts) (A pa fa) = + go (PChoiceF qpn _ ts) (A pa fa sa) = asum $ -- try children in order, P.mapWithKey -- when descending ... - (\ k r -> r (A (M.insert qpn k pa) fa)) $ -- record the pkg choice + (\ k r -> r (A (M.insert qpn k pa) fa sa)) $ -- record the pkg choice ts - go (FChoiceF qfn _ _ ts) (A pa fa) = + go (FChoiceF qfn _ _ ts) (A pa fa sa) = asum $ -- try children in order, P.mapWithKey -- when descending ... - (\ k r -> r (A pa (M.insert qfn k fa))) $ -- record the flag choice + (\ k r -> r (A pa (M.insert qfn k fa) sa)) $ -- record the flag choice ts go (GoalChoiceF ts) a = casePSQ ts A.empty -- empty goal choice is an internal error @@ -94,19 +94,19 @@ exploreLog = cata go where go (FailF c fr) _ = failWith (Failure c fr) go (DoneF rdm) a = succeedWith Success (a, rdm) - go (PChoiceF qpn c ts) (A pa fa) = + go (PChoiceF qpn c ts) (A pa fa sa) = backjumpInfo c $ asum $ -- try children in order, P.mapWithKey -- when descending ... (\ k r -> tryWith (TryP (PI qpn k)) $ -- log and ... - r (A (M.insert qpn k pa) fa)) -- record the pkg choice + r (A (M.insert qpn k pa) fa sa)) -- record the pkg choice ts - go (FChoiceF qfn c _ ts) (A pa fa) = + go (FChoiceF qfn c _ ts) (A pa fa sa) = backjumpInfo c $ asum $ -- try children in order, P.mapWithKey -- when descending ... (\ k r -> tryWith (TryF qfn k) $ -- log and ... - r (A pa (M.insert qfn k fa))) -- record the pkg choice + r (A pa (M.insert qfn k fa) sa)) -- record the pkg choice ts go (GoalChoiceF ts) a = casePSQ ts @@ -126,8 +126,8 @@ backjumpInfo c m = m <|> case c of -- important to produce 'm' before matching o -- | Interface. exploreTree :: Alternative m => Tree a -> m (Assignment, RevDepMap) -exploreTree t = explore t (A M.empty M.empty) +exploreTree t = explore t (A M.empty M.empty M.empty) -- | Interface. exploreTreeLog :: Tree (Maybe (ConflictSet QPN)) -> Log Message (Assignment, RevDepMap) -exploreTreeLog t = exploreLog t (A M.empty M.empty) +exploreTreeLog t = exploreLog t (A M.empty M.empty M.empty) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
