InteractiveContext: Smarter caching when rebuilding the ic_rn_gbl_env

The GlobalRdrEnv of a GHCI session changes in odd ways: New bindings are
not just added "to the end", but also "in the middle", namely when
changing the set of imports: These are treated as if they happened
before all bindings from the prompt, even those that happened earlier.

Previously, this meant that the `ic_rn_gbl_env` is recalculated from the
`ic_tythings`. But this wasteful if `ic_tythings` has many entries that
define the same unqualified name. By separately keeping track of a
`GlobalRdrEnv` of all the locally defined things we can speed this
operation up significantly.

This change improves `T14052Type` by 60% (It used to be 70%, but it
looks that !6723 already reaped some of the rewards).
But more importantly, it hopefully unblocks #20455, becaues with this
smarter caching, the change needed to fix that issue will no longer make
`T14052` explode. I hope.

It does regress `T14052` by 30%; caching isn’t free. Oh well.

Metric Decrease:
    T14052Type

Metric Increase:
    T14052

5 files changed, 111 insertions, 37 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index ad584905a4..2074cd1054 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -1469,7 +1469,7 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do
 
 -- | get the GlobalRdrEnv for a session
 getGRE :: GhcMonad m => m GlobalRdrEnv
-getGRE = withSession $ \hsc_env-> return $ ic_rn_gbl_env (hsc_IC hsc_env)
+getGRE = withSession $ \hsc_env-> return $ icReaderEnv (hsc_IC hsc_env)
 
 -- | Retrieve all type and family instances in the environment, indexed
 -- by 'Name'. Each name's lists will contain every instance in which that name
diff --git a/compiler/GHC/Runtime/Context.hs b/compiler/GHC/Runtime/Context.hs
index b364c0d184..4b042aacca 100644
--- a/compiler/GHC/Runtime/Context.hs
+++ b/compiler/GHC/Runtime/Context.hs
@@ -6,7 +6,8 @@ module GHC.Runtime.Context
    , extendInteractiveContextWithIds
    , setInteractivePrintName
    , substInteractiveContext
-   , icExtendGblRdrEnv
+   , replaceImportEnv
+   , icReaderEnv
    , icInteractiveModule
    , icInScopeTTs
    , icPrintUnqual
@@ -20,7 +21,7 @@ import GHC.Hs
 import GHC.Driver.Session
 import {-# SOURCE #-} GHC.Driver.Plugins
 
-import GHC.Runtime.Eval.Types ( Resume )
+import GHC.Runtime.Eval.Types ( IcGlobalRdrEnv(..), Resume )
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -182,6 +183,37 @@ e.g.    Prelude> data T = A | B
         Prelude> instance Eq T where ...   -- This one overrides
 
 It's exactly the same for type-family instances.  See #7102
+
+Note [icReaderEnv recalculation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The GlobalRdrEnv describing what’s in scope at the prompts consists
+of all the imported things, followed by all the things defined on the prompt, with
+shadowing. Defining new things on the prompt is easy: we shadow as needed and then extend the environment.  But changing the set of imports, which can happen later as well,
+is tricky: we need to re-apply the shadowing from all the things defined at the prompt!
+
+For example:
+
+    ghci> let empty = True
+    ghci> import Data.IntMap.Strict     -- Exports 'empty'
+    ghci> empty   -- Still gets the 'empty' defined at the prompt
+    True
+
+
+It would be correct ot re-construct the env from scratch based on
+`ic_tythings`, but that'd be quite expensive if there are many entires in
+`ic_tythings` that shadow each other.
+
+Therefore we keep around a that `GlobalRdrEnv` in `igre_prompt_env` that
+contians _just_ the things defined at the prompt, and use that in
+`replaceImportEnv` to rebuild the full env.  Conveniently, `shadowNames` takes
+such an `OccEnv` to denote the set of names to shadow.
+
+INVARIANT: Every `OccName` in `igre_prompt_env` is present unqualified as well
+(else it would not be right to use pass `igre_prompt_env` to `shadowNames`.)
+
+The definition of the IcGlobalRdrEnv type should conceptually be in this module, and
+made abstract, but it’s used in `Resume`, so it lives in GHC.Runtime.Eval.Type.
+-
 -}
 
 -- | Interactive context, recording information about the state of the
@@ -200,7 +232,7 @@ data InteractiveContext
              -- See Note [The interactive package]
 
          ic_imports :: [InteractiveImport],
-             -- ^ The GHCi top-level scope (ic_rn_gbl_env) is extended with
+             -- ^ The GHCi top-level scope (icReaderEnv) is extended with
              -- these imports
              --
              -- This field is only stored here so that the client
@@ -213,11 +245,16 @@ data InteractiveContext
              -- definition (ie most recent at the front)
              -- See Note [ic_tythings]
 
-         ic_rn_gbl_env :: GlobalRdrEnv,
-             -- ^ The cached 'GlobalRdrEnv', built by
-             -- 'GHC.Runtime.Eval.setContext' and updated regularly
-             -- It contains everything in scope at the command line,
-             -- including everything in ic_tythings
+         ic_gre_cache :: IcGlobalRdrEnv,
+             -- ^ Essentially the cached 'GlobalRdrEnv'.
+             --
+             -- The GlobalRdrEnv contains everything in scope at the command
+             -- line, both imported and everything in ic_tythings, with the
+             -- correct shadowing.
+             --
+             -- The IcGlobalRdrEnv contains extra data to allow efficient
+             -- recalculation when the set of imports change.
+             -- See Note [icReaderEnv recalculation]
 
          ic_instances  :: ([ClsInst], [FamInst]),
              -- ^ All instances and family instances created during
@@ -233,7 +270,7 @@ data InteractiveContext
          ic_default :: Maybe [Type],
              -- ^ The current default types, set by a 'default' declaration
 
-          ic_resume :: [Resume],
+         ic_resume :: [Resume],
              -- ^ The stack of breakpoint contexts
 
          ic_monad      :: Name,
@@ -261,6 +298,11 @@ data InteractiveImport
       -- of this module, including the things imported
       -- into it.
 
+emptyIcGlobalRdrEnv :: IcGlobalRdrEnv
+emptyIcGlobalRdrEnv = IcGlobalRdrEnv
+    { igre_env = emptyGlobalRdrEnv
+    , igre_prompt_env = emptyGlobalRdrEnv
+    }
 
 -- | Constructs an empty InteractiveContext.
 emptyInteractiveContext :: DynFlags -> InteractiveContext
@@ -268,7 +310,7 @@ emptyInteractiveContext dflags
   = InteractiveContext {
        ic_dflags     = dflags,
        ic_imports    = [],
-       ic_rn_gbl_env = emptyGlobalRdrEnv,
+       ic_gre_cache  = emptyIcGlobalRdrEnv,
        ic_mod_index  = 1,
        ic_tythings   = [],
        ic_instances  = ([],[]),
@@ -281,6 +323,9 @@ emptyInteractiveContext dflags
        ic_plugins    = []
        }
 
+icReaderEnv :: InteractiveContext -> GlobalRdrEnv
+icReaderEnv = igre_env . ic_gre_cache
+
 icInteractiveModule :: InteractiveContext -> Module
 icInteractiveModule (InteractiveContext { ic_mod_index = index })
   = mkInteractiveModule index
@@ -292,8 +337,7 @@ icInScopeTTs = ic_tythings
 
 -- | Get the PrintUnqualified function based on the flags and this InteractiveContext
 icPrintUnqual :: UnitEnv -> InteractiveContext -> PrintUnqualified
-icPrintUnqual unit_env InteractiveContext{ ic_rn_gbl_env = grenv } =
-    mkPrintUnqualified unit_env grenv
+icPrintUnqual unit_env ictxt = mkPrintUnqualified unit_env (icReaderEnv ictxt)
 
 -- | extendInteractiveContext is called with new TyThings recently defined to update the
 -- InteractiveContext to include them.  Ids are easily removed when shadowed,
@@ -312,7 +356,7 @@ extendInteractiveContext ictxt new_tythings new_cls_insts new_fam_insts defaults
                             -- Always bump this; even instances should create
                             -- a new mod_index (#9426)
           , ic_tythings   = new_tythings ++ old_tythings
-          , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings
+          , ic_gre_cache  = ic_gre_cache  ictxt `icExtendIcGblRdrEnv` new_tythings
           , ic_instances  = ( new_cls_insts ++ old_cls_insts
                             , new_fam_insts ++ fam_insts )
                             -- we don't shadow old family instances (#7102),
@@ -333,9 +377,11 @@ extendInteractiveContextWithIds :: InteractiveContext -> [Id] -> InteractiveCont
 -- Just a specialised version
 extendInteractiveContextWithIds ictxt new_ids
   | null new_ids = ictxt
-  | otherwise    = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
-                         , ic_tythings   = new_tythings ++ old_tythings
-                         , ic_rn_gbl_env = ic_rn_gbl_env ictxt `icExtendGblRdrEnv` new_tythings }
+  | otherwise
+  = ictxt { ic_mod_index  = ic_mod_index ictxt + 1
+          , ic_tythings   = new_tythings ++ old_tythings
+          , ic_gre_cache  = ic_gre_cache ictxt `icExtendIcGblRdrEnv` new_tythings
+          }
   where
     new_tythings = map AnId new_ids
     old_tythings = filterOut (shadowed_by new_ids) (ic_tythings ictxt)
@@ -351,7 +397,19 @@ shadowed_by ids = shadowed
 setInteractivePrintName :: InteractiveContext -> Name -> InteractiveContext
 setInteractivePrintName ic n = ic{ic_int_print = n}
 
-    -- ToDo: should not add Ids to the gbl env here
+icExtendIcGblRdrEnv :: IcGlobalRdrEnv -> [TyThing] -> IcGlobalRdrEnv
+icExtendIcGblRdrEnv igre tythings = IcGlobalRdrEnv
+    { igre_env = igre_env igre `icExtendGblRdrEnv` tythings
+    , igre_prompt_env = igre_prompt_env igre `icExtendGblRdrEnv` tythings
+    }
+
+-- This is used by setContext in GHC.Runtime.Eval when the set of imports
+-- changes, and recalculates the GlobalRdrEnv. See Note [icReaderEnv recalculation]
+replaceImportEnv :: IcGlobalRdrEnv -> GlobalRdrEnv -> IcGlobalRdrEnv
+replaceImportEnv igre import_env = igre { igre_env = new_env }
+  where
+    import_env_shadowed = import_env `shadowNames` igre_prompt_env igre
+    new_env = import_env_shadowed `plusGlobalRdrEnv` igre_prompt_env igre
 
 -- | Add TyThings to the GlobalRdrEnv, earlier ones in the list shadowing
 -- later ones, and shadowing existing entries in the GlobalRdrEnv.
@@ -399,4 +457,3 @@ substInteractiveContext ictxt@InteractiveContext{ ic_tythings = tts } subst
 instance Outputable InteractiveImport where
   ppr (IIModule m) = char '*' <> ppr m
   ppr (IIDecl d)   = ppr d
-
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index a4ddbbfd4a..e934692334 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -233,7 +233,7 @@ execStmt' stmt stmt_text ExecOptions{..} = do
               evalStmt interp eval_opts (execWrap hval)
 
         let ic = hsc_IC hsc_env
-            bindings = (ic_tythings ic, ic_rn_gbl_env ic)
+            bindings = (ic_tythings ic, ic_gre_cache ic)
 
             size = ghciHistSize idflags'
 
@@ -310,7 +310,9 @@ emptyHistory :: Int -> BoundedList History
 emptyHistory size = nilBL size
 
 handleRunStatus :: GhcMonad m
-                => SingleStep -> String -> ([TyThing],GlobalRdrEnv) -> [Id]
+                => SingleStep -> String
+                -> ResumeBindings
+                -> [Id]
                 -> EvalStatus_ [ForeignHValue] [HValueRef]
                 -> BoundedList History
                 -> m ExecResult
@@ -418,9 +420,9 @@ resumeExec canLogSpan step mbCnt
         -- unbind the temporary locals by restoring the TypeEnv from
         -- before the breakpoint, and drop this Resume from the
         -- InteractiveContext.
-        let (resume_tmp_te,resume_rdr_env) = resumeBindings r
+        let (resume_tmp_te,resume_gre_cache) = resumeBindings r
             ic' = ic { ic_tythings = resume_tmp_te,
-                       ic_rn_gbl_env = resume_rdr_env,
+                       ic_gre_cache = resume_gre_cache,
                        ic_resume   = rs }
         setSession hsc_env{ hsc_IC = ic' }
 
@@ -773,7 +775,7 @@ fromListBL bound l = BL (length l) bound l []
 --
 -- (setContext imports) sets the ic_imports field (which in turn
 -- determines what is in scope at the prompt) to 'imports', and
--- constructs the ic_rn_glb_env environment to reflect it.
+-- updates the icReaderEnv environment to reflect it.
 --
 -- We retain in scope all the things defined at the prompt, and kept
 -- in ic_tythings.  (Indeed, they shadow stuff from ic_imports.)
@@ -788,10 +790,10 @@ setContext imports
                liftIO $ throwGhcExceptionIO (formatError dflags mod err)
            Right all_env -> do {
        ; let old_ic         = hsc_IC hsc_env
-             !final_rdr_env = all_env `icExtendGblRdrEnv` ic_tythings old_ic
+             !final_gre_cache = ic_gre_cache old_ic `replaceImportEnv` all_env
        ; setSession
-         hsc_env{ hsc_IC = old_ic { ic_imports    = imports
-                                  , ic_rn_gbl_env = final_rdr_env }}}}
+         hsc_env{ hsc_IC = old_ic { ic_imports   = imports
+                                  , ic_gre_cache = final_gre_cache }}}}
   where
     formatError dflags mod err = ProgramError . showSDoc dflags $
       text "Cannot add module" <+> ppr mod <+>
@@ -856,7 +858,7 @@ getInfo allInfo name
        case mb_stuff of
          Nothing -> return Nothing
          Just (thing, fixity, cls_insts, fam_insts, docs) -> do
-           let rdr_env = ic_rn_gbl_env (hsc_IC hsc_env)
+           let rdr_env = icReaderEnv (hsc_IC hsc_env)
 
            -- Filter the instances based on whether the constituent names of their
            -- instance heads are all in scope.
@@ -865,7 +867,7 @@ getInfo allInfo name
            return (Just (thing, fixity, cls_insts', fam_insts', docs))
   where
     plausible rdr_env names
-          -- Dfun involving only names that are in ic_rn_glb_env
+          -- Dfun involving only names that are in icReaderEnv
         = allInfo
        || nameSetAll ok names
         where   -- A name is ok if it's in the rdr_env,
@@ -880,7 +882,7 @@ getInfo allInfo name
 -- | Returns all names in scope in the current interactive context
 getNamesInScope :: GhcMonad m => m [Name]
 getNamesInScope = withSession $ \hsc_env ->
-  return (map greMangledName (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
+  return (map greMangledName (globalRdrEnvElts (icReaderEnv (hsc_IC hsc_env))))
 
 -- | Returns all 'RdrName's in scope in the current interactive
 -- context, excluding any that are internally-generated.
@@ -888,7 +890,7 @@ getRdrNamesInScope :: GhcMonad m => m [RdrName]
 getRdrNamesInScope = withSession $ \hsc_env -> do
   let
       ic = hsc_IC hsc_env
-      gbl_rdrenv = ic_rn_gbl_env ic
+      gbl_rdrenv = icReaderEnv ic
       gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv
   -- Exclude internally generated names; see e.g. #11328
   return (filter (not . isDerivedOccName . rdrNameOcc) gbl_names)
diff --git a/compiler/GHC/Runtime/Eval/Types.hs b/compiler/GHC/Runtime/Eval/Types.hs
index 5706c037de..85fd1c8037 100644
--- a/compiler/GHC/Runtime/Eval/Types.hs
+++ b/compiler/GHC/Runtime/Eval/Types.hs
@@ -7,7 +7,8 @@
 -- -----------------------------------------------------------------------------
 
 module GHC.Runtime.Eval.Types (
-        Resume(..), History(..), ExecResult(..),
+        Resume(..), ResumeBindings, IcGlobalRdrEnv(..),
+        History(..), ExecResult(..),
         SingleStep(..), isStep, ExecOptions(..)
         ) where
 
@@ -53,10 +54,22 @@ data ExecResult
        , breakInfo :: Maybe BreakInfo
        }
 
+-- | Essentially a GlobalRdrEnv, but with additional cached values to allow
+-- efficient re-calculation when the imports change.
+-- Fields are strict to avoid space leaks (see T4029)
+-- All operations are in GHC.Runtime.Context.
+-- See Note [icReaderEnv recalculation]
+data IcGlobalRdrEnv = IcGlobalRdrEnv
+  { igre_env :: !GlobalRdrEnv
+    -- ^ The final environment
+  , igre_prompt_env :: !GlobalRdrEnv
+    -- ^ Just the things defined at the prompt (excluding imports!)
+  }
+
 data Resume = Resume
        { resumeStmt      :: String       -- the original statement
        , resumeContext   :: ForeignRef (ResumeContext [HValueRef])
-       , resumeBindings  :: ([TyThing], GlobalRdrEnv)
+       , resumeBindings  :: ResumeBindings
        , resumeFinalIds  :: [Id]         -- [Id] to bind on completion
        , resumeApStack   :: ForeignHValue -- The object from which we can get
                                         -- value of the free variables.
@@ -75,6 +88,8 @@ data Resume = Resume
        , resumeHistoryIx :: Int           -- 0 <==> at the top of the history
        }
 
+type ResumeBindings = ([TyThing], IcGlobalRdrEnv)
+
 data History
    = History {
         historyApStack   :: ForeignHValue,
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 8739c33ec5..53ee34ed9e 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2040,8 +2040,8 @@ runTcInteractive hsc_env thing_inside
     do { traceTc "setInteractiveContext" $
             vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
                  , text "ic_insts:" <+> vcat (map (pprBndr LetBind . instanceDFunId) ic_insts)
-                 , text "ic_rn_gbl_env (LocalDef)" <+>
-                      vcat (map ppr [ local_gres | gres <- nonDetOccEnvElts (ic_rn_gbl_env icxt)
+                 , text "icReaderEnv (LocalDef)" <+>
+                      vcat (map ppr [ local_gres | gres <- nonDetOccEnvElts (icReaderEnv icxt)
                                                  , let local_gres = filter isLocalGRE gres
                                                  , not (null local_gres) ]) ]
 
@@ -2063,7 +2063,7 @@ runTcInteractive hsc_env thing_inside
 
        ; (gbl_env, lcl_env) <- getEnvs
        ; let gbl_env' = gbl_env {
-                           tcg_rdr_env      = ic_rn_gbl_env icxt
+                           tcg_rdr_env      = icReaderEnv icxt
                          , tcg_type_env     = type_env
                          , tcg_inst_env     = extendInstEnvList
                                                (extendInstEnvList (tcg_inst_env gbl_env) ic_insts)
@@ -2910,7 +2910,7 @@ loadUnqualIfaces hsc_env ictxt
     home_unit = hsc_home_unit hsc_env
 
     unqual_mods = [ nameModule name
-                  | gre <- globalRdrEnvElts (ic_rn_gbl_env ictxt)
+                  | gre <- globalRdrEnvElts (icReaderEnv ictxt)
                   , let name = greMangledName gre
                   , nameIsFromExternalPackage home_unit name
                   , isTcOcc (nameOccName name)   -- Types and classes only