diff options
author | Andre Marianiello <andremarianiello@users.noreply.github.com> | 2022-05-14 16:02:06 -0400 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-05-25 01:36:09 -0400 |
commit | 9973c0167c266dad1c9c6f2b96dbba3c29c22062 (patch) | |
tree | f2ea79ae9edacb51d7c8a815cf794f9f248eb73c | |
parent | cfb9faff791064fab1b308b08b6ec1be288a4675 (diff) | |
download | haskell-9973c0167c266dad1c9c6f2b96dbba3c29c22062.tar.gz |
Remove HscEnv from GHC.HsToCore.Usage (related to #17957)
Metric Decrease:
T16875
-rw-r--r-- | compiler/GHC/Driver/Config/HsToCore/Usage.hs | 14 | ||||
-rw-r--r-- | compiler/GHC/HsToCore.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Usage.hs | 44 | ||||
-rw-r--r-- | compiler/GHC/Iface/Make.hs | 9 | ||||
-rw-r--r-- | compiler/ghc.cabal.in | 1 |
5 files changed, 54 insertions, 21 deletions
diff --git a/compiler/GHC/Driver/Config/HsToCore/Usage.hs b/compiler/GHC/Driver/Config/HsToCore/Usage.hs new file mode 100644 index 0000000000..b5e0dbc374 --- /dev/null +++ b/compiler/GHC/Driver/Config/HsToCore/Usage.hs @@ -0,0 +1,14 @@ +module GHC.Driver.Config.HsToCore.Usage + ( initUsageConfig + ) +where + +import GHC.Driver.Env.Types +import GHC.Driver.Session + +import GHC.HsToCore.Usage + +initUsageConfig :: HscEnv -> UsageConfig +initUsageConfig hsc_env = UsageConfig + { uc_safe_implicit_imps_req = safeImplicitImpsReq (hsc_dflags hsc_env) + } diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs index b1a6e6f572..8e2b9849e3 100644 --- a/compiler/GHC/HsToCore.hs +++ b/compiler/GHC/HsToCore.hs @@ -20,6 +20,7 @@ import GHC.Prelude import GHC.Driver.Session import GHC.Driver.Config +import GHC.Driver.Config.HsToCore.Usage import GHC.Driver.Env import GHC.Driver.Backend import GHC.Driver.Plugins @@ -215,7 +216,11 @@ deSugar hsc_env ; safe_mode <- finalSafeMode dflags tcg_env ; (needed_mods, needed_pkgs) <- readIORef (tcg_th_needed_deps tcg_env) - ; usages <- mkUsageInfo hsc_env mod (imp_mods imports) used_names + ; let uc = initUsageConfig hsc_env + ; let plugins = hsc_plugins hsc_env + ; let fc = hsc_FC hsc_env + ; let unit_env = hsc_unit_env hsc_env + ; usages <- mkUsageInfo uc plugins fc unit_env mod (imp_mods imports) used_names dep_files merged needed_mods needed_pkgs -- id_mod /= mod when we are processing an hsig, but hsigs -- never desugared and compiled (there's no code!) diff --git a/compiler/GHC/HsToCore/Usage.hs b/compiler/GHC/HsToCore/Usage.hs index 2ef692c241..f3eb5ab0b3 100644 --- a/compiler/GHC/HsToCore/Usage.hs +++ b/compiler/GHC/HsToCore/Usage.hs @@ -5,13 +5,13 @@ module GHC.HsToCore.Usage ( -- * Dependency/fingerprinting code (used by GHC.Iface.Make) mkUsageInfo, mkUsedNames, + + UsageConfig(..), ) where import GHC.Prelude import GHC.Driver.Env -import GHC.Driver.Session - import GHC.Tc.Types @@ -25,6 +25,7 @@ import GHC.Types.Name.Set ( NameSet, allUses ) import GHC.Types.Unique.Set import GHC.Unit +import GHC.Unit.Env import GHC.Unit.External import GHC.Unit.Module.Imported import GHC.Unit.Module.ModIface @@ -32,6 +33,7 @@ import GHC.Unit.Module.Deps import GHC.Data.Maybe +import Data.IORef import Data.List (sortBy) import Data.Map (Map) import qualified Data.Map as Map @@ -63,15 +65,21 @@ its dep_orphs. This was the cause of #14128. mkUsedNames :: TcGblEnv -> NameSet mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus -mkUsageInfo :: HscEnv -> Module -> ImportedMods -> NameSet -> [FilePath] +data UsageConfig = UsageConfig + { uc_safe_implicit_imps_req :: !Bool -- ^ Are all implicit imports required to be safe for this Safe Haskell mode? + } + +mkUsageInfo :: UsageConfig -> Plugins -> FinderCache -> UnitEnv -> Module -> ImportedMods -> NameSet -> [FilePath] -> [(Module, Fingerprint)] -> [Linkable] -> PkgsLoaded -> IO [Usage] -mkUsageInfo hsc_env this_mod dir_imp_mods used_names dependent_files merged needed_links needed_pkgs +mkUsageInfo uc plugins fc unit_env this_mod dir_imp_mods used_names dependent_files merged needed_links needed_pkgs = do - eps <- hscEPS hsc_env + eps <- readIORef (euc_eps (ue_eps unit_env)) hashes <- mapM getFileHash dependent_files + let hu = unsafeGetHomeUnit unit_env + hug = ue_home_unit_graph unit_env -- Dependencies on object files due to TH and plugins - object_usages <- mkObjectUsage (eps_PIT eps) hsc_env needed_links needed_pkgs - let mod_usages = mk_mod_usage_info (eps_PIT eps) hsc_env this_mod + object_usages <- mkObjectUsage (eps_PIT eps) plugins fc hug needed_links needed_pkgs + let mod_usages = mk_mod_usage_info (eps_PIT eps) uc hug hu this_mod dir_imp_mods used_names usages = mod_usages ++ [ UsageFile { usg_file_path = f , usg_file_hash = hash @@ -150,18 +158,18 @@ to inject the appropriate dependencies. -- | Find object files corresponding to the transitive closure of given home -- modules and direct object files for pkg dependencies -mkObjectUsage :: PackageIfaceTable -> HscEnv -> [Linkable] -> PkgsLoaded -> IO [Usage] -mkObjectUsage pit hsc_env th_links_needed th_pkgs_needed = do +mkObjectUsage :: PackageIfaceTable -> Plugins -> FinderCache -> HomeUnitGraph-> [Linkable] -> PkgsLoaded -> IO [Usage] +mkObjectUsage pit plugins fc hug th_links_needed th_pkgs_needed = do let ls = ordNubOn linkableModule (th_links_needed ++ plugins_links_needed) ds = concatMap loaded_pkg_hs_objs $ eltsUDFM (plusUDFM th_pkgs_needed plugin_pkgs_needed) -- TODO possibly record loaded_pkg_non_hs_objs as well - (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps $ hsc_plugins hsc_env + (plugins_links_needed, plugin_pkgs_needed) = loadedPluginDeps plugins concat <$> sequence (map linkableToUsage ls ++ map librarySpecToUsage ds) where linkableToUsage (LM _ m uls) = mapM (unlinkedToUsage m) uls msg m = moduleNameString (moduleName m) ++ "[TH] changed" - fing mmsg fn = UsageFile fn <$> lookupFileCache (hsc_FC hsc_env) fn <*> pure mmsg + fing mmsg fn = UsageFile fn <$> lookupFileCache fc fn <*> pure mmsg unlinkedToUsage m ul = case nameOfObject_maybe ul of @@ -169,7 +177,7 @@ mkObjectUsage pit hsc_env th_links_needed th_pkgs_needed = do Nothing -> do -- This should only happen for home package things but oneshot puts -- home package ifaces in the PIT. - let miface = lookupIfaceByModule (hsc_HUG hsc_env) pit m + let miface = lookupIfaceByModule hug pit m case miface of Nothing -> pprPanic "mkObjectUsage" (ppr m) Just iface -> @@ -182,17 +190,17 @@ mkObjectUsage pit hsc_env th_links_needed th_pkgs_needed = do librarySpecToUsage _ = return [] mk_mod_usage_info :: PackageIfaceTable - -> HscEnv + -> UsageConfig + -> HomeUnitGraph + -> HomeUnit -> Module -> ImportedMods -> NameSet -> [Usage] -mk_mod_usage_info pit hsc_env this_mod direct_imports used_names +mk_mod_usage_info pit uc hpt home_unit this_mod direct_imports used_names = mapMaybe mkUsage usage_mods where - hpt = hsc_HUG hsc_env - dflags = hsc_dflags hsc_env - home_unit = hsc_home_unit hsc_env + safe_implicit_imps_req = uc_safe_implicit_imps_req uc used_mods = moduleEnvKeys ent_map dir_imp_mods = moduleEnvKeys direct_imports @@ -281,7 +289,7 @@ mk_mod_usage_info pit hsc_env this_mod direct_imports used_names -- across all imports, why did the old code only look -- at the first import? Just bys -> (True, any by_is_safe bys) - Nothing -> (False, safeImplicitImpsReq dflags) + Nothing -> (False, safe_implicit_imps_req) -- Nothing case is for references to entities which were -- not directly imported (NB: the "implicit" Prelude import -- counts as directly imported! An entity is not directly diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs index 7a7b66b137..5db10d502b 100644 --- a/compiler/GHC/Iface/Make.hs +++ b/compiler/GHC/Iface/Make.hs @@ -49,6 +49,7 @@ import GHC.Core.FamInstEnv import GHC.Core.Ppr import GHC.Core.Unify( RoughMatchTc(..) ) +import GHC.Driver.Config.HsToCore.Usage import GHC.Driver.Env import GHC.Driver.Backend import GHC.Driver.Session @@ -84,7 +85,7 @@ import GHC.Data.FastString import GHC.Data.Maybe import GHC.HsToCore.Docs -import GHC.HsToCore.Usage ( mkUsageInfo, mkUsedNames ) +import GHC.HsToCore.Usage import GHC.Unit import GHC.Unit.Module.Warnings @@ -210,6 +211,10 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary used_th <- readIORef tc_splice_used dep_files <- (readIORef dependent_files) (needed_links, needed_pkgs) <- readIORef (tcg_th_needed_deps tc_result) + let uc = initUsageConfig hsc_env + plugins = hsc_plugins hsc_env + fc = hsc_FC hsc_env + unit_env = hsc_unit_env hsc_env -- Do NOT use semantic module here; this_mod in mkUsageInfo -- is used solely to decide if we should record a dependency -- or not. When we instantiate a signature, the semantic @@ -217,7 +222,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary -- but if you pass that in here, we'll decide it's the local -- module and does not need to be recorded as a dependency. -- See Note [Identity versus semantic module] - usages <- mkUsageInfo hsc_env this_mod (imp_mods imports) used_names + usages <- mkUsageInfo uc plugins fc unit_env this_mod (imp_mods imports) used_names dep_files merged needed_links needed_pkgs docs <- extractDocs (ms_hspp_opts mod_summary) tc_result diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index ace7a0ddbd..51a1bf7e3f 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -393,6 +393,7 @@ Library GHC.Driver.Config.Diagnostic GHC.Driver.Config.Finder GHC.Driver.Config.HsToCore + GHC.Driver.Config.HsToCore.Usage GHC.Driver.Config.Logger GHC.Driver.Config.Parser GHC.Driver.Config.Stg.Debug |