summaryrefslogtreecommitdiff
path: root/compiler/GHC/Driver/Env.hs
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2021-05-05 13:48:19 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-05-19 23:33:02 -0400
commit38faeea1a94072ffd9f459d9fe570f06bc1da84a (patch)
tree00df888e529aa208e40589fe3f73790906324b8b /compiler/GHC/Driver/Env.hs
parentc8564c639a9889d4d19c68f4b96c092f670b092c (diff)
downloadhaskell-38faeea1a94072ffd9f459d9fe570f06bc1da84a.tar.gz
Remove transitive information about modules and packages from interface files
This commit modifies interface files so that *only* direct information about modules and packages is stored in the interface file. * Only direct module and direct package dependencies are stored in the interface files. * Trusted packages are now stored separately as they need to be checked transitively. * hs-boot files below the compiled module in the home module are stored so that eps_is_boot can be calculated in one-shot mode without loading all interface files in the home package. * The transitive closure of signatures is stored separately This is important for two reasons * Less recompilation is needed, as motivated by #16885, a lot of redundant compilation was triggered when adding new imports deep in the module tree as all the parent interface files had to be redundantly updated. * Checking an interface file is cheaper because you don't have to perform a transitive traversal to check the dependencies are up-to-date. In the code, places where we would have used the transitive closure, we instead compute the necessary transitive closure. The closure is not computed very often, was already happening in checkDependencies, and was already happening in getLinkDeps. Fixes #16885 ------------------------- Metric Decrease: MultiLayerModules T13701 T13719 -------------------------
Diffstat (limited to 'compiler/GHC/Driver/Env.hs')
-rw-r--r--compiler/GHC/Driver/Env.hs55
1 files changed, 47 insertions, 8 deletions
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 27e250b68c..756d8eaff0 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -13,7 +13,8 @@ module GHC.Driver.Env
, hscEPS
, hscInterp
, hptCompleteSigs
- , hptInstances
+ , hptAllInstances
+ , hptInstancesBelow
, hptAnns
, hptAllThings
, hptSomeThingsBelowUs
@@ -64,9 +65,10 @@ import GHC.Utils.Outputable
import GHC.Utils.Monad
import GHC.Utils.Panic
import GHC.Utils.Misc
+import GHC.Types.Unique.FM
-import Control.Monad ( guard )
import Data.IORef
+import qualified Data.Set as Set
runHsc :: HscEnv -> Hsc a -> IO a
runHsc hsc_env (Hsc hsc) = do
@@ -180,14 +182,28 @@ hptCompleteSigs = hptAllThings (md_complete_matches . hm_details)
-- the Home Package Table filtered by the provided predicate function.
-- Used in @tcRnImports@, to select the instances that are in the
-- transitive closure of imports from the currently compiled module.
-hptInstances :: HscEnv -> (ModuleName -> Bool) -> ([ClsInst], [FamInst])
-hptInstances hsc_env want_this_module
+hptAllInstances :: HscEnv -> ([ClsInst], [FamInst])
+hptAllInstances hsc_env
= let (insts, famInsts) = unzip $ flip hptAllThings hsc_env $ \mod_info -> do
- guard (want_this_module (moduleName (mi_module (hm_iface mod_info))))
let details = hm_details mod_info
return (md_insts details, md_fam_insts details)
in (concat insts, concat famInsts)
+-- | Find instances visible from the given set of imports
+hptInstancesBelow :: HscEnv -> ModuleName -> [ModuleNameWithIsBoot] -> ([ClsInst], [FamInst])
+hptInstancesBelow hsc_env mn mns =
+ let (insts, famInsts) =
+ unzip $ hptSomeThingsBelowUs (\mod_info ->
+ let details = hm_details mod_info
+ -- Don't include instances for the current module
+ in if moduleName (mi_module (hm_iface mod_info)) == mn
+ then []
+ else [(md_insts details, md_fam_insts details)])
+ True -- Include -hi-boot
+ hsc_env
+ mns
+ in (concat insts, concat famInsts)
+
-- | Get rules from modules "below" this one (in the dependency sense)
hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]
hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False
@@ -201,10 +217,33 @@ hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env
hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a]
hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env))
+hptModulesBelow :: HscEnv -> [ModuleNameWithIsBoot] -> Set.Set ModuleNameWithIsBoot
+hptModulesBelow hsc_env mn = Set.fromList (eltsUFM $ go mn emptyUFM)
+ where
+ hpt = hsc_HPT hsc_env
+
+ go [] seen = seen
+ go (mn:mns) seen
+ | Just mn' <- lookupUFM seen (gwib_mod mn)
+ -- Already seen the module before
+ , gwib_isBoot mn' == gwib_isBoot mn = go mns seen
+ | otherwise =
+ case lookupHpt hpt (gwib_mod mn) of
+ -- Not a home module
+ Nothing -> go mns seen
+ Just hmi ->
+ let
+ comb m@(GWIB { gwib_isBoot = NotBoot }) _ = m
+ comb (GWIB { gwib_isBoot = IsBoot }) x = x
+ in
+ go (dep_direct_mods (mi_deps (hm_iface hmi)) ++ mns)
+ (addToUFM_C comb seen (gwib_mod mn) mn)
+
+
-- | Get things from modules "below" this one (in the dependency sense)
-- C.f Inst.hptInstances
hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]
-hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
+hptSomeThingsBelowUs extract include_hi_boot hsc_env mod
| isOneShot (ghcMode (hsc_dflags hsc_env)) = []
| otherwise
@@ -212,7 +251,7 @@ hptSomeThingsBelowUs extract include_hi_boot hsc_env deps
in
[ thing
| -- Find each non-hi-boot module below me
- GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- deps
+ GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env mod)
, include_hi_boot || (is_boot == NotBoot)
-- unsavoury: when compiling the base package with --make, we
@@ -243,7 +282,7 @@ prepareAnnotations hsc_env mb_guts = do
-- Extract dependencies of the module if we are supplied one,
-- otherwise load annotations from all home package table
-- entries regardless of dependency ordering.
- home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_mods . mg_deps) mb_guts
+ home_pkg_anns = (mkAnnEnv . hptAnns hsc_env) $ fmap (dep_direct_mods . mg_deps) mb_guts
other_pkg_anns = eps_ann_env eps
ann_env = foldl1' plusAnnEnv $ catMaybes [mb_this_module_anns,
Just home_pkg_anns,