From 86721c111fd00f6e7ad8a2f61910a7e5317c4775 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Mon, 2 Mar 2026 22:40:43 -0700 Subject: [PATCH 1/3] Speed up solver --- .../Distribution/Solver/Modular/Assignment.hs | 5 ++-- .../Solver/Modular/ConflictSet.hs | 24 ++++++++++++++----- .../Distribution/Solver/Modular/Explore.hs | 18 ++++++++++---- .../Distribution/Solver/Modular/Validate.hs | 5 +--- 4 files changed, 35 insertions(+), 17 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Assignment.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Assignment.hs index d1ae64e5b38..8075b6a83d6 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Assignment.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Assignment.hs @@ -22,6 +22,7 @@ import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackagePath +import Distribution.Simple.Utils (ordNub) import Distribution.Solver.Modular.Configured import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag @@ -52,8 +53,8 @@ toCPs (A pa fa sa) rdm = g :: Graph Component vm :: Vertex -> ((), QPN, [(Component, QPN)]) cvm :: QPN -> Maybe Vertex - -- Note that the RevDepMap contains duplicate dependencies. Therefore the nub. - (g, vm, cvm) = graphFromEdges (L.map (\ (x, xs) -> ((), x, nub xs)) + -- Note that the RevDepMap contains duplicate dependencies. Therefore the dedup. + (g, vm, cvm) = graphFromEdges (L.map (\ (x, xs) -> ((), x, ordNub xs)) (M.toList rdm)) tg :: Graph Component tg = transposeG g diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs index 00cf15b466f..cc20853d943 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE PatternSynonyms #-} -- | Conflict sets -- -- Intended for double import @@ -8,7 +9,7 @@ module Distribution.Solver.Modular.ConflictSet ( ConflictSet -- opaque , Conflict(..) , ConflictMap - , OrderedVersionRange(..) + , OrderedVersionRange(OrderedVersionRange) , showConflictSet , showCSSortedByFrequency , showCSWithFrequency @@ -78,13 +79,24 @@ data Conflict = | OtherConflict deriving (Eq, Ord, Show) --- | Version range with an 'Ord' instance. -newtype OrderedVersionRange = OrderedVersionRange VR - deriving (Eq, Show) +-- | Version range with an 'Ord' instance. The show string is cached to avoid +-- recomputing it on every comparison. +data OrderedVersionRange = OVR !String !VR + +pattern OrderedVersionRange :: VR -> OrderedVersionRange +pattern OrderedVersionRange vr <- OVR _ vr + where OrderedVersionRange vr = OVR (show vr) vr +{-# COMPLETE OrderedVersionRange #-} + +instance Eq OrderedVersionRange where + OVR _ a == OVR _ b = a == b --- TODO: Avoid converting the version ranges to strings. instance Ord OrderedVersionRange where - compare = compare `on` show + compare (OVR sa _) (OVR sb _) = compare sa sb + +instance Show OrderedVersionRange where + showsPrec d (OVR _ vr) = showParen (d > 10) $ + showString "OrderedVersionRange " . showsPrec 11 vr showConflictSet :: ConflictSet -> String showConflictSet = intercalate ", " . map showVar . toList diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs index 90038a28f5c..3ac07fe8400 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs @@ -267,23 +267,31 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx -- is true, because it is always safe to explore a package instance. -- Skipping it is an optimization. If false, it returns a new conflict set -- to be merged with the previous one. + qo = defaultQualifyOptions idx + couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts = let (PInfo deps _ _ _) = idx M.! pn M.! i - qdeps = qualifyDeps (defaultQualifyOptions idx) currentQPN deps + qdeps = qualifyDeps qo currentQPN deps + + -- Pre-index: map from QPN to list of version ranges (Constrained only) + depVRs :: M.Map QPN [VR] + depVRs = M.fromListWith (++) + [ (qpn, case ci of Constrained vr -> [vr]; _ -> []) + | Simple (LDep _ (Dep (PkgComponent qpn _) ci)) _ <- qdeps ] couldBeResolved :: CS.Conflict -> Maybe ConflictSet couldBeResolved CS.OtherConflict = Nothing couldBeResolved (CS.GoalConflict conflictingDep) = -- Check whether this package instance also has 'conflictingDep' -- as a dependency (ignoring flag and stanza choices). - if null [() | Simple (LDep _ (Dep (PkgComponent qpn _) _)) _ <- qdeps, qpn == conflictingDep] - then Nothing - else Just CS.empty + case M.lookup conflictingDep depVRs of + Nothing -> Nothing + Just _ -> Just CS.empty couldBeResolved (CS.VersionConstraintConflict dep excludedVersion) = -- Check whether this package instance also excludes version -- 'excludedVersion' of 'dep' (ignoring flag and stanza choices). - let vrs = [vr | Simple (LDep _ (Dep (PkgComponent qpn _) (Constrained vr))) _ <- qdeps, qpn == dep ] + let vrs = M.findWithDefault [] dep depVRs vrIntersection = L.foldl' (.&&.) anyVersion vrs in if checkVR vrIntersection excludedVersion then Nothing diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 4af149b31cf..ecaaae06c8d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -301,7 +301,7 @@ checkComponentsInNewPackage :: ComponentDependencyReasons -> Map ExposedComponent ComponentInfo -> Either Conflict () checkComponentsInNewPackage required qpn providedComps = - case M.toList $ deleteKeys (M.keys providedComps) required of + case M.toList $ M.difference required providedComps of (missingComp, dr) : _ -> Left $ mkConflict missingComp dr NewPackageIsMissingRequiredComponent [] -> @@ -325,9 +325,6 @@ checkComponentsInNewPackage required qpn providedComps = mkConflict comp dr mkFailure = (CS.insert (P qpn) (dependencyReasonToConflictSet dr), mkFailure comp dr) - deleteKeys :: Ord k => [k] -> Map k v -> Map k v - deleteKeys ks m = L.foldr M.delete m ks - -- | We try to extract as many concrete dependencies from the given flagged -- dependencies as possible. We make use of all the flag knowledge we have -- already acquired. From 47e5847e6543b069fad9af7ae4bfcb1a1a217d8b Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 4 Mar 2026 11:46:05 -0700 Subject: [PATCH 2/3] Address review feedback --- .../Distribution/Solver/Modular/ConflictSet.hs | 6 ++++-- .../src/Distribution/Solver/Modular/Explore.hs | 17 ++++++++--------- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs index cc20853d943..5010d732b19 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/ConflictSet.hs @@ -41,6 +41,8 @@ import qualified Data.Set as S import Distribution.Solver.Modular.Var import Distribution.Solver.Modular.Version import Distribution.Solver.Types.PackagePath +import Distribution.Utils.ShortText (ShortText) +import qualified Distribution.Utils.ShortText as ShortText -- | The set of variables involved in a solver conflict, each paired with -- details about the conflict. @@ -81,11 +83,11 @@ data Conflict = -- | Version range with an 'Ord' instance. The show string is cached to avoid -- recomputing it on every comparison. -data OrderedVersionRange = OVR !String !VR +data OrderedVersionRange = OVR !ShortText !VR pattern OrderedVersionRange :: VR -> OrderedVersionRange pattern OrderedVersionRange vr <- OVR _ vr - where OrderedVersionRange vr = OVR (show vr) vr + where OrderedVersionRange vr = OVR (ShortText.toShortText (show vr)) vr {-# COMPLETE OrderedVersionRange #-} instance Eq OrderedVersionRange where diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs index 3ac07fe8400..9deb492f586 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs @@ -274,10 +274,10 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx let (PInfo deps _ _ _) = idx M.! pn M.! i qdeps = qualifyDeps qo currentQPN deps - -- Pre-index: map from QPN to list of version ranges (Constrained only) - depVRs :: M.Map QPN [VR] - depVRs = M.fromListWith (++) - [ (qpn, case ci of Constrained vr -> [vr]; _ -> []) + -- Pre-index: map from QPN to intersected version range (Constrained only) + depVRs :: M.Map QPN VR + depVRs = M.fromListWith (.&&.) + [ (qpn, case ci of Constrained vr -> vr; _ -> anyVersion) | Simple (LDep _ (Dep (PkgComponent qpn _) ci)) _ <- qdeps ] couldBeResolved :: CS.Conflict -> Maybe ConflictSet @@ -285,14 +285,13 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx couldBeResolved (CS.GoalConflict conflictingDep) = -- Check whether this package instance also has 'conflictingDep' -- as a dependency (ignoring flag and stanza choices). - case M.lookup conflictingDep depVRs of - Nothing -> Nothing - Just _ -> Just CS.empty + if M.member conflictingDep depVRs + then Just CS.empty + else Nothing couldBeResolved (CS.VersionConstraintConflict dep excludedVersion) = -- Check whether this package instance also excludes version -- 'excludedVersion' of 'dep' (ignoring flag and stanza choices). - let vrs = M.findWithDefault [] dep depVRs - vrIntersection = L.foldl' (.&&.) anyVersion vrs + let vrIntersection = M.findWithDefault anyVersion dep depVRs in if checkVR vrIntersection excludedVersion then Nothing else -- If we skip this package instance, we need to update the From 85fe65e1478efb9f31280c06b53a9bcb30884656 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 10 Mar 2026 10:11:32 -0600 Subject: [PATCH 3/3] Add a Set of QPN --- .../src/Distribution/Solver/Modular/Explore.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs index 9deb492f586..46ff6725c5d 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs @@ -262,13 +262,13 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx , esBackjumps = 0 } + qo = defaultQualifyOptions idx + -- Is it possible for this package instance (QPN and POption) to resolve any -- of the conflicts that were caused by the previous instance? The default -- is true, because it is always safe to explore a package instance. -- Skipping it is an optimization. If false, it returns a new conflict set -- to be merged with the previous one. - qo = defaultQualifyOptions idx - couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts = let (PInfo deps _ _ _) = idx M.! pn M.! i @@ -278,14 +278,18 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx depVRs :: M.Map QPN VR depVRs = M.fromListWith (.&&.) [ (qpn, case ci of Constrained vr -> vr; _ -> anyVersion) - | Simple (LDep _ (Dep (PkgComponent qpn _) ci)) _ <- qdeps ] + | Simple (LDep _ (Dep (PkgComponent qpn _) ci)) _ <- qdeps + ] + + depsWithVRs :: S.Set QPN + depsWithVRs = M.keysSet depVRs couldBeResolved :: CS.Conflict -> Maybe ConflictSet couldBeResolved CS.OtherConflict = Nothing couldBeResolved (CS.GoalConflict conflictingDep) = -- Check whether this package instance also has 'conflictingDep' -- as a dependency (ignoring flag and stanza choices). - if M.member conflictingDep depVRs + if S.member conflictingDep depsWithVRs then Just CS.empty else Nothing couldBeResolved (CS.VersionConstraintConflict dep excludedVersion) =