Hannes Siebenhandl pushed to branch wip/fendor/ghc-pkg-faster-closure at Glasgow Haskell Compiler / GHC Commits: 9ac39e74 by fendor at 2026-05-21T09:49:37+02:00 Simplify 'closure' implementation and rename to 'brokenPackages' - - - - - 1 changed file: - utils/ghc-pkg/Main.hs Changes: ===================================== utils/ghc-pkg/Main.hs ===================================== @@ -1826,7 +1826,7 @@ checkConsistency verbosity my_flags = do all_ps = map mungedId pkgs1 let not_broken_pkgs = filterOut broken_pkgs pkgs - (_, trans_broken_pkgs) = closure [] not_broken_pkgs + trans_broken_pkgs = brokenPackages not_broken_pkgs all_broken_pkgs :: [InstalledPackageInfo] all_broken_pkgs = broken_pkgs ++ trans_broken_pkgs @@ -1845,34 +1845,30 @@ checkConsistency verbosity my_flags = do when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1) -closure :: [InstalledPackageInfo] -> [InstalledPackageInfo] - -> ([InstalledPackageInfo], [InstalledPackageInfo]) -closure pkgs db_stack = go (pkgs, pkg_ids) db_stack +-- | Compute the set of transitive broken packages. +-- +-- A package is assumed to be broken if any of its dependencies is not +-- found in the 'db_stack' after a transitive reduction. +brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] +brokenPackages db_stack = go Set.empty db_stack where - pkg_ids = Set.fromList $ map installedUnitId pkgs - go (avail, avail_ids) not_avail = + go avail_ids not_avail = case partition (depsAvailable avail_ids) not_avail of ([], not_avail') -> - (avail, not_avail') + not_avail' (new_avail, not_avail') -> let all_pkg_ids = foldl' (flip Set.insert) avail_ids (map installedUnitId new_avail) in - go (new_avail ++ avail, all_pkg_ids) not_avail' - + go all_pkg_ids not_avail' - depsAvailable :: Set.Set UnitId -> InstalledPackageInfo - -> Bool - depsAvailable pids pkg = null dangling - where dangling = filter (`Set.notMember` pids) (depends pkg) + depsAvailable :: Set.Set UnitId -> InstalledPackageInfo -> Bool + depsAvailable pids pkg = all (`Set.member` pids) (depends pkg) -- we want mutually recursive groups of package to show up -- as broken. (#1750) -brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] -brokenPackages pkgs = snd (closure [] pkgs) - ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs -- if requested. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ac39e747ffc6a8361135e1334caf971... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9ac39e747ffc6a8361135e1334caf971... You're receiving this email because of your account on gitlab.haskell.org.