Hannes Siebenhandl pushed to branch wip/fendor/ghc-pkg-faster-closure at Glasgow Haskell Compiler / GHC Commits: 38ba8673 by fendor at 2026-05-19T12:35:08+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. - - - - - 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 ===================================== @@ -1847,21 +1847,28 @@ checkConsistency verbosity my_flags = do 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' - - depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo - -> Bool - depsAvailable pkgs_ok pkg = null dangling - where dangling = filter (`notElem` pids) (depends pkg) - pids = map installedUnitId pkgs_ok - - -- we want mutually recursive groups of package to show up - -- as broken. (#1750) +closure pkgs db_stack = go (pkgs, pkg_ids) db_stack + where + pkg_ids = Set.fromList $ map installedUnitId pkgs + go (avail, avail_ids) not_avail = + case partition (depsAvailable avail_ids) not_avail of + ([], not_avail') -> + (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' + + + depsAvailable :: Set.Set UnitId -> InstalledPackageInfo + -> Bool + depsAvailable pids pkg = null dangling + where dangling = filter (`Set.notMember` pids) (depends pkg) + + -- we want mutually recursive groups of package to show up + -- as broken. (#1750) brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo] brokenPackages pkgs = snd (closure [] pkgs) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38ba8673938dfdfd565a11d7b95c7622... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/38ba8673938dfdfd565a11d7b95c7622... You're receiving this email because of your account on gitlab.haskell.org.