[Git][ghc/ghc][wip/no-mi-globals] Don't store a GlobalRdrEnv in `mi_globals` for GHCi.
Zubin (@wz1000)
gitlab at gitlab.haskell.org
Wed Feb 28 13:43:05 UTC 2024
Zubin pushed to branch wip/no-mi-globals at Glasgow Haskell Compiler / GHC
Commits:
3c3f2620 by Zubin Duggal at 2024-02-28T19:12:43+05:30
Don't store a GlobalRdrEnv in `mi_globals` for GHCi.
GHCi only needs the `mi_globals` field for modules imported with
:module +*SomeModule.
It uses this field to make the top level environment in `SomeModule` available
to the repl.
By default, only the first target in the command line parameters is
"star" loaded into GHCi. Other modules have to be manually "star" loaded
into the repl.
Storing the top level GlobalRdrEnv for each module is very wasteful, especially
given that we will most likely never need most of these environments.
Instead we store only the information needed to reconstruct the top level environment
in a module, which is the `IfaceTopEnv` data structure, consisting of all import statements
as well as all top level symbols defined in the module (not taking export lists into account)
When a particular module is "star-loaded" into GHCi (as the first commandline target, or via
an explicit `:module +*SomeModule`, we reconstruct the top level environment on demand using
the `IfaceTopEnv`.
- - - - -
24 changed files:
- compiler/GHC.hs
- compiler/GHC/Driver/Backend.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Runtime/Eval.hs
- compiler/GHC/Runtime/Loader.hs
- compiler/GHC/Tc/Gen/Export.hs
- compiler/GHC/Tc/Module.hs
- compiler/GHC/Tc/Types.hs
- compiler/GHC/Tc/Utils/Backpack.hs
- compiler/GHC/Tc/Utils/Monad.hs
- compiler/GHC/Types/Name/Reader.hs
- compiler/GHC/Types/PkgQual.hs
- compiler/GHC/Types/SrcLoc.hs
- compiler/GHC/Types/Unique/Set.hs
- compiler/GHC/Unit/Module/ModIface.hs
- compiler/Language/Haskell/Syntax/ImpExp.hs
- ghc/GHCi/UI.hs
- ghc/GHCi/UI/Info.hs
- ghc/GHCi/UI/Monad.hs
Changes:
=====================================
compiler/GHC.hs
=====================================
@@ -86,18 +86,15 @@ module GHC (
ModuleInfo,
getModuleInfo,
modInfoTyThings,
- modInfoTopLevelScope,
modInfoExports,
modInfoExportsWithSelectors,
modInfoInstances,
modInfoIsExportedName,
modInfoLookupName,
modInfoIface,
- modInfoRdrEnv,
modInfoSafe,
lookupGlobalName,
findGlobalAnns,
- mkNamePprCtxForModule,
ModIface, ModIface_(..),
SafeHaskellMode(..),
@@ -343,7 +340,7 @@ import GHC.Builtin.Types.Prim ( alphaTyVars )
import GHC.Data.StringBuffer
import GHC.Data.FastString
import qualified GHC.LanguageExtensions as LangExt
-import GHC.Rename.Names (renamePkgQual, renameRawPkgQual, gresFromAvails)
+import GHC.Rename.Names (renamePkgQual, renameRawPkgQual)
import GHC.Tc.Utils.Monad ( finalSafeMode, fixSafeInstances, initIfaceTcRn )
import GHC.Tc.Types
@@ -390,7 +387,6 @@ import GHC.Types.Target
import GHC.Types.Basic
import GHC.Types.TyThing
import GHC.Types.Name.Env
-import GHC.Types.Name.Ppr
import GHC.Types.TypeEnv
import GHC.Types.BreakInfo
import GHC.Types.PkgQual
@@ -1223,9 +1219,6 @@ typecheckModule pmod = do
details <- makeSimpleDetails lcl_logger tc_gbl_env
safe <- finalSafeMode lcl_dflags tc_gbl_env
- let !rdr_env = forceGlobalRdrEnv $ tcg_rdr_env tc_gbl_env
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
return $
TypecheckedModule {
tm_internals_ = (tc_gbl_env, details),
@@ -1236,7 +1229,6 @@ typecheckModule pmod = do
ModuleInfo {
minf_type_env = md_types details,
minf_exports = md_exports details,
- minf_rdr_env = Just rdr_env,
minf_instances = fixSafeInstances safe $ instEnvElts $ md_insts details,
minf_iface = Nothing,
minf_safe = safe,
@@ -1389,7 +1381,6 @@ getNamePprCtx = withSession $ \hsc_env -> do
data ModuleInfo = ModuleInfo {
minf_type_env :: TypeEnv,
minf_exports :: [AvailInfo],
- minf_rdr_env :: Maybe IfGlobalRdrEnv, -- Nothing for a compiled/package mod
minf_instances :: [ClsInst],
minf_iface :: Maybe ModIface,
minf_safe :: SafeHaskellMode,
@@ -1416,32 +1407,15 @@ getPackageModuleInfo hsc_env mdl
tys = [ ty | name <- concatMap availNames avails,
Just ty <- [lookupTypeEnv pte name] ]
- let !rdr_env = availsToGlobalRdrEnv hsc_env mdl avails
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
return (Just (ModuleInfo {
minf_type_env = mkTypeEnv tys,
minf_exports = avails,
- minf_rdr_env = Just rdr_env,
minf_instances = error "getModuleInfo: instances for package module unimplemented",
minf_iface = Just iface,
minf_safe = getSafeMode $ mi_trust iface,
minf_modBreaks = emptyModBreaks
}))
-availsToGlobalRdrEnv :: HasDebugCallStack => HscEnv -> Module -> [AvailInfo] -> IfGlobalRdrEnv
-availsToGlobalRdrEnv hsc_env mod avails
- = forceGlobalRdrEnv rdr_env
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
- where
- rdr_env = mkGlobalRdrEnv (gresFromAvails hsc_env (Just imp_spec) avails)
- -- We're building a GlobalRdrEnv as if the user imported
- -- all the specified modules into the global interactive module
- imp_spec = ImpSpec { is_decl = decl, is_item = ImpAll}
- decl = ImpDeclSpec { is_mod = mod, is_as = moduleName mod,
- is_qual = False,
- is_dloc = srcLocSpan interactiveSrcLoc }
-
getHomeModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
getHomeModuleInfo hsc_env mdl =
case lookupHugByModule mdl (hsc_HUG hsc_env) of
@@ -1452,7 +1426,6 @@ getHomeModuleInfo hsc_env mdl =
return (Just (ModuleInfo {
minf_type_env = md_types details,
minf_exports = md_exports details,
- minf_rdr_env = mi_globals $ hm_iface hmi,
-- NB: already forced. See Note [Forcing GREInfo] in GHC.Types.GREInfo.
minf_instances = instEnvElts $ md_insts details,
minf_iface = Just iface,
@@ -1464,12 +1437,6 @@ getHomeModuleInfo hsc_env mdl =
modInfoTyThings :: ModuleInfo -> [TyThing]
modInfoTyThings minf = typeEnvElts (minf_type_env minf)
-modInfoTopLevelScope :: ModuleInfo -> Maybe [Name]
-modInfoTopLevelScope minf
- = fmap (map greName . globalRdrEnvElts) (minf_rdr_env minf)
- -- NB: no need to force this again.
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
-
modInfoExports :: ModuleInfo -> [Name]
modInfoExports minf = concatMap availNames $! minf_exports minf
@@ -1484,15 +1451,6 @@ modInfoInstances = minf_instances
modInfoIsExportedName :: ModuleInfo -> Name -> Bool
modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))
-mkNamePprCtxForModule ::
- GhcMonad m =>
- ModuleInfo ->
- m (Maybe NamePprCtx) -- XXX: returns a Maybe X
-mkNamePprCtxForModule minf = withSession $ \hsc_env -> do
- let mk_name_ppr_ctx = mkNamePprCtx ptc (hsc_unit_env hsc_env)
- ptc = initPromotionTickContext (hsc_dflags hsc_env)
- return (fmap mk_name_ppr_ctx (minf_rdr_env minf))
-
modInfoLookupName :: GhcMonad m =>
ModuleInfo -> Name
-> m (Maybe TyThing) -- XXX: returns a Maybe X
@@ -1504,9 +1462,6 @@ modInfoLookupName minf name = withSession $ \hsc_env -> do
modInfoIface :: ModuleInfo -> Maybe ModIface
modInfoIface = minf_iface
-modInfoRdrEnv :: ModuleInfo -> Maybe IfGlobalRdrEnv
-modInfoRdrEnv = minf_rdr_env
-
-- | Retrieve module safe haskell mode
modInfoSafe :: ModuleInfo -> SafeHaskellMode
modInfoSafe = minf_safe
=====================================
compiler/GHC/Driver/Backend.hs
=====================================
@@ -511,7 +511,7 @@ backendRespectsSpecialise (Named JavaScript) = True
backendRespectsSpecialise (Named Interpreter) = False
backendRespectsSpecialise (Named NoBackend) = False
--- | This back end wants the `mi_globals` field of a
+-- | This back end wants the `mi_top_env` field of a
-- `ModIface` to be populated (with the top-level bindings
-- of the original source). Only true for the interpreter.
backendWantsGlobalBindings :: Backend -> Bool
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1100,7 +1100,7 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
{-# SCC "GHC.Driver.Main.mkPartialIface" #-}
-- This `force` saves 2M residency in test T10370
-- See Note [Avoiding space leaks in toIface*] for details.
- force (mkPartialIface hsc_env (cg_binds cg_guts) details summary simplified_guts)
+ force (mkPartialIface hsc_env (cg_binds cg_guts) details summary (tcg_import_decls tc_result) simplified_guts)
return HscRecomp { hscs_guts = cg_guts,
hscs_mod_location = ms_location summary,
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -27,6 +27,7 @@ import GHC.StgToCmm.Types (CmmCgInfos (..))
import GHC.Tc.Utils.TcType
import GHC.Tc.Utils.Monad
+import GHC.Tc.Gen.Export
import GHC.Iface.Decl
import GHC.Iface.Syntax
@@ -106,9 +107,10 @@ mkPartialIface :: HscEnv
-> CoreProgram
-> ModDetails
-> ModSummary
+ -> [ImportUserSpec]
-> ModGuts
-> PartialModIface
-mkPartialIface hsc_env core_prog mod_details mod_summary
+mkPartialIface hsc_env core_prog mod_details mod_summary import_decls
ModGuts{ mg_module = this_mod
, mg_hsc_src = hsc_src
, mg_usages = usages
@@ -122,7 +124,7 @@ mkPartialIface hsc_env core_prog mod_details mod_summary
, mg_trust_pkg = self_trust
, mg_docs = docs
}
- = mkIface_ hsc_env this_mod core_prog hsc_src used_th deps rdr_env fix_env warns hpc_info self_trust
+ = mkIface_ hsc_env this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env warns hpc_info self_trust
safe_mode usages docs mod_summary mod_details
-- | Fully instantiate an interface. Adds fingerprints and potentially code
@@ -194,6 +196,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
tc_result at TcGblEnv{ tcg_mod = this_mod,
tcg_src = hsc_src,
tcg_imports = imports,
+ tcg_import_decls = import_decls,
tcg_rdr_env = rdr_env,
tcg_fix_env = fix_env,
tcg_merged = merged,
@@ -232,7 +235,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
let partial_iface = mkIface_ hsc_env
this_mod (fromMaybe [] mb_program) hsc_src
- used_th deps rdr_env
+ used_th deps rdr_env import_decls
fix_env warns hpc_info
(imp_trust_own_pkg imports) safe_mode usages
docs mod_summary
@@ -241,7 +244,7 @@ mkIfaceTc hsc_env safe_mode mod_details mod_summary mb_program
mkFullIface hsc_env partial_iface Nothing Nothing
mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
- -> Bool -> Dependencies -> GlobalRdrEnv
+ -> Bool -> Dependencies -> GlobalRdrEnv -> [ImportUserSpec]
-> NameEnv FixItem -> Warnings GhcRn -> HpcInfo
-> Bool
-> SafeHaskellMode
@@ -251,7 +254,7 @@ mkIface_ :: HscEnv -> Module -> CoreProgram -> HscSource
-> ModDetails
-> PartialModIface
mkIface_ hsc_env
- this_mod core_prog hsc_src used_th deps rdr_env fix_env src_warns
+ this_mod core_prog hsc_src used_th deps rdr_env import_decls fix_env src_warns
hpc_info pkg_trust_req safe_mode usages
docs mod_summary
ModDetails{ md_insts = insts,
@@ -323,7 +326,7 @@ mkIface_ hsc_env
mi_fixities = fixities,
mi_warns = warns,
mi_anns = annotations,
- mi_globals = rdrs,
+ mi_top_env = rdrs,
mi_used_th = used_th,
mi_decls = decls,
mi_extra_decls = extra_decls,
@@ -345,16 +348,18 @@ mkIface_ hsc_env
dflags = hsc_dflags hsc_env
- -- We only fill in mi_globals if the module was compiled to byte
+ -- We only fill in mi_top_env if the module was compiled to byte
-- code. Otherwise, the compiler may not have retained all the
-- top-level bindings and they won't be in the TypeEnv (see
- -- Desugar.addExportFlagsAndRules). The mi_globals field is used
+ -- Desugar.addExportFlagsAndRules). The mi_top_env field is used
-- by GHCi to decide whether the module has its full top-level
-- scope available. (#5534)
- maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe IfGlobalRdrEnv
+ maybeGlobalRdrEnv :: GlobalRdrEnv -> Maybe IfaceTopEnv
maybeGlobalRdrEnv rdr_env
| backendWantsGlobalBindings (backend dflags)
- = Just $! forceGlobalRdrEnv rdr_env
+ = Just $! let !exports = mkIfaceExports $ all_rdr_exports rdr_env
+ !imports = mkIfaceImports import_decls
+ in IfaceTopEnv exports imports
-- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
| otherwise
= Nothing
@@ -472,6 +477,13 @@ mkIfaceAnnotation (Annotation { ann_target = target, ann_value = payload })
ifAnnotatedValue = payload
}
+mkIfaceImports :: [ImportUserSpec] -> [IfaceImport]
+mkIfaceImports = map go
+ where
+ go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll
+ go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env))
+ go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns)
+
mkIfaceExports :: [AvailInfo] -> [IfaceExport] -- Sort to make canonical
mkIfaceExports exports
= sortBy stableAvailCmp (map sort_subs exports)
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -25,6 +25,8 @@ module GHC.Iface.Syntax (
IfaceTyConParent(..),
IfaceCompleteMatch(..),
IfaceLFInfo(..), IfaceTopBndrInfo(..),
+ IfaceImport(..),
+ ImpIfaceList(..),
-- * Binding names
IfaceTopBndr,
@@ -63,6 +65,7 @@ import GHC.Types.FieldLabel
import GHC.Types.Name.Set
import GHC.Core.Coercion.Axiom ( BranchIndex )
import GHC.Types.Name
+import GHC.Types.Name.Reader
import GHC.Types.CostCentre
import GHC.Types.Literal
import GHC.Types.ForeignCall
@@ -105,6 +108,13 @@ infixl 3 &&&
************************************************************************
-}
+data IfaceImport = IfaceImport ImpDeclSpec ImpIfaceList
+
+data ImpIfaceList
+ = ImpIfaceAll -- ^ no user import list
+ | ImpIfaceExplicit !IfGlobalRdrEnv
+ | ImpIfaceEverythingBut !NameSet
+
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type IfaceTopBndr = Name
@@ -128,7 +138,6 @@ putIfaceTopBndr bh name =
--pprTrace "putIfaceTopBndr" (ppr name) $
put_binding_name bh name
-
data IfaceDecl
= IfaceId { ifName :: IfaceTopBndr,
ifType :: IfaceType,
@@ -2725,6 +2734,14 @@ instance Binary IfaceCompleteMatch where
************************************************************************
-}
+instance NFData IfaceImport where
+ rnf (IfaceImport a b) = rnf a `seq` rnf b
+
+instance NFData ImpIfaceList where
+ rnf ImpIfaceAll = ()
+ rnf (ImpIfaceEverythingBut ns) = rnf ns
+ rnf (ImpIfaceExplicit gre) = rnf gre
+
instance NFData IfaceDecl where
rnf = \case
IfaceId f1 f2 f3 f4 ->
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -28,6 +28,7 @@ module GHC.IfaceToCore (
tcIfaceExpr, -- Desired by HERMIT (#7683)
tcIfaceGlobal,
tcIfaceOneShot, tcTopIfaceBindings,
+ tcIfaceImport,
hydrateCgBreakInfo
) where
@@ -54,6 +55,7 @@ import GHC.Tc.Errors.Types
import GHC.Tc.TyCl.Build
import GHC.Tc.Utils.Monad
import GHC.Tc.Utils.TcType
+import GHC.Tc.Utils.Env
import GHC.Core.Type
import GHC.Core.Coercion
@@ -111,6 +113,7 @@ import GHC.Types.Literal
import GHC.Types.Var as Var
import GHC.Types.Var.Set
import GHC.Types.Name
+import GHC.Types.Name.Reader
import GHC.Types.Name.Env
import GHC.Types.Id
import GHC.Types.Id.Make
@@ -2176,3 +2179,12 @@ hydrateCgBreakInfo CgBreakInfo{..} = do
result_ty <- tcIfaceType cgb_resty
mbVars <- mapM (traverse (\(if_gbl, offset) -> (,offset) <$> bindIfaceId if_gbl return)) cgb_vars
return (mbVars, result_ty)
+
+-- | This function is only used to construct the environment for GHCi,
+-- so we make up fake locations
+tcIfaceImport :: HscEnv -> IfaceImport -> ImportUserSpec
+tcIfaceImport _ (IfaceImport spec ImpIfaceAll) = ImpUserSpec spec ImpUserAll
+tcIfaceImport _ (IfaceImport spec (ImpIfaceEverythingBut ns)) = ImpUserSpec spec (ImpUserEverythingBut ns)
+tcIfaceImport hsc_env (IfaceImport spec (ImpIfaceExplicit gre)) = ImpUserSpec spec (ImpUserExplicit (hydrateGlobalRdrEnv get_GRE_info gre))
+ where
+ get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -1958,7 +1958,7 @@ lookupQualifiedNameGHCi fos rdr_name
, gre_info = info }
where
info = lookupGREInfo hsc_env nm
- spec = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, is_qual = True, is_dloc = noSrcSpan }
+ spec = ImpDeclSpec { is_mod = mod, is_as = moduleName mod, is_pkg_qual = NoPkgQual, is_qual = True, is_isboot = NotBoot, is_dloc = noSrcSpan }
is = ImpSpec { is_decl = spec, is_item = ImpAll }
-- | Look up the 'GREInfo' associated with the given 'Name'
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -14,6 +14,8 @@ Extracting imported and top-level names in scope
module GHC.Rename.Names (
rnImports, getLocalNonValBinders, newRecordFieldLabel,
+ importsFromIface,
+ ImportUserSpec(..),
extendGlobalRdrEnvRn,
gresFromAvails,
calculateAvails,
@@ -48,7 +50,8 @@ import GHC.Tc.Types.LclEnv
import GHC.Tc.Zonk.TcType ( tcInitTidyEnv )
import GHC.Hs
-import GHC.Iface.Load ( loadSrcInterface )
+import GHC.Iface.Load ( loadSrcInterface, cannotFindModule )
+import GHC.Iface.Errors.Types
import GHC.Iface.Syntax ( fromIfaceWarnings )
import GHC.Builtin.Names
import GHC.Parser.PostProcess ( setRdrNameSpace )
@@ -107,6 +110,7 @@ import qualified Data.Set as S
import System.FilePath ((</>))
import System.IO
+import GHC.Unit.Finder
{-
************************************************************************
@@ -200,7 +204,7 @@ with yes we have gone with no for now.
-- Note: Do the non SOURCE ones first, so that we get a helpful warning
-- for SOURCE ones that are unnecessary
rnImports :: [(LImportDecl GhcPs, SDoc)]
- -> RnM ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
+ -> RnM ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImports imports = do
tcg_env <- getGblEnv
-- NB: want an identity module here, because it's OK for a signature
@@ -211,14 +215,14 @@ rnImports imports = do
stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
stuff2 <- mapAndReportM (rnImportDecl this_mod) source
-- Safe Haskell: See Note [Tracking Trust Transitively]
- let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
+ let (decls, imp_user_spec, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
-- Update imp_boot_mods if imp_direct_mods mentions any of them
let merged_import_avail = clobberSourceImports imp_avails
dflags <- getDynFlags
let final_import_avail =
merged_import_avail { imp_dep_direct_pkgs = S.fromList (implicitPackageDeps dflags)
`S.union` imp_dep_direct_pkgs merged_import_avail}
- return (decls, rdr_env, final_import_avail, hpc_usage)
+ return (decls, imp_user_spec, rdr_env, final_import_avail, hpc_usage)
where
clobberSourceImports imp_avails =
@@ -231,19 +235,20 @@ rnImports imports = do
combJ (GWIB _ IsBoot) x = Just x
combJ r _ = Just r
-- See Note [Combining ImportAvails]
- combine :: [(LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
- -> ([LImportDecl GhcRn], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
+ combine :: [(LImportDecl GhcRn, ImportUserSpec, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
+ -> ([LImportDecl GhcRn], [ImportUserSpec], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
combine ss =
- let (decls, rdr_env, imp_avails, hpc_usage, finsts) = foldr
+ let (decls, imp_user_spec, rdr_env, imp_avails, hpc_usage, finsts) = foldr
plus
- ([], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet)
+ ([], [], emptyGlobalRdrEnv, emptyImportAvails, False, emptyModuleSet)
ss
- in (decls, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts },
+ in (decls, imp_user_spec, rdr_env, imp_avails { imp_finsts = moduleSetElts finsts },
hpc_usage)
- plus (decl, gbl_env1, imp_avails1, hpc_usage1)
- (decls, gbl_env2, imp_avails2, hpc_usage2, finsts_set)
+ plus (decl, us, gbl_env1, imp_avails1, hpc_usage1)
+ (decls, uss, gbl_env2, imp_avails2, hpc_usage2, finsts_set)
= ( decl:decls,
+ us:uss,
gbl_env1 `plusGlobalRdrEnv` gbl_env2,
imp_avails1' `plusImportAvails` imp_avails2,
hpc_usage1 || hpc_usage2,
@@ -295,6 +300,26 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
-}
+importSpec :: LImportDecl GhcPs -> RnM (ImpDeclSpec, Maybe (ImportListInterpretation, LocatedL [LIE GhcPs]))
+importSpec (L loc (ImportDecl { ideclName = loc_imp_mod_name
+ , ideclPkgQual = raw_pkg_qual
+ , ideclSource = want_boot
+ , ideclQualified = qual_style
+ , ideclAs = as_mod, ideclImportList = imp_details }))
+ = do hsc_env <- getTopEnv
+ let unit_env = hsc_unit_env hsc_env
+ let imp_mod_name = unLoc loc_imp_mod_name
+ let pkg_qual = renameRawPkgQual unit_env imp_mod_name raw_pkg_qual
+ res <- liftIO $ findImportedModule hsc_env imp_mod_name pkg_qual
+ imp_mod <- case res of
+ Found _ mod -> pure mod
+ err -> failWithTc $ TcRnInterfaceError $ Can'tFindInterface (cannotFindModule hsc_env imp_mod_name err) $ LookingForModule imp_mod_name want_boot
+ let qual_only = isImportDeclQualified qual_style
+ qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
+ imp_spec = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only, is_pkg_qual = pkg_qual,
+ is_dloc = locA loc, is_as = qual_mod_name, is_isboot = want_boot }
+ pure (imp_spec, imp_details)
+
-- | Given a located import declaration @decl@ from @this_mod@,
-- calculate the following pieces of information:
@@ -312,32 +337,31 @@ Running generateModules from #14693 with DEPTH=16, WIDTH=30 finishes in
-- 4. A boolean 'AnyHpcUsage' which is true if the imported module
-- used HPC.
rnImportDecl :: Module -> (LImportDecl GhcPs, SDoc)
- -> RnM (LImportDecl GhcRn, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
+ -> RnM (LImportDecl GhcRn, ImportUserSpec , GlobalRdrEnv, ImportAvails, AnyHpcUsage)
rnImportDecl this_mod
- (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name
- , ideclPkgQual = raw_pkg_qual
- , ideclSource = want_boot, ideclSafe = mod_safe
- , ideclQualified = qual_style
- , ideclExt = XImportDeclPass { ideclImplicit = implicit }
- , ideclAs = as_mod, ideclImportList = imp_details }), import_reason)
+ ( ldecl@(L loc decl@(ImportDecl { ideclSafe = mod_safe
+ , ideclExt = XImportDeclPass { ideclImplicit = implicit }}))
+ , import_reason)
= setSrcSpanA loc $ do
- case raw_pkg_qual of
- NoRawPkgQual -> pure ()
- RawPkgQual _ -> do
+ (imp_spec,imp_details) <- importSpec ldecl
+
+ let pkg_qual = is_pkg_qual imp_spec
+ want_boot = is_isboot imp_spec
+ case pkg_qual of
+ NoPkgQual -> pure ()
+ _ -> do
pkg_imports <- xoptM LangExt.PackageImports
when (not pkg_imports) $ addErr TcRnPackageImportsDisabled
- let qual_only = isImportDeclQualified qual_style
+ let qual_only = is_qual imp_spec
-- If there's an error in loadInterface, (e.g. interface
-- file not found) we get lots of spurious errors from 'filterImports'
- let imp_mod_name = unLoc loc_imp_mod_name
+ let imp_mod_name = moduleName $ is_mod imp_spec
doc = ppr imp_mod_name <+> import_reason
hsc_env <- getTopEnv
- unit_env <- hsc_unit_env <$> getTopEnv
- let pkg_qual = renameRawPkgQual unit_env imp_mod_name raw_pkg_qual
-- Check for self-import, which confuses the typechecker (#9032)
-- ghc --make rejects self-import cycles already, but batch-mode may not
@@ -390,21 +414,14 @@ rnImportDecl this_mod
when (mod_safe && not (safeImportsOn dflags)) $
addErr (TcRnSafeImportsDisabled imp_mod_name)
- let imp_mod = mi_module iface
- qual_mod_name = fmap unLoc as_mod `orElse` imp_mod_name
- imp_spec = ImpDeclSpec { is_mod = imp_mod, is_qual = qual_only,
- is_dloc = locA loc, is_as = qual_mod_name }
-
-- filter the imports according to the import declaration
- (new_imp_details, gres) <- filterImports hsc_env iface imp_spec imp_details
+ (new_imp_details, imp_user_list, gbl_env) <- filterImports hsc_env iface imp_spec imp_details
-- for certain error messages, we’d like to know what could be imported
-- here, if everything were imported
- potential_gres <- mkGlobalRdrEnv . snd <$> filterImports hsc_env iface imp_spec Nothing
+ potential_gres <- (\(_,_,x) -> x) <$> filterImports hsc_env iface imp_spec Nothing
- let gbl_env = mkGlobalRdrEnv gres
-
- is_hiding | Just (EverythingBut,_) <- imp_details = True
+ let is_hiding | Just (EverythingBut,_) <- imp_details = True
| otherwise = False
-- should the import be safe?
@@ -416,7 +433,7 @@ rnImportDecl this_mod
let home_unit = hsc_home_unit hsc_env
other_home_units = hsc_all_home_unit_ids hsc_env
imv = ImportedModsVal
- { imv_name = qual_mod_name
+ { imv_name = is_as imp_spec
, imv_span = locA loc
, imv_is_safe = mod_safe'
, imv_is_hiding = is_hiding
@@ -444,7 +461,7 @@ rnImportDecl this_mod
, ideclImportList = new_imp_details
}
- return (L loc new_imp_decl, gbl_env, imports, mi_hpc iface)
+ return (L loc new_imp_decl, ImpUserSpec imp_spec imp_user_list, gbl_env, imports, mi_hpc iface)
-- | Rename raw package imports
@@ -1188,6 +1205,14 @@ gresFromAvail hsc_env prov avail =
gresFromAvails :: HscEnv -> Maybe ImportSpec -> [AvailInfo] -> [GlobalRdrElt]
gresFromAvails hsc_env prov = concatMap (gresFromAvail hsc_env prov)
+importsFromIface :: HscEnv -> ModIface -> ImpDeclSpec -> Maybe NameSet -> GlobalRdrEnv
+importsFromIface hsc_env iface decl_spec hidden = mkGlobalRdrEnv $ case hidden of
+ Nothing -> all_gres
+ Just hidden_names -> filter (not . (`elemNameSet` hidden_names) . greName) all_gres
+ where
+ all_gres = gresFromAvails hsc_env (Just imp_spec) (mi_exports iface)
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
+
filterImports
:: HasDebugCallStack
=> HscEnv
@@ -1197,13 +1222,10 @@ filterImports
-> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])
-- ^ Whether this is a "hiding" import list
-> RnM (Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]), -- Import spec w/ Names
- [GlobalRdrElt]) -- Same again, but in GRE form
+ ImpUserList, -- same, but designed for storage in interfaces
+ GlobalRdrEnv) -- Same again, but in GRE form
filterImports hsc_env iface decl_spec Nothing
- = return (Nothing, gresFromAvails hsc_env (Just imp_spec) all_avails)
- where
- all_avails = mi_exports iface
- imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
-
+ = return (Nothing, ImpUserAll, importsFromIface hsc_env iface decl_spec Nothing)
filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
= do -- check for errors, convert RdrNames to Names
items1 <- mapM lookup_lie import_items
@@ -1213,20 +1235,18 @@ filterImports hsc_env iface decl_spec (Just (want_hiding, L l import_items))
-- NB we may have duplicates, and several items
-- for the same parent; e.g N(x) and N(y)
- gres = case want_hiding of
+ (gres, imp_user_list) = case want_hiding of
Exactly ->
- concatMap (gresFromIE decl_spec) items2
+ let gre_env = mkGlobalRdrEnv $ concatMap (gresFromIE decl_spec) items2
+ in (gre_env, ImpUserExplicit gre_env)
EverythingBut ->
let hidden_names = mkNameSet $ concatMap (map greName . snd) items2
- keep n = not (n `elemNameSet` hidden_names)
- all_gres = gresFromAvails hsc_env (Just hiding_spec) all_avails
- in filter (keep . greName) all_gres
+ in (importsFromIface hsc_env iface decl_spec (Just hidden_names), ImpUserEverythingBut hidden_names)
- return (Just (want_hiding, L l (map fst items2)), gres)
+ return (Just (want_hiding, L l (map fst items2)), imp_user_list, gres)
where
import_mod = mi_module iface
all_avails = mi_exports iface
- hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
imp_occ_env = mkImportOccEnv hsc_env decl_spec all_avails
-- Look up a parent (type constructor, class or data constructor)
=====================================
compiler/GHC/Runtime/Eval.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -24,6 +25,7 @@ module GHC.Runtime.Eval (
setupBreakpoint,
back, forward,
setContext, getContext,
+ mkTopLevEnv,
getNamesInScope,
getRdrNamesInScope,
moduleIsInterpreted,
@@ -53,6 +55,8 @@ import GHC.Driver.DynFlags
import GHC.Driver.Ppr
import GHC.Driver.Config
+import GHC.Rename.Names (gresFromAvails, importsFromIface)
+
import GHC.Runtime.Eval.Types
import GHC.Runtime.Interpreter as GHCi
import GHC.Runtime.Heap.Inspect
@@ -75,6 +79,7 @@ import GHC.Core.Type hiding( typeKind )
import qualified GHC.Core.Type as Type
import GHC.Iface.Env ( newInteractiveBinder )
+import GHC.Iface.Load ( loadSrcInterface )
import GHC.Tc.Utils.TcType
import GHC.Tc.Types.Constraint
import GHC.Tc.Types.Origin
@@ -117,7 +122,7 @@ import GHC.Unit.Home.ModInfo
import GHC.Tc.Module ( runTcInteractive, tcRnType, loadUnqualIfaces )
import GHC.Tc.Solver (simplifyWantedsTcM)
-import GHC.Tc.Utils.Env (tcGetInstEnvs, lookupGlobal)
+import GHC.Tc.Utils.Env (tcGetInstEnvs)
import GHC.Tc.Utils.Instantiate (instDFunType)
import GHC.Tc.Utils.Monad
import GHC.Tc.Zonk.Env ( ZonkFlexi (SkolemiseFlexi) )
@@ -806,14 +811,9 @@ findGlobalRdrEnv :: HscEnv -> [InteractiveImport]
findGlobalRdrEnv hsc_env imports
= do { idecls_env <- hscRnImportDecls hsc_env idecls
-- This call also loads any orphan modules
- ; return $ case partitionWith mkEnv imods of
- (err : _, _) -> Left err
- ([], imods_env0) ->
- -- Need to rehydrate the 'GlobalRdrEnv' to recover the 'GREInfo's.
- -- This is done in order to avoid space leaks.
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
- let imods_env = map (hydrateGlobalRdrEnv get_GRE_info) imods_env0
- in Right (foldr plusGlobalRdrEnv idecls_env imods_env)
+ ; partitionWithM mkEnv imods >>= \case
+ (err : _, _) -> return $ Left err
+ ([], imods_env) -> return $ Right (foldr plusGlobalRdrEnv idecls_env imods_env)
}
where
idecls :: [LImportDecl GhcPs]
@@ -822,23 +822,33 @@ findGlobalRdrEnv hsc_env imports
imods :: [ModuleName]
imods = [m | IIModule m <- imports]
- mkEnv mod = case mkTopLevEnv (hsc_HPT hsc_env) mod of
- Left err -> Left (mod, err)
- Right env -> Right env
-
- get_GRE_info nm = tyThingGREInfo <$> lookupGlobal hsc_env nm
+ mkEnv mod = mkTopLevEnv hsc_env mod >>= \case
+ Left err -> pure $ Left (mod, err)
+ Right env -> pure $ Right env
-mkTopLevEnv :: HomePackageTable -> ModuleName -> Either String IfGlobalRdrEnv
-mkTopLevEnv hpt modl
+mkTopLevEnv :: HscEnv -> ModuleName -> IO (Either String GlobalRdrEnv)
+mkTopLevEnv hsc_env modl
= case lookupHpt hpt modl of
- Nothing -> Left "not a home module"
+ Nothing -> pure $ Left "not a home module"
Just details ->
- case mi_globals (hm_iface details) of
- Nothing -> Left "not interpreted"
- Just env -> Right env
- -- It's OK to be lazy here; we force the GlobalRdrEnv before storing it
- -- in ModInfo; see GHCi.UI.Info.
- -- See Note [Forcing GREInfo] in GHC.Types.GREInfo.
+ case mi_top_env (hm_iface details) of
+ Nothing -> pure $ Left "not interpreted"
+ Just (IfaceTopEnv exports imports) -> do
+ imports_env <-
+ runInteractiveHsc hsc_env
+ $ ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env
+ $ fmap (foldr plusGlobalRdrEnv emptyGlobalRdrEnv)
+ $ forM imports $ \iface_import -> do
+ let ImpUserSpec spec details = tcIfaceImport hsc_env iface_import
+ iface <- loadSrcInterface (text "imported by GHCi") (moduleName $ is_mod spec) (is_isboot spec) (is_pkg_qual spec)
+ pure $ case details of
+ ImpUserAll -> importsFromIface hsc_env iface spec Nothing
+ ImpUserEverythingBut ns -> importsFromIface hsc_env iface spec (Just ns)
+ ImpUserExplicit x -> x
+ let exports_env = mkGlobalRdrEnv $ gresFromAvails hsc_env Nothing exports
+ pure $ Right $ plusGlobalRdrEnv imports_env exports_env
+ where
+ hpt = hsc_HPT hsc_env
-- | Get the interactive evaluation context, consisting of a pair of the
-- set of modules from which we take the full top-level scope, and the set
@@ -854,7 +864,7 @@ moduleIsInterpreted modl = withSession $ \h ->
if notHomeModule (hsc_home_unit h) modl
then return False
else case lookupHpt (hsc_HPT h) (moduleName modl) of
- Just details -> return (isJust (mi_globals (hm_iface details)))
+ Just details -> return (isJust (mi_top_env (hm_iface details)))
_not_a_home_module -> return False
-- | Looks up an identifier in the current interactive context (for :info)
=====================================
compiler/GHC/Runtime/Loader.hs
=====================================
@@ -49,6 +49,7 @@ import GHC.Core.TyCon ( TyCon(tyConName) )
import GHC.Types.SrcLoc ( noSrcSpan )
import GHC.Types.Name ( Name, nameModule, nameModule_maybe )
import GHC.Types.Id ( idType )
+import GHC.Types.PkgQual
import GHC.Types.TyThing
import GHC.Types.Name.Occurrence ( OccName, mkVarOccFS )
import GHC.Types.Name.Reader
@@ -57,7 +58,7 @@ import GHC.Types.Unique.DFM
import GHC.Unit.Finder ( findPluginModule, FindResult(..) )
import GHC.Driver.Config.Finder ( initFinderOpts )
import GHC.Driver.Config.Diagnostic ( initIfaceMessageOpts )
-import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit) )
+import GHC.Unit.Module ( Module, ModuleName, thisGhcUnit, GenModule(moduleUnit), IsBootInterface(NotBoot) )
import GHC.Unit.Module.ModIface
import GHC.Unit.Env
@@ -357,8 +358,8 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
case mb_iface of
Just iface -> do
-- Try and find the required name in the exports
- let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name
- , is_qual = False, is_dloc = noSrcSpan }
+ let decl_spec = ImpDeclSpec { is_mod = mod, is_as = mod_name, is_pkg_qual = NoPkgQual
+ , is_qual = False, is_dloc = noSrcSpan, is_isboot = NotBoot }
imp_spec = ImpSpec decl_spec ImpAll
env = mkGlobalRdrEnv
$ gresFromAvails hsc_env (Just imp_spec) (mi_exports iface)
=====================================
compiler/GHC/Tc/Gen/Export.hs
=====================================
@@ -4,7 +4,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TupleSections #-}
-module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs) where
+module GHC.Tc.Gen.Export (rnExports, exports_from_avail, classifyGREs, all_rdr_exports) where
import GHC.Prelude
@@ -243,6 +243,21 @@ type ExportWarnSpanNames = [(Name, WarningTxt GhcRn, SrcSpan)]
-- the spans of export list items that are missing those warnings
type DontWarnExportNames = NameEnv (NE.NonEmpty SrcSpan)
+all_rdr_exports :: GlobalRdrEnv -> Avails
+all_rdr_exports rdr_env = map fix_faminst . gresToAvailInfo . filter isLocalGRE . globalRdrEnvElts $ rdr_env
+ where
+ -- #11164: when we define a data instance
+ -- but not data family, re-export the family
+ -- Even though we don't check whether this is actually a data family
+ -- only data families can locally define subordinate things (`ns` here)
+ -- without locally defining (and instead importing) the parent (`n`)
+ fix_faminst avail@(AvailTC n ns)
+ | availExportsDecl avail
+ = avail
+ | otherwise
+ = AvailTC n (n:ns)
+ fix_faminst avail = avail
+
exports_from_avail :: Maybe (LocatedL [LIE GhcPs])
-- ^ 'Nothing' means no explicit export list
-> GlobalRdrEnv
@@ -264,23 +279,8 @@ exports_from_avail Nothing rdr_env _imports _this_mod
= do {
; addDiagnostic
(TcRnMissingExportList $ moduleName _this_mod)
- ; let avails =
- map fix_faminst . gresToAvailInfo
- . filter isLocalGRE . globalRdrEnvElts $ rdr_env
+ ; let avails = all_rdr_exports rdr_env
; return (Nothing, avails, []) }
- where
- -- #11164: when we define a data instance
- -- but not data family, re-export the family
- -- Even though we don't check whether this is actually a data family
- -- only data families can locally define subordinate things (`ns` here)
- -- without locally defining (and instead importing) the parent (`n`)
- fix_faminst avail@(AvailTC n ns)
- | availExportsDecl avail
- = avail
- | otherwise
- = AvailTC n (n:ns)
- fix_faminst avail = avail
-
exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
= do (ie_avails, export_warn_spans, dont_warn_export)
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -373,7 +373,7 @@ tcRnModuleTcRnM hsc_env mod_sum
tcRnImports :: HscEnv -> [(LImportDecl GhcPs, SDoc)] -> TcM TcGblEnv
tcRnImports hsc_env import_decls
- = do { (rn_imports, rdr_env, imports, hpc_info) <- rnImports import_decls ;
+ = do { (rn_imports, imp_user_spec, rdr_env, imports, hpc_info) <- rnImports import_decls ;
; this_mod <- getModule
; gbl_env <- getGblEnv
@@ -402,6 +402,7 @@ tcRnImports hsc_env import_decls
gbl {
tcg_rdr_env = tcg_rdr_env gbl `plusGlobalRdrEnv` rdr_env,
tcg_imports = tcg_imports gbl `plusImportAvails` imports,
+ tcg_import_decls = imp_user_spec,
tcg_rn_imports = rn_imports,
tcg_inst_env = tcg_inst_env gbl `unionInstEnv` home_insts,
tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl)
=====================================
compiler/GHC/Tc/Types.hs
=====================================
@@ -43,6 +43,8 @@ module GHC.Tc.Types(
-- Renamer types
ErrCtxt,
ImportAvails(..), emptyImportAvails, plusImportAvails,
+ ImportUserSpec(..),
+ ImpUserList(..),
mkModDeps,
-- Typechecker types
@@ -179,6 +181,30 @@ import Data.Map ( Map )
import Data.Typeable ( TypeRep )
import Data.Maybe ( mapMaybe )
+-- | The import specification as written by the user, including
+-- the list of explicitly imported names. Used in 'ModIface' to
+-- allow GHCi to reconstruct the top level environment on demand.
+--
+-- This is distinct from 'ImportSpec' because we don't want to store
+-- the list of explicitly imported names along with each 'GRE'
+--
+-- We don't want to store the entire GlobalRdrEnv for modules that
+-- are imported without explicit export lists, as these may grow
+-- to be very large. However, GlobalRdrEnvs which are the result
+-- of explicit import lists are typically quite small.
+--
+-- Why do we not store something like (Maybe (ImportListInterpretation, [IE GhcPs]) in such a case?
+-- Because we don't want to store source syntax including annotations in
+-- interface files.
+data ImportUserSpec
+ = ImpUserSpec { ius_decl :: !ImpDeclSpec
+ , ius_imports :: !ImpUserList
+ }
+
+data ImpUserList
+ = ImpUserAll -- ^ no user import list
+ | ImpUserExplicit !GlobalRdrEnv
+ | ImpUserEverythingBut !NameSet
-- | A 'NameShape' is a substitution on 'Name's that can be used
-- to refine the identities of a hole while we are renaming interfaces
@@ -507,6 +533,7 @@ data TcGblEnv
-- These three fields track unused bindings and imports
-- See Note [Tracking unused binding and imports]
+ tcg_import_decls :: ![ImportUserSpec],
tcg_dus :: DefUses,
tcg_used_gres :: TcRef [GlobalRdrElt],
-- ^ INVARIANT: all these GREs were imported; that is,
=====================================
compiler/GHC/Tc/Utils/Backpack.hs
=====================================
@@ -635,10 +635,12 @@ mergeSignatures
-- because we need module
-- LocalSig (from the local
-- export list) to match it!
- is_mod = mi_module ireq_iface,
- is_as = mod_name,
- is_qual = False,
- is_dloc = locA loc
+ is_mod = mi_module ireq_iface,
+ is_as = mod_name,
+ is_pkg_qual = NoPkgQual,
+ is_qual = False,
+ is_isboot = NotBoot,
+ is_dloc = locA loc
} ImpAll
rdr_env = mkGlobalRdrEnv $ gresFromAvails hsc_env (Just ispec) as1
setGblEnv tcg_env {
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -318,6 +318,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_th_needed_deps = th_needed_deps_var,
tcg_exports = [],
tcg_imports = emptyImportAvails,
+ tcg_import_decls = [],
tcg_used_gres = used_gre_var,
tcg_dus = emptyDUs,
=====================================
compiler/GHC/Types/Name/Reader.hs
=====================================
@@ -121,6 +121,7 @@ import GHC.Types.Name
import GHC.Types.Name.Env
( NameEnv, nonDetNameEnvElts, emptyNameEnv, extendNameEnv_Acc )
import GHC.Types.Name.Set
+import GHC.Types.PkgQual
import GHC.Types.SrcLoc as SrcLoc
import GHC.Types.Unique
import GHC.Types.Unique.FM
@@ -1780,7 +1781,9 @@ shadowNames drop_only_qualified env new_gres = minusOccEnv_C_Ns do_shadowing env
old_mod_name = moduleName old_mod
id_spec = ImpDeclSpec { is_mod = old_mod
, is_as = old_mod_name
+ , is_pkg_qual = NoPkgQual
, is_qual = True
+ , is_isboot = NotBoot
, is_dloc = greDefinitionSrcSpan old_gre }
set_qual :: ImportSpec -> ImportSpec
@@ -1939,10 +1942,15 @@ data ImpDeclSpec
-- TODO: either should be Module, or there
-- should be a Maybe UnitId here too.
is_as :: !ModuleName, -- ^ Import alias, e.g. from @as M@ (or @Muggle@ if there is no @as@ clause)
+ is_pkg_qual :: !PkgQual, -- ^ Was this a package import?
is_qual :: !Bool, -- ^ Was this import qualified?
- is_dloc :: !SrcSpan -- ^ The location of the entire import declaration
+ is_dloc :: !SrcSpan, -- ^ The location of the entire import declaration
+ is_isboot :: !IsBootInterface -- ^ Was this a SOURCE import?
} deriving (Eq, Data)
+instance NFData ImpDeclSpec where
+ rnf = rwhnf -- Already strict in all fields
+
-- | Import Item Specification
--
-- Describes import info a particular Name
=====================================
compiler/GHC/Types/PkgQual.hs
=====================================
@@ -22,8 +22,8 @@ data RawPkgQual
-- package qualifier.
data PkgQual
= NoPkgQual -- ^ No package qualifier
- | ThisPkg UnitId -- ^ Import from home-unit
- | OtherPkg UnitId -- ^ Import from another unit
+ | ThisPkg !UnitId -- ^ Import from home-unit
+ | OtherPkg !UnitId -- ^ Import from another unit
deriving (Data, Ord, Eq)
instance Outputable RawPkgQual where
=====================================
compiler/GHC/Types/SrcLoc.hs
=====================================
@@ -369,6 +369,9 @@ data RealSrcSpan
}
deriving Eq
+instance NFData RealSrcSpan where
+ rnf = rwhnf -- already strict
+
-- | StringBuffer Source Span
data BufSpan =
BufSpan { bufSpanStart, bufSpanEnd :: {-# UNPACK #-} !BufPos }
=====================================
compiler/GHC/Types/Unique/Set.hs
=====================================
@@ -55,6 +55,7 @@ import Data.Coerce
import GHC.Utils.Outputable
import Data.Data
import qualified Data.Semigroup as Semi
+import Control.DeepSeq
-- Note [UniqSet invariant]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -66,6 +67,9 @@ import qualified Data.Semigroup as Semi
newtype UniqSet a = UniqSet {getUniqSet' :: UniqFM a a}
deriving (Data, Semi.Semigroup, Monoid)
+instance NFData a => NFData (UniqSet a) where
+ rnf = forceUniqSet rnf
+
emptyUniqSet :: UniqSet a
emptyUniqSet = UniqSet emptyUFM
@@ -200,3 +204,7 @@ pprUniqSet :: (a -> SDoc) -> UniqSet a -> SDoc
-- It's OK to use nonDetUFMToList here because we only use it for
-- pretty-printing.
pprUniqSet f = braces . pprWithCommas f . nonDetEltsUniqSet
+
+
+forceUniqSet :: (a -> ()) -> UniqSet a -> ()
+forceUniqSet f (UniqSet fm) = seqEltsUFM f fm
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -15,6 +15,8 @@ module GHC.Unit.Module.ModIface
, IfaceExport
, WhetherHasOrphans
, WhetherHasFamInst
+ , IfaceTopEnv (..)
+ , IfaceImport(..)
, mi_boot
, mi_fix
, mi_semantic_module
@@ -45,7 +47,6 @@ import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.HpcInfo
import GHC.Types.Name
-import GHC.Types.Name.Reader
import GHC.Types.SafeHaskell
import GHC.Types.SourceFile
import GHC.Types.Unique.DSet
@@ -208,8 +209,8 @@ data ModIface_ (phase :: ModIfacePhase)
-- combined with mi_decls allows us to restart code generation.
-- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs]
- mi_globals :: !(Maybe IfGlobalRdrEnv),
- -- ^ Binds all the things defined at the top level in
+ mi_top_env :: !(Maybe IfaceTopEnv),
+ -- ^ Just enough information to reconstruct the top level environment in
-- the /original source/ code for this module. which
-- is NOT the same as mi_exports, nor mi_decls (which
-- may contains declarations for things not actually
@@ -266,6 +267,16 @@ data ModIface_ (phase :: ModIfacePhase)
-- ^ Hash of the .hs source, used for recompilation checking.
}
+-- Enough information to reconstruct the top level environment for a module
+data IfaceTopEnv
+ = IfaceTopEnv
+ { ifaceTopExports :: ![IfaceExport] -- ^ all top level things in this module, including unexported stuff
+ , ifaceImports :: ![IfaceImport] -- ^ all the imports in this module
+ }
+
+instance NFData IfaceTopEnv where
+ rnf (IfaceTopEnv a b) = rnf a `seq` rnf b
+
{-
Note [Strictness in ModIface]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -458,7 +469,7 @@ instance Binary ModIface where
mi_warns = warns,
mi_decls = decls,
mi_extra_decls = extra_decls,
- mi_globals = Nothing,
+ mi_top_env = Nothing,
mi_insts = insts,
mi_fam_insts = fam_insts,
mi_rules = rules,
@@ -508,7 +519,7 @@ emptyPartialModIface mod
mi_rules = [],
mi_decls = [],
mi_extra_decls = Nothing,
- mi_globals = Nothing,
+ mi_top_env = Nothing,
mi_hpc = False,
mi_trust = noIfaceTrustInfo,
mi_trust_pkg = False,
@@ -559,7 +570,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
) => NFData (ModIface_ phase) where
rnf (ModIface{ mi_module, mi_sig_of, mi_hsc_src, mi_deps, mi_usages
, mi_exports, mi_used_th, mi_fixities, mi_warns, mi_anns
- , mi_decls, mi_extra_decls, mi_globals, mi_insts
+ , mi_decls, mi_extra_decls, mi_top_env, mi_insts
, mi_fam_insts, mi_rules, mi_hpc, mi_trust, mi_trust_pkg
, mi_complete_matches, mi_docs, mi_final_exts
, mi_ext_fields, mi_src_hash })
@@ -575,7 +586,7 @@ instance ( NFData (IfaceBackendExts (phase :: ModIfacePhase))
`seq` rnf mi_anns
`seq` rnf mi_decls
`seq` rnf mi_extra_decls
- `seq` rnf mi_globals
+ `seq` rnf mi_top_env
`seq` rnf mi_insts
`seq` rnf mi_fam_insts
`seq` rnf mi_rules
=====================================
compiler/Language/Haskell/Syntax/ImpExp.hs
=====================================
@@ -14,6 +14,8 @@ import Data.Maybe (Maybe)
import Data.String (String)
import Data.Int (Int)
+import Control.DeepSeq
+
import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST
{-
@@ -48,6 +50,9 @@ data ImportDeclQualifiedStyle
data IsBootInterface = NotBoot | IsBoot
deriving (Eq, Ord, Show, Data)
+instance NFData IsBootInterface where
+ rnf = rwhnf
+
-- | Import Declaration
--
-- A single Haskell @import@ declaration.
@@ -86,6 +91,9 @@ data ImportDecl pass
data ImportListInterpretation = Exactly | EverythingBut
deriving (Eq, Data)
+instance NFData ImportListInterpretation where
+ rnf = rwhnf
+
-- | Located Import or Export
type LIE pass = XRec pass (IE pass)
-- ^ When in a list this may have
=====================================
ghc/GHCi/UI.hs
=====================================
@@ -36,6 +36,7 @@ import GHCi.UI.Monad hiding ( args, runStmt )
import GHCi.UI.Info
import GHCi.UI.Exception
import GHC.Runtime.Debugger
+import GHC.Runtime.Eval (mkTopLevEnv)
-- The GHC interface
import GHC.Runtime.Interpreter
@@ -75,7 +76,7 @@ import GHC.Types.Var ( varType )
import GHC.Iface.Syntax ( showToHeader )
import GHC.Builtin.Names
import GHC.Builtin.Types( stringTyCon_RDR )
-import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName )
+import GHC.Types.Name.Reader as RdrName ( getGRE_NameQualifier_maybes, getRdrName, greName, globalRdrEnvElts)
import GHC.Types.SrcLoc as SrcLoc
import qualified GHC.Parser.Lexer as Lexer
import GHC.Parser.Header ( toArgs )
@@ -206,7 +207,7 @@ ghciCommands = map mkCmd [
("browse", keepGoing' (browseCmd False), completeModule),
("browse!", keepGoing' (browseCmd True), completeModule),
("cd", keepGoingMulti' changeDirectory, completeFilename),
- ("check", keepGoing' checkModule, completeHomeModule),
+ -- ("check", keepGoing' checkModule, completeHomeModule),
("continue", keepGoing continueCmd, noCompletion),
("cmd", keepGoing cmdCmd, completeExpression),
("def", keepGoing (defineMacro False), completeExpression),
@@ -1892,28 +1893,6 @@ getGhciStepIO = do
nlHsFunTy ghciM ioM
return $ noLocA $ ExprWithTySig noAnn body tySig
------------------------------------------------------------------------------
--- :check
-
-checkModule :: GhciMonad m => String -> m ()
-checkModule m = do
- let modl = GHC.mkModuleName m
- ok <- handleSourceError (\e -> printErrAndMaybeExit e >> return False) $ do
- r <- GHC.typecheckModule =<< GHC.parseModule =<< GHC.getModSummary modl
- dflags <- getDynFlags
- liftIO $ putStrLn $ showSDoc dflags $
- case GHC.moduleInfo r of
- cm | Just scope <- GHC.modInfoTopLevelScope cm ->
- let
- (loc, glob) = assert (all isExternalName scope) $
- partition ((== modl) . GHC.moduleName . GHC.nameModule) scope
- in
- (text "global names: " <+> ppr glob) $$
- (text "local names: " <+> ppr loc)
- _ -> empty
- return True
- afterLoad (successIf ok) False
-
-----------------------------------------------------------------------------
-- :doc
@@ -2355,9 +2334,7 @@ typeAtCmd str = runExceptGhciMonad $ do
(span',sample) <- exceptT $ parseSpanArg str
infos <- lift $ mod_infos <$> getGHCiState
(info, ty) <- findType infos span' sample
- let mb_rdr_env = case modinfoRdrEnv info of
- Strict.Just rdrs -> Just rdrs
- Strict.Nothing -> Nothing
+ let mb_rdr_env = Just (modinfoRdrEnv info)
lift $ printForUserGlobalRdrEnv
mb_rdr_env
(sep [text sample,nest 2 (dcolon <+> ppr ty)])
@@ -2643,10 +2620,16 @@ browseModule bang modl exports_only = do
Nothing -> throwGhcException (CmdLineError ("unknown module: " ++
GHC.moduleNameString (GHC.moduleName modl)))
Just mod_info -> do
- let names
- | exports_only = GHC.modInfoExports mod_info
- | otherwise = GHC.modInfoTopLevelScope mod_info
- `orElse` []
+ names <-
+ if exports_only
+ then pure $ GHC.modInfoExports mod_info
+ else do
+ hsc_env <- GHC.getSession
+ mmod_env <- liftIO $ mkTopLevEnv hsc_env (moduleName modl)
+ case mmod_env of
+ Left err -> throwGhcException (CmdLineError (GHC.moduleNameString (GHC.moduleName modl) ++ " " ++ err))
+ Right mod_env -> pure $ map greName . globalRdrEnvElts $ mod_env
+ let
-- sort alphabetically name, but putting locally-defined
-- identifiers first. We would like to improve this; see #1799.
=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -42,6 +42,7 @@ import GHC.Driver.Monad
import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Types.Name
+import GHC.Tc.Types
import GHC.Types.Name.Reader
import GHC.Types.Name.Set
import GHC.Utils.Outputable
@@ -59,7 +60,7 @@ data ModInfo = ModInfo
-- ^ Generated set of information about all spans in the
-- module that correspond to some kind of identifier for
-- which there will be type info and/or location info.
- , modinfoRdrEnv :: !(Strict.Maybe IfGlobalRdrEnv)
+ , modinfoRdrEnv :: !IfGlobalRdrEnv
-- ^ What's in scope in the module.
, modinfoLastUpdate :: !UTCTime
-- ^ The timestamp of the file used to generate this record.
@@ -314,26 +315,19 @@ getModInfo name = do
typechecked <- typecheckModule p
let allTypes = processAllTypeCheckedModule typechecked
module_info = tm_checked_module_info typechecked
- !rdr_env = case modInfoRdrEnv module_info of
- Just rdrs -> Strict.Just rdrs
- -- NB: this has already been deeply forced; no need to do that again.
- -- See test case T15369 and Note [Forcing GREInfo] in GHC.Types.GREInfo.
- Nothing -> Strict.Nothing
+ let !rdr_env = tcg_rdr_env (fst $ tm_internals_ typechecked)
ts <- liftIO $ getModificationTime $ srcFilePath m
return $
ModInfo
{ modinfoSummary = m
, modinfoSpans = allTypes
- , modinfoRdrEnv = rdr_env
+ , modinfoRdrEnv = forceGlobalRdrEnv rdr_env
, modinfoLastUpdate = ts
}
-- | Get the 'Name's from the 'GlobalRdrEnv' of the 'ModInfo', if any.
modInfo_rdrs :: ModInfo -> [Name]
-modInfo_rdrs mi =
- case modinfoRdrEnv mi of
- Strict.Nothing -> []
- Strict.Just env -> map greName $ globalRdrEnvElts env
+modInfo_rdrs mi = map greName $ globalRdrEnvElts $ modinfoRdrEnv mi
-- | Get ALL source spans in the module.
processAllTypeCheckedModule :: TypecheckedModule -> [SpanInfo]
=====================================
ghc/GHCi/UI/Monad.hs
=====================================
@@ -25,7 +25,7 @@ module GHCi.UI.Monad (
ActionStats(..), runAndPrintStats, runWithStats, printStats,
printForUserNeverQualify,
- printForUserModInfo, printForUserGlobalRdrEnv,
+ printForUserGlobalRdrEnv,
printForUser, printForUserPartWay, prettyLocations,
compileGHCiExpr,
@@ -365,9 +365,6 @@ printForUserNeverQualify doc = do
dflags <- GHC.getInteractiveDynFlags
liftIO $ Ppr.printForUser dflags stdout neverQualify AllTheWay doc
-printForUserModInfo :: GhcMonad m => GHC.ModuleInfo -> SDoc -> m ()
-printForUserModInfo info = printForUserGlobalRdrEnv (GHC.modInfoRdrEnv info)
-
printForUserGlobalRdrEnv :: (GhcMonad m, Outputable info)
=> Maybe (GlobalRdrEnvX info) -> SDoc -> m ()
printForUserGlobalRdrEnv mb_rdr_env doc = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c3f262019b99a20c941a361ced1cd7ddc07f4e5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/3c3f262019b99a20c941a361ced1cd7ddc07f4e5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240228/b5c11132/attachment-0001.html>
More information about the ghc-commits
mailing list