CoreToStg.Prep: Get rid of `DynFlags` and `HscEnv`wip/no-dyn-flags-core-cmm

The call sites in `Driver.Main` are duplicative, but this is good,
because the next step is to remove `InteractiveContext` from `Core.Lint`
into `Core.Lint.Interactive`.

Also further clean up `Core.Lint` to use a better configuration record
than the one we initially added.

6 files changed, 164 insertions, 92 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index f6043bdbfa..62acf32415 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -25,6 +25,7 @@ module GHC.Core.Lint (
     interactiveInScope,
 
     -- ** Debug output
+    EndPassConfig (..),
     endPassIO,
     displayLintResults, dumpPassResult
  ) where
@@ -93,7 +94,7 @@ import qualified GHC.Utils.Error as Err
 import GHC.Utils.Logger
 
 import Control.Monad
-import Data.Foldable      ( toList )
+import Data.Foldable      ( for_, toList )
 import Data.List.NonEmpty ( NonEmpty(..), groupWith )
 import Data.List          ( partition )
 import Data.Maybe
@@ -273,20 +274,30 @@ points but not the RHSes of value bindings (thunks and functions).
 ************************************************************************
 -}
 
+-- | Configuration for boilerplate operations at the end of a
+-- compilation pass producing Core.
+data EndPassConfig = EndPassConfig
+  { ep_dumpCoreSizes :: !Bool
+  -- ^ Whether core bindings should be dumped with the size of what they
+  -- are binding (i.e. the size of the RHS of the binding).
+
+  , ep_lintPassResult :: !(Maybe LintPassResultConfig)
+  -- ^ Whether we should lint the result of this pass.
+  }
+
 endPassIO :: Logger
-           -> LintPassResultConfig
-           -> Bool -- dump core sizes
-           -> Bool -- lint pass result
-           -> PrintUnqualified
-           -> CoreToDo -> CoreProgram -> [CoreRule]
-           -> IO ()
+          -> EndPassConfig
+          -> PrintUnqualified
+          -> CoreToDo -> CoreProgram -> [CoreRule]
+          -> IO ()
 -- Used by the IO-is CorePrep too
-endPassIO logger lp_cfg dump_core_sizes lint_pass_result print_unqual
+endPassIO logger cfg print_unqual
            pass binds rules
-  = do { dumpPassResult logger dump_core_sizes print_unqual mb_flag
+  = do { dumpPassResult logger (ep_dumpCoreSizes cfg) print_unqual mb_flag
                         (renderWithContext defaultSDocContext (ppr pass))
                         (pprPassDetails pass) binds rules
-       ; when lint_pass_result $ lintPassResult' logger lp_cfg pass binds
+       ; for_ (ep_lintPassResult cfg) $ \lp_cfg ->
+           lintPassResult' logger lp_cfg pass binds
        }
   where
     mb_flag = case coreDumpFlag pass of
@@ -364,10 +375,10 @@ coreDumpFlag (CoreDoPasses {})        = Nothing
 -}
 
 data LintPassResultConfig = LintPassResultConfig
-  { endPass_diagOpts      :: !DiagOpts
-  , endPass_platform      :: !Platform
-  , endPass_makeLinkFlags :: CoreToDo -> LintFlags
-  , endPass_localsInScope :: ![Var]
+  { lpr_diagOpts      :: !DiagOpts
+  , lpr_platform      :: !Platform
+  , lpr_makeLintFlags :: !(CoreToDo -> LintFlags)
+  , lpr_localsInScope :: ![Var]
   }
 
 lintPassResult' :: Logger -> LintPassResultConfig
@@ -375,10 +386,10 @@ lintPassResult' :: Logger -> LintPassResultConfig
 lintPassResult' logger cfg pass binds
   = do { let warns_and_errs = lintCoreBindings'
                (LintConfig
-                { l_diagOpts = endPass_diagOpts cfg
-                , l_platform = endPass_platform cfg
-                , l_flags    = endPass_makeLinkFlags cfg pass
-                , l_vars     = endPass_localsInScope cfg
+                { l_diagOpts = lpr_diagOpts cfg
+                , l_platform = lpr_platform cfg
+                , l_flags    = lpr_makeLintFlags cfg pass
+                , l_vars     = lpr_localsInScope cfg
                 })
                binds
        ; Err.showPass logger $
diff --git a/compiler/GHC/CoreToStg/Prep.hs b/compiler/GHC/CoreToStg/Prep.hs
index e92888ec33..f4b6f2908d 100644
--- a/compiler/GHC/CoreToStg/Prep.hs
+++ b/compiler/GHC/CoreToStg/Prep.hs
@@ -1,4 +1,3 @@
-
 {-# LANGUAGE BangPatterns #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -11,7 +10,9 @@ Core pass to saturate constructors and PrimOps
 -}
 
 module GHC.CoreToStg.Prep
-   ( corePrepPgm
+   ( CorePrepConfig (..)
+   , CorePrepPgmConfig (..)
+   , corePrepPgm
    , corePrepExpr
    , mkConvertNumLiteral
    )
@@ -21,10 +22,7 @@ import GHC.Prelude
 
 import GHC.Platform
 
-import GHC.Driver.Session
-import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO )
-import GHC.Driver.Env
-import GHC.Driver.Ppr
+import GHC.Driver.Flags
 
 import GHC.Tc.Utils.Env
 import GHC.Unit
@@ -38,6 +36,7 @@ import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )
 import GHC.Core.Utils
 import GHC.Core.Opt.Arity
 import GHC.Core.Opt.Monad ( CoreToDo(..) )
+import GHC.Core.Lint    ( EndPassConfig, endPassIO )
 import GHC.Core
 import GHC.Core.Make hiding( FloatBind(..) )   -- We use our own FloatBind here
 import GHC.Core.Type
@@ -68,7 +67,7 @@ import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Id.Make ( realWorldPrimId )
 import GHC.Types.Basic
-import GHC.Types.Name   ( NamedThing(..), nameSrcSpan, isInternalName )
+import GHC.Types.Name   ( Name, NamedThing(..), nameSrcSpan, isInternalName )
 import GHC.Types.SrcLoc ( SrcSpan(..), realSrcLocSpan, mkRealSrcLoc )
 import GHC.Types.Literal
 import GHC.Types.Tickish
@@ -234,17 +233,28 @@ type CpeRhs  = CoreExpr    -- Non-terminal 'rhs'
 ************************************************************************
 -}
 
-corePrepPgm :: HscEnv -> Module -> ModLocation -> CoreProgram -> [TyCon]
+data CorePrepPgmConfig = CorePrepPgmConfig
+  { cpPgm_endPassConfig     :: !EndPassConfig
+  , cpPgm_generateDebugInfo :: !Bool
+  }
+
+corePrepPgm :: Logger
+            -> CorePrepConfig
+            -> CorePrepPgmConfig
+            -> Module -> ModLocation -> CoreProgram -> [TyCon]
             -> IO CoreProgram
-corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
+corePrepPgm logger cp_cfg pgm_cfg
+            this_mod mod_loc binds data_tycons =
     withTiming logger
                (text "CorePrep"<+>brackets (ppr this_mod))
                (\a -> a `seqList` ()) $ do
     us <- mkSplitUniqSupply 's'
-    initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
+    let initialCorePrepEnv = mkInitialCorePrepEnv cp_cfg
 
     let
-        implicit_binds = mkDataConWorkers dflags mod_loc data_tycons
+        implicit_binds = mkDataConWorkers
+          (cpPgm_generateDebugInfo pgm_cfg)
+          mod_loc data_tycons
             -- NB: we must feed mkImplicitBinds through corePrep too
             -- so that they are suitably cloned and eta-expanded
 
@@ -253,18 +263,15 @@ corePrepPgm hsc_env this_mod mod_loc binds data_tycons =
                       floats2 <- corePrepTopBinds initialCorePrepEnv implicit_binds
                       return (deFloatTop (floats1 `appendFloats` floats2))
 
-    endPassHscEnvIO hsc_env alwaysQualify CorePrep binds_out []
+    endPassIO logger (cpPgm_endPassConfig pgm_cfg)
+              alwaysQualify CorePrep binds_out []
     return binds_out
-  where
-    dflags = hsc_dflags hsc_env
-    logger = hsc_logger hsc_env
 
-corePrepExpr :: HscEnv -> CoreExpr -> IO CoreExpr
-corePrepExpr hsc_env expr = do
-    let logger = hsc_logger hsc_env
+corePrepExpr :: Logger -> CorePrepConfig -> CoreExpr -> IO CoreExpr
+corePrepExpr logger config expr = do
     withTiming logger (text "CorePrep [expr]") (\e -> e `seq` ()) $ do
       us <- mkSplitUniqSupply 's'
-      initialCorePrepEnv <- mkInitialCorePrepEnv hsc_env
+      let initialCorePrepEnv = mkInitialCorePrepEnv config
       let new_expr = initUs_ us (cpeBodyNF initialCorePrepEnv expr)
       putDumpFileMaybe logger Opt_D_dump_prep "CorePrep" FormatCore (ppr new_expr)
       return new_expr
@@ -283,10 +290,10 @@ corePrepTopBinds initialCorePrepEnv binds
                                floatss <- go env' binds
                                return (floats `appendFloats` floatss)
 
-mkDataConWorkers :: DynFlags -> ModLocation -> [TyCon] -> [CoreBind]
+mkDataConWorkers :: Bool -> ModLocation -> [TyCon] -> [CoreBind]
 -- See Note [Data constructor workers]
 -- c.f. Note [Injecting implicit bindings] in GHC.Iface.Tidy
-mkDataConWorkers dflags mod_loc data_tycons
+mkDataConWorkers generate_debug_info mod_loc data_tycons
   = [ NonRec id (tick_it (getName data_con) (Var id))
                                 -- The ice is thin here, but it works
     | tycon <- data_tycons,     -- CorePrep will eta-expand it
@@ -297,11 +304,12 @@ mkDataConWorkers dflags mod_loc data_tycons
    -- If we want to generate debug info, we put a source note on the
    -- worker. This is useful, especially for heap profiling.
    tick_it name
-     | not (needSourceNotes dflags)           = id
+     | not generate_debug_info               = id
      | RealSrcSpan span _ <- nameSrcSpan name = tick span
      | Just file <- ml_hs_file mod_loc       = tick (span1 file)
      | otherwise                             = tick (span1 "???")
-     where tick span  = Tick (SourceNote span $ showSDoc dflags (ppr name))
+     where tick span  = Tick $ SourceNote span $
+             renderWithContext defaultSDocContext $ ppr name
            span1 file = realSrcLocSpan $ mkRealSrcLoc (mkFastString file) 1 1
 
 {-
@@ -774,7 +782,7 @@ cpeRhsE env (Type ty)
 cpeRhsE env (Coercion co)
   = return (emptyFloats, Coercion (cpSubstCo env co))
 cpeRhsE env expr@(Lit (LitNumber nt i))
-   = case cpe_convertNumLit env nt i of
+   = case cp_convertNumLit (cpe_config env) nt i of
       Nothing -> return (emptyFloats, expr)
       Just e  -> cpeRhsE env e
 cpeRhsE _env expr@(Lit {}) = return (emptyFloats, expr)
@@ -848,13 +856,7 @@ cpeRhsE env (Case scrut bndr ty alts)
   = do { (floats, scrut') <- cpeBody env scrut
        ; (env', bndr2) <- cpCloneBndr env bndr
        ; let alts'
-                 -- This flag is intended to aid in debugging strictness
-                 -- analysis bugs. These are particularly nasty to chase down as
-                 -- they may manifest as segmentation faults. When this flag is
-                 -- enabled we instead produce an 'error' expression to catch
-                 -- the case where a function we think should bottom
-                 -- unexpectedly returns.
-               | gopt Opt_CatchNonexhaustiveCases (cpe_dynFlags env)
+               | cp_catchNonexhaustiveCases $ cpe_config env
                , not (altsAreExhaustive alts)
                = addDefault alts (Just err)
                | otherwise = alts
@@ -1906,8 +1908,25 @@ map to CoreExprs, not Ids.
 
 -}
 
+data CorePrepConfig = CorePrepConfig
+  { cp_catchNonexhaustiveCases :: !Bool
+  -- ^ Whether to generate a default alternative with ``error`` in these
+  -- cases. This is helpful when debugging demand analysis or type
+  -- checker bugs which can sometimes manifest as segmentation faults.
+
+  , cp_convertNumLit           :: !(LitNumType -> Integer -> Maybe CoreExpr)
+  -- ^ Convert some numeric literals (Integer, Natural) into their final
+  -- Core form.
+  }
+
 data CorePrepEnv
-  = CPE { cpe_dynFlags        :: DynFlags
+  = CPE { cpe_config          :: !CorePrepConfig
+        -- ^ This flag is intended to aid in debugging strictness
+        -- analysis bugs. These are particularly nasty to chase down as
+        -- they may manifest as segmentation faults. When this flag is
+        -- enabled we instead produce an 'error' expression to catch
+        -- the case where a function we think should bottom
+        -- unexpectedly returns.
         , cpe_env             :: IdEnv CoreExpr   -- Clone local Ids
         -- ^ This environment is used for three operations:
         --
@@ -1922,20 +1941,13 @@ data CorePrepEnv
         --      and Note [CorePrep inlines trivial CoreExpr not Id] (#12076)
 
         , cpe_tyco_env :: Maybe CpeTyCoEnv -- See Note [CpeTyCoEnv]
-
-        , cpe_convertNumLit   :: LitNumType -> Integer -> Maybe CoreExpr
-        -- ^ Convert some numeric literals (Integer, Natural) into their
-        -- final Core form
     }
 
-mkInitialCorePrepEnv :: HscEnv -> IO CorePrepEnv
-mkInitialCorePrepEnv hsc_env = do
-   convertNumLit <- mkConvertNumLiteral hsc_env
-   return $ CPE
-      { cpe_dynFlags      = hsc_dflags hsc_env
+mkInitialCorePrepEnv :: CorePrepConfig -> CorePrepEnv
+mkInitialCorePrepEnv cfg = CPE
+      { cpe_config        = cfg
       , cpe_env           = emptyVarEnv
       , cpe_tyco_env      = Nothing
-      , cpe_convertNumLit = convertNumLit
       }
 
 extendCorePrepEnv :: CorePrepEnv -> Id -> Id -> CorePrepEnv
@@ -2206,13 +2218,12 @@ wrapTicks (Floats flag floats0) expr =
 
 -- | Create a function that converts Bignum literals into their final CoreExpr
 mkConvertNumLiteral
-   :: HscEnv
+   :: Platform
+   -> HomeUnit
+   -> (Name -> IO TyThing)
    -> IO (LitNumType -> Integer -> Maybe CoreExpr)
-mkConvertNumLiteral hsc_env = do
+mkConvertNumLiteral platform home_unit lookup_global = do
    let
-      dflags   = hsc_dflags hsc_env
-      platform = targetPlatform dflags
-      home_unit = hsc_home_unit hsc_env
       guardBignum act
          | isHomeUnitInstanceOf home_unit primUnitId
          = return $ panic "Bignum literals are not supported in ghc-prim"
@@ -2220,7 +2231,7 @@ mkConvertNumLiteral hsc_env = do
          = return $ panic "Bignum literals are not supported in ghc-bignum"
          | otherwise = act
 
-      lookupBignumId n      = guardBignum (tyThingId <$> lookupGlobal hsc_env n)
+      lookupBignumId n      = guardBignum (tyThingId <$> lookup_global n)
 
    -- The lookup is done here but the failure (panic) is reported lazily when we
    -- try to access the `bigNatFromWordList` function.
@@ -2237,8 +2248,6 @@ mkConvertNumLiteral hsc_env = do
 
       convertBignatPrim i =
          let
-            target    = targetPlatform dflags
-
             -- ByteArray# literals aren't supported (yet). Were they supported,
             -- we would use them directly. We would need to handle
             -- wordSize/endianness conversion between host and target
@@ -2254,7 +2263,7 @@ mkConvertNumLiteral hsc_env = do
                   f x = let low  = x .&. mask
                             high = x `shiftR` bits
                         in Just (mkConApp wordDataCon [Lit (mkLitWord platform low)], high)
-                  bits = platformWordSizeInBits target
+                  bits = platformWordSizeInBits platform
                   mask = 2 ^ bits - 1
 
          in mkApps (Var bignatFromWordListId) [words]
diff --git a/compiler/GHC/Driver/Config/Core/Lint.hs b/compiler/GHC/Driver/Config/Core/Lint.hs
index d7d26a9718..e96aedaf8e 100644
--- a/compiler/GHC/Driver/Config/Core/Lint.hs
+++ b/compiler/GHC/Driver/Config/Core/Lint.hs
@@ -4,6 +4,7 @@ module GHC.Driver.Config.Core.Lint
   , lintPassResult
   , lintCoreBindings
   , lintInteractiveExpr
+  , initEndPassConfig
   , initLintPassResultConfig
   , initLintConfig
   ) where
@@ -27,7 +28,6 @@ import GHC.Runtime.Context
 
 import GHC.Data.Bag
 
-import GHC.Utils.Logger
 import GHC.Utils.Outputable as Outputable
 
 {-
@@ -38,14 +38,9 @@ before and after core passes, and do Core Lint when necessary.
 
 endPass :: CoreToDo -> CoreProgram -> [CoreRule] -> CoreM ()
 endPass pass binds rules
-  = do { logger <- getLogger
-       ; m_ic <- getInteractiveContext
-       ; dflags <- getDynFlags
-       ; let dump_core_sizes = not (gopt Opt_SuppressCoreSizes dflags)
+  = do { hsc_env <- getHscEnv
        ; print_unqual <- getPrintUnqualified
-       ; liftIO $ endPassIO logger
-           (initLintPassResultConfig m_ic dflags)
-           dump_core_sizes (gopt Opt_DoCoreLinting dflags)
+       ; liftIO $ endPassHscEnvIO hsc_env
            print_unqual pass binds rules
        }
 
@@ -53,11 +48,9 @@ endPassHscEnvIO :: HscEnv -> PrintUnqualified
           -> CoreToDo -> CoreProgram -> [CoreRule] -> IO ()
 endPassHscEnvIO hsc_env print_unqual pass binds rules
   = do { let dflags  = hsc_dflags hsc_env
-       ; let dump_core_sizes = not (gopt Opt_SuppressCoreSizes dflags)
        ; endPassIO
            (hsc_logger hsc_env)
-           (initLintPassResultConfig (hsc_IC hsc_env) dflags)
-           dump_core_sizes (gopt Opt_DoCoreLinting dflags)
+           (initEndPassConfig (hsc_IC hsc_env) dflags)
            print_unqual pass binds rules
        }
 
@@ -96,12 +89,20 @@ lintInteractiveExpr what hsc_env expr
     dflags = hsc_dflags hsc_env
     logger = hsc_logger hsc_env
 
+initEndPassConfig :: InteractiveContext -> DynFlags -> EndPassConfig
+initEndPassConfig ic dflags = EndPassConfig
+  { ep_dumpCoreSizes = not (gopt Opt_SuppressCoreSizes dflags)
+  , ep_lintPassResult = if gopt Opt_DoCoreLinting dflags
+      then Just $ initLintPassResultConfig ic dflags
+      else Nothing
+  }
+
 initLintPassResultConfig :: InteractiveContext -> DynFlags -> LintPassResultConfig
 initLintPassResultConfig ic dflags = LintPassResultConfig
-  { endPass_diagOpts      = initDiagOpts dflags
-  , endPass_platform      = targetPlatform dflags
-  , endPass_makeLinkFlags = perPassFlags dflags
-  , endPass_localsInScope = interactiveInScope ic
+  { lpr_diagOpts      = initDiagOpts dflags
+  , lpr_platform      = targetPlatform dflags
+  , lpr_makeLintFlags = perPassFlags dflags
+  , lpr_localsInScope = interactiveInScope ic
   }
 
 perPassFlags :: DynFlags -> CoreToDo -> LintFlags
diff --git a/compiler/GHC/Driver/Config/CoreToStg/Prep.hs b/compiler/GHC/Driver/Config/CoreToStg/Prep.hs
new file mode 100644
index 0000000000..a0dab03519
--- /dev/null
+++ b/compiler/GHC/Driver/Config/CoreToStg/Prep.hs
@@ -0,0 +1,32 @@
+module GHC.Driver.Config.CoreToStg.Prep
+  ( initCorePrepConfig
+  , initCorePrepPgmConfig
+  ) where
+
+import GHC.Prelude
+
+import GHC.Driver.Env
+import GHC.Driver.Session
+import GHC.Driver.Config.Core.Lint
+import GHC.Runtime.Context ( InteractiveContext )
+import GHC.Tc.Utils.Env
+
+import GHC.CoreToStg.Prep
+
+initCorePrepConfig :: HscEnv -> IO CorePrepConfig
+initCorePrepConfig hsc_env = do
+   convertNumLit <- do
+     let platform = targetPlatform $ hsc_dflags hsc_env
+         home_unit = hsc_home_unit hsc_env
+         lookup_global = lookupGlobal hsc_env
+     mkConvertNumLiteral platform home_unit lookup_global
+   return $ CorePrepConfig
+      { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env
+      , cp_convertNumLit = convertNumLit
+      }
+
+initCorePrepPgmConfig :: InteractiveContext -> DynFlags -> CorePrepPgmConfig
+initCorePrepPgmConfig ic dflags = CorePrepPgmConfig
+  { cpPgm_endPassConfig     = initEndPassConfig ic dflags
+  , cpPgm_generateDebugInfo = needSourceNotes dflags
+  }
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 7db9b62331..2936630db8 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -113,6 +113,7 @@ import GHC.Driver.Errors.Types
 import GHC.Driver.CodeOutput
 import GHC.Driver.Config.Cmm.Parser (initCmmParserConfig)
 import GHC.Driver.Config.Core.Lint ( endPassHscEnvIO, lintInteractiveExpr )
+import GHC.Driver.Config.CoreToStg.Prep
 import GHC.Driver.Config.Logger   (initLogFlags)
 import GHC.Driver.Config.Parser   (initParserOpts)
 import GHC.Driver.Config.Stg.Ppr  (initStgPprOpts)
@@ -1689,9 +1690,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" #-}
-                       corePrepPgm hsc_env this_mod location
-                                   core_binds data_tycons
+        (prepd_binds) <- {-# SCC "CorePrep" #-} do
+          cp_cfg <- initCorePrepConfig hsc_env
+          corePrepPgm
+            (hsc_logger hsc_env)
+            cp_cfg
+            (initCorePrepPgmConfig (hsc_IC hsc_env) (hsc_dflags hsc_env))
+            this_mod location core_binds data_tycons
 
         -----------------  Convert to STG ------------------
         (stg_binds, denv, (caf_ccs, caf_cc_stacks))
@@ -1768,8 +1773,13 @@ hscInteractive hsc_env cgguts location = do
     -------------------
     -- PREPARE FOR CODE GENERATION
     -- Do saturation and convert to A-normal form
-    prepd_binds <- {-# SCC "CorePrep" #-}
-                   corePrepPgm hsc_env this_mod location core_binds data_tycons
+    prepd_binds <- {-# SCC "CorePrep" #-} do
+      cp_cfg <- initCorePrepConfig hsc_env
+      corePrepPgm
+        (hsc_logger hsc_env)
+        cp_cfg
+        (initCorePrepPgmConfig (hsc_IC hsc_env) (hsc_dflags hsc_env))
+        this_mod location core_binds data_tycons
 
     (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks)
       <- {-# SCC "CoreToStg" #-}
@@ -2110,8 +2120,13 @@ 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 $ corePrepPgm hsc_env this_mod iNTERACTIVELoc core_binds data_tycons
+    prepd_binds <- {-# SCC "CorePrep" #-} liftIO $ do
+      cp_cfg <- initCorePrepConfig hsc_env
+      corePrepPgm
+        (hsc_logger hsc_env)
+        cp_cfg
+        (initCorePrepPgmConfig (hsc_IC hsc_env) (hsc_dflags hsc_env))
+        this_mod iNTERACTIVELoc core_binds data_tycons
 
     (stg_binds, _infotable_prov, _caf_ccs__caf_cc_stacks)
         <- {-# SCC "CoreToStg" #-}
@@ -2327,7 +2342,10 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
          ; let tidy_expr = tidyExpr emptyTidyEnv simpl_expr
 
            {- Prepare for codegen -}
-         ; prepd_expr <- corePrepExpr hsc_env tidy_expr
+         ; cp_cfg <- initCorePrepConfig hsc_env
+         ; prepd_expr <- corePrepExpr
+            (hsc_logger hsc_env) cp_cfg
+            tidy_expr
 
            {- Lint if necessary -}
          ; lintInteractiveExpr (text "hscCompileExpr") hsc_env prepd_expr
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 2bc5acba4f..bc38dbeaa8 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -402,6 +402,7 @@ Library
         GHC.Driver.Config.Core.Opt.LiberateCase
         GHC.Driver.Config.Core.Opt.WorkWrap
         GHC.Driver.Config.Core.Rules
+        GHC.Driver.Config.CoreToStg.Prep
         GHC.Driver.Config.Diagnostic
         GHC.Driver.Config.Finder
         GHC.Driver.Config.HsToCore