diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2021-05-05 13:48:19 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-19 23:33:02 -0400 |
commit | 38faeea1a94072ffd9f459d9fe570f06bc1da84a (patch) | |
tree | 00df888e529aa208e40589fe3f73790906324b8b /compiler/GHC/Driver/Env.hs | |
parent | c8564c639a9889d4d19c68f4b96c092f670b092c (diff) | |
download | haskell-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.hs | 55 |
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, |