summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-11-08 17:28:52 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-11-11 07:22:03 -0500
commit4230e4fb8c12da16ad994a9af6b81ff755084bc6 (patch)
tree2890c96308b17424a38c36f97a45c69fbdbced06
parentc2ed85cb1e2430c089e4d00c070a2bfa2d84a4ba (diff)
downloadhaskell-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.hs33
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