diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-11-08 17:28:52 +0000 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-11-11 07:22:03 -0500 |
commit | 4230e4fb8c12da16ad994a9af6b81ff755084bc6 (patch) | |
tree | 2890c96308b17424a38c36f97a45c69fbdbced06 | |
parent | c2ed85cb1e2430c089e4d00c070a2bfa2d84a4ba (diff) | |
download | haskell-4230e4fb8c12da16ad994a9af6b81ff755084bc6.tar.gz |
driver: Use shared transitive dependency calculation in hptModulesBelow
This saves a lot of repeated work on big dependency graphs.
-------------------------
Metric Decrease:
MultiLayerModules
T13719
-------------------------
-rw-r--r-- | compiler/GHC/Driver/Env.hs | 33 |
1 files changed, 10 insertions, 23 deletions
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs index 45fa18e31d..6f23139f26 100644 --- a/compiler/GHC/Driver/Env.hs +++ b/compiler/GHC/Driver/Env.hs @@ -77,6 +77,9 @@ import GHC.Utils.Trace import Data.IORef import qualified Data.Set as Set import Data.Set (Set) +import GHC.Unit.Module.Graph +import Data.List (sort) +import qualified Data.Map as Map runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env (Hsc hsc) = do @@ -234,30 +237,14 @@ hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env)) -- boot module and the non-boot module can be reached, it only returns the -- non-boot one. hptModulesBelow :: HscEnv -> Set ModuleNameWithIsBoot -> Set ModuleNameWithIsBoot -hptModulesBelow hsc_env mn = filtered_mods $ dep_mods mn Set.empty +hptModulesBelow hsc_env mn = filtered_mods $ [ mnwib | NodeKey_Module mnwib <- modules_below] where - !hpt = hsc_HPT hsc_env - - -- get all the dependent modules without filtering boot/non-boot - dep_mods !deps !seen -- invariant: intersection of deps and seen is null - | Set.null deps = seen - | otherwise = dep_mods deps' seen' - where - get_deps d@(GWIB mod _is_boot) (home_deps,all_deps) = case lookupHpt hpt mod of - Nothing -> (home_deps,all_deps) -- not a home-module - Just hmi -> let - !home_deps' = Set.insert d home_deps - !all_deps' = Set.union all_deps (dep_direct_mods (mi_deps (hm_iface hmi))) - in (home_deps', all_deps') - - -- all the non-transitive deps from our deps - (seen',new_deps) = Set.foldr' get_deps (seen,Set.empty) deps - - -- maintain the invariant that deps haven't already been seen - deps' = Set.difference new_deps seen' - - -- remove boot modules when there is also a non-boot one - filtered_mods mods = Set.fromDistinctAscList $ filter_mods $ Set.toAscList mods + td_map = mgTransDeps (hsc_mod_graph hsc_env) + + modules_below = Set.toList (Set.unions (mapMaybe (\mn -> Map.lookup (NodeKey_Module mn) td_map) (Set.toList mn)) + `Set.union` (Set.map NodeKey_Module mn)) + + filtered_mods = Set.fromDistinctAscList . filter_mods . sort -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a |