diff options
author | Zubin Duggal <zubin.duggal@gmail.com> | 2022-02-09 17:01:38 +0530 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-02-20 13:56:15 -0500 |
commit | 4b04f7e175a01b30e098af63dfabe6ea068e9b0b (patch) | |
tree | 559e4dc5ba03f5ac8fc8917dcccef9f7c71e6507 /compiler/GHC/Unit/Module/Env.hs | |
parent | 67dd5724297094af93be1887ef000845722c6f2b (diff) | |
download | haskell-4b04f7e175a01b30e098af63dfabe6ea068e9b0b.tar.gz |
Track object file dependencies for TH accurately (#20604)
`hscCompileCoreExprHook` is changed to return a list of `Module`s required
by a splice. These modules are accumulated in the TcGblEnv (tcg_th_needed_mods).
Dependencies on the object files of these modules are recording in the
interface.
The data structures in `LoaderState` are replaced with more efficient versions
to keep track of all the information required. The
MultiLayerModulesTH_Make allocations increase slightly but runtime is
faster.
Fixes #20604
-------------------------
Metric Increase:
MultiLayerModulesTH_Make
-------------------------
Diffstat (limited to 'compiler/GHC/Unit/Module/Env.hs')
-rw-r--r-- | compiler/GHC/Unit/Module/Env.hs | 21 |
1 files changed, 20 insertions, 1 deletions
diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs index a69c865aef..0c8016e17e 100644 --- a/compiler/GHC/Unit/Module/Env.hs +++ b/compiler/GHC/Unit/Module/Env.hs @@ -7,6 +7,7 @@ module GHC.Unit.Module.Env , extendModuleEnvList_C, plusModuleEnv_C , delModuleEnvList, delModuleEnv, plusModuleEnv, lookupModuleEnv , lookupWithDefaultModuleEnv, mapModuleEnv, mkModuleEnv, emptyModuleEnv + , partitionModuleEnv , moduleEnvKeys, moduleEnvElts, moduleEnvToList , unitModuleEnv, isEmptyModuleEnv , extendModuleEnvWith, filterModuleEnv @@ -19,7 +20,8 @@ module GHC.Unit.Module.Env , emptyModuleSet, mkModuleSet, moduleSetElts , extendModuleSet, extendModuleSetList, delModuleSet , elemModuleSet, intersectModuleSet, minusModuleSet, unionModuleSet - , unitModuleSet + , unitModuleSet, isEmptyModuleSet + , unionManyModuleSets -- * InstalledModuleEnv , InstalledModuleEnv @@ -56,6 +58,9 @@ import GHC.Utils.Outputable -- | A map keyed off of 'Module's newtype ModuleEnv elt = ModuleEnv (Map NDModule elt) +instance Outputable a => Outputable (ModuleEnv a) where + ppr (ModuleEnv m) = ppr m + {- Note [ModuleEnv performance and determinism] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -76,6 +81,9 @@ newtype NDModule = NDModule { unNDModule :: Module } deriving Eq -- A wrapper for Module with faster nondeterministic Ord. -- Don't export, See [ModuleEnv performance and determinism] + -- +instance Outputable NDModule where + ppr (NDModule a) = ppr a instance Ord NDModule where compare (NDModule (Module p1 n1)) (NDModule (Module p2 n2)) = @@ -130,6 +138,11 @@ lookupWithDefaultModuleEnv (ModuleEnv e) x m = mapModuleEnv :: (a -> b) -> ModuleEnv a -> ModuleEnv b mapModuleEnv f (ModuleEnv e) = ModuleEnv (Map.mapWithKey (\_ v -> f v) e) +partitionModuleEnv :: (a -> Bool) -> ModuleEnv a -> (ModuleEnv a, ModuleEnv a) +partitionModuleEnv f (ModuleEnv e) = (ModuleEnv a, ModuleEnv b) + where + (a,b) = Map.partition f e + mkModuleEnv :: [(Module, a)] -> ModuleEnv a mkModuleEnv xs = ModuleEnv (Map.fromList [(NDModule k, v) | (k,v) <- xs]) @@ -170,6 +183,9 @@ extendModuleSetList s ms = foldl' (coerce . flip Set.insert) s ms emptyModuleSet :: ModuleSet emptyModuleSet = Set.empty +isEmptyModuleSet :: ModuleSet -> Bool +isEmptyModuleSet = Set.null + moduleSetElts :: ModuleSet -> [Module] moduleSetElts = sort . coerce . Set.toList @@ -188,6 +204,9 @@ delModuleSet = coerce (flip Set.delete) unionModuleSet :: ModuleSet -> ModuleSet -> ModuleSet unionModuleSet = coerce Set.union +unionManyModuleSets :: [ModuleSet] -> ModuleSet +unionManyModuleSets = coerce (Set.unions :: [Set NDModule] -> Set NDModule) + unitModuleSet :: Module -> ModuleSet unitModuleSet = coerce Set.singleton |