Hannes Siebenhandl pushed to branch wip/fendor/ghc-pkg-faster-closure at Glasgow Haskell Compiler / GHC Commits: d320afe7 by fendor at 2026-05-21T10:26:33+02:00 Speed up 'closure' computation in `ghc-pkg` Cache the set of already seen `UnitId`s and use `Set` operations to speed up 'closure' computation. Further simplify the implementation of 'closure' to account for the actual usage. As a consequence, we rename 'closure' to 'brokenPackages' to reflect its purpose better after the simplification. - - - - - 2 changed files: - + changelog.d/ghc-pkg-faster-closure - utils/ghc-pkg/Main.hs Changes: ===================================== changelog.d/ghc-pkg-faster-closure ===================================== @@ -0,0 +1,10 @@ +section: ghc-pkg +synopsis: Improve performance of `ghc-pkg list` command +issues: #27275 +mrs: !16062 + +description: { +`ghc-pkg list` was quadratic in the number of packages due to an inefficient `closure` computation. +We cache the set of seen packages, allowing us to speed up the `closure` computation, improving run-time +for the commands `list`, `check`, `distrust`, `expose`, `hide`, `trust` and `unregister`. +} ===================================== 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,26 +1845,26 @@ 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 db_stack - where - go avail not_avail = - case partition (depsAvailable avail) not_avail of - ([], not_avail') -> (avail, not_avail') - (new_avail, not_avail') -> go (new_avail ++ avail) not_avail' +-- | 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 + go avail_ids not_avail = + case partition (depsAvailable avail_ids) not_avail of + ([], not_avail') -> not_avail' + (new_avail, not_avail') -> go (add new_avail avail_ids) not_avail' - depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo - -> Bool - depsAvailable pkgs_ok pkg = null dangling - where dangling = filter (`notElem` pids) (depends pkg) - pids = map installedUnitId pkgs_ok + add new_avail avail_ids = + foldl' (flip Set.insert) avail_ids (map installedUnitId new_avail) - -- we want mutually recursive groups of package to show up - -- as broken. (#1750) + depsAvailable :: Set.Set UnitId -> InstalledPackageInfo -> Bool + depsAvailable pids pkg = all (`Set.member` pids) (depends pkg) -brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] -brokenPackages pkgs = snd (closure [] pkgs) + -- we want mutually recursive groups of package to show up + -- as broken. (#1750) ----------------------------------------------------------------------------- -- Sanity-check a new package config, and automatically build GHCi libs View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d320afe76db0791b1b04b73d0a034629... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d320afe76db0791b1b04b73d0a034629... You're receiving this email because of your account on gitlab.haskell.org.