WIP: remove `InteractiveContext` from `HscEnv`wip/rip-out-interactive-context

GHC the library typechecks!

30 files changed, 1765 insertions, 529 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 750c17c141..2985dc27f5 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -32,7 +32,7 @@ module GHC (
         GhcMode(..), GhcLink(..),
         parseDynamicFlags, parseTargetFiles,
         getSessionDynFlags,
-        setTopSessionDynFlags,
+        setTopSessionDynFlags, setTopSessionInteractiveDynFlags,
         setSessionDynFlags,
         setUnitDynFlags,
         getProgramDynFlags, setProgramDynFlags,
@@ -701,14 +701,15 @@ setTopSessionDynFlags dflags = do
       return Nothing
 #endif
 
-
   modifySession $ \h -> hscSetFlags dflags
-                        h{ hsc_IC = (hsc_IC h){ ic_dflags = dflags }
-                         , hsc_interp = hsc_interp h <|> interp
-                         }
+                        h{ hsc_interp = hsc_interp h <|> interp }
 
   invalidateModSummaryCache
 
+setTopSessionInteractiveDynFlags :: GhciMonad m => DynFlags -> m ()
+setTopSessionInteractiveDynFlags dflags = do
+  modifyInteractiveContext $ \ic -> ic{ ic_dflags = dflags }
+
 -- | Sets the program 'DynFlags'.  Note: this invalidates the internal
 -- cached module graph, causing more work to be done the next time
 -- 'load' is called.
@@ -796,31 +797,28 @@ getProgramDynFlags = getSessionDynFlags
 -- Note: this cannot be used for changes to packages.  Use
 -- 'setSessionDynFlags', or 'setProgramDynFlags' and then copy the
 -- 'unitState' into the interactive @DynFlags@.
-setInteractiveDynFlags :: GhcMonad m => DynFlags -> m ()
+setInteractiveDynFlags :: GhciMonad m => DynFlags -> m ()
 setInteractiveDynFlags dflags = do
   logger <- getLogger
   dflags' <- checkNewDynFlags logger dflags
   dflags'' <- checkNewInteractiveDynFlags logger dflags'
-  modifySessionM $ \hsc_env0 -> do
-    let ic0 = hsc_IC hsc_env0
-
+  hsc_env <- getSession
+  modifyInteractiveContextM $ \ic0 -> do
     -- Initialise (load) plugins in the interactive environment with the new
     -- DynFlags
-    plugin_env <- liftIO $ initializePlugins $ mkInteractiveHscEnv $
-                    hsc_env0 { hsc_IC = ic0 { ic_dflags = dflags'' }}
+    let ic1 = ic0{ ic_dflags = dflags'' }
+    plugin_env <- liftIO $ initializePlugins (mkInteractiveHscEnv hsc_env ic1) ic1
 
     -- Update both plugins cache and DynFlags in the interactive context.
-    return $ hsc_env0
-                { hsc_IC = ic0
-                    { ic_plugins = hsc_plugins plugin_env
-                    , ic_dflags  = hsc_dflags  plugin_env
-                    }
+    return $ ic0
+                { ic_plugins = hsc_plugins plugin_env
+                , ic_dflags  = hsc_dflags  plugin_env
                 }
 
 
 -- | Get the 'DynFlags' used to evaluate interactive expressions.
-getInteractiveDynFlags :: GhcMonad m => m DynFlags
-getInteractiveDynFlags = withSession $ \h -> return (ic_dflags (hsc_IC h))
+getInteractiveDynFlags :: GhciMonad m => m DynFlags
+getInteractiveDynFlags = ic_dflags <$> getInteractiveContext
 
 
 parseDynamicFlags
@@ -1285,8 +1283,10 @@ compileCore simplify fn = do
              hsc_env <- getSession
              simpl_guts <- liftIO $ do
                plugins <- readIORef (tcg_th_coreplugins tcg)
-               hscSimplify hsc_env plugins mod_guts
-             tidy_guts <- liftIO $ hscTidy hsc_env simpl_guts
+               -- TODO interactive context?
+               hscSimplify hsc_env (emptyInteractiveContext $ hsc_dflags hsc_env) plugins mod_guts
+             -- TODO interactive context?
+             tidy_guts <- liftIO $ hscTidy hsc_env Nothing simpl_guts
              return $ Left tidy_guts
           else
              return $ Right mod_guts
@@ -1334,19 +1334,21 @@ isLoadedModule uid m = withSession $ \hsc_env ->
   return $! isJust (lookupHug (hsc_HUG hsc_env) uid m)
 
 -- | Return the bindings for the current interactive session.
-getBindings :: GhcMonad m => m [TyThing]
-getBindings = withSession $ \hsc_env ->
-    return $ icInScopeTTs $ hsc_IC hsc_env
+getBindings :: GhciMonad m => m [TyThing]
+getBindings = icInScopeTTs <$> getInteractiveContext
 
 -- | Return the instances for the current interactive session.
-getInsts :: GhcMonad m => m ([ClsInst], [FamInst])
-getInsts = withSession $ \hsc_env ->
-    let (inst_env, fam_env) = ic_instances (hsc_IC hsc_env)
-    in return (instEnvElts inst_env, fam_env)
-
-getPrintUnqual :: GhcMonad m => m PrintUnqualified
-getPrintUnqual = withSession $ \hsc_env -> do
-  return $ icPrintUnqual (hsc_unit_env hsc_env) (hsc_IC hsc_env)
+getInsts :: GhciMonad m => m ([ClsInst], [FamInst])
+getInsts = do
+  ic <- getInteractiveContext
+  let (inst_env, fam_env) = ic_instances ic
+  return (instEnvElts inst_env, fam_env)
+
+getPrintUnqual :: GhciMonad m => m PrintUnqualified
+getPrintUnqual = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
+  return $ icPrintUnqual (hsc_unit_env hsc_env) ic
 
 -- | Container for information about a 'Module'.
 data ModuleInfo = ModuleInfo {
@@ -1363,16 +1365,18 @@ data ModuleInfo = ModuleInfo {
 
 
 -- | Request information about a loaded 'Module'
-getModuleInfo :: GhcMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
-getModuleInfo mdl = withSession $ \hsc_env -> do
+getModuleInfo :: GhciMonad m => Module -> m (Maybe ModuleInfo)  -- XXX: Maybe X
+getModuleInfo mdl = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
   if moduleUnitId mdl `S.member` hsc_all_home_unit_ids hsc_env
         then liftIO $ getHomeModuleInfo hsc_env mdl
-        else liftIO $ getPackageModuleInfo hsc_env mdl
+        else liftIO $ getPackageModuleInfo hsc_env ic mdl
 
-getPackageModuleInfo :: HscEnv -> Module -> IO (Maybe ModuleInfo)
-getPackageModuleInfo hsc_env mdl
+getPackageModuleInfo :: HscEnv -> InteractiveContext -> Module -> IO (Maybe ModuleInfo)
+getPackageModuleInfo hsc_env ic mdl
   = do  eps <- hscEPS hsc_env
-        iface <- hscGetModuleInterface hsc_env mdl
+        iface <- hscGetModuleInterface hsc_env ic mdl
         let
             avails = mi_exports iface
             pte    = eps_PTE eps
@@ -1487,13 +1491,13 @@ findGlobalAnns deserialize target = withSession $ \hsc_env -> do
     return (findAnns deserialize ann_env target)
 
 -- | get the GlobalRdrEnv for a session
-getGRE :: GhcMonad m => m GlobalRdrEnv
-getGRE = withSession $ \hsc_env-> return $ icReaderEnv (hsc_IC hsc_env)
+getGRE :: GhciMonad m => m GlobalRdrEnv
+getGRE = icReaderEnv <$> getInteractiveContext
 
 -- | Retrieve all type and family instances in the environment, indexed
 -- by 'Name'. Each name's lists will contain every instance in which that name
 -- is mentioned in the instance head.
-getNameToInstancesIndex :: GhcMonad m
+getNameToInstancesIndex :: GhciMonad m
   => [Module]        -- ^ visible modules. An orphan instance will be returned
                      -- if it is visible from at least one module in the list.
   -> Maybe [Module]  -- ^ modules to load. If this is not specified, we load
@@ -1501,9 +1505,10 @@ getNameToInstancesIndex :: GhcMonad m
   -> m (Messages TcRnMessage, Maybe (NameEnv ([ClsInst], [FamInst])))
 getNameToInstancesIndex visible_mods mods_to_load = do
   hsc_env <- getSession
-  liftIO $ runTcInteractive hsc_env $
+  ic <- getInteractiveContext
+  liftIO $ runTcInteractive hsc_env ic $
     do { case mods_to_load of
-           Nothing -> loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+           Nothing -> loadUnqualIfaces hsc_env ic
            Just mods ->
              let doc = text "Need interface for reporting instances in scope"
              in initIfaceTcRn $ mapM_ (loadSysInterface doc) mods
@@ -1728,30 +1733,35 @@ lookupLoadedHomeModule uid mod_name = withSession $ \hsc_env ->
 --
 -- We return True to indicate the import is safe and False otherwise
 -- although in the False case an error may be thrown first.
-isModuleTrusted :: GhcMonad m => Module -> m Bool
-isModuleTrusted m = withSession $ \hsc_env ->
-    liftIO $ hscCheckSafe hsc_env m noSrcSpan
+isModuleTrusted :: GhciMonad m => Module -> m Bool
+isModuleTrusted m = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
+  liftIO $ hscCheckSafe hsc_env (Just ic) m noSrcSpan
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-moduleTrustReqs :: GhcMonad m => Module -> m (Bool, Set UnitId)
-moduleTrustReqs m = withSession $ \hsc_env ->
-    liftIO $ hscGetSafe hsc_env m noSrcSpan
+moduleTrustReqs :: GhciMonad m => Module -> m (Bool, Set UnitId)
+moduleTrustReqs m = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
+  liftIO $ hscGetSafe hsc_env (Just ic) m noSrcSpan
 
 -- | Set the monad GHCi lifts user statements into.
 --
 -- Checks that a type (in string form) is an instance of the
 -- @GHC.GHCi.GHCiSandboxIO@ type class. Sets it to be the GHCi monad if it is,
 -- throws an error otherwise.
-setGHCiMonad :: GhcMonad m => String -> m ()
-setGHCiMonad name = withSession $ \hsc_env -> do
-    ty <- liftIO $ hscIsGHCiMonad hsc_env name
-    modifySession $ \s ->
-        let ic = (hsc_IC s) { ic_monad = ty }
-        in s { hsc_IC = ic }
+setGHCiMonad :: GhciMonad m => String -> m ()
+setGHCiMonad name = do
+  hsc_env <- getSession
+  ic0 <- getInteractiveContext
+  ty <- liftIO $ hscIsGHCiMonad hsc_env ic0 name
+  modifyInteractiveContext $ \ic ->
+    ic { ic_monad = ty }
 
 -- | Get the monad GHCi lifts user statements into.
-getGHCiMonad :: GhcMonad m => m Name
-getGHCiMonad = fmap (ic_monad . hsc_IC) getSession
+getGHCiMonad :: GhciMonad m => m Name
+getGHCiMonad = ic_monad <$> getInteractiveContext
 
 getHistorySpan :: GhcMonad m => History -> m SrcSpan
 getHistorySpan h = withSession $ \hsc_env ->
@@ -1761,17 +1771,20 @@ obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term
 obtainTermFromVal bound force ty a = withSession $ \hsc_env ->
     liftIO $ GHC.Runtime.Eval.obtainTermFromVal hsc_env bound force ty a
 
-obtainTermFromId :: GhcMonad m => Int -> Bool -> Id -> m Term
-obtainTermFromId bound force id = withSession $ \hsc_env ->
-    liftIO $ GHC.Runtime.Eval.obtainTermFromId hsc_env bound force id
+obtainTermFromId :: GhciMonad m => Int -> Bool -> Id -> m Term
+obtainTermFromId bound force id = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
+  liftIO $ GHC.Runtime.Eval.obtainTermFromId hsc_env ic bound force id
 
 
 -- | Returns the 'TyThing' for a 'Name'.  The 'Name' may refer to any
 -- entity known to GHC, including 'Name's defined using 'runStmt'.
-lookupName :: GhcMonad m => Name -> m (Maybe TyThing)
-lookupName name =
-     withSession $ \hsc_env ->
-       liftIO $ hscTcRcLookupName hsc_env name
+lookupName :: GhciMonad m => Name -> m (Maybe TyThing)
+lookupName name = do
+  hsc_env <- getSession
+  ic <- getInteractiveContext
+  liftIO $ hscTcRcLookupName hsc_env ic name
 
 -- -----------------------------------------------------------------------------
 -- Pure API
diff --git a/compiler/GHC/Core/Lint/Interactive.hs b/compiler/GHC/Core/Lint/Interactive.hs
index 7154c867a3..617a4ee5b3 100644
--- a/compiler/GHC/Core/Lint/Interactive.hs
+++ b/compiler/GHC/Core/Lint/Interactive.hs
@@ -33,8 +33,6 @@ interactiveInScope :: InteractiveContext -> [Var]
 --
 -- We do this by find local-named things that may appear free in interactive
 -- context.  This function is pretty revolting and quite possibly not quite right.
--- When we are not in GHCi, the interactive context is empty
--- so this is a (cheap) no-op.
 --
 -- See #8215 for an example
 interactiveInScope ictxt
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
new file mode 100644
index 0000000000..89f964e647
--- /dev/null
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -0,0 +1,1149 @@
+{-
+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
+
+\section[SimplCore]{Driver for simplifying @Core@ programs}
+-}
+
+{-# LANGUAGE CPP #-}
+
+module GHC.Core.Opt.Pipeline ( core2core, simplifyExpr ) where
+
+import GHC.Prelude
+
+import GHC.Driver.Session
+import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
+import GHC.Driver.Env
+import GHC.Driver.Config.Core.Lint ( endPass, lintPassResult )
+import GHC.Driver.Config.Core.Opt.CallerCC ( initCallerCCOpts )
+import GHC.Driver.Config.Core.Opt.SpecConstr ( initSpecConstrOpts )
+import GHC.Driver.Config.Core.Opt.LiberateCase ( initLiberateCaseOpts )
+import GHC.Driver.Config.Core.Opt.WorkWrap ( initWorkWrapOpts )
+import GHC.Driver.Config.Core.Rules ( initRuleOpts )
+import GHC.Platform.Ways  ( hasWay, Way(WayProf) )
+
+import GHC.Core
+import GHC.Core.Opt.CSE  ( cseProgram )
+import GHC.Core.Rules   ( mkRuleBase,
+                          extendRuleBaseList, ruleCheckProgram, addRuleInfo,
+                          getRules )
+import GHC.Core.Ppr     ( pprCoreBindings, pprCoreExpr )
+import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
+import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
+import GHC.Core.Utils   ( mkTicks, stripTicksTop, dumpIdInfoOfProgram )
+import GHC.Core.Lint    ( dumpPassResult, lintAnnots )
+import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
+import GHC.Core.Opt.Simplify       ( simplTopBinds, simplExpr, simplImpRules )
+import GHC.Core.Opt.Simplify.Utils ( simplEnvForGHCi, activeRule, activeUnfolding )
+import GHC.Core.Opt.Simplify.Env
+import GHC.Core.Opt.Simplify.Monad
+import GHC.Core.Opt.Utils        ( FloatOutSwitches(..), SimplMode(..)
+                                 , simplCountN, getFirstAnnotationsFromHscEnv )
+import GHC.Core.Opt.FloatIn      ( floatInwards )
+import GHC.Core.Opt.FloatOut     ( floatOutwards )
+import GHC.Core.Opt.LiberateCase ( liberateCase )
+import GHC.Core.Opt.StaticArgs   ( doStaticArgs )
+import GHC.Core.Opt.Specialise   ( SpecialiseOpts(..), specProgram )
+import GHC.Core.Opt.SpecConstr   ( specConstrProgram )
+import GHC.Core.Opt.DmdAnal
+import GHC.Core.Opt.CprAnal      ( cprAnalProgram )
+import GHC.Core.Opt.CallArity    ( callArityAnalProgram )
+import GHC.Core.Opt.Exitify      ( exitifyProgram )
+import GHC.Core.Opt.WorkWrap     ( wwTopBinds )
+import GHC.Core.Opt.CallerCC     ( addCallerCostCentres )
+import GHC.Core.LateCC           (addLateCostCentres)
+import GHC.Core.Seq (seqBinds)
+import GHC.Core.FamInstEnv
+
+import GHC.Plugins.Monad
+
+import GHC.Serialized   ( deserializeWithData )
+
+import GHC.Utils.Error  ( withTiming )
+import GHC.Utils.Logger as Logger
+import GHC.Utils.Outputable
+import GHC.Utils.Panic
+import GHC.Utils.Constants (debugIsOn)
+import GHC.Utils.Trace
+
+import GHC.Unit.External
+import GHC.Unit.Module.Env
+import GHC.Unit.Module.ModGuts
+import GHC.Unit.Module.Deps
+
+import GHC.Runtime.Context
+
+import GHC.Types.Id
+import GHC.Types.Id.Info
+import GHC.Types.Basic
+import GHC.Types.Demand ( zapDmdEnvSig )
+import GHC.Types.Var.Set
+import GHC.Types.Var.Env
+import GHC.Types.Tickish
+import GHC.Types.Unique.FM
+import GHC.Types.Name.Ppr
+
+import Control.Monad
+import qualified GHC.LanguageExtensions as LangExt
+import GHC.Unit.Module
+{-
+************************************************************************
+*                                                                      *
+\subsection{The driver for the simplifier}
+*                                                                      *
+************************************************************************
+-}
+
+core2core :: HscEnv -> ModGuts -> IO ModGuts
+core2core hsc_env guts@(ModGuts { mg_module  = mod
+                                , mg_loc     = loc
+                                , mg_deps    = deps
+                                , mg_rdr_env = rdr_env })
+  = do { let builtin_passes = getCoreToDo logger dflags
+             orph_mods = mkModuleSet (mod : dep_orphs deps)
+             uniq_mask = 's'
+       ;
+       ; (guts2, stats) <- runCoreM hsc_env hpt_rule_base uniq_mask mod
+                                    orph_mods print_unqual loc $
+                           do { hsc_env' <- getHscEnv
+                              ; all_passes <- withPlugins (hsc_plugins hsc_env')
+                                                installCoreToDos
+                                                builtin_passes
+                              ; runCorePasses all_passes guts }
+
+       ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
+             "Grand total simplifier statistics"
+             FormatText
+             (pprSimplCount stats)
+
+       ; return guts2 }
+  where
+    logger         = hsc_logger hsc_env
+    dflags         = hsc_dflags hsc_env
+    home_pkg_rules = hptRules hsc_env (moduleUnitId mod) (GWIB { gwib_mod = moduleName mod
+                                                               , gwib_isBoot = NotBoot })
+    hpt_rule_base  = mkRuleBase home_pkg_rules
+    print_unqual   = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env
+    -- mod: get the module out of the current HscEnv so we can retrieve it from the monad.
+    -- This is very convienent for the users of the monad (e.g. plugins do not have to
+    -- consume the ModGuts to find the module) but somewhat ugly because mg_module may
+    -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which
+    -- would mean our cached value would go out of date.
+
+{-
+************************************************************************
+*                                                                      *
+           Generating the main optimisation pipeline
+*                                                                      *
+************************************************************************
+-}
+
+getCoreToDo :: Logger -> DynFlags -> [CoreToDo]
+getCoreToDo logger dflags
+  = flatten_todos core_todo
+  where
+    phases        = simplPhases        dflags
+    max_iter      = maxSimplIterations dflags
+    rule_check    = ruleCheck          dflags
+    const_fold    = gopt Opt_CoreConstantFolding          dflags
+    call_arity    = gopt Opt_CallArity                    dflags
+    exitification = gopt Opt_Exitification                dflags
+    strictness    = gopt Opt_Strictness                   dflags
+    full_laziness = gopt Opt_FullLaziness                 dflags
+    do_specialise = gopt Opt_Specialise                   dflags
+    do_float_in   = gopt Opt_FloatIn                      dflags
+    cse           = gopt Opt_CSE                          dflags
+    spec_constr   = gopt Opt_SpecConstr                   dflags
+    liberate_case = gopt Opt_LiberateCase                 dflags
+    late_dmd_anal = gopt Opt_LateDmdAnal                  dflags
+    late_specialise = gopt Opt_LateSpecialise             dflags
+    static_args   = gopt Opt_StaticArgumentTransformation dflags
+    rules_on      = gopt Opt_EnableRewriteRules           dflags
+    eta_expand_on = gopt Opt_DoLambdaEtaExpansion         dflags
+    pre_inline_on = gopt Opt_SimplPreInlining             dflags
+    ww_on         = gopt Opt_WorkerWrapper                dflags
+    static_ptrs   = xopt LangExt.StaticPointers           dflags
+    profiling     = ways dflags `hasWay` WayProf
+
+    do_presimplify = do_specialise -- TODO: any other optimizations benefit from pre-simplification?
+    do_simpl3      = const_fold || rules_on -- TODO: any other optimizations benefit from three-phase simplification?
+
+    maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
+
+    maybe_strictness_before (Phase phase)
+      | phase `elem` strictnessBefore dflags = CoreDoDemand
+    maybe_strictness_before _
+      = CoreDoNothing
+
+    base_mode = SimplMode { sm_phase        = panic "base_mode"
+                          , sm_names        = []
+                          , sm_dflags       = dflags
+                          , sm_logger       = logger
+                          , sm_uf_opts      = unfoldingOpts dflags
+                          , sm_rules        = rules_on
+                          , sm_eta_expand   = eta_expand_on
+                          , sm_cast_swizzle = True
+                          , sm_inline       = True
+                          , sm_case_case    = True
+                          , sm_pre_inline   = pre_inline_on
+                          }
+
+    simpl_phase phase name iter
+      = CoreDoPasses
+      $   [ maybe_strictness_before phase
+          , CoreDoSimplify iter
+                (base_mode { sm_phase = phase
+                           , sm_names = [name] })
+
+          , maybe_rule_check phase ]
+
+    -- Run GHC's internal simplification phase, after all rules have run.
+    -- See Note [Compiler phases] in GHC.Types.Basic
+    simplify name = simpl_phase FinalPhase name max_iter
+
+    -- initial simplify: mk specialiser happy: minimum effort please
+    simpl_gently = CoreDoSimplify max_iter
+                       (base_mode { sm_phase = InitialPhase
+                                  , sm_names = ["Gentle"]
+                                  , sm_rules = rules_on   -- Note [RULEs enabled in InitialPhase]
+                                  , sm_inline = True
+                                              -- See Note [Inline in InitialPhase]
+                                  , sm_case_case = False })
+                          -- Don't do case-of-case transformations.
+                          -- This makes full laziness work better
+
+    dmd_cpr_ww = if ww_on then [CoreDoDemand,CoreDoCpr,CoreDoWorkerWrapper]
+                          else [CoreDoDemand,CoreDoCpr]
+
+
+    demand_analyser = (CoreDoPasses (
+                           dmd_cpr_ww ++
+                           [simplify "post-worker-wrapper"]
+                           ))
+
+    -- Static forms are moved to the top level with the FloatOut pass.
+    -- See Note [Grand plan for static forms] in GHC.Iface.Tidy.StaticPtrTable.
+    static_ptrs_float_outwards =
+      runWhen static_ptrs $ CoreDoPasses
+        [ simpl_gently -- Float Out can't handle type lets (sometimes created
+                       -- by simpleOptPgm via mkParallelBindings)
+        , CoreDoFloatOutwards FloatOutSwitches
+          { floatOutLambdas   = Just 0
+          , floatOutConstants = True
+          , floatOutOverSatApps = False
+          , floatToTopLevelOnly = True
+          }
+        ]
+
+    add_caller_ccs =
+        runWhen (profiling && not (null $ callerCcFilters dflags)) CoreAddCallerCcs
+
+    add_late_ccs =
+        runWhen (profiling && gopt Opt_ProfLateCcs dflags) $ CoreAddLateCcs
+
+    core_todo =
+     [
+    -- We want to do the static argument transform before full laziness as it
+    -- may expose extra opportunities to float things outwards. However, to fix
+    -- up the output of the transformation we need at do at least one simplify
+    -- after this before anything else
+        runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
+
+        -- initial simplify: mk specialiser happy: minimum effort please
+        runWhen do_presimplify simpl_gently,
+
+        -- Specialisation is best done before full laziness
+        -- so that overloaded functions have all their dictionary lambdas manifest
+        runWhen do_specialise CoreDoSpecialising,
+
+        if full_laziness then
+           CoreDoFloatOutwards FloatOutSwitches {
+                                 floatOutLambdas   = Just 0,
+                                 floatOutConstants = True,
+                                 floatOutOverSatApps = False,
+                                 floatToTopLevelOnly = False }
+                -- Was: gentleFloatOutSwitches
+                --
+                -- I have no idea why, but not floating constants to
+                -- top level is very bad in some cases.
+                --
+                -- Notably: p_ident in spectral/rewrite
+                --          Changing from "gentle" to "constantsOnly"
+                --          improved rewrite's allocation by 19%, and
+                --          made 0.0% difference to any other nofib
+                --          benchmark
+                --
+                -- Not doing floatOutOverSatApps yet, we'll do
+                -- that later on when we've had a chance to get more
+                -- accurate arity information.  In fact it makes no
+                -- difference at all to performance if we do it here,
+                -- but maybe we save some unnecessary to-and-fro in
+                -- the simplifier.
+        else
+           -- Even with full laziness turned off, we still need to float static
+           -- forms to the top level. See Note [Grand plan for static forms] in
+           -- GHC.Iface.Tidy.StaticPtrTable.
+           static_ptrs_float_outwards,
+
+        -- Run the simplier phases 2,1,0 to allow rewrite rules to fire
+        runWhen do_simpl3
+            (CoreDoPasses $ [ simpl_phase (Phase phase) "main" max_iter
+                            | phase <- [phases, phases-1 .. 1] ] ++
+                            [ simpl_phase (Phase 0) "main" (max max_iter 3) ]),
+                -- Phase 0: allow all Ids to be inlined now
+                -- This gets foldr inlined before strictness analysis
+
+                -- At least 3 iterations because otherwise we land up with
+                -- huge dead expressions because of an infelicity in the
+                -- simplifier.
+                --      let k = BIG in foldr k z xs
+                -- ==>  let k = BIG in letrec go = \xs -> ...(k x).... in go xs
+                -- ==>  let k = BIG in letrec go = \xs -> ...(BIG x).... in go xs
+                -- Don't stop now!
+
+        runWhen do_float_in CoreDoFloatInwards,
+            -- Run float-inwards immediately before the strictness analyser
+            -- Doing so pushes bindings nearer their use site and hence makes
+            -- them more likely to be strict. These bindings might only show
+            -- up after the inlining from simplification.  Example in fulsom,
+            -- Csg.calc, where an arg of timesDouble thereby becomes strict.
+
+        runWhen call_arity $ CoreDoPasses
+            [ CoreDoCallArity
+            , simplify "post-call-arity"
+            ],
+
+        -- Strictness analysis
+        runWhen strictness demand_analyser,
+
+        runWhen exitification CoreDoExitify,
+            -- See Note [Placement of the exitification pass]
+
+        runWhen full_laziness $
+           CoreDoFloatOutwards FloatOutSwitches {
+                                 floatOutLambdas     = floatLamArgs dflags,
+                                 floatOutConstants   = True,
+                                 floatOutOverSatApps = True,
+                                 floatToTopLevelOnly = False },
+                -- nofib/spectral/hartel/wang doubles in speed if you
+                -- do full laziness late in the day.  It only happens
+                -- after fusion and other stuff, so the early pass doesn't
+                -- catch it.  For the record, the redex is
+                --        f_el22 (f_el21 r_midblock)
+
+
+        runWhen cse CoreCSE,
+                -- We want CSE to follow the final full-laziness pass, because it may
+                -- succeed in commoning up things floated out by full laziness.
+                -- CSE used to rely on the no-shadowing invariant, but it doesn't any more
+
+        runWhen do_float_in CoreDoFloatInwards,
+
+        simplify "final",  -- Final tidy-up
+
+        maybe_rule_check FinalPhase,
+
+        --------  After this we have -O2 passes -----------------
+        -- None of them run with -O
+
+                -- Case-liberation for -O2.  This should be after
+                -- strictness analysis and the simplification which follows it.
+        runWhen liberate_case $ CoreDoPasses
+           [ CoreLiberateCase, simplify "post-liberate-case" ],
+           -- Run the simplifier after LiberateCase to vastly
+           -- reduce the possibility of shadowing
+           -- Reason: see Note [Shadowing] in GHC.Core.Opt.SpecConstr
+
+        runWhen spec_constr $ CoreDoPasses
+           [ CoreDoSpecConstr, simplify "post-spec-constr"],
+           -- See Note [Simplify after SpecConstr]
+
+        maybe_rule_check FinalPhase,
+
+        runWhen late_specialise $ CoreDoPasses
+           [ CoreDoSpecialising, simplify "post-late-spec"],
+
+        -- LiberateCase can yield new CSE opportunities because it peels
+        -- off one layer of a recursive function (concretely, I saw this
+        -- in wheel-sieve1), and I'm guessing that SpecConstr can too
+        -- And CSE is a very cheap pass. So it seems worth doing here.
+        runWhen ((liberate_case || spec_constr) && cse) $ CoreDoPasses
+           [ CoreCSE, simplify "post-final-cse" ],
+
+        ---------  End of -O2 passes --------------
+
+        runWhen late_dmd_anal $ CoreDoPasses (
+            dmd_cpr_ww ++ [simplify "post-late-ww"]
+          ),
+
+        -- Final run of the demand_analyser, ensures that one-shot thunks are
+        -- really really one-shot thunks. Only needed if the demand analyser
+        -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal
+        -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution
+        -- can become /exponentially/ more expensive. See #11731, #12996.
+        runWhen (strictness || late_dmd_anal) CoreDoDemand,
+
+        maybe_rule_check FinalPhase,
+
+        add_caller_ccs,
+        add_late_ccs
+     ]
+
+    -- Remove 'CoreDoNothing' and flatten 'CoreDoPasses' for clarity.
+    flatten_todos [] = []
+    flatten_todos (CoreDoNothing : rest) = flatten_todos rest
+    flatten_todos (CoreDoPasses passes : rest) =
+      flatten_todos passes ++ flatten_todos rest
+    flatten_todos (todo : rest) = todo : flatten_todos rest
+
+-- The core-to-core pass ordering is derived from the DynFlags:
+runWhen :: Bool -> CoreToDo -> CoreToDo
+runWhen True  do_this = do_this
+runWhen False _       = CoreDoNothing
+
+runMaybe :: Maybe a -> (a -> CoreToDo) -> CoreToDo
+runMaybe (Just x) f = f x
+runMaybe Nothing  _ = CoreDoNothing
+
+{- Note [Inline in InitialPhase]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+In GHC 8 and earlier we did not inline anything in the InitialPhase. But that is
+confusing for users because when they say INLINE they expect the function to inline
+right away.
+
+So now we do inlining immediately, even in the InitialPhase, assuming that the
+Id's Activation allows it.
+
+This is a surprisingly big deal. Compiler performance improved a lot
+when I made this change:
+
+   perf/compiler/T5837.run            T5837 [stat too good] (normal)
+   perf/compiler/parsing001.run       parsing001 [stat too good] (normal)
+   perf/compiler/T12234.run           T12234 [stat too good] (optasm)
+   perf/compiler/T9020.run            T9020 [stat too good] (optasm)
+   perf/compiler/T3064.run            T3064 [stat too good] (normal)
+   perf/compiler/T9961.run            T9961 [stat too good] (normal)
+   perf/compiler/T13056.run           T13056 [stat too good] (optasm)
+   perf/compiler/T9872d.run           T9872d [stat too good] (normal)
+   perf/compiler/T783.run             T783 [stat too good] (normal)
+   perf/compiler/T12227.run           T12227 [stat too good] (normal)
+   perf/should_run/lazy-bs-alloc.run  lazy-bs-alloc [stat too good] (normal)
+   perf/compiler/T1969.run            T1969 [stat too good] (normal)
+   perf/compiler/T9872a.run           T9872a [stat too good] (normal)
+   perf/compiler/T9872c.run           T9872c [stat too good] (normal)
+   perf/compiler/T9872b.run           T9872b [stat too good] (normal)
+   perf/compiler/T9872d.run           T9872d [stat too good] (normal)
+
+Note [RULEs enabled in InitialPhase]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+RULES are enabled when doing "gentle" simplification in InitialPhase,
+or with -O0.  Two reasons:
+
+  * We really want the class-op cancellation to happen:
+        op (df d1 d2) --> $cop3 d1 d2
+    because this breaks the mutual recursion between 'op' and 'df'
+
+  * I wanted the RULE
+        lift String ===> ...
+    to work in Template Haskell when simplifying
+    splices, so we get simpler code for literal strings
+
+But watch out: list fusion can prevent floating.  So use phase control
+to switch off those rules until after floating.
+
+Note [Simplify after SpecConstr]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We want to run the simplifier after SpecConstr, and before late-Specialise,
+for two reasons, both shown up in test perf/compiler/T16473,
+with -O2 -flate-specialise
+
+1.  I found that running late-Specialise after SpecConstr, with no
+    simplification in between meant that the carefullly constructed
+    SpecConstr rule never got to fire.  (It was something like
+          lvl = f a   -- Arity 1
+          ....g lvl....
+    SpecConstr specialised g for argument lvl; but Specialise then
+    specialised lvl = f a to lvl = $sf, and inlined. Or something like
+    that.)
+
+2.  Specialise relies on unfoldings being available for top-level dictionary
+    bindings; but SpecConstr kills them all!  The Simplifer restores them.
+
+This extra run of the simplifier has a cost, but this is only with -O2.
+
+
+************************************************************************
+*                                                                      *
+                  The CoreToDo interpreter
+*                                                                      *
+************************************************************************
+-}
+
+runCorePasses :: [CoreToDo] -> ModGuts -> CoreM ModGuts
+runCorePasses passes guts
+  = foldM do_pass guts passes
+  where
+    do_pass guts CoreDoNothing = return guts
+    do_pass guts (CoreDoPasses ps) = runCorePasses ps guts
+    do_pass guts pass = do
+      logger <- getLogger
+      withTiming logger (ppr pass <+> brackets (ppr mod))
+                   (const ()) $ do
+            guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
+            -- TODO interactive var in scope?
+            endPass [] pass (mg_binds guts') (mg_rules guts')
+            return guts'
+
+    mod = mg_module guts
+
+doCorePass :: CoreToDo -> ModGuts -> CoreM ModGuts
+doCorePass pass guts = do
+  logger    <- getLogger
+  dflags    <- getDynFlags
+  us        <- getUniqueSupplyM
+  p_fam_env <- getPackageFamInstEnv
+  let platform = targetPlatform dflags
+  let fam_envs = (p_fam_env, mg_fam_inst_env guts)
+  let updateBinds  f = return $ guts { mg_binds = f (mg_binds guts) }
+  let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' }
+
+  case pass of
+    CoreDoSimplify {}         -> {-# SCC "Simplify" #-}
+                                 simplifyPgm pass guts
+
+    CoreCSE                   -> {-# SCC "CommonSubExpr" #-}
+                                 updateBinds cseProgram
+
+    CoreLiberateCase          -> {-# SCC "LiberateCase" #-}
+                                 updateBinds (liberateCase (initLiberateCaseOpts dflags))
+
+    CoreDoFloatInwards        -> {-# SCC "FloatInwards" #-}
+                                 updateBinds (floatInwards platform)
+
+    CoreDoFloatOutwards f     -> {-# SCC "FloatOutwards" #-}
+                                 updateBindsM (liftIO . floatOutwards logger f us)
+
+    CoreDoStaticArgs          -> {-# SCC "StaticArgs" #-}
+                                 updateBinds (doStaticArgs us)
+
+    CoreDoCallArity           -> {-# SCC "CallArity" #-}
+                                 updateBinds callArityAnalProgram
+
+    CoreDoExitify             -> {-# SCC "Exitify" #-}
+                                 updateBinds exitifyProgram
+
+    CoreDoDemand              -> {-# SCC "DmdAnal" #-}
+                                 updateBindsM (liftIO . dmdAnal logger dflags fam_envs (mg_rules guts))
+
+    CoreDoCpr                 -> {-# SCC "CprAnal" #-}
+                                 updateBindsM (liftIO . cprAnalProgram logger fam_envs)
+
+    CoreDoWorkerWrapper       -> {-# SCC "WorkWrap" #-}
+                                 updateBinds (wwTopBinds
+                                               (initWorkWrapOpts (mg_module guts) dflags fam_envs)
+                                               us)
+
+    CoreDoSpecialising        -> {-# SCC "Specialise" #-} do
+                                   specialise_opts <- initSpecialiseOpts
+                                   liftIO $ specProgram logger specialise_opts guts
+
+    CoreDoSpecConstr          -> {-# SCC "SpecConstr" #-} do
+      this_mod <- getModule
+      hsc_env <- getHscEnv
+      (_, annos) <- liftIO $ getFirstAnnotationsFromHscEnv hsc_env deserializeWithData guts
+      liftIO $ specConstrProgram
+        annos us
+        (initSpecConstrOpts dflags this_mod)
+        guts
+
+    CoreAddCallerCcs          -> {-# SCC "AddCallerCcs" #-}
+                                 return (addCallerCostCentres (initCallerCCOpts dflags) guts)
+
+    CoreAddLateCcs            -> {-# SCC "AddLateCcs" #-}
+                                 addLateCostCentres guts
+
+    CoreDoPrintCore           -> {-# SCC "PrintCore" #-}
+                                 liftIO $ printCore logger (mg_binds guts) >> return guts
+
+    CoreDoRuleCheck phase pat -> {-# SCC "RuleCheck" #-}
+                                 ruleCheckPass phase pat guts
+    CoreDoNothing             -> return guts
+    CoreDoPasses passes       -> runCorePasses passes guts
+    -- TODO interactive vars in scope?
+
+    CoreDoPluginPass _ p      -> {-# SCC "Plugin" #-} p guts
+
+    CoreDesugar               -> pprPanic "doCorePass" (ppr pass)
+    CoreDesugarOpt            -> pprPanic "doCorePass" (ppr pass)
+    CoreTidy                  -> pprPanic "doCorePass" (ppr pass)
+    CorePrep                  -> pprPanic "doCorePass" (ppr pass)
+    CoreOccurAnal             -> pprPanic "doCorePass" (ppr pass)
+
+{-
+************************************************************************
+*                                                                      *
+        Initialize options for the optimization passes
+*                                                                      *
+************************************************************************
+
+These initialization functions will be moved to the 'GHC.Driver.Config.Core.Opt'
+namespace as part of the refactoring which is tracked in T17957.
+-}
+
+initSpecialiseOpts :: CoreM SpecialiseOpts
+initSpecialiseOpts = do
+  dflags <- getDynFlags
+  hsc_env <- getHscEnv
+  eps <- liftIO $ hscEPS hsc_env
+  loc <- getSrcSpanM
+  rule_base <- getRuleBase
+  mask <- getUniqMask
+  unqual <- getPrintUnqualified
+  vis_orphans <- getVisibleOrphanMods
+  return SpecialiseOpts
+    { so_dflags = dflags
+    , so_external_rule_base = eps_rule_base eps
+    , so_loc = loc
+    , so_rule_base = rule_base
+    , so_uniq_mask = mask
+    , so_unqual = unqual
+    , so_visible_orphan_mods = vis_orphans
+    }
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{Core pass combinators}
+*                                                                      *
+************************************************************************
+-}
+
+printCore :: Logger -> CoreProgram -> IO ()
+printCore logger binds
+    = Logger.logDumpMsg logger "Print Core" (pprCoreBindings binds)
+
+ruleCheckPass :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts
+ruleCheckPass current_phase pat guts = do
+    dflags <- getDynFlags
+    logger <- getLogger
+    withTiming logger (text "RuleCheck"<+>brackets (ppr $ mg_module guts))
+                (const ()) $ do
+        rb <- getRuleBase
+        vis_orphs <- getVisibleOrphanMods
+        let rule_fn fn = getRules (RuleEnv [rb] vis_orphs) fn
+                          ++ (mg_rules guts)
+        let ropts = initRuleOpts dflags
+        liftIO $ logDumpMsg logger "Rule check"
+                     (ruleCheckProgram ropts current_phase pat
+                        rule_fn (mg_binds guts))
+        return guts
+
+{-
+************************************************************************
+*                                                                      *
+        Gentle simplification
+*                                                                      *
+************************************************************************
+-}
+
+simplifyExpr :: HscEnv -- includes spec of what core-to-core passes to do
+             -> InteractiveContext
+             -> CoreExpr
+             -> IO CoreExpr
+-- simplifyExpr is called by the driver to simplify an
+-- expression typed in at the interactive prompt
+simplifyExpr hsc_env ic expr
+  = withTiming logger (text "Simplify [expr]") (const ()) $
+    do  { eps <- hscEPS hsc_env ;
+        ; let fi_env    = ( eps_fam_inst_env eps
+                          , extendFamInstEnvList emptyFamInstEnv $
+                            snd $ ic_instances ic )
+              simpl_env = simplEnvForGHCi logger dflags
+
+        ; let sz = exprSize expr
+
+        ; (expr', counts) <- initSmpl logger dflags (eps_rule_base <$> hscEPS hsc_env) emptyRuleEnv fi_env sz $
+                             simplExprGently simpl_env expr
+
+        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
+                  "Simplifier statistics" FormatText (pprSimplCount counts)
+
+        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression"
+                        FormatCore
+                        (pprCoreExpr expr')
+
+        ; return expr'
+        }
+  where
+    dflags = hsc_dflags hsc_env
+    logger = hsc_logger hsc_env
+
+simplExprGently :: SimplEnv -> CoreExpr -> SimplM CoreExpr
+-- Simplifies an expression
+--      does occurrence analysis, then simplification
+--      and repeats (twice currently) because one pass
+--      alone leaves tons of crud.
+-- Used (a) for user expressions typed in at the interactive prompt
+--      (b) the LHS and RHS of a RULE
+--      (c) Template Haskell splices
+--
+-- The name 'Gently' suggests that the SimplMode is InitialPhase,
+-- and in fact that is so.... but the 'Gently' in simplExprGently doesn't
+-- enforce that; it just simplifies the expression twice
+
+-- It's important that simplExprGently does eta reduction; see
+-- Note [Simplify rule LHS] above.  The
+-- simplifier does indeed do eta reduction (it's in GHC.Core.Opt.Simplify.completeLam)
+-- but only if -O is on.
+
+simplExprGently env expr = do
+    expr1 <- simplExpr env (occurAnalyseExpr expr)
+    simplExpr env (occurAnalyseExpr expr1)
+
+{-
+************************************************************************
+*                                                                      *
+\subsection{The driver for the simplifier}
+*                                                                      *
+************************************************************************
+-}
+
+simplifyPgm :: CoreToDo -> ModGuts -> CoreM ModGuts
+simplifyPgm pass guts
+  = do { hsc_env <- getHscEnv
+       ; rb <- getRuleBase
+       ; liftIOWithCount $
+         simplifyPgmIO pass hsc_env rb guts }
+
+simplifyPgmIO :: CoreToDo
+              -> HscEnv
+              -> RuleBase
+              -> ModGuts
+              -> IO (SimplCount, ModGuts)  -- New bindings
+
+simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
+              hsc_env hpt_rule_base
+              guts@(ModGuts { mg_module = this_mod
+                            , mg_rdr_env = rdr_env
+                            , mg_deps = deps
+                            , mg_binds = binds, mg_rules = rules
+                            , mg_fam_inst_env = fam_inst_env })
+  = do { (termination_msg, it_count, counts_out, guts')
+           <- do_iteration 1 [] binds rules
+
+        ; when (logHasDumpFlag logger Opt_D_verbose_core2core
+                && logHasDumpFlag logger Opt_D_dump_simpl_stats) $
+          logDumpMsg logger
+                  "Simplifier statistics for following pass"
+                  (vcat [text termination_msg <+> text "after" <+> ppr it_count
+                                              <+> text "iterations",
+                         blankLine,
+                         pprSimplCount counts_out])
+
+        ; return (counts_out, guts')
+    }
+  where
+    dflags       = hsc_dflags hsc_env
+    logger       = hsc_logger hsc_env
+    print_unqual = mkPrintUnqualified (hsc_unit_env hsc_env) rdr_env
+    simpl_env    = mkSimplEnv mode
+    active_rule  = activeRule mode
+    active_unf   = activeUnfolding mode
+
+    do_iteration :: Int --UniqSupply
+                --  -> Int          -- Counts iterations
+                 -> [SimplCount] -- Counts from earlier iterations, reversed
+                 -> CoreProgram  -- Bindings in
+                 -> [CoreRule]   -- and orphan rules
+                 -> IO (String, Int, SimplCount, ModGuts)
+
+    do_iteration iteration_no counts_so_far binds rules
+        -- iteration_no is the number of the iteration we are
+        -- about to begin, with '1' for the first
+      | iteration_no > max_iterations   -- Stop if we've run out of iterations
+      = warnPprTrace (debugIsOn && (max_iterations > 2))
+            "Simplifier bailing out"
+            ( hang (ppr this_mod <> text ", after"
+                    <+> int max_iterations <+> text "iterations"
+                    <+> (brackets $ hsep $ punctuate comma $
+                         map (int . simplCountN) (reverse counts_so_far)))
+                 2 (text "Size =" <+> ppr (coreBindsStats binds))) $
+
+                -- Subtract 1 from iteration_no to get the
+                -- number of iterations we actually completed
+        return ( "Simplifier baled out", iteration_no - 1
+               , totalise counts_so_far
+               , guts { mg_binds = binds, mg_rules = rules } )
+
+      -- Try and force thunks off the binds; significantly reduces
+      -- space usage, especially with -O.  JRS, 000620.
+      | let sz = coreBindsSize binds
+      , () <- sz `seq` ()     -- Force it
+      = do {
+                -- Occurrence analysis
+           let { tagged_binds = {-# SCC "OccAnal" #-}
+                     occurAnalysePgm this_mod active_unf active_rule rules
+                                     binds
+               } ;
+           Logger.putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
+                     FormatCore
+                     (pprCoreBindings tagged_binds);
+
+                -- read_eps_rules:
+                -- We need to read rules from the EPS regularly because simplification can
+                -- poke on IdInfo thunks, which in turn brings in new rules
+                -- behind the scenes.  Otherwise there's a danger we'll simply
+                -- miss the rules for Ids hidden inside imported inlinings
+                -- Hence just before attempting to match rules we read on the EPS
+                -- value and then combine it when the existing rule base.
+                -- See `GHC.Core.Opt.Simplify.Monad.getSimplRules`.
+           eps <- hscEPS hsc_env ;
+           let  { read_eps_rules = eps_rule_base <$> hscEPS hsc_env
+                ; rule_base = extendRuleBaseList hpt_rule_base rules
+                ; fam_envs = (eps_fam_inst_env eps, fam_inst_env)
+                ; vis_orphs = this_mod : dep_orphs deps } ;
+
+                -- Simplify the program
+           ((binds1, rules1), counts1) <-
+             initSmpl logger dflags read_eps_rules (mkRuleEnv rule_base vis_orphs) fam_envs sz $
+               do { (floats, env1) <- {-# SCC "SimplTopBinds" #-}
+                                      simplTopBinds simpl_env tagged_binds
+
+                      -- Apply the substitution to rules defined in this module
+                      -- for imported Ids.  Eg  RULE map my_f = blah
+                      -- If we have a substitution my_f :-> other_f, we'd better
+                      -- apply it to the rule to, or it'll never match
+                  ; rules1 <- simplImpRules env1 rules
+
+                  ; return (getTopFloatBinds floats, rules1) } ;
+
+                -- Stop if nothing happened; don't dump output
+                -- See Note [Which transformations are innocuous] in GHC.Core.Opt.Utils
+           if isZeroSimplCount counts1 then
+                return ( "Simplifier reached fixed point", iteration_no
+                       , totalise (counts1 : counts_so_far)  -- Include "free" ticks
+                       , guts { mg_binds = binds1, mg_rules = rules1 } )
+           else do {
+                -- Short out indirections
+                -- We do this *after* at least one run of the simplifier
+                -- because indirection-shorting uses the export flag on *occurrences*
+                -- and that isn't guaranteed to be ok until after the first run propagates
+                -- stuff from the binding site to its occurrences
+                --
+                -- ToDo: alas, this means that indirection-shorting does not happen at all
+                --       if the simplifier does nothing (not common, I know, but unsavoury)
+           let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ;
+
+                -- Dump the result of this iteration
+           let { dump_core_sizes = not (gopt Opt_SuppressCoreSizes dflags) } ;
+           dump_end_iteration logger dump_core_sizes print_unqual iteration_no counts1 binds2 rules1 ;
+           -- TODO interactive vars in scope?
+           lintPassResult hsc_env [] pass binds2 ;
+
+                -- Loop
+           do_iteration (iteration_no + 1) (counts1:counts_so_far) binds2 rules1
+           } }
+#if __GLASGOW_HASKELL__ <= 810
+      | otherwise = panic "do_iteration"
+#endif
+      where
+        -- Remember the counts_so_far are reversed
+        totalise :: [SimplCount] -> SimplCount
+        totalise = foldr (\c acc -> acc `plusSimplCount` c)
+                         (zeroSimplCount dflags)
+
+simplifyPgmIO _ _ _ _ = panic "simplifyPgmIO"
+
+-------------------
+dump_end_iteration :: Logger -> Bool -> PrintUnqualified -> Int
+                   -> SimplCount -> CoreProgram -> [CoreRule] -> IO ()
+dump_end_iteration logger dump_core_sizes print_unqual iteration_no counts binds rules
+  = dumpPassResult logger dump_core_sizes print_unqual mb_flag hdr pp_counts binds rules
+  where
+    mb_flag | logHasDumpFlag logger Opt_D_dump_simpl_iterations = Just Opt_D_dump_simpl_iterations
+            | otherwise                                         = Nothing
+            -- Show details if Opt_D_dump_simpl_iterations is on
+
+    hdr = "Simplifier iteration=" ++ show iteration_no
+    pp_counts = vcat [ text "---- Simplifier counts for" <+> text hdr
+                     , pprSimplCount counts
+                     , text "---- End of simplifier counts for" <+> text hdr ]
+
+{-
+************************************************************************
+*                                                                      *
+                Shorting out indirections
+*                                                                      *
+************************************************************************
+
+If we have this:
+
+        x_local = <expression>
+        ...bindings...
+        x_exported = x_local
+
+where x_exported is exported, and x_local is not, then we replace it with this:
+
+        x_exported = <expression>
+        x_local = x_exported
+        ...bindings...
+
+Without this we never get rid of the x_exported = x_local thing.  This
+save a gratuitous jump (from \tr{x_exported} to \tr{x_local}), and
+makes strictness information propagate better.  This used to happen in
+the final phase, but it's tidier to do it here.
+
+Note [Messing up the exported Id's RULES]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We must be careful about discarding (obviously) or even merging the
+RULES on the exported Id. The example that went bad on me at one stage
+was this one:
+
+    iterate :: (a -> a) -> a -> [a]
+        [Exported]
+    iterate = iterateList
+
+    iterateFB c f x = x `c` iterateFB c f (f x)
+    iterateList f x =  x : iterateList f (f x)
+        [Not exported]
+
+    {-# RULES
+    "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
+    "iterateFB"                 iterateFB (:) = iterateList
+     #-}
+
+This got shorted out to:
+
+    iterateList :: (a -> a) -> a -> [a]
+    iterateList = iterate
+
+    iterateFB c f x = x `c` iterateFB c f (f x)
+    iterate f x =  x : iterate f (f x)
+
+    {-# RULES
+    "iterate"   forall f x.     iterate f x = build (\c _n -> iterateFB c f x)
+    "iterateFB"                 iterateFB (:) = iterate
+     #-}
+
+And now we get an infinite loop in the rule system
+        iterate f x -> build (\cn -> iterateFB c f x)
+                    -> iterateFB (:) f x
+                    -> iterate f x
+
+Old "solution":
+        use rule switching-off pragmas to get rid
+        of iterateList in the first place
+
+But in principle the user *might* want rules that only apply to the Id
+they say.  And inline pragmas are similar
+   {-# NOINLINE f #-}
+   f = local
+   local = <stuff>
+Then we do not want to get rid of the NOINLINE.
+
+Hence hasShortableIdinfo.
+
+
+Note [Rules and indirection-zapping]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Problem: what if x_exported has a RULE that mentions something in ...bindings...?
+Then the things mentioned can be out of scope!  Solution
+ a) Make sure that in this pass the usage-info from x_exported is
+        available for ...bindings...
+ b) If there are any such RULES, rec-ify the entire top-level.
+    It'll get sorted out next time round
+
+Other remarks
+~~~~~~~~~~~~~
+If more than one exported thing is equal to a local thing (i.e., the
+local thing really is shared), then we do one only:
+\begin{verbatim}
+        x_local = ....
+        x_exported1 = x_local
+        x_exported2 = x_local
+==>
+        x_exported1 = ....
+
+        x_exported2 = x_exported1
+\end{verbatim}
+
+We rely on prior eta reduction to simplify things like
+\begin{verbatim}
+        x_exported = /\ tyvars -> x_local tyvars
+==>
+        x_exported = x_local
+\end{verbatim}
+Hence,there's a possibility of leaving unchanged something like this:
+\begin{verbatim}
+        x_local = ....
+        x_exported1 = x_local Int
+\end{verbatim}
+By the time we've thrown away the types in STG land this
+could be eliminated.  But I don't think it's very common
+and it's dangerous to do this fiddling in STG land
+because we might eliminate a binding that's mentioned in the
+unfolding for something.
+
+Note [Indirection zapping and ticks]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Unfortunately this is another place where we need a special case for
+ticks. The following happens quite regularly:
+
+        x_local = <expression>
+        x_exported = tick<x> x_local
+
+Which we want to become:
+
+        x_exported =  tick<x> <expression>
+
+As it makes no sense to keep the tick and the expression on separate
+bindings. Note however that this might increase the ticks scoping
+over the execution of x_local, so we can only do this for floatable
+ticks. More often than not, other references will be unfoldings of
+x_exported, and therefore carry the tick anyway.
+-}
+
+type IndEnv = IdEnv (Id, [CoreTickish]) -- Maps local_id -> exported_id, ticks
+
+shortOutIndirections :: CoreProgram -> CoreProgram
+shortOutIndirections binds
+  | isEmptyVarEnv ind_env = binds
+  | no_need_to_flatten    = binds'                      -- See Note [Rules and indirection-zapping]
+  | otherwise             = [Rec (flattenBinds binds')] -- for this no_need_to_flatten stuff
+  where
+    ind_env            = makeIndEnv binds
+    -- These exported Ids are the subjects  of the indirection-elimination
+    exp_ids            = map fst $ nonDetEltsUFM ind_env
+      -- It's OK to use nonDetEltsUFM here because we forget the ordering
+      -- by immediately converting to a set or check if all the elements
+      -- satisfy a predicate.
+    exp_id_set         = mkVarSet exp_ids
+    no_need_to_flatten = all (null . ruleInfoRules . idSpecialisation) exp_ids
+    binds'             = concatMap zap binds
+
+    zap (NonRec bndr rhs) = [NonRec b r | (b,r) <- zapPair (bndr,rhs)]
+    zap (Rec pairs)       = [Rec (concatMap zapPair pairs)]
+
+    zapPair (bndr, rhs)
+        | bndr `elemVarSet` exp_id_set
+        = []   -- Kill the exported-id binding
+
+        | Just (exp_id, ticks) <- lookupVarEnv ind_env bndr
+        , (exp_id', lcl_id') <- transferIdInfo exp_id bndr
+        =      -- Turn a local-id binding into two bindings
+               --    exp_id = rhs; lcl_id = exp_id
+          [ (exp_id', mkTicks ticks rhs),
+            (lcl_id', Var exp_id') ]
+
+        | otherwise
+        = [(bndr,rhs)]
+
+makeIndEnv :: [CoreBind] -> IndEnv
+makeIndEnv binds
+  = foldl' add_bind emptyVarEnv binds
+  where
+    add_bind :: IndEnv -> CoreBind -> IndEnv
+    add_bind env (NonRec exported_id rhs) = add_pair env (exported_id, rhs)
+    add_bind env (Rec pairs)              = foldl' add_pair env pairs
+
+    add_pair :: IndEnv -> (Id,CoreExpr) -> IndEnv
+    add_pair env (exported_id, exported)
+        | (ticks, Var local_id) <- stripTicksTop tickishFloatable exported
+        , shortMeOut env exported_id local_id
+        = extendVarEnv env local_id (exported_id, ticks)
+    add_pair env _ = env
+
+-----------------
+shortMeOut :: IndEnv -> Id -> Id -> Bool
+shortMeOut ind_env exported_id local_id
+-- The if-then-else stuff is just so I can get a pprTrace to see
+-- how often I don't get shorting out because of IdInfo stuff
+  = if isExportedId exported_id &&              -- Only if this is exported
+
+       isLocalId local_id &&                    -- Only if this one is defined in this
+                                                --      module, so that we *can* change its
+                                                --      binding to be the exported thing!
+
+       not (isExportedId local_id) &&           -- Only if this one is not itself exported,
+                                                --      since the transformation will nuke it
+
+       not (local_id `elemVarEnv` ind_env)      -- Only if not already substituted for
+    then
+        if hasShortableIdInfo exported_id
+        then True       -- See Note [Messing up the exported Id's RULES]
+        else warnPprTrace True "Not shorting out" (ppr exported_id) False
+    else
+        False
+
+-----------------
+hasShortableIdInfo :: Id -> Bool
+-- True if there is no user-attached IdInfo on exported_id,
+-- so we can safely discard it
+-- See Note [Messing up the exported Id's RULES]
+hasShortableIdInfo id
+  =  isEmptyRuleInfo (ruleInfo info)
+  && isDefaultInlinePragma (inlinePragInfo info)
+  && not (isStableUnfolding (realUnfoldingInfo info))
+  where
+     info = idInfo id
+
+-----------------
+{- Note [Transferring IdInfo]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we have
+     lcl_id = e; exp_id = lcl_id
+
+and lcl_id has useful IdInfo, we don't want to discard it by going
+     gbl_id = e; lcl_id = gbl_id
+
+Instead, transfer IdInfo from lcl_id to exp_id, specifically
+* (Stable) unfolding
+* Strictness
+* Rules
+* Inline pragma
+
+Overwriting, rather than merging, seems to work ok.
+
+For the lcl_id we
+
+* Zap the InlinePragma. It might originally have had a NOINLINE, which
+  we have now transferred; and we really want the lcl_id to inline now
+  that its RHS is trivial!
+
+* Zap any Stable unfolding.  agian, we want lcl_id = gbl_id to inline,
+  replacing lcl_id by gbl_id. That won't happen if lcl_id has its original
+  great big Stable unfolding
+-}
+
+transferIdInfo :: Id -> Id -> (Id, Id)
+-- See Note [Transferring IdInfo]
+transferIdInfo exported_id local_id
+  = ( modifyIdInfo transfer exported_id
+    , modifyIdInfo zap_info local_id )
+  where
+    local_info = idInfo local_id
+    transfer exp_info = exp_info `setDmdSigInfo`     dmdSigInfo local_info
+                                 `setCprSigInfo`     cprSigInfo local_info
+                                 `setUnfoldingInfo`  realUnfoldingInfo local_info
+                                 `setInlinePragInfo` inlinePragInfo local_info
+                                 `setRuleInfo`       addRuleInfo (ruleInfo exp_info) new_info
+    new_info = setRuleInfoHead (idName exported_id)
+                               (ruleInfo local_info)
+        -- Remember to set the function-name field of the
+        -- rules as we transfer them from one function to another
+
+    zap_info lcl_info = lcl_info `setInlinePragInfo` defaultInlinePragma
+                                 `setUnfoldingInfo`  noUnfolding
+
+
+dmdAnal :: Logger -> DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram
+dmdAnal logger dflags fam_envs rules binds = do
+  let !opts = DmdAnalOpts
+               { dmd_strict_dicts    = gopt Opt_DictsStrict dflags
+               , dmd_unbox_width     = dmdUnboxWidth dflags
+               , dmd_max_worker_args = maxWorkerArgs dflags
+               }
+      binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds
+  Logger.putDumpFileMaybe logger Opt_D_dump_str_signatures "Strictness signatures" FormatText $
+    dumpIdInfoOfProgram (hasPprDebug dflags) (ppr . zapDmdEnvSig . dmdSigInfo) binds_plus_dmds
+  -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal
+  seqBinds binds_plus_dmds `seq` return binds_plus_dmds
diff --git a/compiler/GHC/Driver/Config/Core/Lint.hs b/compiler/GHC/Driver/Config/Core/Lint.hs
index d3e505bc7e..f24dbb23bd 100644
--- a/compiler/GHC/Driver/Config/Core/Lint.hs
+++ b/compiler/GHC/Driver/Config/Core/Lint.hs
@@ -16,6 +16,7 @@ import GHC.Driver.Session
 import GHC.Driver.Config.Diagnostic
 
 import GHC.Core.Lint
+import GHC.Core.Lint.Interactive
 import GHC.Core.Opt.Config
 import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )
 import GHC.Core.Opt.Simplify.Env ( SimplMode(..) )
diff --git a/compiler/GHC/Driver/Config/Core/Lint/Interactive.hs b/compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
index 3c798ef478..376fe847ce 100644
--- a/compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
+++ b/compiler/GHC/Driver/Config/Core/Lint/Interactive.hs
@@ -14,7 +14,7 @@ import GHC.Core.Ppr
 import GHC.Core.Lint
 import GHC.Core.Lint.Interactive
 
---import GHC.Runtime.Context
+import GHC.Runtime.Context
 
 import GHC.Data.Bag
 
@@ -22,11 +22,12 @@ import GHC.Utils.Outputable as Outputable
 
 lintInteractiveExpr :: SDoc -- ^ The source of the linted expression
                     -> HscEnv
+                    -> InteractiveContext
                     -> CoreExpr -> IO ()
-lintInteractiveExpr what hsc_env expr
+lintInteractiveExpr what hsc_env ic expr
   | not (gopt Opt_DoCoreLinting dflags)
   = return ()
-  | Just err <- lintExpr (initLintConfig dflags $ interactiveInScope $ hsc_IC hsc_env) expr
+  | Just err <- lintExpr (initLintConfig dflags $ interactiveInScope ic) expr
   = displayLintResults logger False what (pprCoreExpr expr) (emptyBag, err)
   | otherwise
   = return ()
diff --git a/compiler/GHC/Driver/Config/CoreToStg/Prep.hs b/compiler/GHC/Driver/Config/CoreToStg/Prep.hs
index 0e43c27ebe..2e6c9d4b90 100644
--- a/compiler/GHC/Driver/Config/CoreToStg/Prep.hs
+++ b/compiler/GHC/Driver/Config/CoreToStg/Prep.hs
@@ -7,8 +7,9 @@ import GHC.Prelude
 
 import GHC.Driver.Env
 import GHC.Driver.Session
-import GHC.Driver.Config.Core.EndPass ()
+--import GHC.Driver.Config.Core.EndPass ()
 import GHC.Driver.Config.Core.Lint ( defaultLintFlags, maybeInitLintPassResultConfig )
+import GHC.Runtime.Context ( InteractiveContext )
 import GHC.Tc.Utils.Env
 import GHC.Types.Var
 import GHC.Utils.Outputable
@@ -20,12 +21,12 @@ import GHC.CoreToStg.Prep
 
 import qualified GHC.LanguageExtensions as LangExt
 
-initCorePrepConfig :: HscEnv -> IO CorePrepConfig
-initCorePrepConfig hsc_env = do
+initCorePrepConfig :: HscEnv -> Maybe InteractiveContext -> IO CorePrepConfig
+initCorePrepConfig hsc_env m_ic = do
    convertNumLit <- do
      let platform = targetPlatform $ hsc_dflags hsc_env
          home_unit = hsc_home_unit hsc_env
-         lookup_global = lookupGlobal hsc_env
+         lookup_global = lookupGlobal hsc_env m_ic
      mkConvertNumLiteral platform home_unit lookup_global
    return $ CorePrepConfig
       { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env
diff --git a/compiler/GHC/Driver/Config/Tidy.hs b/compiler/GHC/Driver/Config/Tidy.hs
index 89bdf31b2c..381840a0c7 100644
--- a/compiler/GHC/Driver/Config/Tidy.hs
+++ b/compiler/GHC/Driver/Config/Tidy.hs
@@ -21,18 +21,19 @@ import GHC.Data.Maybe
 import GHC.Utils.Panic
 import GHC.Utils.Outputable
 import GHC.Builtin.Names
+import GHC.Runtime.Context ( InteractiveContext )
 import GHC.Tc.Utils.Env (lookupGlobal_maybe)
 import GHC.Types.TyThing
 import GHC.Platform.Ways
 
 import qualified GHC.LanguageExtensions as LangExt
 
-initTidyOpts :: HscEnv -> IO TidyOpts
-initTidyOpts hsc_env = do
+initTidyOpts :: HscEnv -> Maybe InteractiveContext -> IO TidyOpts
+initTidyOpts hsc_env m_ic = do
   let dflags = hsc_dflags hsc_env
   static_ptr_opts <- if not (xopt LangExt.StaticPointers dflags)
     then pure Nothing
-    else Just <$> initStaticPtrOpts hsc_env
+    else Just <$> initStaticPtrOpts hsc_env m_ic
   pure $ TidyOpts
     { opt_name_cache        = hsc_NC hsc_env
     , opt_collect_ccs       = ways dflags `hasWay` WayProf
@@ -45,11 +46,11 @@ initTidyOpts hsc_env = do
     , opt_static_ptr_opts   = static_ptr_opts
     }
 
-initStaticPtrOpts :: HscEnv -> IO StaticPtrOpts
-initStaticPtrOpts hsc_env = do
+initStaticPtrOpts :: HscEnv -> Maybe InteractiveContext -> IO StaticPtrOpts
+initStaticPtrOpts hsc_env m_ic = do
   let dflags = hsc_dflags hsc_env
 
-  let lookupM n = lookupGlobal_maybe hsc_env n >>= \case
+  let lookupM n = lookupGlobal_maybe hsc_env m_ic n >>= \case
         Succeeded r -> pure r
         Failed err  -> pprPanic "initStaticPtrOpts: couldn't find" (ppr (err,n))
 
diff --git a/compiler/GHC/Driver/Core/Opt.hs b/compiler/GHC/Driver/Core/Opt.hs
index 90a303132f..271ed5cae3 100644
--- a/compiler/GHC/Driver/Core/Opt.hs
+++ b/compiler/GHC/Driver/Core/Opt.hs
@@ -22,11 +22,14 @@ import GHC.Core.Rules ( mkRuleBase )
 import GHC.Core.Opt ( CoreOptEnv (..), runCorePasses )
 import GHC.Core.Opt.Stats    ( SimplCountM, runSimplCountM, pprSimplCount )
 
+import GHC.Runtime.Context
+
 import GHC.Unit
 import GHC.Unit.Module.ModGuts
 import GHC.Unit.Module.Deps
 
 import GHC.Types.Name.Ppr
+import GHC.Types.Var ( Var )
 
 import GHC.Utils.Logger as Logger
 
@@ -41,28 +44,32 @@ import Control.Monad.IO.Class
 
 -- | Run Core2Core simplifier. The list of String is a list of (Core) plugin
 -- module names added via TH (cf 'addCorePlugin').
-hscSimplify :: HscEnv -> [String] -> ModGuts -> IO ModGuts
-hscSimplify hsc_env plugins modguts =
-    runHsc hsc_env $ hscSimplify' plugins modguts
+hscSimplify :: HscEnv -> InteractiveContext -> [String] -> ModGuts -> IO ModGuts
+hscSimplify hsc_env ic plugins modguts =
+    runHsc hsc_env $ hscSimplify' ic plugins modguts
 
 -- | Run Core2Core simplifier. The list of String is a list of (Core) plugin
 -- module names added via TH (cf 'addCorePlugin').
-hscSimplify' :: [String] -> ModGuts -> Hsc ModGuts
-hscSimplify' plugins ds_result = do
+hscSimplify' :: InteractiveContext -> [String] -> ModGuts -> Hsc ModGuts
+hscSimplify' ic plugins ds_result = do
     hsc_env <- getHscEnv
     hsc_env_with_plugins <- if null plugins -- fast path
         then return hsc_env
         else liftIO $ initializePlugins
-                    $ hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins)
-                      hsc_env
+            (hscUpdateFlags (\dflags -> foldr addPluginModuleName dflags plugins) hsc_env)
+            ic
     {-# SCC "Core2Core" #-}
-      liftIO $ core2core hsc_env_with_plugins ds_result
-
-core2core :: HscEnv -> ModGuts -> IO ModGuts
-core2core hsc_env guts@(ModGuts { mg_module  = mod
-                                , mg_loc     = loc
-                                , mg_deps    = deps
-                                , mg_rdr_env = rdr_env })
+      liftIO $ core2core
+        hsc_env_with_plugins (interactiveInScope ic)
+        ds_result
+
+core2core :: HscEnv -> [Var] -> ModGuts -> IO ModGuts
+core2core hsc_env
+          extra_vars
+          guts@(ModGuts { mg_module  = mod
+                        , mg_loc     = loc
+                        , mg_deps    = deps
+                        , mg_rdr_env = rdr_env })
   = do { let builtin_passes = getCoreToDo dflags extra_vars
 
        ; (guts2, stats) <- runSimplCountM dump_simpl_stats $ do
@@ -80,7 +87,6 @@ core2core hsc_env guts@(ModGuts { mg_module  = mod
     dflags           = hsc_dflags hsc_env
     logger           = hsc_logger hsc_env
     dump_simpl_stats = logHasDumpFlag logger Opt_D_dump_simpl_stats
-    extra_vars       = interactiveInScope (hsc_IC hsc_env)
     home_pkg_rules   = hptRules hsc_env (moduleUnitId mod) (GWIB { gwib_mod = moduleName mod
                                                                  , gwib_isBoot = NotBoot })
     hpt_rule_base  = mkRuleBase home_pkg_rules
@@ -99,7 +105,7 @@ core2core hsc_env guts@(ModGuts { mg_module  = mod
       , co_visOrphans    = mkModuleSet (mod : dep_orphs deps)
       , co_hasPprDebug   = hasPprDebug dflags
       , co_getEps        = hscEPS hsc_env
-      , co_extraVars     = interactiveInScope $ hsc_IC hsc_env
+      , co_extraVars     = extra_vars
       , co_specConstrAnn = fmap snd . getFirstAnnotationsFromHscEnv hsc_env deserializeWithData
       , co_endPassCfg    = \pass -> initEndPassConfig dflags extra_vars (co_printUnqual env) pass
       , co_lintAnnotationsCfg = \pass -> initLintAnnotationsConfig dflags loc (co_printUnqual env) pass
diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs
index 53c45af240..b4d400380b 100644
--- a/compiler/GHC/Driver/Env.hs
+++ b/compiler/GHC/Driver/Env.hs
@@ -108,16 +108,15 @@ getHscEnv :: Hsc HscEnv
 getHscEnv = Hsc $ \e w -> return (e, w)
 
 -- | Switches in the DynFlags and Plugins from the InteractiveContext
-mkInteractiveHscEnv :: HscEnv -> HscEnv
-mkInteractiveHscEnv hsc_env =
-    let ic = hsc_IC hsc_env
-    in hscSetFlags (ic_dflags ic) $
+mkInteractiveHscEnv :: HscEnv -> InteractiveContext -> HscEnv
+mkInteractiveHscEnv hsc_env ic =
+    hscSetFlags (ic_dflags ic) $
        hsc_env { hsc_plugins = ic_plugins ic }
 
 -- | A variant of runHsc that switches in the DynFlags and Plugins from the
 -- InteractiveContext before running the Hsc computation.
-runInteractiveHsc :: HscEnv -> Hsc a -> IO a
-runInteractiveHsc hsc_env = runHsc (mkInteractiveHscEnv hsc_env)
+runInteractiveHsc :: HscEnv -> InteractiveContext -> Hsc a -> IO a
+runInteractiveHsc hsc_env ic = runHsc (mkInteractiveHscEnv hsc_env ic)
 
 hsc_home_unit :: HscEnv -> HomeUnit
 hsc_home_unit = unsafeGetHomeUnit . hsc_unit_env
@@ -433,19 +432,18 @@ hscActiveUnitId e = ue_currentUnit (hsc_unit_env e)
 -- | Discard the contents of the InteractiveContext, but keep the DynFlags and
 -- the loaded plugins.  It will also keep ic_int_print and ic_monad if their
 -- names are from external packages.
-discardIC :: HscEnv -> HscEnv
-discardIC hsc_env
-  = hsc_env { hsc_IC = empty_ic { ic_int_print = new_ic_int_print
-                                , ic_monad     = new_ic_monad
-                                , ic_plugins   = old_plugins
-                                } }
+discardIC :: HscEnv -> InteractiveContext -> InteractiveContext
+discardIC hsc_env old_ic
+  = empty_ic { ic_int_print = new_ic_int_print
+             , ic_monad     = new_ic_monad
+             , ic_plugins   = old_plugins
+             }
   where
   -- Force the new values for ic_int_print and ic_monad to avoid leaking old_ic
   !new_ic_int_print = keep_external_name ic_int_print
   !new_ic_monad = keep_external_name ic_monad
   !old_plugins = ic_plugins old_ic
   dflags = ic_dflags old_ic
-  old_ic = hsc_IC hsc_env
   empty_ic = emptyInteractiveContext dflags
   keep_external_name ic_name
     | nameIsFromExternalPackage home_unit old_name = old_name
diff --git a/compiler/GHC/Driver/Env/Types.hs b/compiler/GHC/Driver/Env/Types.hs
index 63a5eb86cb..288d186507 100644
--- a/compiler/GHC/Driver/Env/Types.hs
+++ b/compiler/GHC/Driver/Env/Types.hs
@@ -11,7 +11,6 @@ import GHC.Driver.Session ( ContainsDynFlags(..), HasDynFlags(..), DynFlags )
 import GHC.Driver.LlvmConfigCache (LlvmConfigCache)
 
 import GHC.Prelude
-import GHC.Runtime.Context
 import GHC.Runtime.Interpreter.Types ( Interp )
 import GHC.Types.Error ( Messages )
 import GHC.Types.Name.Cache
@@ -68,9 +67,6 @@ data HscEnv
         hsc_mod_graph :: ModuleGraph,
                 -- ^ The module graph of the current session
 
-        hsc_IC :: InteractiveContext,
-                -- ^ The context for evaluating interactive statements
-
         hsc_NC  :: {-# UNPACK #-} !NameCache,
                 -- ^ Global Name cache so that each Name gets a single Unique.
                 -- Also track the origin of the Names.
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 97098b9c52..6ffae869f2 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -298,7 +298,6 @@ newHscEnvWithHUG top_dir top_dynflags cur_unit home_unit_graph = do
                   , hsc_logger         = setLogFlags logger (initLogFlags top_dynflags)
                   , hsc_targets        = []
                   , hsc_mod_graph      = emptyMG
-                  , hsc_IC             = emptyInteractiveContext dflags
                   , hsc_NC             = nc_var
                   , hsc_FC             = fc_var
                   , hsc_type_env_vars  = emptyKnotVars
@@ -425,42 +424,42 @@ ioMsgMaybe' ioA = do
 -- -----------------------------------------------------------------------------
 -- | Lookup things in the compiler's environment
 
-hscTcRnLookupRdrName :: HscEnv -> LocatedN RdrName -> IO [Name]
-hscTcRnLookupRdrName hsc_env0 rdr_name
-  = runInteractiveHsc hsc_env0 $
+hscTcRnLookupRdrName :: HscEnv -> InteractiveContext -> LocatedN RdrName -> IO [Name]
+hscTcRnLookupRdrName hsc_env0 ic rdr_name
+  = runInteractiveHsc hsc_env0 ic $
     do { hsc_env <- getHscEnv
-       ; ioMsgMaybe $ hoistTcRnMessage $ tcRnLookupRdrName hsc_env rdr_name }
+       ; ioMsgMaybe $ hoistTcRnMessage $ tcRnLookupRdrName hsc_env ic rdr_name }
 
-hscTcRcLookupName :: HscEnv -> Name -> IO (Maybe TyThing)
-hscTcRcLookupName hsc_env0 name = runInteractiveHsc hsc_env0 $ do
+hscTcRcLookupName :: HscEnv -> InteractiveContext -> Name -> IO (Maybe TyThing)
+hscTcRcLookupName hsc_env0 ic name = runInteractiveHsc hsc_env0 ic $ do
   hsc_env <- getHscEnv
-  ioMsgMaybe' $ hoistTcRnMessage $ tcRnLookupName hsc_env name
+  ioMsgMaybe' $ hoistTcRnMessage $ tcRnLookupName hsc_env ic name
       -- ignore errors: the only error we're likely to get is
       -- "name not found", and the Maybe in the return type
       -- is used to indicate that.
 
-hscTcRnGetInfo :: HscEnv -> Name
+hscTcRnGetInfo :: HscEnv -> InteractiveContext -> Name
                -> IO (Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
-hscTcRnGetInfo hsc_env0 name
-  = runInteractiveHsc hsc_env0 $
+hscTcRnGetInfo hsc_env0 ic name
+  = runInteractiveHsc hsc_env0 ic $
     do { hsc_env <- getHscEnv
-       ; ioMsgMaybe' $ hoistTcRnMessage $ tcRnGetInfo hsc_env name }
+       ; ioMsgMaybe' $ hoistTcRnMessage $ tcRnGetInfo hsc_env ic name }
 
-hscIsGHCiMonad :: HscEnv -> String -> IO Name
-hscIsGHCiMonad hsc_env name
-  = runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ isGHCiMonad hsc_env name
+hscIsGHCiMonad :: HscEnv -> InteractiveContext -> String -> IO Name
+hscIsGHCiMonad hsc_env ic name
+  = runHsc hsc_env $ ioMsgMaybe $ hoistTcRnMessage $ isGHCiMonad hsc_env ic name
 
-hscGetModuleInterface :: HscEnv -> Module -> IO ModIface
-hscGetModuleInterface hsc_env0 mod = runInteractiveHsc hsc_env0 $ do
+hscGetModuleInterface :: HscEnv -> InteractiveContext -> Module -> IO ModIface
+hscGetModuleInterface hsc_env0 ic mod = runInteractiveHsc hsc_env0 ic $ do
   hsc_env <- getHscEnv
-  ioMsgMaybe $ hoistTcRnMessage $ getModuleInterface hsc_env mod
+  ioMsgMaybe $ hoistTcRnMessage $ getModuleInterface hsc_env ic mod
 
 -- -----------------------------------------------------------------------------
 -- | Rename some import declarations
-hscRnImportDecls :: HscEnv -> [LImportDecl GhcPs] -> IO GlobalRdrEnv
-hscRnImportDecls hsc_env0 import_decls = runInteractiveHsc hsc_env0 $ do
+hscRnImportDecls :: HscEnv -> InteractiveContext -> [LImportDecl GhcPs] -> IO GlobalRdrEnv
+hscRnImportDecls hsc_env0 ic import_decls = runInteractiveHsc hsc_env0 ic $ do
   hsc_env <- getHscEnv
-  ioMsgMaybe $ hoistTcRnMessage $ tcRnImportDecls hsc_env import_decls
+  ioMsgMaybe $ hoistTcRnMessage $ tcRnImportDecls hsc_env ic import_decls
 
 -- -----------------------------------------------------------------------------
 -- | parse a file, returning the abstract syntax
@@ -716,7 +715,8 @@ tcRnModule' sum save_rn_syntax mod = do
 
       -- module (could be) safe, throw warning if needed
       else do
-          tcg_res' <- hscCheckSafeImports tcg_res
+          -- TODO interactive context?
+          tcg_res' <- hscCheckSafeImports Nothing tcg_res
           safe <- liftIO $ readIORef (tcg_safe_infer tcg_res')
           when safe $
             case wopt Opt_WarnSafe dflags of
@@ -1008,10 +1008,12 @@ hscDesugarAndSimplify summary (FrontendTypecheck tc_result) tc_warnings mb_old_h
       -- Just cause we desugared doesn't mean we are generating code, see above.
       Just desugared_guts | backendGeneratesCode bcknd -> do
           plugins <- liftIO $ readIORef (tcg_th_coreplugins tc_result)
-          simplified_guts <- hscSimplify' plugins desugared_guts
+          -- TODO plugins should not require an interactive context!
+          simplified_guts <- hscSimplify' (emptyInteractiveContext dflags) plugins desugared_guts
 
           (cg_guts, details) <-
-              liftIO $ hscTidy hsc_env simplified_guts
+              -- TODO interactive context?
+              liftIO $ hscTidy hsc_env Nothing simplified_guts
 
           let !partial_iface =
                 {-# SCC "GHC.Driver.Main.mkPartialIface" #-}
@@ -1286,10 +1288,10 @@ batchMsgWith extra hsc_env_start mod_index recomp node =
 -- If not we either issue a compilation error if the module is explicitly
 -- using Safe Haskell, or mark the module as unsafe if we're in safe
 -- inference mode.
-hscCheckSafeImports :: TcGblEnv -> Hsc TcGblEnv
-hscCheckSafeImports tcg_env = do
+hscCheckSafeImports :: Maybe InteractiveContext -> TcGblEnv -> Hsc TcGblEnv
+hscCheckSafeImports m_ic tcg_env = do
     dflags   <- getDynFlags
-    tcg_env' <- checkSafeImports tcg_env
+    tcg_env' <- checkSafeImports m_ic tcg_env
     checkRULES dflags tcg_env'
 
   where
@@ -1328,8 +1330,8 @@ hscCheckSafeImports tcg_env = do
 -- module are collected and unioned.  Specifically see the Note [Tracking Trust
 -- Transitively] in "GHC.Rename.Names" and the Note [Trust Own Package] in
 -- "GHC.Rename.Names".
-checkSafeImports :: TcGblEnv -> Hsc TcGblEnv
-checkSafeImports tcg_env
+checkSafeImports :: Maybe InteractiveContext -> TcGblEnv -> Hsc TcGblEnv
+checkSafeImports m_ic tcg_env
     = do
         dflags <- getDynFlags
         imps <- mapM condense imports'
@@ -1395,7 +1397,7 @@ checkSafeImports tcg_env
 
     -- easier interface to work with
     checkSafe :: (Module, SrcSpan, a) -> Hsc (Maybe UnitId)
-    checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m l
+    checkSafe (m, l, _) = fst `fmap` hscCheckSafe' m_ic m l
 
     -- what pkg's to add to our trust requirements
     pkgTrustReqs :: DynFlags -> Set UnitId -> Set UnitId ->
@@ -1413,18 +1415,18 @@ checkSafeImports tcg_env
 --
 -- We return True to indicate the import is safe and False otherwise
 -- although in the False case an exception may be thrown first.
-hscCheckSafe :: HscEnv -> Module -> SrcSpan -> IO Bool
-hscCheckSafe hsc_env m l = runHsc hsc_env $ do
+hscCheckSafe :: HscEnv -> Maybe InteractiveContext -> Module -> SrcSpan -> IO Bool
+hscCheckSafe hsc_env m_ic m l = runHsc hsc_env $ do
     dflags <- getDynFlags
-    pkgs <- snd `fmap` hscCheckSafe' m l
+    pkgs <- snd `fmap` hscCheckSafe' m_ic m l
     when (packageTrustOn dflags) $ checkPkgTrust pkgs
     errs <- getDiagnostics
     return $ isEmptyMessages errs
 
 -- | Return if a module is trusted and the pkgs it depends on to be trusted.
-hscGetSafe :: HscEnv -> Module -> SrcSpan -> IO (Bool, Set UnitId)
-hscGetSafe hsc_env m l = runHsc hsc_env $ do
-    (self, pkgs) <- hscCheckSafe' m l
+hscGetSafe :: HscEnv -> Maybe InteractiveContext -> Module -> SrcSpan -> IO (Bool, Set UnitId)
+hscGetSafe hsc_env m_ic m l = runHsc hsc_env $ do
+    (self, pkgs) <- hscCheckSafe' m_ic m l
     good         <- isEmptyMessages `fmap` getDiagnostics
     clearDiagnostics -- don't want them printed...
     let pkgs' | Just p <- self = S.insert p pkgs
@@ -1435,9 +1437,9 @@ hscGetSafe hsc_env m l = runHsc hsc_env $ do
 -- Return (regardless of trusted or not) if the trust type requires the modules
 -- own package be trusted and a list of other packages required to be trusted
 -- (these later ones haven't been checked) but the own package trust has been.
-hscCheckSafe' :: Module -> SrcSpan
+hscCheckSafe' :: Maybe InteractiveContext -> Module -> SrcSpan
   -> Hsc (Maybe UnitId, Set UnitId)
-hscCheckSafe' m l = do
+hscCheckSafe' m_ic m l = do
     hsc_env <- getHscEnv
     let home_unit = hsc_home_unit hsc_env
     (tw, pkgs) <- isModSafe home_unit m l
@@ -1526,7 +1528,9 @@ hscCheckSafe' m l = do
         -- so we need to call 'getModuleInterface' to load from disk
         case iface of
             Just _  -> return iface
-            Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)
+            Nothing -> case m_ic of
+                Just ic -> liftIO $ snd <$> getModuleInterface hsc_env ic m
+                Nothing -> pure Nothing
 
 
 -- | Check the list of packages are trusted.
@@ -1672,11 +1676,13 @@ hscGenHardCode hsc_env cgguts location output_filename = do
         -- PREPARE FOR CODE GENERATION
         -- Do saturation and convert to A-normal form
         (prepd_binds) <- {-# SCC "CorePrep" #-} do
-          cp_cfg <- initCorePrepConfig hsc_env
+          -- TODO interactive context?
+          cp_cfg <- initCorePrepConfig hsc_env Nothing
           corePrepPgm
             (hsc_logger hsc_env)
             cp_cfg
-            (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env))
+            -- TODO interactive in scope?
+            (initCorePrepPgmConfig (hsc_dflags hsc_env) [])
             this_mod location core_binds data_tycons
 
         -----------------  Convert to STG ------------------
@@ -1685,7 +1691,8 @@ hscGenHardCode hsc_env cgguts location output_filename = do
                withTiming logger
                    (text "CoreToStg"<+>brackets (ppr this_mod))
                    (\(a, b, (c,d)) -> a `seqList` b `seq` c `seqList` d `seqList` ())
-                   (myCoreToStg logger dflags (hsc_IC hsc_env) False this_mod location prepd_binds)
+                   -- TODO interactive in scope?
+                   (myCoreToStg logger dflags [] False this_mod location prepd_binds)
 
         let cost_centre_info =
               (local_ccs ++ caf_ccs, caf_cc_stacks)
@@ -1731,10 +1738,11 @@ hscGenHardCode hsc_env cgguts location output_filename = do
 
 
 hscInteractive :: HscEnv
+               -> InteractiveContext
                -> CgGuts
                -> ModLocation
                -> IO (Maybe FilePath, CompiledByteCode, [SptEntry])
-hscInteractive hsc_env cgguts location = do
+hscInteractive hsc_env ic cgguts location = do
     let dflags = hsc_dflags hsc_env
     let logger = hsc_logger hsc_env
     let tmpfs  = hsc_tmpfs hsc_env
@@ -1755,16 +1763,18 @@ hscInteractive hsc_env cgguts location = do
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-} do
-      cp_cfg <- initCorePrepConfig hsc_env
+      cp_cfg <- initCorePrepConfig hsc_env $ Just ic
       corePrepPgm
         (hsc_logger hsc_env)
         cp_cfg
-        (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env))
+        (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope ic))
         this_mod location core_binds data_tycons
 
     (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks)
-      <- {-# SCC "CoreToStg" #-}
-          myCoreToStg logger dflags (hsc_IC hsc_env) True this_mod location prepd_binds
+      <- {-# SCC "CoreToStg" #-} myCoreToStg
+        logger dflags
+        (interactiveInScope ic)
+        True this_mod location prepd_binds
     -----------------  Generate byte code ------------------
     comp_bc <- byteCodeGen hsc_env this_mod stg_binds data_tycons mod_breaks
     ------------------ Create f-x-dynamic C-side stuff -----
@@ -1932,27 +1942,28 @@ myCoreToStgExpr logger dflags ictxt for_bytecode this_mod ml prepd_expr = do
     (stg_binds, prov_map, collected_ccs) <-
        myCoreToStg logger
                    dflags
-                   ictxt
+                   (interactiveInScope ictxt)
                    for_bytecode
                    this_mod
                    ml
                    [NonRec bco_tmp_id prepd_expr]
     return (bco_tmp_id, stg_binds, prov_map, collected_ccs)
 
-myCoreToStg :: Logger -> DynFlags -> InteractiveContext
+myCoreToStg :: Logger -> DynFlags -> [Var]
             -> Bool
             -> Module -> ModLocation -> CoreProgram
             -> IO ( [CgStgTopBinding] -- output program
                   , InfoTableProvMap
                   , CollectedCCs )  -- CAF cost centre info (declared and used)
-myCoreToStg logger dflags ictxt for_bytecode this_mod ml prepd_binds = do
+myCoreToStg logger dflags extra_vars for_bytecode this_mod ml prepd_binds = do
     let (stg_binds, denv, cost_centre_info)
          = {-# SCC "Core2Stg" #-}
            coreToStg dflags this_mod ml prepd_binds
 
     stg_binds_with_fvs
         <- {-# SCC "Stg2Stg" #-}
-           stg2stg logger (interactiveInScope ictxt) (initStgPipelineOpts dflags for_bytecode)
+           stg2stg logger extra_vars
+                   (initStgPipelineOpts dflags for_bytecode)
                    this_mod stg_binds
 
     putDumpFileMaybe logger Opt_D_dump_stg_cg "CodeGenInput STG:" FormatSTG
@@ -1979,42 +1990,44 @@ IO monad as explained in Note [Interactively-bound Ids in GHCi] in GHC.Runtime.C
 --
 -- We return Nothing to indicate an empty statement (or comment only), not a
 -- parse error.
-hscStmt :: HscEnv -> String -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
-hscStmt hsc_env stmt = hscStmtWithLocation hsc_env stmt "<interactive>" 1
+hscStmt :: HscEnv -> InteractiveContext -> String -> IO (Maybe ([Id], ForeignHValue, FixityEnv))
+hscStmt hsc_env ic stmt = hscStmtWithLocation hsc_env ic stmt "<interactive>" 1
 
 -- | Compile a stmt all the way to an HValue, but don't run it
 --
 -- We return Nothing to indicate an empty statement (or comment only), not a
 -- parse error.
 hscStmtWithLocation :: HscEnv
+                    -> InteractiveContext
                     -> String -- ^ The statement
                     -> String -- ^ The source
                     -> Int    -- ^ Starting line
                     -> IO ( Maybe ([Id]
                           , ForeignHValue {- IO [HValue] -}
                           , FixityEnv))
-hscStmtWithLocation hsc_env0 stmt source linenumber =
-  runInteractiveHsc hsc_env0 $ do
+hscStmtWithLocation hsc_env0 ic stmt source linenumber =
+  runInteractiveHsc hsc_env0 ic $ do
     maybe_stmt <- hscParseStmtWithLocation source linenumber stmt
     case maybe_stmt of
       Nothing -> return Nothing
 
       Just parsed_stmt -> do
         hsc_env <- getHscEnv
-        liftIO $ hscParsedStmt hsc_env parsed_stmt
+        liftIO $ hscParsedStmt hsc_env ic parsed_stmt
 
 hscParsedStmt :: HscEnv
+              -> InteractiveContext
               -> GhciLStmt GhcPs  -- ^ The parsed statement
               -> IO ( Maybe ([Id]
                     , ForeignHValue {- IO [HValue] -}
                     , FixityEnv))
-hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
+hscParsedStmt hsc_env ic stmt = runInteractiveHsc hsc_env ic $ do
   -- Rename and typecheck it
-  (ids, tc_expr, fix_env) <- ioMsgMaybe $ hoistTcRnMessage $ tcRnStmt hsc_env stmt
+  (ids, tc_expr, fix_env) <- ioMsgMaybe $ hoistTcRnMessage $ tcRnStmt hsc_env ic stmt
 
   -- Desugar it
-  ds_expr <- ioMsgMaybe $ hoistDsMessage $ deSugarExpr hsc_env tc_expr
-  liftIO (lintInteractiveExpr (text "desugar expression") hsc_env ds_expr)
+  ds_expr <- ioMsgMaybe $ hoistDsMessage $ deSugarExpr hsc_env ic tc_expr
+  liftIO (lintInteractiveExpr (text "desugar expression") hsc_env ic ds_expr)
   handleWarnings
 
   -- Then code-gen, and link it
@@ -2022,47 +2035,49 @@ hscParsedStmt hsc_env stmt = runInteractiveHsc hsc_env $ do
   -- for linking, else we try to link 'main' and can't find it.
   -- Whereas the linker already knows to ignore 'interactive'
   let src_span = srcLocSpan interactiveSrcLoc
-  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env src_span ds_expr
+  (hval,_,_) <- liftIO $ hscCompileCoreExpr hsc_env ic src_span ds_expr
 
   return $ Just (ids, hval, fix_env)
 
 -- | Compile a decls
 hscDecls :: HscEnv
+         -> InteractiveContext
          -> String -- ^ The statement
          -> IO ([TyThing], InteractiveContext)
-hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1
+hscDecls hsc_env ic str = hscDeclsWithLocation hsc_env ic str "<interactive>" 1
 
-hscParseModuleWithLocation :: HscEnv -> String -> Int -> String -> IO (HsModule GhcPs)
-hscParseModuleWithLocation hsc_env source line_num str = do
+hscParseModuleWithLocation :: HscEnv -> InteractiveContext -> String -> Int -> String -> IO (HsModule GhcPs)
+hscParseModuleWithLocation hsc_env ic source line_num str = do
     L _ mod <-
-      runInteractiveHsc hsc_env $
+      runInteractiveHsc hsc_env ic $
         hscParseThingWithLocation source line_num parseModule str
     return mod
 
-hscParseDeclsWithLocation :: HscEnv -> String -> Int -> String -> IO [LHsDecl GhcPs]
-hscParseDeclsWithLocation hsc_env source line_num str = do
-  HsModule { hsmodDecls = decls } <- hscParseModuleWithLocation hsc_env source line_num str
+hscParseDeclsWithLocation :: HscEnv -> InteractiveContext -> String -> Int -> String -> IO [LHsDecl GhcPs]
+hscParseDeclsWithLocation hsc_env ic source line_num str = do
+  HsModule { hsmodDecls = decls } <- hscParseModuleWithLocation hsc_env ic source line_num str
   return decls
 
 -- | Compile a decls
 hscDeclsWithLocation :: HscEnv
+                     -> InteractiveContext
                      -> String -- ^ The statement
                      -> String -- ^ The source
                      -> Int    -- ^ Starting line
                      -> IO ([TyThing], InteractiveContext)
-hscDeclsWithLocation hsc_env str source linenumber = do
+hscDeclsWithLocation hsc_env ic str source linenumber = do
     L _ (HsModule{ hsmodDecls = decls }) <-
-      runInteractiveHsc hsc_env $
+      runInteractiveHsc hsc_env ic $
         hscParseThingWithLocation source linenumber parseModule str
-    hscParsedDecls hsc_env decls
+    hscParsedDecls hsc_env ic decls
 
-hscParsedDecls :: HscEnv -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
-hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
+hscParsedDecls :: HscEnv -> InteractiveContext -> [LHsDecl GhcPs] -> IO ([TyThing], InteractiveContext)
+hscParsedDecls hsc_env ictxt decls = runInteractiveHsc hsc_env ictxt $ do
     hsc_env <- getHscEnv
     let interp = hscInterp hsc_env
 
     {- Rename and typecheck it -}
-    tc_gblenv <- ioMsgMaybe $ hoistTcRnMessage $ tcRnDeclsi hsc_env decls
+    tc_gblenv <- ioMsgMaybe $ hoistTcRnMessage $ tcRnDeclsi hsc_env ictxt decls
 
     {- Grab the new instances -}
     -- We grab the whole environment because of the overlapping that may have
@@ -2083,10 +2098,10 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
     {- Simplify -}
     simpl_mg <- liftIO $ do
       plugins <- readIORef (tcg_th_coreplugins tc_gblenv)
-      hscSimplify hsc_env plugins ds_result
+      hscSimplify hsc_env ictxt plugins ds_result
 
     {- Tidy -}
-    (tidy_cg, mod_details) <- liftIO $ hscTidy hsc_env simpl_mg
+    (tidy_cg, mod_details) <- liftIO $ hscTidy hsc_env (Just ictxt) simpl_mg
 
     let !CgGuts{ cg_module    = this_mod,
                  cg_binds     = core_binds,
@@ -2102,18 +2117,18 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
     {- Prepare For Code Generation -}
     -- Do saturation and convert to A-normal form
     prepd_binds <- {-# SCC "CorePrep" #-} liftIO $ do
-      cp_cfg <- initCorePrepConfig hsc_env
+      cp_cfg <- initCorePrepConfig hsc_env $ Just ictxt
       corePrepPgm
         (hsc_logger hsc_env)
         cp_cfg
-        (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope $ hsc_IC hsc_env))
+        (initCorePrepPgmConfig (hsc_dflags hsc_env) (interactiveInScope ictxt))
         this_mod iNTERACTIVELoc core_binds data_tycons
 
     (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks)
         <- {-# SCC "CoreToStg" #-}
            liftIO $ myCoreToStg (hsc_logger hsc_env)
                                 (hsc_dflags hsc_env)
-                                (hsc_IC hsc_env)
+                                (interactiveInScope ictxt)
                                 True
                                 this_mod
                                 iNTERACTIVELoc
@@ -2143,7 +2158,6 @@ hscParsedDecls hsc_env decls = runInteractiveHsc hsc_env $ do
             -- c.f. GHC.Tc.Module.runTcInteractive, which reconstructs the TypeEnv
 
         new_tythings = map AnId ext_ids ++ map ATyCon tcs ++ map (AConLike . PatSynCon) patsyns
-        ictxt        = hsc_IC hsc_env
         -- See Note [Fixity declarations in GHCi]
         fix_env      = tcg_fix_env tc_gblenv
         new_ictxt    = extendInteractiveContext ictxt new_tythings cls_insts
@@ -2177,8 +2191,8 @@ hscAddSptEntries hsc_env entries = do
 
 -}
 
-hscImport :: HscEnv -> String -> IO (ImportDecl GhcPs)
-hscImport hsc_env str = runInteractiveHsc hsc_env $ do
+hscImport :: HscEnv -> InteractiveContext -> String -> IO (ImportDecl GhcPs)
+hscImport hsc_env ic str = runInteractiveHsc hsc_env ic $ do
     -- Use >>= \case instead of MonadFail desugaring to take into
     -- consideration `instance XXModule p = DataConCantHappen`.
     -- Tracked in #15681
@@ -2193,24 +2207,26 @@ hscImport hsc_env str = runInteractiveHsc hsc_env $ do
 
 -- | Typecheck an expression (but don't run it)
 hscTcExpr :: HscEnv
+          -> InteractiveContext
           -> TcRnExprMode
           -> String -- ^ The expression
           -> IO Type
-hscTcExpr hsc_env0 mode expr = runInteractiveHsc hsc_env0 $ do
+hscTcExpr hsc_env0 ic mode expr = runInteractiveHsc hsc_env0 ic $ do
   hsc_env <- getHscEnv
   parsed_expr <- hscParseExpr expr
-  ioMsgMaybe $ hoistTcRnMessage $ tcRnExpr hsc_env mode parsed_expr
+  ioMsgMaybe $ hoistTcRnMessage $ tcRnExpr hsc_env ic mode parsed_expr
 
 -- | Find the kind of a type, after generalisation
 hscKcType
   :: HscEnv
+  -> InteractiveContext
   -> Bool            -- ^ Normalise the type
   -> String          -- ^ The type as a string
   -> IO (Type, Kind) -- ^ Resulting type (possibly normalised) and kind
-hscKcType hsc_env0 normalise str = runInteractiveHsc hsc_env0 $ do
+hscKcType hsc_env0 ic normalise str = runInteractiveHsc hsc_env0 ic $ do
     hsc_env <- getHscEnv
     ty <- hscParseType str
-    ioMsgMaybe $ hoistTcRnMessage $ tcRnType hsc_env DefaultFlexi normalise ty
+    ioMsgMaybe $ hoistTcRnMessage $ tcRnType hsc_env ic DefaultFlexi normalise ty
 
 hscParseExpr :: String -> Hsc (LHsExpr GhcPs)
 hscParseExpr expr = do
@@ -2233,9 +2249,9 @@ hscParseStmtWithLocation source linenumber stmt =
 hscParseType :: String -> Hsc (LHsType GhcPs)
 hscParseType = hscParseThing parseType
 
-hscParseIdentifier :: HscEnv -> String -> IO (LocatedN RdrName)
-hscParseIdentifier hsc_env str =
-    runInteractiveHsc hsc_env $ hscParseThing parseIdentifier str
+hscParseIdentifier :: HscEnv -> InteractiveContext -> String -> IO (LocatedN RdrName)
+hscParseIdentifier hsc_env ic str =
+    runInteractiveHsc hsc_env ic $ hscParseThing parseIdentifier str
 
 hscParseThing :: (Outputable thing, Data thing)
               => Lexer.P thing -> String -> Hsc thing
@@ -2264,13 +2280,13 @@ hscParseThingWithLocation source linenumber parser str = do
                             FormatHaskell (showAstData NoBlankSrcSpan NoBlankEpAnnotations thing)
                 return thing
 
-hscTidy :: HscEnv -> ModGuts -> IO (CgGuts, ModDetails)
-hscTidy hsc_env guts = do
+hscTidy :: HscEnv -> Maybe InteractiveContext -> ModGuts -> IO (CgGuts, ModDetails)
+hscTidy hsc_env m_ic guts = do
   let dflags   = hsc_dflags hsc_env
   let logger   = hsc_logger hsc_env
   let this_mod = mg_module guts
 
-  opts <- initTidyOpts hsc_env
+  opts <- initTidyOpts hsc_env m_ic
   (cgguts, details) <- withTiming logger
     (text "CoreTidy"<+>brackets (ppr this_mod))
     (const ())
@@ -2282,7 +2298,7 @@ hscTidy hsc_env guts = do
   let print_unqual   = mkPrintUnqualified (hsc_unit_env hsc_env) (mg_rdr_env guts)
 
   let tidy_ppr = text "Tidy Core"
-  let extra_vars = interactiveInScope $ hsc_IC hsc_env
+  let extra_vars = maybe [] interactiveInScope m_ic
   let tidy_flags = (defaultLintFlags dflags)
         { -- See Note [Checking for global Ids]
           lf_check_global_ids = False
@@ -2331,35 +2347,34 @@ hscTidy hsc_env guts = do
 %*                                                                      *
 %********************************************************************* -}
 
-hscCompileCoreExpr :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
-hscCompileCoreExpr hsc_env loc expr =
+hscCompileCoreExpr :: HscEnv -> InteractiveContext -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+hscCompileCoreExpr hsc_env ic loc expr =
   case hscCompileCoreExprHook (hsc_hooks hsc_env) of
-      Nothing -> hscCompileCoreExpr' hsc_env loc expr
+      Nothing -> hscCompileCoreExpr' hsc_env ic loc expr
       Just h  -> h                   hsc_env loc expr
 
-hscCompileCoreExpr' :: HscEnv -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
-hscCompileCoreExpr' hsc_env srcspan ds_expr
+hscCompileCoreExpr' :: HscEnv -> InteractiveContext -> SrcSpan -> CoreExpr -> IO (ForeignHValue, [Linkable], PkgsLoaded)
+hscCompileCoreExpr' hsc_env ictxt srcspan ds_expr
     = do { {- Simplify it -}
            -- Question: should we call SimpleOpt.simpleOptExpr here instead?
            -- It is, well, simpler, and does less inlining etc.
            let dflags = hsc_dflags hsc_env
          ; let logger = hsc_logger hsc_env
-         ; let ic = hsc_IC hsc_env
          ; let unit_env = hsc_unit_env hsc_env
-         ; let simplify_expr_opts = initSimplifyExprOpts dflags ic
+         ; let simplify_expr_opts = initSimplifyExprOpts dflags ictxt
          ; simpl_expr <- simplifyExpr logger (ue_eps unit_env) simplify_expr_opts ds_expr
 
            {- Tidy it (temporary, until coreSat does cloning) -}
          ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
 
            {- Prepare for codegen -}
-         ; cp_cfg <- initCorePrepConfig hsc_env
+         ; cp_cfg <- initCorePrepConfig hsc_env $ Just ictxt
          ; prepd_expr <- corePrepExpr
             logger cp_cfg
             tidy_expr
 
            {- Lint if necessary -}
-         ; lintInteractiveExpr (text "hscCompileExpr") hsc_env prepd_expr
+         ; lintInteractiveExpr (text "hscCompileExpr") hsc_env ictxt prepd_expr
          ; let iNTERACTIVELoc = ModLocation{ ml_hs_file   = Nothing,
                                       ml_hi_file   = panic "hscCompileCoreExpr':ml_hi_file",
                                       ml_obj_file  = panic "hscCompileCoreExpr':ml_obj_file",
@@ -2367,7 +2382,6 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
                                       ml_dyn_hi_file  = panic "hscCompileCoreExpr': ml_dyn_hi_file",
                                       ml_hie_file  = panic "hscCompileCoreExpr':ml_hie_file" }
 
-         ; let ictxt = hsc_IC hsc_env
          ; (binding_id, stg_expr, _, _) <-
              myCoreToStgExpr logger
                              dflags
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 1968bfa954..6069e2c59a 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -58,6 +58,7 @@ import GHC.Tc.Utils.Backpack
 import GHC.Tc.Utils.Monad  ( initIfaceCheck )
 
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Context ( emptyInteractiveContext )
 import qualified GHC.Linker.Loader as Linker
 import GHC.Linker.Types
 
@@ -721,7 +722,7 @@ load' mhmi_cache how_much mHscMessage mod_graph = do
     -- write an empty HPT to allow the old HPT to be GC'd.
 
     let pruneHomeUnitEnv hme = hme { homeUnitEnv_hpt = emptyHomePackageTable }
-    setSession $ discardIC $ hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
+    setSession $ {- discardIC $ -} hscUpdateHUG (unitEnv_map pruneHomeUnitEnv) hsc_env
 
     -- Unload everything
     liftIO $ unload interp hsc_env
@@ -753,7 +754,7 @@ loadFinish :: GhcMonad m => SuccessFlag -> m SuccessFlag
 -- Empty the interactive context and set the module context to the topmost
 -- newly loaded module, or the Prelude if none were loaded.
 loadFinish all_ok
-  = do modifySession discardIC
+  = do -- modifyInteractiveContext discardIC
        return all_ok
 
 
@@ -2610,7 +2611,8 @@ runPipelines _ _ _ [] = return ()
 runPipelines n_job orig_hsc_env mHscMessager all_pipelines = do
   liftIO $ label_self "main --make thread"
 
-  plugins_hsc_env <- initializePlugins orig_hsc_env
+  -- TODO plugins should not need an interactive context
+  plugins_hsc_env <- initializePlugins orig_hsc_env $ emptyInteractiveContext $ hsc_dflags orig_hsc_env
   case n_job of
     1 -> runSeqPipelines plugins_hsc_env mHscMessager all_pipelines
     _n -> runParPipelines n_job plugins_hsc_env mHscMessager all_pipelines
diff --git a/compiler/GHC/Driver/Monad/Interactive.hs b/compiler/GHC/Driver/Monad/Interactive.hs
new file mode 100644
index 0000000000..b37a612a83
--- /dev/null
+++ b/compiler/GHC/Driver/Monad/Interactive.hs
@@ -0,0 +1,21 @@
+module GHC.Driver.Monad.Interactive where
+
+import GHC.Prelude
+
+import GHC.Driver.Monad    ( GhcMonad )
+import GHC.Runtime.Context ( InteractiveContext )
+
+class GhcMonad m => GhciMonad m where
+  getInteractiveContext :: m InteractiveContext
+
+  setInteractiveContext :: InteractiveContext -> m ()
+
+  modifyInteractiveContext :: (InteractiveContext -> InteractiveContext) -> m ()
+  modifyInteractiveContext f = do
+    m <- getInteractiveContext
+    setInteractiveContext $ f m
+
+modifyInteractiveContextM :: GhciMonad m => (InteractiveContext -> m InteractiveContext) -> m ()
+modifyInteractiveContextM f = do
+  m <- getInteractiveContext
+  setInteractiveContext =<< f m
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 0149bf644f..99e80c63b3 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -92,6 +92,7 @@ import GHC.Data.StringBuffer   ( hPutStringBuffer )
 import GHC.Data.Maybe          ( expectJust )
 
 import GHC.Iface.Make          ( mkFullIface )
+import GHC.Runtime.Context     ( emptyInteractiveContext )
 import GHC.Runtime.Loader      ( initializePlugins )
 
 
@@ -236,7 +237,8 @@ compileOne' mHscMessage
              addFilesToClean tmpfs TFL_GhcSession $
                  [ml_obj_file $ ms_location summary]
 
-   plugin_hsc_env <- initializePlugins hsc_env
+   -- TODO plugins should not need an interactive context?
+   plugin_hsc_env <- initializePlugins hsc_env $ emptyInteractiveContext dflags
    let pipe_env = mkPipeEnv NoStop input_fn pipelineOutput
    status <- hscRecompStatus mHscMessage plugin_hsc_env upd_summary
                 mb_old_iface mb_old_linkable (mod_index, nmods)
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 7390735f28..b8ba32d837 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -63,6 +63,7 @@ import GHC.Parser.Header
 import GHC.Data.StringBuffer
 import GHC.Types.SourceError
 import GHC.Unit.Finder
+import GHC.Runtime.Context (emptyInteractiveContext)
 import GHC.Runtime.Loader
 import Data.IORef
 import GHC.Types.Name.Env
@@ -553,7 +554,9 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
               final_iface <- mkFullIface hsc_env partial_iface Nothing
               hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location
 
-              (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location
+              -- TODO need persisted interactive context?
+              let ic = emptyInteractiveContext dflags
+              (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env ic cgguts mod_location
 
               stub_o <- case hasStub of
                         Nothing -> return []
@@ -699,7 +702,8 @@ runHscPhase pipe_env hsc_env0 input_fn src_flavour = do
   -- run the compiler!
   let msg :: Messager
       msg hsc_env _ what _ = oneShotMsg (hsc_logger hsc_env) what
-  plugin_hsc_env' <- initializePlugins hsc_env
+  -- TODO plugins should not need an interactive context
+  plugin_hsc_env' <- initializePlugins hsc_env (emptyInteractiveContext dflags)
 
   -- Need to set the knot-tying mutable variable for interface
   -- files. See GHC.Tc.Utils.TcGblEnv.tcg_type_env_var.
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 60f2f5cd30..8a23e1b6b5 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -50,7 +50,6 @@ import GHC.Core
 import GHC.Core.FVs       ( exprsSomeFreeVarsList )
 import GHC.Core.EndPass   ( EndPassConfig(..), endPassIO )
 import GHC.Core.Lint      ( LintFlags(..) )
-import GHC.Core.Lint.Interactive ( interactiveInScope )
 import GHC.Core.SimpleOpt ( simpleOptPgm, simpleOptExpr )
 import GHC.Core.Utils
 import GHC.Core.Unfold.Make
@@ -76,6 +75,8 @@ import GHC.Utils.Misc
 import GHC.Utils.Monad
 import GHC.Utils.Logger
 
+import GHC.Runtime.Context ( InteractiveContext )
+
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.ForeignStubs
@@ -212,7 +213,6 @@ deSugar hsc_env
         -- we want F# to be in scope in the foreign marshalling code!
         -- You might think it doesn't matter, but the simplifier brings all top-level
         -- things into the in-scope set before simplifying; so we get no unfolding for F#!
-              extra_vars = interactiveInScope $ hsc_IC hsc_env
 
         ; let desugar_before_ppr = text "Desugar (before optimization)"
         ; let desugar_before_flags = (defaultLintFlags dflags)
@@ -231,7 +231,7 @@ deSugar hsc_env
         ; let desugar_before_cfg = EndPassConfig
                 { ep_dumpCoreSizes = not (gopt Opt_SuppressCoreSizes dflags)
                 , ep_lintPassResult = maybeInitLintPassResultConfig dflags
-                    extra_vars
+                    [] -- TODO No GHCi in this use-case?
                     desugar_before_flags
                     desugar_before_ppr
                     True
@@ -258,7 +258,7 @@ deSugar hsc_env
         ; let desugar_after_cfg = EndPassConfig
                 { ep_dumpCoreSizes = not (gopt Opt_SuppressCoreSizes dflags)
                 , ep_lintPassResult = maybeInitLintPassResultConfig dflags
-                    extra_vars
+                    [] -- TODO No GHCi in this use-case?
                     desugar_after_flags
                     desugar_after_ppr
                     True
@@ -267,6 +267,7 @@ deSugar hsc_env
                 , ep_prettyPass = desugar_after_ppr
                 , ep_passDetails = empty
                 }
+        -- TODO interactive vars in scope?
         ; endPassIO (hsc_logger hsc_env) desugar_after_cfg ds_binds ds_rules_for_imps
 
         ; let used_names = mkUsedNames tcg_env
@@ -366,14 +367,14 @@ So we pull out the type/coercion variables (which are in dependency order),
 and Rec the rest.
 -}
 
-deSugarExpr :: HscEnv -> LHsExpr GhcTc -> IO (Messages DsMessage, Maybe CoreExpr)
-deSugarExpr hsc_env tc_expr = do
+deSugarExpr :: HscEnv -> InteractiveContext -> LHsExpr GhcTc -> IO (Messages DsMessage, Maybe CoreExpr)
+deSugarExpr hsc_env ic tc_expr = do
     let logger = hsc_logger hsc_env
 
     showPass logger "Desugar"
 
     -- Do desugaring
-    (tc_msgs, mb_result) <- runTcInteractive hsc_env $
+    (tc_msgs, mb_result) <- runTcInteractive hsc_env ic $
                             initDsTc $
                             dsLExpr tc_expr
 
diff --git a/compiler/GHC/Iface/Env.hs b/compiler/GHC/Iface/Env.hs
index eeef41ecc1..b7c53254f6 100644
--- a/compiler/GHC/Iface/Env.hs
+++ b/compiler/GHC/Iface/Env.hs
@@ -77,11 +77,11 @@ newGlobalBinder mod occ loc
                   (vcat [ ppr mod <+> ppr occ <+> ppr loc, ppr name]))
        ; return name }
 
-newInteractiveBinder :: HscEnv -> OccName -> SrcSpan -> IO Name
+newInteractiveBinder :: HscEnv -> InteractiveContext -> OccName -> SrcSpan -> IO Name
 -- Works in the IO monad, and gets the Module
 -- from the interactive context
-newInteractiveBinder hsc_env occ loc = do
-  let mod = icInteractiveModule (hsc_IC hsc_env)
+newInteractiveBinder hsc_env ic occ loc = do
+  let mod = icInteractiveModule ic
   allocateGlobalBinder (hsc_NC hsc_env) mod occ loc
 
 allocateGlobalBinder
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 18554fdc50..ac6fa72e39 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -658,7 +658,6 @@ dontLeakTheHUG thing_inside = do
        in
        hsc_env {  hsc_targets      = panic "cleanTopEnv: hsc_targets"
                ,  hsc_mod_graph    = panic "cleanTopEnv: hsc_mod_graph"
-               ,  hsc_IC           = panic "cleanTopEnv: hsc_IC"
                ,  hsc_type_env_vars = case maybe_type_vars of
                                           Just vars -> vars
                                           Nothing -> panic "cleanTopEnv: hsc_type_env_vars"
diff --git a/compiler/GHC/Plugins.hs b/compiler/GHC/Plugins.hs
index 9eb540dc9e..8a8599172e 100644
--- a/compiler/GHC/Plugins.hs
+++ b/compiler/GHC/Plugins.hs
@@ -163,7 +163,8 @@ import qualified Language.Haskell.TH as TH
    GHC.Plugins.Monad does not depend on GHC.Tc.Utils.Env -}
 instance MonadThings CoreM where
     lookupThing name = do { hsc_env <- getHscEnv
-                          ; liftIO $ lookupGlobal hsc_env name }
+                          -- TODO interactive context?
+                          ; liftIO $ lookupGlobal hsc_env Nothing name }
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Plugins/Monad.hs b/compiler/GHC/Plugins/Monad.hs
index 87e41522fd..ad2cd9b2fd 100644
--- a/compiler/GHC/Plugins/Monad.hs
+++ b/compiler/GHC/Plugins/Monad.hs
@@ -18,7 +18,6 @@ module GHC.Plugins.Monad (
     getHscEnv, getModule,
     getRuleBase, getExternalRuleBase,
     getDynFlags, getPackageFamInstEnv,
-    getInteractiveContext,
     getVisibleOrphanMods, getUniqMask,
     getPrintUnqualified, getSrcSpanM,
 
@@ -48,8 +47,6 @@ import GHC.Core.Opt.Stats
   ( SimplCount, zeroSimplCount, plusSimplCount
   )
 
-import GHC.Runtime.Context ( InteractiveContext )
-
 import GHC.Types.Unique.Supply
 import GHC.Types.Name.Env
 import GHC.Types.SrcLoc
@@ -273,9 +270,6 @@ instance HasLogger CoreM where
 instance HasModule CoreM where
     getModule = read cr_module
 
-getInteractiveContext :: CoreM InteractiveContext
-getInteractiveContext = hsc_IC <$> getHscEnv
-
 getPackageFamInstEnv :: CoreM PackageFamInstEnv
 getPackageFamInstEnv = eps_fam_inst_env <$> get_eps
 
diff --git a/compiler/GHC/Runtime/Debugger.hs b/compiler/GHC/Runtime/Debugger.hs
index 04709b38cf..fa2260aec6 100644
--- a/compiler/GHC/Runtime/Debugger.hs
+++ b/compiler/GHC/Runtime/Debugger.hs
@@ -19,6 +19,7 @@ import GHC
 import GHC.Driver.Session
 import GHC.Driver.Ppr
 import GHC.Driver.Monad
+import GHC.Driver.Monad.Interactive
 import GHC.Driver.Env
 
 import GHC.Linker.Loader
@@ -55,7 +56,7 @@ import Data.IORef
 -------------------------------------
 -- | The :print & friends commands
 -------------------------------------
-pprintClosureCommand :: GhcMonad m => Bool -> Bool -> String -> m ()
+pprintClosureCommand :: GhciMonad m => Bool -> Bool -> String -> m ()
 pprintClosureCommand bindThings force str = do
   tythings <- (catMaybes . concat) `liftM`
                  mapM (\w -> GHC.parseName w >>=
@@ -70,8 +71,8 @@ pprintClosureCommand bindThings force str = do
   (subst, terms) <- mapAccumLM go emptyTCvSubst ids
 
   -- Apply the substitutions obtained after recovering the types
-  modifySession $ \hsc_env ->
-    hsc_env{hsc_IC = substInteractiveContext (hsc_IC hsc_env) subst}
+  modifyInteractiveContext $ \ic ->
+    substInteractiveContext ic subst
 
   -- Finally, print the Results
   docterms <- mapM showTerm terms
@@ -94,14 +95,14 @@ pprintClosureCommand bindThings force str = do
           text "is not eligible for the :print, :sprint or :force commands."
 
    -- Helper to print out the results of :print and friends
-   printSDocs :: GhcMonad m => [SDoc] -> m ()
+   printSDocs :: GhciMonad m => [SDoc] -> m ()
    printSDocs sdocs = do
       logger <- getLogger
       unqual <- GHC.getPrintUnqual
       liftIO $ printOutputForUser logger unqual $ vcat sdocs
 
    -- Do the obtainTerm--bindSuspensions-computeSubstitution dance
-   go :: GhcMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
+   go :: GhciMonad m => TCvSubst -> Id -> m (TCvSubst, Term)
    go subst id = do
        let id' = updateIdTypeAndMult (substTy subst) id
            id_ty' = idType id'
@@ -126,10 +127,10 @@ pprintClosureCommand bindThings force str = do
                                   text "new substitution:" , ppr subst'])
                            ; return (subst `unionTCvSubst` subst', term')}
 
-   tidyTermTyVars :: GhcMonad m => Term -> m Term
-   tidyTermTyVars t =
-     withSession $ \hsc_env -> do
-     let env_tvs      = tyThingsTyCoVars $ ic_tythings $ hsc_IC hsc_env
+   tidyTermTyVars :: GhciMonad m => Term -> m Term
+   tidyTermTyVars t = do
+     ic <- getInteractiveContext
+     let env_tvs      = tyThingsTyCoVars $ ic_tythings ic
          my_tvs       = termTyCoVars t
          tvs          = env_tvs `minusVarSet` my_tvs
          tyvarOccName = nameOccName . tyVarName
@@ -141,32 +142,32 @@ pprintClosureCommand bindThings force str = do
 
 -- | Give names, and bind in the interactive environment, to all the suspensions
 --   included (inductively) in a term
-bindSuspensions :: GhcMonad m => Term -> m Term
+bindSuspensions :: GhciMonad m => Term -> m Term
 bindSuspensions t = do
       hsc_env <- getSession
+      ictxt <- getInteractiveContext
       inScope <- GHC.getBindings
-      let ictxt        = hsc_IC hsc_env
-          prefix       = "_t"
+      let prefix       = "_t"
           alreadyUsedNames = map (occNameString . nameOccName . getName) inScope
           availNames   = map ((prefix++) . show) [(1::Int)..] \\ alreadyUsedNames
       availNames_var  <- liftIO $ newIORef availNames
-      (t', stuff)     <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env availNames_var) t
+      (t', stuff)     <- liftIO $ foldTerm (nameSuspensionsAndGetInfos hsc_env ictxt availNames_var) t
       let (names, tys, fhvs) = unzip3 stuff
       let ids = [ mkVanillaGlobal name ty
                 | (name,ty) <- zip names tys]
           new_ic = extendInteractiveContextWithIds ictxt ids
           interp = hscInterp hsc_env
       liftIO $ extendLoadedEnv interp (zip names fhvs)
-      setSession hsc_env {hsc_IC = new_ic }
+      setInteractiveContext new_ic
       return t'
      where
 
 --    Processing suspensions. Give names and recopilate info
-        nameSuspensionsAndGetInfos :: HscEnv -> IORef [String]
+        nameSuspensionsAndGetInfos :: HscEnv -> InteractiveContext -> IORef [String]
                                    -> TermFold (IO (Term, [(Name,Type,ForeignHValue)]))
-        nameSuspensionsAndGetInfos hsc_env freeNames = TermFold
+        nameSuspensionsAndGetInfos hsc_env ic freeNames = TermFold
                       {
-                        fSuspension = doSuspension hsc_env freeNames
+                        fSuspension = doSuspension hsc_env ic freeNames
                       , fTerm = \ty dc v tt -> do
                                     tt' <- sequence tt
                                     let (terms,names) = unzip tt'
@@ -180,14 +181,14 @@ bindSuspensions t = do
                                     (term, names) <- t
                                     return (RefWrap ty term, names)
                       }
-        doSuspension hsc_env freeNames ct ty hval _name = do
+        doSuspension hsc_env ic freeNames ct ty hval _name = do
           name <- atomicModifyIORef' freeNames (\x->(tail x, head x))
-          n <- newGrimName hsc_env name
+          n <- newGrimName hsc_env ic name
           return (Suspension ct ty hval (Just n), [(n,ty,hval)])
 
 
 --  A custom Term printer to enable the use of Show instances
-showTerm :: GhcMonad m => Term -> m SDoc
+showTerm :: GhciMonad m => Term -> m SDoc
 showTerm term = do
     dflags       <- GHC.getSessionDynFlags
     if gopt Opt_PrintEvldWithShow dflags
@@ -198,20 +199,21 @@ showTerm term = do
     if not (isFullyEvaluatedTerm t)
      then return Nothing
      else do
-        let set_session = do
+        let set_ic = do
                 hsc_env <- getSession
-                (new_env, bname) <- bindToFreshName hsc_env ty "showme"
-                setSession new_env
+                old_ic <- getInteractiveContext
+                (new_ic, bname) <- bindToFreshName hsc_env old_ic ty "showme"
+                setInteractiveContext new_ic
 
                 -- this disables logging of errors
                 let noop_log _ _ _ _ = return ()
                 pushLogHookM (const noop_log)
 
-                return (hsc_env, bname)
+                return (old_ic, bname)
 
-            reset_session (old_env,_) = setSession old_env
+            reset_ic (old_ic,_) = setInteractiveContext old_ic
 
-        MC.bracket set_session reset_session $ \(_,bname) -> do
+        MC.bracket set_ic reset_ic $ \(_,bname) -> do
            hsc_env <- getSession
            dflags  <- GHC.getSessionDynFlags
            let expr = "Prelude.return (Prelude.show " ++
@@ -238,20 +240,20 @@ showTerm term = do
   needsParens txt = ' ' `elem` txt
 
 
-  bindToFreshName hsc_env ty userName = do
-    name <- newGrimName hsc_env userName
+  bindToFreshName hsc_env ic ty userName = do
+    name <- newGrimName hsc_env ic userName
     let id       = mkVanillaGlobal name ty
-        new_ic   = extendInteractiveContextWithIds (hsc_IC hsc_env) [id]
-    return (hsc_env {hsc_IC = new_ic }, name)
+        new_ic   = extendInteractiveContextWithIds ic [id]
+    return (new_ic, name)
 
 --    Create new uniques and give them sequentially numbered names
-newGrimName :: MonadIO m => HscEnv -> String -> m Name
-newGrimName hsc_env userName
-  = liftIO (newInteractiveBinder hsc_env occ noSrcSpan)
+newGrimName :: MonadIO m => HscEnv -> InteractiveContext -> String -> m Name
+newGrimName hsc_env ic userName
+  = liftIO (newInteractiveBinder hsc_env ic occ noSrcSpan)
   where
     occ = mkOccName varName userName
 
-pprTypeAndContents :: GhcMonad m => Id -> m SDoc
+pprTypeAndContents :: GhciMonad m => Id -> m SDoc
 pprTypeAndContents id = do
   dflags  <- GHC.getSessionDynFlags
   let pcontents = gopt Opt_PrintBindContents dflags
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index e4f4de3fc5..e48ec1a93b 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -13,6 +13,7 @@
 -- -----------------------------------------------------------------------------
 
 module GHC.Runtime.Eval (
+        GhciMonad(..), modifyInteractiveContextM,
         Resume(..), History(..),
         execStmt, execStmt', ExecOptions(..), execOptions, ExecResult(..), resumeExec,
         runDecls, runDeclsWithLocation, runParsedDecls,
@@ -47,6 +48,7 @@ module GHC.Runtime.Eval (
 import GHC.Prelude
 
 import GHC.Driver.Monad
+import GHC.Driver.Monad.Interactive
 import GHC.Driver.Main
 import GHC.Driver.Errors.Types ( hoistTcRnMessage )
 import GHC.Driver.Env
@@ -140,8 +142,8 @@ import GHC.Unit.Env
 -- -----------------------------------------------------------------------------
 -- running a statement interactively
 
-getResumeContext :: GhcMonad m => m [Resume]
-getResumeContext = withSession (return . ic_resume . hsc_IC)
+getResumeContext :: GhciMonad m => m [Resume]
+getResumeContext = ic_resume <$> getInteractiveContext
 
 mkHistory :: HscEnv -> ForeignHValue -> BreakInfo -> History
 mkHistory hsc_env hval bi = History hval bi (findEnclosingDecls hsc_env bi)
@@ -168,11 +170,10 @@ findEnclosingDecls hsc_env (BreakInfo modl ix) =
    in modBreaks_decls mb ! ix
 
 -- | Update fixity environment in the current interactive context.
-updateFixityEnv :: GhcMonad m => FixityEnv -> m ()
+updateFixityEnv :: GhciMonad m => FixityEnv -> m ()
 updateFixityEnv fix_env = do
-  hsc_env <- getSession
-  let ic = hsc_IC hsc_env
-  setSession $ hsc_env { hsc_IC = ic { ic_fix_env = fix_env } }
+  ic <- getInteractiveContext
+  setInteractiveContext $ ic { ic_fix_env = fix_env }
 
 -- -----------------------------------------------------------------------------
 -- execStmt
@@ -188,16 +189,17 @@ execOptions = ExecOptions
 
 -- | Run a statement in the current interactive context.
 execStmt
-  :: GhcMonad m
+  :: GhciMonad m
   => String             -- ^ a statement (bind or expression)
   -> ExecOptions
   -> m ExecResult
 execStmt input exec_opts@ExecOptions{..} = do
     hsc_env <- getSession
+    ic <- getInteractiveContext
 
     mb_stmt <-
       liftIO $
-      runInteractiveHsc hsc_env $
+      runInteractiveHsc hsc_env ic $
       hscParseStmtWithLocation execSourceFile execLineNumber input
 
     case mb_stmt of
@@ -208,18 +210,19 @@ execStmt input exec_opts@ExecOptions{..} = do
 -- | Like `execStmt`, but takes a parsed statement as argument. Useful when
 -- doing preprocessing on the AST before execution, e.g. in GHCi (see
 -- GHCi.UI.runStmt).
-execStmt' :: GhcMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
+execStmt' :: GhciMonad m => GhciLStmt GhcPs -> String -> ExecOptions -> m ExecResult
 execStmt' stmt stmt_text ExecOptions{..} = do
     hsc_env <- getSession
+    ic <- getInteractiveContext
     let interp = hscInterp hsc_env
 
     -- Turn off -fwarn-unused-local-binds when running a statement, to hide
     -- warnings about the implicit bindings we introduce.
-    let ic       = hsc_IC hsc_env -- use the interactive dflags
-        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
-        hsc_env' = mkInteractiveHscEnv (hsc_env{ hsc_IC = ic{ ic_dflags = idflags' }})
+    let idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
+        ic' = ic { ic_dflags = idflags' }
+        hsc_env' = mkInteractiveHscEnv hsc_env ic'
 
-    r <- liftIO $ hscParsedStmt hsc_env' stmt
+    r <- liftIO $ hscParsedStmt hsc_env' ic' stmt
 
     case r of
       Nothing ->
@@ -234,37 +237,39 @@ execStmt' stmt stmt_text ExecOptions{..} = do
               let eval_opts = initEvalOpts idflags' (isStep execSingleStep)
               evalStmt interp eval_opts (execWrap hval)
 
-        let ic = hsc_IC hsc_env
-            bindings = (ic_tythings ic, ic_gre_cache ic)
+        ic <- getInteractiveContext
+        let bindings = (ic_tythings ic, ic_gre_cache ic)
 
             size = ghciHistSize idflags'
 
         handleRunStatus execSingleStep stmt_text bindings ids
                         status (emptyHistory size)
 
-runDecls :: GhcMonad m => String -> m [Name]
+runDecls :: GhciMonad m => String -> m [Name]
 runDecls = runDeclsWithLocation "<interactive>" 1
 
 -- | Run some declarations and return any user-visible names that were brought
 -- into scope.
-runDeclsWithLocation :: GhcMonad m => String -> Int -> String -> m [Name]
+runDeclsWithLocation :: GhciMonad m => String -> Int -> String -> m [Name]
 runDeclsWithLocation source line_num input = do
     hsc_env <- getSession
-    decls <- liftIO (hscParseDeclsWithLocation hsc_env source line_num input)
+    ic <- getInteractiveContext
+    decls <- liftIO (hscParseDeclsWithLocation hsc_env ic source line_num input)
     runParsedDecls decls
 
 -- | Like `runDeclsWithLocation`, but takes parsed declarations as argument.
 -- Useful when doing preprocessing on the AST before execution, e.g. in GHCi
 -- (see GHCi.UI.runStmt).
-runParsedDecls :: GhcMonad m => [LHsDecl GhcPs] -> m [Name]
+runParsedDecls :: GhciMonad m => [LHsDecl GhcPs] -> m [Name]
 runParsedDecls decls = do
     hsc_env <- getSession
-    (tyThings, ic) <- liftIO (hscParsedDecls hsc_env decls)
+    ic0 <- getInteractiveContext
+    (tyThings, ic) <- liftIO (hscParsedDecls hsc_env ic0 decls)
 
-    setSession $ hsc_env { hsc_IC = ic }
+    setInteractiveContext ic
     hsc_env <- getSession
-    hsc_env' <- liftIO $ rttiEnvironment hsc_env
-    setSession hsc_env'
+    ic1 <- liftIO $ rttiEnvironment hsc_env ic
+    setInteractiveContext ic1
     return $ filter (not . isDerivedOccName . nameOccName)
              -- For this filter, see Note [What to show to users]
            $ map getName tyThings
@@ -279,7 +284,7 @@ them. The relevant predicate is OccName.isDerivedOccName.
 See #11051 for more background and examples.
 -}
 
-withVirtualCWD :: GhcMonad m => m a -> m a
+withVirtualCWD :: GhciMonad m => m a -> m a
 withVirtualCWD m = do
   hsc_env <- getSession
 
@@ -288,7 +293,7 @@ withVirtualCWD m = do
   case interpInstance <$> hsc_interp hsc_env of
     Just (ExternalInterp {}) -> m
     _ -> do
-      let ic = hsc_IC hsc_env
+      ic <- getInteractiveContext
       let set_cwd = do
             dir <- liftIO $ getCurrentDirectory
             case ic_cwd ic of
@@ -298,20 +303,21 @@ withVirtualCWD m = do
 
           reset_cwd orig_dir = do
             virt_dir <- liftIO $ getCurrentDirectory
-            hsc_env <- getSession
-            let old_IC = hsc_IC hsc_env
-            setSession hsc_env{  hsc_IC = old_IC{ ic_cwd = Just virt_dir } }
+            old_ic <- getInteractiveContext
+            setInteractiveContext old_ic{ ic_cwd = Just virt_dir }
             liftIO $ setCurrentDirectory orig_dir
 
       MC.bracket set_cwd reset_cwd $ \_ -> m
 
-parseImportDecl :: GhcMonad m => String -> m (ImportDecl GhcPs)
-parseImportDecl expr = withSession $ \hsc_env -> liftIO $ hscImport hsc_env expr
+parseImportDecl :: GhciMonad m => String -> m (ImportDecl GhcPs)
+parseImportDecl expr = withSession $ \hsc_env -> do
+  ic <- getInteractiveContext
+  liftIO $ hscImport hsc_env ic expr
 
 emptyHistory :: Int -> BoundedList History
 emptyHistory size = nilBL size
 
-handleRunStatus :: GhcMonad m
+handleRunStatus :: GhciMonad m
                 => SingleStep -> String
                 -> ResumeBindings
                 -> [Id]
@@ -369,8 +375,9 @@ handleRunStatus step expr bindings final_ids status history
              modl = mi_module (hm_iface hmi)
              bp | is_exception = Nothing
                 | otherwise = Just (BreakInfo modl ix)
-         (hsc_env1, names, span, decl) <- liftIO $
-           bindLocalsAtBreakpoint hsc_env apStack_fhv bp
+         ictxt0 <- getInteractiveContext
+         (ictxt1, names, span, decl) <- liftIO $
+           bindLocalsAtBreakpoint hsc_env ictxt0 apStack_fhv bp
          let
            resume = Resume
              { resumeStmt = expr, resumeContext = resume_ctxt_fhv
@@ -381,20 +388,21 @@ handleRunStatus step expr bindings final_ids status history
              , resumeDecl = decl
              , resumeCCS = ccs
              , resumeHistoryIx = 0 }
-           hsc_env2 = pushResume hsc_env1 resume
+           ictxt2 = pushResume ictxt1 resume
 
-         setSession hsc_env2
+         setInteractiveContext ictxt2
          return (ExecBreak names bp)
 
     -- Completed successfully
     | EvalComplete allocs (EvalSuccess hvals) <- status
     = do hsc_env <- getSession
-         let final_ic = extendInteractiveContextWithIds (hsc_IC hsc_env) final_ids
+         ic <- getInteractiveContext
+         let final_ic = extendInteractiveContextWithIds ic final_ids
              final_names = map getName final_ids
              interp = hscInterp hsc_env
          liftIO $ Loader.extendLoadedEnv interp (zip final_names hvals)
-         hsc_env' <- liftIO $ rttiEnvironment hsc_env{hsc_IC=final_ic}
-         setSession hsc_env'
+         ic' <- liftIO $ rttiEnvironment hsc_env final_ic
+         setInteractiveContext ic'
          return (ExecComplete (Right final_names) allocs)
 
     -- Completed with an exception
@@ -407,13 +415,13 @@ handleRunStatus step expr bindings final_ids status history
 #endif
 
 
-resumeExec :: GhcMonad m => (SrcSpan->Bool) -> SingleStep -> Maybe Int
+resumeExec :: GhciMonad m => (SrcSpan->Bool) -> SingleStep -> Maybe Int
            -> m ExecResult
 resumeExec canLogSpan step mbCnt
  = do
    hsc_env <- getSession
-   let ic = hsc_IC hsc_env
-       resume = ic_resume ic
+   ic <- getInteractiveContext
+   let resume = ic_resume ic
 
    case resume of
      [] -> liftIO $
@@ -426,7 +434,7 @@ resumeExec canLogSpan step mbCnt
             ic' = ic { ic_tythings = resume_tmp_te,
                        ic_gre_cache = resume_gre_cache,
                        ic_resume   = rs }
-        setSession hsc_env{ hsc_IC = ic' }
+        setInteractiveContext ic'
 
         -- remove any bindings created since the breakpoint from the
         -- linker's environment
@@ -472,16 +480,17 @@ setupBreakpoint hsc_env brkInfo cnt = do
   _ <- liftIO $ GHCi.storeBreakpoint interp breakarray ix cnt
   pure ()
 
-back :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)
+back :: GhciMonad m => Int -> m ([Name], Int, SrcSpan, String)
 back n = moveHist (+n)
 
-forward :: GhcMonad m => Int -> m ([Name], Int, SrcSpan, String)
+forward :: GhciMonad m => Int -> m ([Name], Int, SrcSpan, String)
 forward n = moveHist (subtract n)
 
-moveHist :: GhcMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan, String)
+moveHist :: GhciMonad m => (Int -> Int) -> m ([Name], Int, SrcSpan, String)
 moveHist fn = do
   hsc_env <- getSession
-  case ic_resume (hsc_IC hsc_env) of
+  ic <- getInteractiveContext
+  case ic_resume ic of
      [] -> liftIO $
            throwGhcExceptionIO (ProgramError "not stopped at a breakpoint")
      (r:rs) -> do
@@ -496,13 +505,13 @@ moveHist fn = do
 
         let
           update_ic apStack mb_info = do
-            (hsc_env1, names, span, decl) <-
-              liftIO $ bindLocalsAtBreakpoint hsc_env apStack mb_info
-            let ic = hsc_IC hsc_env1
-                r' = r { resumeHistoryIx = new_ix }
-                ic' = ic { ic_resume = r':rs }
+            ic <- getInteractiveContext
+            (ic1, names, span, decl) <-
+              liftIO $ bindLocalsAtBreakpoint hsc_env ic apStack mb_info
+            let r' = r { resumeHistoryIx = new_ix }
+                ic2 = ic1 { ic_resume = r':rs }
 
-            setSession hsc_env1{ hsc_IC = ic' }
+            setInteractiveContext ic2
 
             return (names, new_ix, span, decl)
 
@@ -527,34 +536,34 @@ result_fs = fsLit "_result"
 
 bindLocalsAtBreakpoint
         :: HscEnv
+        -> InteractiveContext
         -> ForeignHValue
         -> Maybe BreakInfo
-        -> IO (HscEnv, [Name], SrcSpan, String)
+        -> IO (InteractiveContext, [Name], SrcSpan, String)
 
 -- Nothing case: we stopped when an exception was raised, not at a
 -- breakpoint.  We have no location information or local variables to
 -- bind, all we can do is bind a local variable to the exception
 -- value.
-bindLocalsAtBreakpoint hsc_env apStack Nothing = do
+bindLocalsAtBreakpoint hsc_env ictxt0 apStack Nothing = do
    let exn_occ = mkVarOccFS (fsLit "_exception")
        span    = mkGeneralSrcSpan (fsLit "<unknown>")
-   exn_name <- newInteractiveBinder hsc_env exn_occ span
+   exn_name <- newInteractiveBinder hsc_env ictxt0 exn_occ span
 
    let e_fs    = fsLit "e"
        e_name  = mkInternalName (getUnique e_fs) (mkTyVarOccFS e_fs) span
        e_tyvar = mkRuntimeUnkTyVar e_name liftedTypeKind
        exn_id  = Id.mkVanillaGlobal exn_name (mkTyVarTy e_tyvar)
 
-       ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContextWithIds ictxt0 [exn_id]
        interp = hscInterp hsc_env
    --
    Loader.extendLoadedEnv interp [(exn_name, apStack)]
-   return (hsc_env{ hsc_IC = ictxt1 }, [exn_name], span, "<exception thrown>")
+   return (ictxt1, [exn_name], span, "<exception thrown>")
 
 -- Just case: we stopped at a breakpoint, we have information about the location
 -- of the breakpoint and the free variables of the expression.
-bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
+bindLocalsAtBreakpoint hsc_env ictxt0 apStack_fhv (Just BreakInfo{..}) = do
    let
        hmi       = expectJust "bindLocalsAtBreakpoint" $
                      lookupHpt (hsc_HPT hsc_env) (moduleName breakInfo_module)
@@ -594,7 +603,7 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
                       map (substTy tv_subst . idType) filtered_ids
 
    new_ids     <- zipWith3M mkNewId occs'' tidy_tys filtered_ids
-   result_name <- newInteractiveBinder hsc_env (mkVarOccFS result_fs) span
+   result_name <- newInteractiveBinder hsc_env ictxt0 (mkVarOccFS result_fs) span
 
    let result_id = Id.mkVanillaGlobal result_name
                      (substTy tv_subst result_ty)
@@ -602,15 +611,14 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
 
        final_ids | result_ok = result_id : new_ids
                  | otherwise = new_ids
-       ictxt0 = hsc_IC hsc_env
        ictxt1 = extendInteractiveContextWithIds ictxt0 final_ids
        names  = map idName new_ids
 
    let fhvs = catMaybes mb_hValues
    Loader.extendLoadedEnv interp (zip names fhvs)
    when result_ok $ Loader.extendLoadedEnv interp [(result_name, apStack_fhv)]
-   hsc_env1 <- rttiEnvironment hsc_env{ hsc_IC = ictxt1 }
-   return (hsc_env1, if result_ok then result_name:names else names, span, decl)
+   ictxt2 <- rttiEnvironment hsc_env ictxt1
+   return (ictxt2, if result_ok then result_name:names else names, span, decl)
   where
         -- We need a fresh Unique for each Id we bind, because the linker
         -- state is single-threaded and otherwise we'd spam old bindings
@@ -618,7 +626,7 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
         -- saved/restored, but not the linker state.  See #1743, test break026.
    mkNewId :: OccName -> Type -> Id -> IO Id
    mkNewId occ ty old_id
-     = do { name <- newInteractiveBinder hsc_env occ (getSrcSpan old_id)
+     = do { name <- newInteractiveBinder hsc_env ictxt0 occ (getSrcSpan old_id)
           ; return (Id.mkVanillaGlobalWithInfo name ty (idInfo old_id)) }
 
    newTyVars :: UniqSupply -> [TcTyVar] -> TCvSubst
@@ -648,31 +656,31 @@ bindLocalsAtBreakpoint hsc_env apStack_fhv (Just BreakInfo{..}) = do
        joinOccs = zipWithEqual "bindLocalsAtBreakpoint" joinOcc
        joinOcc mbV oc = (\(a,b) c -> (a,b,c)) <$> mbV <*> pure oc
 
-rttiEnvironment :: HscEnv -> IO HscEnv
-rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
-   let tmp_ids = [id | AnId id <- ic_tythings ic]
+rttiEnvironment :: HscEnv -> InteractiveContext -> IO InteractiveContext
+rttiEnvironment hsc_env ic0 = do
+   let tmp_ids = [id | AnId id <- ic_tythings ic0]
        incompletelyTypedIds =
            [id | id <- tmp_ids
                , not $ noSkolems id
                , (occNameFS.nameOccName.idName) id /= result_fs]
-   foldM improveTypes hsc_env (map idName incompletelyTypedIds)
+   foldM (improveTypes hsc_env) ic0 (map idName incompletelyTypedIds)
     where
      noSkolems = noFreeVarsOfType . idType
-     improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do
+     improveTypes hsc_env ic name = do
       let tmp_ids = [id | AnId id <- ic_tythings ic]
           Just id = find (\i -> idName i == name) tmp_ids
       if noSkolems id
-         then return hsc_env
+         then return ic
          else do
-           mb_new_ty <- reconstructType hsc_env 10 id
+           mb_new_ty <- reconstructType hsc_env ic 10 id
            let old_ty = idType id
            case mb_new_ty of
-             Nothing -> return hsc_env
+             Nothing -> return ic
              Just new_ty -> do
               case improveRTTIType hsc_env old_ty new_ty of
                Nothing -> return $
                         warnPprTrace True (":print failed to calculate the "
-                                           ++ "improvement for a type") empty hsc_env
+                                           ++ "improvement for a type") empty ic
                Just subst -> do
                  let logger = hsc_logger hsc_env
                  putDumpFileMaybe logger Opt_D_dump_rtti "RTTI"
@@ -680,14 +688,12 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
                    (fsep [text "RTTI Improvement for", ppr id, equals,
                           ppr subst])
 
-                 let ic' = substInteractiveContext ic subst
-                 return hsc_env{hsc_IC=ic'}
+                 pure $ substInteractiveContext ic subst
 
-pushResume :: HscEnv -> Resume -> HscEnv
-pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
-  where
-        ictxt0 = hsc_IC hsc_env
-        ictxt1 = ictxt0 { ic_resume = resume : ic_resume ictxt0 }
+pushResume :: InteractiveContext -> Resume -> InteractiveContext
+pushResume ictxt0 resume = ictxt0
+  { ic_resume = resume : ic_resume ictxt0
+  }
 
 
   {-
@@ -721,29 +727,29 @@ pushResume hsc_env resume = hsc_env { hsc_IC = ictxt1 }
 -- -----------------------------------------------------------------------------
 -- Abandoning a resume context
 
-abandon :: GhcMonad m => m Bool
+abandon :: GhciMonad m => m Bool
 abandon = do
    hsc_env <- getSession
-   let ic = hsc_IC hsc_env
-       resume = ic_resume ic
+   ic <- getInteractiveContext
+   let resume = ic_resume ic
        interp = hscInterp hsc_env
    case resume of
       []    -> return False
       r:rs  -> do
-         setSession hsc_env{ hsc_IC = ic { ic_resume = rs } }
+         setInteractiveContext ic{ ic_resume = rs }
          liftIO $ abandonStmt interp (resumeContext r)
          return True
 
-abandonAll :: GhcMonad m => m Bool
+abandonAll :: GhciMonad m => m Bool
 abandonAll = do
    hsc_env <- getSession
-   let ic = hsc_IC hsc_env
-       resume = ic_resume ic
+   ic <- getInteractiveContext
+   let resume = ic_resume ic
        interp = hscInterp hsc_env
    case resume of
       []  -> return False
       rs  -> do
-         setSession hsc_env{ hsc_IC = ic { ic_resume = [] } }
+         setInteractiveContext ic{ ic_resume = [] }
          liftIO $ mapM_ (abandonStmt interp. resumeContext) rs
          return True
 
@@ -783,30 +789,33 @@ fromListBL bound l = BL (length l) bound l []
 -- We retain in scope all the things defined at the prompt, and kept
 -- in ic_tythings.  (Indeed, they shadow stuff from ic_imports.)
 
-setContext :: GhcMonad m => [InteractiveImport] -> m ()
+setContext :: GhciMonad m => [InteractiveImport] -> m ()
 setContext imports
   = do { hsc_env <- getSession
        ; let dflags = hsc_dflags hsc_env
-       ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env imports
+       ; old_ic <- getInteractiveContext
+       ; all_env_err <- liftIO $ findGlobalRdrEnv hsc_env old_ic imports
        ; case all_env_err of
            Left (mod, err) ->
                liftIO $ throwGhcExceptionIO (formatError dflags mod err)
            Right all_env -> do {
-       ; let old_ic         = hsc_IC hsc_env
-             !final_gre_cache = ic_gre_cache old_ic `replaceImportEnv` all_env
-       ; setSession
-         hsc_env{ hsc_IC = old_ic { ic_imports   = imports
-                                  , ic_gre_cache = final_gre_cache }}}}
+       ; let !final_gre_cache = ic_gre_cache old_ic `replaceImportEnv` all_env
+       ; setInteractiveContext
+           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 <+>
       text "to context:" <+> text err
 
-findGlobalRdrEnv :: HscEnv -> [InteractiveImport]
+findGlobalRdrEnv :: HscEnv -> InteractiveContext 
+                 -> [InteractiveImport]
                  -> IO (Either (ModuleName, String) GlobalRdrEnv)
 -- Compute the GlobalRdrEnv for the interactive context
-findGlobalRdrEnv hsc_env imports
-  = do { idecls_env <- hscRnImportDecls hsc_env idecls
+findGlobalRdrEnv hsc_env ic imports
+  = do { idecls_env <- hscRnImportDecls hsc_env ic idecls
                     -- This call also loads any orphan modules
        ; return $ case partitionEithers (map mkEnv imods) of
            ([], imods_env) -> Right (foldr plusGlobalRdrEnv idecls_env imods_env)
@@ -834,9 +843,8 @@ mkTopLevEnv hpt modl
 -- | 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
 -- of modules from which we take just the exports respectively.
-getContext :: GhcMonad m => m [InteractiveImport]
-getContext = withSession $ \HscEnv{ hsc_IC=ic } ->
-             return (ic_imports ic)
+getContext :: GhciMonad m => m [InteractiveImport]
+getContext = ic_imports <$> getInteractiveContext
 
 -- | Returns @True@ if the specified module is interpreted, and hence has
 -- its full top-level scope available.
@@ -853,15 +861,16 @@ moduleIsInterpreted modl = withSession $ \h ->
 -- are in scope (qualified or otherwise).  Otherwise we list a whole lot too many!
 -- The exact choice of which ones to show, and which to hide, is a judgement call.
 --      (see #1581)
-getInfo :: GhcMonad m => Bool -> Name
+getInfo :: GhciMonad m => Bool -> Name
         -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst], SDoc))
 getInfo allInfo name
   = withSession $ \hsc_env ->
-    do mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env name
+    do ic <- getInteractiveContext
+       mb_stuff <- liftIO $ hscTcRnGetInfo hsc_env ic name
        case mb_stuff of
          Nothing -> return Nothing
          Just (thing, fixity, cls_insts, fam_insts, docs) -> do
-           let rdr_env = icReaderEnv (hsc_IC hsc_env)
+           let rdr_env = icReaderEnv ic
 
            -- Filter the instances based on whether the constituent names of their
            -- instance heads are all in scope.
@@ -883,16 +892,17 @@ getInfo allInfo name
                | otherwise              = True
 
 -- | Returns all names in scope in the current interactive context
-getNamesInScope :: GhcMonad m => m [Name]
-getNamesInScope = withSession $ \hsc_env ->
-  return (map greMangledName (globalRdrEnvElts (icReaderEnv (hsc_IC hsc_env))))
+getNamesInScope :: GhciMonad m => m [Name]
+getNamesInScope =
+  map greMangledName . globalRdrEnvElts . icReaderEnv
+  <$> getInteractiveContext
 
 -- | Returns all 'RdrName's in scope in the current interactive
 -- context, excluding any that are internally-generated.
-getRdrNamesInScope :: GhcMonad m => m [RdrName]
-getRdrNamesInScope = withSession $ \hsc_env -> do
+getRdrNamesInScope :: GhciMonad m => m [RdrName]
+getRdrNamesInScope = do
+  ic <- getInteractiveContext
   let
-      ic = hsc_IC hsc_env
       gbl_rdrenv = icReaderEnv ic
       gbl_names = concatMap greRdrNames $ globalRdrEnvElts gbl_rdrenv
   -- Exclude internally generated names; see e.g. #11328
@@ -901,13 +911,15 @@ getRdrNamesInScope = withSession $ \hsc_env -> do
 
 -- | Parses a string as an identifier, and returns the list of 'Name's that
 -- the identifier can refer to in the current interactive context.
-parseName :: GhcMonad m => String -> m [Name]
-parseName str = withSession $ \hsc_env -> liftIO $
-   do { lrdr_name <- hscParseIdentifier hsc_env str
-      ; hscTcRnLookupRdrName hsc_env lrdr_name }
+parseName :: GhciMonad m => String -> m [Name]
+parseName str = withSession $ \hsc_env -> do
+  ic <- getInteractiveContext
+  liftIO $ do
+    lrdr_name <- hscParseIdentifier hsc_env ic str
+    hscTcRnLookupRdrName hsc_env ic lrdr_name
 
 
-getDocs :: GhcMonad m
+getDocs :: GhciMonad m
         => Name
         -> m (Either GetDocsFailure (Maybe [HsDoc GhcRn], IntMap (HsDoc GhcRn)))
            -- TODO: What about docs for constructors etc.?
@@ -919,7 +931,8 @@ getDocs name =
          if isInteractiveModule mod
            then pure (Left InteractiveName)
            else do
-             iface <- liftIO $ hscGetModuleInterface hsc_env mod
+             ic <- getInteractiveContext
+             iface <- liftIO $ hscGetModuleInterface hsc_env ic mod
              case mi_docs iface of
                Nothing -> pure (Left (NoDocsInIface mod compiled))
                Just Docs { docs_decls = decls
@@ -967,18 +980,20 @@ instance Outputable GetDocsFailure where
 
 -- | Get the type of an expression
 -- Returns the type as described by 'TcRnExprMode'
-exprType :: GhcMonad m => TcRnExprMode -> String -> m Type
+exprType :: GhciMonad m => TcRnExprMode -> String -> m Type
 exprType mode expr = withSession $ \hsc_env -> do
-   ty <- liftIO $ hscTcExpr hsc_env mode expr
+   ic <- getInteractiveContext
+   ty <- liftIO $ hscTcExpr hsc_env ic mode expr
    return $ tidyType emptyTidyEnv ty
 
 -- -----------------------------------------------------------------------------
 -- Getting the kind of a type
 
 -- | Get the kind of a  type
-typeKind  :: GhcMonad m => Bool -> String -> m (Type, Kind)
-typeKind normalise str = withSession $ \hsc_env ->
-   liftIO $ hscKcType hsc_env normalise str
+typeKind :: GhciMonad m => Bool -> String -> m (Type, Kind)
+typeKind normalise str = withSession $ \hsc_env -> do
+   ic <- getInteractiveContext
+   liftIO $ hscKcType hsc_env ic normalise str
 
 -- ----------------------------------------------------------------------------
 -- Getting the class instances for a type
@@ -1027,23 +1042,25 @@ typeKind normalise str = withSession $ \hsc_env ->
 -}
 
 -- Find all instances that match a provided type
-getInstancesForType :: GhcMonad m => Type -> m [ClsInst]
-getInstancesForType ty = withSession $ \hsc_env ->
-  liftIO $ runInteractiveHsc hsc_env $
-    ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env $ do
+getInstancesForType :: GhciMonad m => Type -> m [ClsInst]
+getInstancesForType ty = withSession $ \hsc_env -> do
+  ic <- getInteractiveContext
+  liftIO $ runInteractiveHsc hsc_env ic $
+    ioMsgMaybe $ hoistTcRnMessage $ runTcInteractive hsc_env ic $ do
       -- Bring class and instances from unqualified modules into scope, this fixes #16793.
-      loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+      loadUnqualIfaces hsc_env ic
       matches <- findMatchingInstances ty
 
       fmap catMaybes . forM matches $ uncurry checkForExistence
 
 -- Parse a type string and turn any holes into skolems
-parseInstanceHead :: GhcMonad m => String -> m Type
+parseInstanceHead :: GhciMonad m => String -> m Type
 parseInstanceHead str = withSession $ \hsc_env0 -> do
-  (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 $ do
+  ic <- getInteractiveContext
+  (ty, _) <- liftIO $ runInteractiveHsc hsc_env0 ic $ do
     hsc_env <- getHscEnv
     ty <- hscParseType str
-    ioMsgMaybe $ hoistTcRnMessage $ tcRnType hsc_env SkolemiseFlexi True ty
+    ioMsgMaybe $ hoistTcRnMessage $ tcRnType hsc_env ic SkolemiseFlexi True ty
 
   return ty
 
@@ -1171,25 +1188,26 @@ checkForExistence clsInst mb_inst_tys = do
 
 -- | Parse an expression, the parsed expression can be further processed and
 -- passed to compileParsedExpr.
-parseExpr :: GhcMonad m => String -> m (LHsExpr GhcPs)
-parseExpr expr = withSession $ \hsc_env ->
-  liftIO $ runInteractiveHsc hsc_env $ hscParseExpr expr
+parseExpr :: GhciMonad m => String -> m (LHsExpr GhcPs)
+parseExpr expr = withSession $ \hsc_env -> do
+  ic <- getInteractiveContext
+  liftIO $ runInteractiveHsc hsc_env ic $ hscParseExpr expr
 
 -- | Compile an expression, run it, and deliver the resulting HValue.
-compileExpr :: GhcMonad m => String -> m HValue
+compileExpr :: GhciMonad m => String -> m HValue
 compileExpr expr = do
   parsed_expr <- parseExpr expr
   compileParsedExpr parsed_expr
 
 -- | Compile an expression, run it, and deliver the resulting HValue.
-compileExprRemote :: GhcMonad m => String -> m ForeignHValue
+compileExprRemote :: GhciMonad m => String -> m ForeignHValue
 compileExprRemote expr = do
   parsed_expr <- parseExpr expr
   compileParsedExprRemote parsed_expr
 
 -- | Compile a parsed expression (before renaming), run it, and deliver
 -- the resulting HValue.
-compileParsedExprRemote :: GhcMonad m => LHsExpr GhcPs -> m ForeignHValue
+compileParsedExprRemote :: GhciMonad m => LHsExpr GhcPs -> m ForeignHValue
 compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
   let dflags = hsc_dflags hsc_env
   let interp = hscInterp hsc_env
@@ -1205,7 +1223,8 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
         ValBinds NoAnnSortKey
                      (unitBag $ mkHsVarBind loc' (getRdrName expr_name) expr) []
 
-  pstmt <- liftIO $ hscParsedStmt hsc_env let_stmt
+  ic <- getInteractiveContext
+  pstmt <- liftIO $ hscParsedStmt hsc_env ic let_stmt
   let (hvals_io, fix_env) = case pstmt of
         Just ([_id], hvals_io', fix_env') -> (hvals_io', fix_env')
         _ -> panic "compileParsedExprRemote"
@@ -1219,14 +1238,14 @@ compileParsedExprRemote expr@(L loc _) = withSession $ \hsc_env -> do
       liftIO $ throwIO (fromSerializableException e)
     _ -> panic "compileParsedExpr"
 
-compileParsedExpr :: GhcMonad m => LHsExpr GhcPs -> m HValue
+compileParsedExpr :: GhciMonad m => LHsExpr GhcPs -> m HValue
 compileParsedExpr expr = do
    fhv <- compileParsedExprRemote expr
    interp <- hscInterp <$> getSession
    liftIO $ wormhole interp fhv
 
 -- | Compile an expression, run it and return the result as a Dynamic.
-dynCompileExpr :: GhcMonad m => String -> m Dynamic
+dynCompileExpr :: GhciMonad m => String -> m Dynamic
 dynCompileExpr expr = do
   parsed_expr <- parseExpr expr
   -- > Data.Dynamic.toDyn expr
@@ -1269,16 +1288,16 @@ obtainTermFromVal hsc_env _bound _force _ty _x = case interpInstance interp of
   where
     interp = hscInterp hsc_env
 
-obtainTermFromId :: HscEnv -> Int -> Bool -> Id -> IO Term
-obtainTermFromId hsc_env bound force id =  do
+obtainTermFromId :: HscEnv -> InteractiveContext -> Int -> Bool -> Id -> IO Term
+obtainTermFromId hsc_env ic bound force id =  do
   (hv, _, _) <- Loader.loadName (hscInterp hsc_env) hsc_env (varName id)
-  cvObtainTerm hsc_env bound force (idType id) hv
+  cvObtainTerm hsc_env ic bound force (idType id) hv
 
 -- Uses RTTI to reconstruct the type of an Id, making it less polymorphic
-reconstructType :: HscEnv -> Int -> Id -> IO (Maybe Type)
-reconstructType hsc_env bound id = do
+reconstructType :: HscEnv -> InteractiveContext -> Int -> Id -> IO (Maybe Type)
+reconstructType hsc_env ic bound id = do
   (hv, _, _) <- Loader.loadName (hscInterp hsc_env) hsc_env (varName id)
-  cvReconstructType hsc_env bound (idType id) hv
+  cvReconstructType hsc_env ic bound (idType id) hv
 
 mkRuntimeUnkTyVar :: Name -> Kind -> TyVar
 mkRuntimeUnkTyVar name kind = mkTcTyVar name kind RuntimeUnk
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index df3cd24278..196e1097c1 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -33,6 +33,7 @@ import GHCi.Message ( fromSerializableException )
 
 import GHC.Core.DataCon
 import GHC.Core.Type
+import GHC.Runtime.Context ( InteractiveContext )
 import GHC.Types.RepType
 import GHC.Core.Multiplicity
 import qualified GHC.Core.Unify as U
@@ -529,16 +530,16 @@ type GhciType = Type
 --------------------------------
 type TR a = TcM a
 
-runTR :: HscEnv -> TR a -> IO a
-runTR hsc_env thing = do
-  mb_val <- runTR_maybe hsc_env thing
+runTR :: HscEnv -> InteractiveContext -> TR a -> IO a
+runTR hsc_env ic thing = do
+  mb_val <- runTR_maybe hsc_env ic thing
   case mb_val of
     Nothing -> error "unable to :print the term"
     Just x  -> return x
 
-runTR_maybe :: HscEnv -> TR a -> IO (Maybe a)
-runTR_maybe hsc_env thing_inside
-  = do { (_errs, res) <- initTcInteractive hsc_env thing_inside
+runTR_maybe :: HscEnv -> InteractiveContext -> TR a -> IO (Maybe a)
+runTR_maybe hsc_env ic thing_inside
+  = do { (_errs, res) <- initTcInteractive hsc_env ic thing_inside
        ; return res }
 
 -- | Term Reconstruction trace
@@ -708,12 +709,13 @@ addConstraint actual expected = do
 --
 cvObtainTerm
     :: HscEnv
+    -> InteractiveContext
     -> Int      -- ^ How many times to recurse for subterms
     -> Bool     -- ^ Force thunks
     -> RttiType -- ^ Type of the object to reconstruct
     -> ForeignHValue   -- ^ Object to reconstruct
     -> IO Term
-cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
+cvObtainTerm hsc_env ic max_depth force old_ty hval = runTR hsc_env ic $ do
   -- we quantify existential tyvars as universal,
   -- as this is needed to be able to manipulate
   -- them properly
@@ -990,11 +992,12 @@ extractSubTerms recurse clos = liftM thdOf3 . go 0 0
 --
 cvReconstructType
     :: HscEnv
+    -> InteractiveContext
     -> Int       -- ^ How many times to recurse for subterms
     -> GhciType  -- ^ Type to refine
     -> ForeignHValue  -- ^ Refine the type using this value
     -> IO (Maybe Type)
-cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
+cvReconstructType hsc_env ic max_depth old_ty hval = runTR_maybe hsc_env ic $ do
    traceTR (text "RTTI started with initial type " <> ppr old_ty)
    let sigma_old_ty@(old_tvs, _) = quantifyType old_ty
    new_ty <-
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 393573fd24..d0a4fb5360 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -28,6 +28,7 @@ import GHC.Driver.Hooks
 import GHC.Driver.Plugins
 
 import GHC.Linker.Loader       ( loadModule, loadName )
+import GHC.Runtime.Context     ( InteractiveContext )
 import GHC.Runtime.Interpreter ( wormhole )
 import GHC.Runtime.Interpreter.Types
 
@@ -73,8 +74,8 @@ import Data.List (unzip4)
 -- flags. Should be called after command line arguments are parsed, but before
 -- actual compilation starts. Idempotent operation. Should be re-called if
 -- pluginModNames or pluginModNameOpts changes.
-initializePlugins :: HscEnv -> IO HscEnv
-initializePlugins hsc_env
+initializePlugins :: HscEnv -> InteractiveContext -> IO HscEnv
+initializePlugins hsc_env ic
     -- plugins not changed
   | loaded_plugins <- loadedPlugins (hsc_plugins hsc_env)
   , map lpModuleName loaded_plugins == reverse (pluginModNames dflags)
@@ -82,7 +83,7 @@ initializePlugins hsc_env
   , all same_args loaded_plugins
   = return hsc_env -- no need to reload plugins FIXME: doesn't take static plugins into account
   | otherwise
-  = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env
+  = do (loaded_plugins, links, pkgs) <- loadPlugins hsc_env ic
        let plugins' = (hsc_plugins hsc_env) { loadedPlugins = loaded_plugins, loadedPluginDeps = (links, pkgs) }
        let hsc_env' = hsc_env { hsc_plugins = plugins' }
        withPlugins (hsc_plugins hsc_env') driverPlugin hsc_env'
@@ -92,8 +93,8 @@ initializePlugins hsc_env
     argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
     dflags = hsc_dflags hsc_env
 
-loadPlugins :: HscEnv -> IO ([LoadedPlugin], [Linkable], PkgsLoaded)
-loadPlugins hsc_env
+loadPlugins :: HscEnv -> InteractiveContext -> IO ([LoadedPlugin], [Linkable], PkgsLoaded)
+loadPlugins hsc_env ic
   = do { unless (null to_load) $
            checkExternalInterpreter hsc_env
        ; plugins_with_deps <- mapM loadPlugin to_load
@@ -109,15 +110,15 @@ loadPlugins hsc_env
       where
         options = [ option | (opt_mod_nm, option) <- pluginModNameOpts dflags
                             , opt_mod_nm == mod_nm ]
-    loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env
+    loadPlugin = loadPlugin' (mkVarOcc "plugin") pluginTyConName hsc_env ic
 
 
-loadFrontendPlugin :: HscEnv -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
-loadFrontendPlugin hsc_env mod_name = do
+loadFrontendPlugin :: HscEnv -> InteractiveContext -> ModuleName -> IO (FrontendPlugin, [Linkable], PkgsLoaded)
+loadFrontendPlugin hsc_env ic mod_name = do
     checkExternalInterpreter hsc_env
     (plugin, _iface, links, pkgs)
       <- loadPlugin' (mkVarOcc "frontendPlugin") frontendPluginTyConName
-           hsc_env mod_name
+           hsc_env ic mod_name
     return (plugin, links, pkgs)
 
 -- #14335
@@ -127,11 +128,11 @@ checkExternalInterpreter hsc_env = case interpInstance <$> hsc_interp hsc_env of
     -> throwIO (InstallationError "Plugins require -fno-external-interpreter")
   _ -> pure ()
 
-loadPlugin' :: OccName -> Name -> HscEnv -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded)
-loadPlugin' occ_name plugin_name hsc_env mod_name
+loadPlugin' :: OccName -> Name -> HscEnv -> InteractiveContext -> ModuleName -> IO (a, ModIface, [Linkable], PkgsLoaded)
+loadPlugin' occ_name plugin_name hsc_env ic mod_name
   = do { let plugin_rdr_name = mkRdrQual mod_name occ_name
              dflags = hsc_dflags hsc_env
-       ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env mod_name
+       ; mb_name <- lookupRdrNameInModuleForPlugins hsc_env ic mod_name
                         plugin_rdr_name
        ; case mb_name of {
             Nothing ->
@@ -141,8 +142,8 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
                           , ppr plugin_rdr_name ]) ;
             Just (name, mod_iface) ->
 
-     do { plugin_tycon <- forceLoadTyCon hsc_env plugin_name
-        ; eith_plugin <- getValueSafely hsc_env name (mkTyConTy plugin_tycon)
+     do { plugin_tycon <- forceLoadTyCon hsc_env ic plugin_name
+        ; eith_plugin <- getValueSafely hsc_env ic name (mkTyConTy plugin_tycon)
         ; case eith_plugin of
             Left actual_type ->
                 throwGhcExceptionIO (CmdLineError $
@@ -158,28 +159,28 @@ loadPlugin' occ_name plugin_name hsc_env mod_name
 
 -- | Force the interfaces for the given modules to be loaded. The 'SDoc' parameter is used
 -- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
-forceLoadModuleInterfaces :: HscEnv -> SDoc -> [Module] -> IO ()
-forceLoadModuleInterfaces hsc_env doc modules
-    = (initTcInteractive hsc_env $
+forceLoadModuleInterfaces :: HscEnv -> InteractiveContext -> SDoc -> [Module] -> IO ()
+forceLoadModuleInterfaces hsc_env ic doc modules
+    = (initTcInteractive hsc_env ic $
        initIfaceTcRn $
        mapM_ (loadPluginInterface doc) modules)
       >> return ()
 
 -- | Force the interface for the module containing the name to be loaded. The 'SDoc' parameter is used
 -- for debugging (@-ddump-if-trace@) only: it is shown as the reason why the module is being loaded.
-forceLoadNameModuleInterface :: HscEnv -> SDoc -> Name -> IO ()
-forceLoadNameModuleInterface hsc_env reason name = do
+forceLoadNameModuleInterface :: HscEnv -> InteractiveContext -> SDoc -> Name -> IO ()
+forceLoadNameModuleInterface hsc_env ic reason name = do
     let name_modules = mapMaybe nameModule_maybe [name]
-    forceLoadModuleInterfaces hsc_env reason name_modules
+    forceLoadModuleInterfaces hsc_env ic reason name_modules
 
 -- | Load the 'TyCon' associated with the given name, come hell or high water. Fails if:
 --
 -- * The interface could not be loaded
 -- * The name is not that of a 'TyCon'
 -- * The name did not exist in the loaded module
-forceLoadTyCon :: HscEnv -> Name -> IO TyCon
-forceLoadTyCon hsc_env con_name = do
-    forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of loadTyConTy") con_name
+forceLoadTyCon :: HscEnv -> InteractiveContext -> Name -> IO TyCon
+forceLoadTyCon hsc_env ic con_name = do
+    forceLoadNameModuleInterface hsc_env ic (text "contains a name used in an invocation of loadTyConTy") con_name
 
     mb_con_thing <- lookupType hsc_env con_name
     case mb_con_thing of
@@ -198,10 +199,10 @@ forceLoadTyCon hsc_env con_name = do
 -- * If the Name does not exist in the module
 -- * If the link failed
 
-getValueSafely :: HscEnv -> Name -> Type -> IO (Either Type (a, [Linkable], PkgsLoaded))
-getValueSafely hsc_env val_name expected_type = do
+getValueSafely :: HscEnv -> InteractiveContext -> Name -> Type -> IO (Either Type (a, [Linkable], PkgsLoaded))
+getValueSafely hsc_env ic val_name expected_type = do
   eith_hval <- case getValueSafelyHook hooks of
-    Nothing -> getHValueSafely interp hsc_env val_name expected_type
+    Nothing -> getHValueSafely interp hsc_env ic val_name expected_type
     Just h  -> h                      hsc_env val_name expected_type
   case eith_hval of
     Left actual_type -> return (Left actual_type)
@@ -213,9 +214,9 @@ getValueSafely hsc_env val_name expected_type = do
     logger = hsc_logger hsc_env
     hooks  = hsc_hooks hsc_env
 
-getHValueSafely :: Interp -> HscEnv -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded))
-getHValueSafely interp hsc_env val_name expected_type = do
-    forceLoadNameModuleInterface hsc_env (text "contains a name used in an invocation of getHValueSafely") val_name
+getHValueSafely :: Interp -> HscEnv -> InteractiveContext -> Name -> Type -> IO (Either Type (HValue, [Linkable], PkgsLoaded))
+getHValueSafely interp hsc_env ic val_name expected_type = do
+    forceLoadNameModuleInterface hsc_env ic (text "contains a name used in an invocation of getHValueSafely") val_name
     -- Now look up the names for the value and type constructor in the type environment
     mb_val_thing <- lookupType hsc_env val_name
     case mb_val_thing of
@@ -269,9 +270,10 @@ lessUnsafeCoerce logger context what = do
 -- being compiled.  This was introduced by 57d6798.
 --
 -- Need the module as well to record information in the interface file
-lookupRdrNameInModuleForPlugins :: HscEnv -> ModuleName -> RdrName
+lookupRdrNameInModuleForPlugins :: HscEnv -> InteractiveContext 
+                                -> ModuleName -> RdrName
                                 -> IO (Maybe (Name, ModIface))
-lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
+lookupRdrNameInModuleForPlugins hsc_env ic mod_name rdr_name = do
     let dflags     = hsc_dflags hsc_env
     let fopts      = initFinderOpts dflags
     let fc         = hsc_FC hsc_env
@@ -283,7 +285,7 @@ lookupRdrNameInModuleForPlugins hsc_env mod_name rdr_name = do
     case found_module of
         Found _ mod -> do
             -- Find the exports of the module
-            (_, mb_iface) <- initTcInteractive hsc_env $
+            (_, mb_iface) <- initTcInteractive hsc_env ic $
                              initIfaceTcRn $
                              loadPluginInterface doc mod
             case mb_iface of
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index 4c6279a6d9..378f29fb57 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -78,6 +78,7 @@ import GHC.Iface.Load
 import GHCi.Message
 import GHCi.RemoteTypes
 import GHC.Runtime.Interpreter
+import GHC.Runtime.Context ( emptyInteractiveContext )
 
 import GHC.Rename.Splice( traceSplice, SpliceInfo(..))
 import GHC.Rename.Expr
@@ -1237,8 +1238,10 @@ runMeta' show_code ppr_hs run_and_convert expr
         -- Compile and link it; might fail if linking fails
         ; src_span <- getSrcSpanM
         ; traceTc "About to run (desugared)" (ppr ds_expr)
+        -- TODO Template Haskell is not GHCi, should not need this
+        ; let ic = emptyInteractiveContext $ hsc_dflags hsc_env
         ; either_hval <- tryM $ liftIO $
-                         GHC.Driver.Main.hscCompileCoreExpr hsc_env src_span ds_expr
+                         GHC.Driver.Main.hscCompileCoreExpr hsc_env ic src_span ds_expr
         ; case either_hval of {
             Left exn   -> fail_with_exn "compile and link" exn ;
             Right (hval, needed_mods, needed_pkgs) -> do
@@ -1606,7 +1609,9 @@ getExternalModIface nm = do
           Nothing -> pure Nothing
           Just modNm -> do
             hsc_env <- getTopEnv
-            iface <- liftIO $ hscGetModuleInterface hsc_env modNm
+            -- TODO Template Haskell is not GHCi, should not need this
+            let ic = emptyInteractiveContext $ hsc_dflags hsc_env
+            iface <- liftIO $ hscGetModuleInterface hsc_env ic modNm
             pure (Just iface)
 
 -- | Find the GHC name of the first instance that matches the TH type
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index a332d61fb1..d7ee5db572 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2047,11 +2047,11 @@ get two defns for 'main' in the interface file!
 *********************************************************
 -}
 
-runTcInteractive :: HscEnv -> TcRn a -> IO (Messages TcRnMessage, Maybe a)
+runTcInteractive :: HscEnv -> InteractiveContext -> TcRn a -> IO (Messages TcRnMessage, Maybe a)
 -- Initialise the tcg_inst_env with instances from all home modules.
 -- This mimics the more selective call to hptInstances in tcRnImports
-runTcInteractive hsc_env thing_inside
-  = initTcInteractive hsc_env $ withTcPlugins hsc_env $
+runTcInteractive hsc_env icxt thing_inside
+  = initTcInteractive hsc_env icxt $ withTcPlugins hsc_env $
     withDefaultingPlugins hsc_env $ withHoleFitPlugins hsc_env $
     do { traceTc "setInteractiveContext" $
             vcat [ text "ic_tythings:" <+> vcat (map ppr (ic_tythings icxt))
@@ -2099,7 +2099,6 @@ runTcInteractive hsc_env thing_inside
   where
     (home_insts, home_fam_insts) = hptAllInstances hsc_env
 
-    icxt                     = hsc_IC hsc_env
     (ic_insts, ic_finsts)    = ic_instances icxt
     (lcl_ids, top_ty_things) = partitionWith is_closed (ic_tythings icxt)
 
@@ -2158,13 +2157,13 @@ We don't bother with the tcl_th_bndrs environment either.
 --
 -- The returned TypecheckedHsExpr is of type IO [ () ], a list of the bound
 -- values, coerced to ().
-tcRnStmt :: HscEnv -> GhciLStmt GhcPs
+tcRnStmt :: HscEnv -> InteractiveContext -> GhciLStmt GhcPs
          -> IO (Messages TcRnMessage, Maybe ([Id], LHsExpr GhcTc, FixityEnv))
-tcRnStmt hsc_env rdr_stmt
-  = runTcInteractive hsc_env $ do {
+tcRnStmt hsc_env ic rdr_stmt
+  = runTcInteractive hsc_env ic $ do {
 
     -- The real work is done here
-    ((bound_ids, tc_expr), fix_env) <- tcUserStmt rdr_stmt ;
+    ((bound_ids, tc_expr), fix_env) <- tcUserStmt ic rdr_stmt ;
     zonked_expr <- zonkTopLExpr tc_expr ;
     zonked_ids  <- zonkTopBndrs bound_ids ;
 
@@ -2235,19 +2234,19 @@ runPlans (p:ps) = tryTcDiscardingErrs (runPlans ps) p
 -- in GHCi] in GHC.Driver.Env for more details. We do this lifting by trying
 -- different ways ('plans') of lifting the code into the IO monad and
 -- type checking each plan until one succeeds.
-tcUserStmt :: GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)
+tcUserStmt :: InteractiveContext -> GhciLStmt GhcPs -> TcM (PlanResult, FixityEnv)
 
 -- An expression typed at the prompt is treated very specially
-tcUserStmt (L loc (BodyStmt _ expr _ _))
+tcUserStmt ic (L loc (BodyStmt _ expr _ _))
   = do  { (rn_expr, fvs) <- checkNoErrs (rnLExpr expr)
 
         ; dumpOptTcRn Opt_D_dump_rn_ast "Renamer" FormatHaskell
             (showAstData NoBlankSrcSpan NoBlankEpAnnotations rn_expr)
                -- Don't try to typecheck if the renamer fails!
-        ; ghciStep <- getGhciStepIO
+        ; ghciStep <- getGhciStepIO ic 
         ; uniq <- newUnique
         ; let loc' = noAnnSrcSpan $ locA loc
-        ; interPrintName <- getInteractivePrintName
+        ; let interPrintName = ic_int_print ic
         ; let fresh_it  = itName uniq (locA loc)
               matches   = [mkMatch (mkPrefixFunRhs (L loc' fresh_it)) [] rn_expr
                                    emptyLocalBinds]
@@ -2393,7 +2392,7 @@ But for naked expressions, you will have
           In an equation for ‘x’: x = putStrLn True
 -}
 
-tcUserStmt rdr_stmt@(L loc _)
+tcUserStmt ic rdr_stmt@(L loc _)
   = do { (([rn_stmt], fix_env), fvs) <- checkNoErrs $
            rnStmts (HsDoStmt GhciStmtCtxt) rnExpr [rdr_stmt] $ \_ -> do
              fix_env <- getFixityEnv
@@ -2402,7 +2401,7 @@ tcUserStmt rdr_stmt@(L loc _)
        ; traceRn "tcRnStmt" (vcat [ppr rdr_stmt, ppr rn_stmt, ppr fvs])
        ; rnDump rn_stmt ;
 
-       ; ghciStep <- getGhciStepIO
+       ; ghciStep <- getGhciStepIO ic
        ; let gi_stmt
                | (L loc (BindStmt x pat expr)) <- rn_stmt
                      = L loc $ BindStmt x pat (nlHsApp ghciStep expr)
@@ -2511,9 +2510,9 @@ tcGhciStmts stmts
     }
 
 -- | Generate a typed ghciStepIO expression (ghciStep :: Ty a -> IO a)
-getGhciStepIO :: TcM (LHsExpr GhcRn)
-getGhciStepIO = do
-    ghciTy <- getGHCiMonad
+getGhciStepIO :: InteractiveContext -> TcM (LHsExpr GhcRn)
+getGhciStepIO ic = do
+    let ghciTy = ic_monad ic
     a_tv <- newName (mkTyVarOccFS (fsLit "a"))
     let ghciM   = nlHsAppTy (nlHsTyVar NotPromoted ghciTy) (nlHsTyVar NotPromoted a_tv)
         ioM     = nlHsAppTy (nlHsTyVar NotPromoted ioTyConName) (nlHsTyVar NotPromoted a_tv)
@@ -2529,9 +2528,9 @@ getGhciStepIO = do
 
     return (noLocA $ ExprWithTySig noExtField (nlHsVar ghciStepIoMName) stepTy)
 
-isGHCiMonad :: HscEnv -> String -> IO (Messages TcRnMessage, Maybe Name)
-isGHCiMonad hsc_env ty
-  = runTcInteractive hsc_env $ do
+isGHCiMonad :: HscEnv -> InteractiveContext -> String -> IO (Messages TcRnMessage, Maybe Name)
+isGHCiMonad hsc_env ic ty
+  = runTcInteractive hsc_env ic $ do
         rdrEnv <- getGlobalRdrEnv
         let occIO = lookupOccEnv rdrEnv (mkOccName tcName ty)
         case occIO of
@@ -2554,11 +2553,12 @@ data TcRnExprMode = TM_Inst     -- ^ Instantiate inferred quantifiers only (:typ
 -- | tcRnExpr just finds the type of an expression
 --   for :type
 tcRnExpr :: HscEnv
+         -> InteractiveContext
          -> TcRnExprMode
          -> LHsExpr GhcPs
          -> IO (Messages TcRnMessage, Maybe Type)
-tcRnExpr hsc_env mode rdr_expr
-  = runTcInteractive hsc_env $
+tcRnExpr hsc_env ic mode rdr_expr
+  = runTcInteractive hsc_env ic $
     do {
 
     (rn_expr, _fvs) <- rnLExpr rdr_expr ;
@@ -2647,12 +2647,13 @@ anything here is ad-hoc, and it's a user-sought improvement.
 
 --------------------------
 tcRnImportDecls :: HscEnv
+                -> InteractiveContext
                 -> [LImportDecl GhcPs]
                 -> IO (Messages TcRnMessage, Maybe GlobalRdrEnv)
 -- Find the new chunk of GlobalRdrEnv created by this list of import
 -- decls.  In contract tcRnImports *extends* the TcGblEnv.
-tcRnImportDecls hsc_env import_decls
- =  runTcInteractive hsc_env $
+tcRnImportDecls hsc_env ic import_decls
+ =  runTcInteractive hsc_env ic $
     do { gbl_env <- updGblEnv zap_rdr_env $
                     tcRnImports hsc_env $ map (,text "is directly imported") import_decls
        ; return (tcg_rdr_env gbl_env) }
@@ -2661,12 +2662,13 @@ tcRnImportDecls hsc_env import_decls
 
 -- tcRnType just finds the kind of a type
 tcRnType :: HscEnv
+         -> InteractiveContext
          -> ZonkFlexi
          -> Bool        -- Normalise the returned type
          -> LHsType GhcPs
          -> IO (Messages TcRnMessage, Maybe (Type, Kind))
-tcRnType hsc_env flexi normalise rdr_type
-  = runTcInteractive hsc_env $
+tcRnType hsc_env ic flexi normalise rdr_type
+  = runTcInteractive hsc_env ic $
     setXOptM LangExt.PolyKinds $   -- See Note [Kind-generalise in tcRnType]
     do { (HsWC { hswc_ext = wcs, hswc_body = rn_type }, _fvs)
                <- rnHsWcType GHCiCtx (mkHsWildCardBndrs rdr_type)
@@ -2797,10 +2799,11 @@ tcRnDeclsi exists to allow class, data, and other declarations in GHCi.
 -}
 
 tcRnDeclsi :: HscEnv
+           -> InteractiveContext
            -> [LHsDecl GhcPs]
            -> IO (Messages TcRnMessage, Maybe TcGblEnv)
-tcRnDeclsi hsc_env local_decls
-  = runTcInteractive hsc_env $
+tcRnDeclsi hsc_env ic local_decls
+  = runTcInteractive hsc_env ic $
     tcRnSrcDecls False Nothing local_decls
 
 externaliseAndTidyId :: Module -> Id -> TcM Id
@@ -2823,16 +2826,16 @@ externaliseAndTidyId this_mod id
 -- a package module with an interface on disk.  If neither of these is
 -- true, then the result will be an error indicating the interface
 -- could not be found.
-getModuleInterface :: HscEnv -> Module -> IO (Messages TcRnMessage, Maybe ModIface)
-getModuleInterface hsc_env mod
-  = runTcInteractive hsc_env $
+getModuleInterface :: HscEnv -> InteractiveContext -> Module -> IO (Messages TcRnMessage, Maybe ModIface)
+getModuleInterface hsc_env ic mod
+  = runTcInteractive hsc_env ic $
     loadModuleInterface (text "getModuleInterface") mod
 
-tcRnLookupRdrName :: HscEnv -> LocatedN RdrName
+tcRnLookupRdrName :: HscEnv -> InteractiveContext -> LocatedN RdrName
                   -> IO (Messages TcRnMessage, Maybe [Name])
 -- ^ Find all the Names that this RdrName could mean, in GHCi
-tcRnLookupRdrName hsc_env (L loc rdr_name)
-  = runTcInteractive hsc_env $
+tcRnLookupRdrName hsc_env ic (L loc rdr_name)
+  = runTcInteractive hsc_env ic $
     setSrcSpanA loc          $
     do {   -- If the identifier is a constructor (begins with an
            -- upper-case letter), then we need to consider both
@@ -2844,9 +2847,9 @@ tcRnLookupRdrName hsc_env (L loc rdr_name)
            (text "Not in scope:" <+> quotes (ppr rdr_name)))
        ; return names }
 
-tcRnLookupName :: HscEnv -> Name -> IO (Messages TcRnMessage, Maybe TyThing)
-tcRnLookupName hsc_env name
-  = runTcInteractive hsc_env $
+tcRnLookupName :: HscEnv -> InteractiveContext -> Name -> IO (Messages TcRnMessage, Maybe TyThing)
+tcRnLookupName hsc_env ic name
+  = runTcInteractive hsc_env ic $
     tcRnLookupName' name
 
 -- To look up a name we have to look in the local environment (tcl_lcl)
@@ -2862,6 +2865,7 @@ tcRnLookupName' name = do
      _ -> panic "tcRnLookupName'"
 
 tcRnGetInfo :: HscEnv
+            -> InteractiveContext
             -> Name
             -> IO ( Messages TcRnMessage
                   , Maybe (TyThing, Fixity, [ClsInst], [FamInst], SDoc))
@@ -2873,9 +2877,9 @@ tcRnGetInfo :: HscEnv
 -- but we want to treat it as *both* a data constructor
 --  *and* as a type or class constructor;
 -- hence the call to dataTcOccs, and we return up to two results
-tcRnGetInfo hsc_env name
-  = runTcInteractive hsc_env $
-    do { loadUnqualIfaces hsc_env (hsc_IC hsc_env)
+tcRnGetInfo hsc_env ic name
+  = runTcInteractive hsc_env ic $
+    do { loadUnqualIfaces hsc_env ic
            -- Load the interface for all unqualified types and classes
            -- That way we will find all the instance declarations
            -- (Packages have not orphan modules, and we assume that
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 01fde4cd1a..1eca96d1b7 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -143,34 +143,37 @@ import GHC.Driver.Env.KnotVars
 *                                                                      *
 ********************************************************************* -}
 
-lookupGlobal :: HscEnv -> Name -> IO TyThing
+lookupGlobal :: HscEnv -> Maybe InteractiveContext -> Name -> IO TyThing
 -- A variant of lookupGlobal_maybe for the clients which are not
 -- interested in recovering from lookup failure and accept panic.
-lookupGlobal hsc_env name
+lookupGlobal hsc_env m_ic name
   = do  {
-          mb_thing <- lookupGlobal_maybe hsc_env name
+          mb_thing <- lookupGlobal_maybe hsc_env m_ic name
         ; case mb_thing of
             Succeeded thing -> return thing
             Failed msg      -> pprPanic "lookupGlobal" msg
         }
 
-lookupGlobal_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing)
+lookupGlobal_maybe :: HscEnv -> Maybe InteractiveContext -> Name -> IO (MaybeErr SDoc TyThing)
 -- This may look up an Id that one has previously looked up.
 -- If so, we are going to read its interface file, and add its bindings
 -- to the ExternalPackageTable.
-lookupGlobal_maybe hsc_env name
+lookupGlobal_maybe hsc_env m_ic name
   = do  {    -- Try local envt
-          let mod = icInteractiveModule (hsc_IC hsc_env)
-              mhome_unit = hsc_home_unit_maybe hsc_env
-              tcg_semantic_mod = homeModuleInstantiation mhome_unit mod
-
-        ; if nameIsLocalOrFrom tcg_semantic_mod name
-              then (return
-                (Failed (text "Can't find local name: " <+> ppr name)))
-                  -- Internal names can happen in GHCi
-              else
-           -- Try home package table and external package table
-          lookupImported_maybe hsc_env name
+          let m_tcg_semantic_mod = flip fmap m_ic $ \ic -> let
+                mod = icInteractiveModule ic
+                mhome_unit = hsc_home_unit_maybe hsc_env
+                in homeModuleInstantiation mhome_unit mod
+
+        ; case m_tcg_semantic_mod of 
+            Just tcg_semantic_mod
+              | nameIsLocalOrFrom tcg_semantic_mod name
+              -> return
+                (Failed (text "Can't find local name: " <+> ppr name))
+                -- Internal names can happen in GHCi
+            _ ->
+                -- Try home package table and external package table
+                lookupImported_maybe hsc_env name
         }
 
 lookupImported_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc TyThing)
@@ -192,16 +195,16 @@ importDecl_maybe hsc_env name
   | otherwise
   = initIfaceLoad hsc_env (importDecl name)
 
-ioLookupDataCon :: HscEnv -> Name -> IO DataCon
-ioLookupDataCon hsc_env name = do
-  mb_thing <- ioLookupDataCon_maybe hsc_env name
+ioLookupDataCon :: HscEnv -> Maybe InteractiveContext -> Name -> IO DataCon
+ioLookupDataCon hsc_env m_ic name = do
+  mb_thing <- ioLookupDataCon_maybe hsc_env m_ic name
   case mb_thing of
     Succeeded thing -> return thing
     Failed msg      -> pprPanic "lookupDataConIO" msg
 
-ioLookupDataCon_maybe :: HscEnv -> Name -> IO (MaybeErr SDoc DataCon)
-ioLookupDataCon_maybe hsc_env name = do
-    thing <- lookupGlobal hsc_env name
+ioLookupDataCon_maybe :: HscEnv -> Maybe InteractiveContext -> Name -> IO (MaybeErr SDoc DataCon)
+ioLookupDataCon_maybe hsc_env m_ic name = do
+    thing <- lookupGlobal hsc_env m_ic name
     return $ case thing of
         AConLike (RealDataCon con) -> Succeeded con
         _                          -> Failed $
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 571e02c7cf..cb27824863 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -53,7 +53,7 @@ module GHC.Tc.Utils.Monad(
   debugTc,
 
   -- * Typechecker global environment
-  getIsGHCi, getGHCiMonad, getInteractivePrintName,
+  getIsGHCi,
   tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv,
   getRdrEnvs, getImports,
   getFixityEnv, extendFixityEnv, getRecFieldEnv,
@@ -418,11 +418,11 @@ initTcWithGbl hsc_env gbl_env loc do_this
       ; return (msgs, final_res)
       }
 
-initTcInteractive :: HscEnv -> TcM a -> IO (Messages TcRnMessage, Maybe a)
+initTcInteractive :: HscEnv -> InteractiveContext -> TcM a -> IO (Messages TcRnMessage, Maybe a)
 -- Initialise the type checker monad for use in GHCi
-initTcInteractive hsc_env thing_inside
+initTcInteractive hsc_env ic thing_inside
   = initTc hsc_env HsSrcFile False
-           (icInteractiveModule (hsc_IC hsc_env))
+           (icInteractiveModule ic)
            (realSrcLocSpan interactive_src_loc)
            thing_inside
   where
@@ -910,12 +910,6 @@ getIsGHCi :: TcRn Bool
 getIsGHCi = do { mod <- getModule
                ; return (isInteractiveModule mod) }
 
-getGHCiMonad :: TcRn Name
-getGHCiMonad = do { hsc <- getTopEnv; return (ic_monad $ hsc_IC hsc) }
-
-getInteractivePrintName :: TcRn Name
-getInteractivePrintName = do { hsc <- getTopEnv; return (ic_int_print $ hsc_IC hsc) }
-
 tcIsHsBootOrSig :: TcRn Bool
 tcIsHsBootOrSig = do { env <- getGblEnv; return (isHsBootOrSig (tcg_src env)) }
 
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a5cef449ed..497a9cdb82 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -446,6 +446,7 @@ Library
         GHC.Driver.Make
         GHC.Driver.MakeFile
         GHC.Driver.Monad
+        GHC.Driver.Monad.Interactive
         GHC.Driver.Phases
         GHC.Driver.Pipeline
         GHC.Driver.Pipeline.Execute
diff --git a/ghc/GHCi/UI/Monad.hs b/ghc/GHCi/UI/Monad.hs
index ee0edb1837..1e937dd80c 100644
--- a/ghc/GHCi/UI/Monad.hs
+++ b/ghc/GHCi/UI/Monad.hs
@@ -84,6 +84,7 @@ import qualified GHC.LanguageExtensions as LangExt
 
 data GHCiState = GHCiState
      {
+        other_state    :: InteractiveContext,
         progname       :: String,
         args           :: [String],
         evalWrapper    :: ForeignHValue, -- ^ of type @IO a -> IO a@