Purge `DynFlags` and `HscEnv` from some `GHC.Core` modules where it's not too hardwip/dflags-core-opt-easier

Progress towards #17957

Because of `CoreM`, I did not move the `DynFlags` and `HscEnv` to other
modules as thoroughly as I usually do. This does mean that risk of
`DynFlags` "creeping back in" is higher than it usually is.

After we do the same process to the other Core passes, and then figure
out what we want to do about `CoreM`, we can finish the job started
here.

That is a good deal more work, however, so it certainly makes sense to
land this now.

17 files changed, 127 insertions, 110 deletions

diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs
index 36fa6e2673..c3f861e2f9 100644
--- a/compiler/GHC/Core.hs
+++ b/compiler/GHC/Core.hs
@@ -85,7 +85,7 @@ module GHC.Core (
         -- * Core rule data types
         CoreRule(..), RuleBase,
         RuleName, RuleFun, IdUnfoldingFun, InScopeEnv,
-        RuleEnv(..), RuleOpts(..), mkRuleEnv, emptyRuleEnv,
+        RuleEnv(..), RuleOpts, mkRuleEnv, emptyRuleEnv,
 
         -- ** Operations on 'CoreRule's
         ruleArity, ruleName, ruleIdName, ruleActivation,
@@ -100,6 +100,7 @@ import GHC.Types.Var.Env( InScopeSet )
 import GHC.Types.Var
 import GHC.Core.Type
 import GHC.Core.Coercion
+import GHC.Core.Rules.Config ( RuleOpts )
 import GHC.Types.Name
 import GHC.Types.Name.Set
 import GHC.Types.Name.Env( NameEnv )
@@ -1201,14 +1202,6 @@ data CoreRule
     }
                 -- See Note [Extra args in the target] in GHC.Core.Rules
 
--- | Rule options
-data RuleOpts = RuleOpts
-   { roPlatform                :: !Platform -- ^ Target platform
-   , roNumConstantFolding      :: !Bool     -- ^ Enable more advanced numeric constant folding
-   , roExcessRationalPrecision :: !Bool     -- ^ Cut down precision of Rational values to that of Float/Double if disabled
-   , roBignumRules             :: !Bool     -- ^ Enable rules for bignums
-   }
-
 -- | The 'InScopeSet' in the 'InScopeEnv' is a /superset/ of variables that are
 -- currently in scope. See Note [The InScopeSet invariant].
 type RuleFun = RuleOpts -> InScopeEnv -> Id -> [CoreExpr] -> Maybe CoreExpr
diff --git a/compiler/GHC/Core/Opt/CallerCC.hs b/compiler/GHC/Core/Opt/CallerCC.hs
index e8ac5a7cff..ba9f809092 100644
--- a/compiler/GHC/Core/Opt/CallerCC.hs
+++ b/compiler/GHC/Core/Opt/CallerCC.hs
@@ -27,7 +27,6 @@ import qualified Text.ParserCombinators.ReadP as P
 import GHC.Prelude
 import GHC.Utils.Outputable as Outputable
 import GHC.Driver.Session
-import GHC.Driver.Ppr
 import GHC.Types.CostCentre
 import GHC.Types.CostCentre.State
 import GHC.Types.Name hiding (varName)
@@ -52,7 +51,7 @@ addCallerCostCentres guts = do
       env = Env
         { thisModule = mg_module guts
         , ccState = newCostCentreState
-        , dflags = dflags
+        , countEntries = gopt Opt_ProfCountEntries dflags
         , revParents = []
         , filters = filters
         }
@@ -78,9 +77,9 @@ doExpr env e@(Var v)
           hcat (punctuate dot (map ppr (parents env))) <> parens (text "calling:" <> ppr v)
 
         ccName :: CcName
-        ccName = mkFastString $ showSDoc (dflags env) nameDoc
+        ccName = mkFastString $ renderWithContext defaultSDocContext nameDoc
     ccIdx <- getCCIndex' ccName
-    let count = gopt Opt_ProfCountEntries (dflags env)
+    let count = countEntries env
         span = case revParents env of
           top:_ -> nameSrcSpan $ varName top
           _     -> noSrcSpan
@@ -109,7 +108,7 @@ getCCIndex' name = state (getCCIndex name)
 
 data Env = Env
   { thisModule  :: Module
-  , dflags      :: DynFlags
+  , countEntries :: !Bool
   , ccState     :: CostCentreState
   , revParents  :: [Id]
   , filters     :: [CallerCcFilter]
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index 1904344788..c2fc84687e 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -49,6 +49,7 @@ import GHC.Core.DataCon ( DataCon,dataConTagZ, dataConTyCon, dataConWrapId, data
 import GHC.Core.Utils  ( cheapEqExpr, exprIsHNF, exprType
                        , stripTicksTop, stripTicksTopT, mkTicks )
 import GHC.Core.Multiplicity
+import GHC.Core.Rules.Config
 import GHC.Core.Type
 import GHC.Core.TyCon
    ( tyConDataCons_maybe, isAlgTyCon, isEnumerationTyCon
@@ -1835,12 +1836,12 @@ dataToTagRule = a `mplus` b
     --   dataToTag x
     -- where x's unfolding is a constructor application
     b = do
-      dflags <- getPlatform
+      platform <- getPlatform
       [_, val_arg] <- getArgs
       in_scope <- getInScopeEnv
       (_,floats, dc,_,_) <- liftMaybe $ exprIsConApp_maybe in_scope val_arg
       massert (not (isNewTyCon (dataConTyCon dc)))
-      return $ wrapFloats floats (mkIntVal dflags (toInteger (dataConTagZ dc)))
+      return $ wrapFloats floats (mkIntVal platform (toInteger (dataConTagZ dc)))
 
 {- Note [dataToTag# magic]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs
index 3f6455c9cf..f6120d64b8 100644
--- a/compiler/GHC/Core/Opt/CprAnal.hs
+++ b/compiler/GHC/Core/Opt/CprAnal.hs
@@ -10,7 +10,7 @@ module GHC.Core.Opt.CprAnal ( cprAnalProgram ) where
 
 import GHC.Prelude
 
-import GHC.Driver.Session
+import GHC.Driver.Flags ( DumpFlag (..) )
 
 import GHC.Builtin.Names ( runRWKey )
 
diff --git a/compiler/GHC/Core/Opt/FloatOut.hs b/compiler/GHC/Core/Opt/FloatOut.hs
index 19b687a4a3..362cab0056 100644
--- a/compiler/GHC/Core/Opt/FloatOut.hs
+++ b/compiler/GHC/Core/Opt/FloatOut.hs
@@ -18,7 +18,7 @@ import GHC.Core.Make
 import GHC.Core.Opt.Arity ( exprArity, etaExpand )
 import GHC.Core.Opt.Monad ( FloatOutSwitches(..) )
 
-import GHC.Driver.Session
+import GHC.Driver.Flags  ( DumpFlag (..) )
 import GHC.Utils.Logger
 import GHC.Types.Id      ( Id, idArity, idType, isDeadEndId,
                            isJoinId, isJoinId_maybe )
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index ef9f851e61..4182be9fb9 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -27,7 +27,8 @@ module GHC.Core.Opt.Monad (
     CoreM, runCoreM,
 
     -- ** Reading from the monad
-    getHscEnv, getRuleBase, getModule,
+    getHscEnv, getModule,
+    getRuleBase, getExternalRuleBase,
     getDynFlags, getPackageFamInstEnv,
     getVisibleOrphanMods, getUniqMask,
     getPrintUnqualified, getSrcSpanM,
@@ -707,6 +708,9 @@ getHscEnv = read cr_hsc_env
 getRuleBase :: CoreM RuleBase
 getRuleBase = read cr_rule_base
 
+getExternalRuleBase :: CoreM RuleBase
+getExternalRuleBase = eps_rule_base <$> get_eps
+
 getVisibleOrphanMods :: CoreM ModuleSet
 getVisibleOrphanMods = read cr_visible_orphan_mods
 
@@ -734,10 +738,12 @@ instance HasModule CoreM where
     getModule = read cr_module
 
 getPackageFamInstEnv :: CoreM PackageFamInstEnv
-getPackageFamInstEnv = do
+getPackageFamInstEnv = eps_fam_inst_env <$> get_eps
+
+get_eps :: CoreM ExternalPackageState
+get_eps = do
     hsc_env <- getHscEnv
-    eps <- liftIO $ hscEPS hsc_env
-    return $ eps_fam_inst_env eps
+    liftIO $ hscEPS hsc_env
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Core/Opt/Monad.hs-boot b/compiler/GHC/Core/Opt/Monad.hs-boot
deleted file mode 100644
index b92602dc59..0000000000
--- a/compiler/GHC/Core/Opt/Monad.hs-boot
+++ /dev/null
@@ -1,30 +0,0 @@
--- Created this hs-boot file to remove circular dependencies from the use of
--- Plugins. Plugins needs CoreToDo and CoreM types to define core-to-core
--- transformations.
--- However GHC.Core.Opt.Monad does much more than defining these, and because Plugins are
--- activated in various modules, the imports become circular. To solve this I
--- extracted CoreToDo and CoreM into this file.
--- I needed to write the whole definition of these types, otherwise it created
--- a data-newtype conflict.
-
-module GHC.Core.Opt.Monad ( CoreToDo, CoreM ) where
-
-import GHC.Prelude
-
-import GHC.Data.IOEnv ( IOEnv )
-
-type CoreIOEnv = IOEnv CoreReader
-
-data CoreReader
-
-newtype CoreWriter = CoreWriter {
-        cw_simpl_count :: SimplCount
-}
-
-data SimplCount
-
-newtype CoreM a = CoreM { unCoreM :: CoreIOEnv (a, CoreWriter) }
-
-instance Monad CoreM
-
-data CoreToDo
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 1e336532eb..93e113cd89 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -15,13 +15,14 @@ import GHC.Driver.Plugins ( withPlugins, installCoreToDos )
 import GHC.Driver.Env
 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, initRuleOpts )
+                          getRules )
 import GHC.Core.Ppr     ( pprCoreBindings, pprCoreExpr )
 import GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr )
 import GHC.Core.Stats   ( coreBindsSize, coreBindsStats, exprSize )
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index f87a28f440..f052bae942 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -43,9 +43,11 @@ import GHC.Core.Opt.Arity ( ArityType, exprArity, getBotArity
                           , typeArity, arityTypeArity, etaExpandAT )
 import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
 import GHC.Core.FVs     ( mkRuleInfo )
-import GHC.Core.Rules   ( lookupRule, getRules, initRuleOpts )
+import GHC.Core.Rules   ( lookupRule, getRules )
 import GHC.Core.Multiplicity
 
+import GHC.Driver.Config.Core.Rules ( initRuleOpts )
+
 import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporarily commented out. See #8326
 import GHC.Types.SourceText
 import GHC.Types.Id
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index c07b8ae954..8b303f0316 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -799,7 +799,7 @@ specConstrProgram guts
       this_mod <- getModule
       let binds' = reverse $ fst $ initUs us $ do
                     -- Note [Top-level recursive groups]
-                    (env, binds) <- goEnv (initScEnv dflags this_mod annos)
+                    (env, binds) <- goEnv (initScEnv (initScOpts dflags this_mod) annos)
                                           (mg_binds guts)
                         -- binds is identical to (mg_binds guts), except that the
                         -- binders on the LHS have been replaced by extendBndr
@@ -904,24 +904,38 @@ scrutinised in the body.  True <=> ignore that, and specialise whenever
 the function is applied to a data constructor.
 -}
 
-data ScEnv = SCE { sc_dflags    :: DynFlags,
-                   sc_uf_opts   :: !UnfoldingOpts, -- ^ Unfolding options
-                   sc_module    :: !Module,
-                   sc_size      :: Maybe Int,   -- Size threshold
-                                                -- Nothing => no limit
+-- | Options for Specializing over constructors in Core.
+data SpecConstrOpts = SpecConstrOpts
+  { sc_max_args  :: !Int
+  -- ^ The threshold at which a worker-wrapper transformation used as part of
+  -- this pass will no longer happen, measured in the number of arguments.
 
-                   sc_count     :: Maybe Int,   -- Max # of specialisations for any one fn
-                                                -- Nothing => no limit
-                                                -- See Note [Avoiding exponential blowup]
+  , sc_debug     :: !Bool
+  -- ^ Whether to print debug information
 
-                   sc_recursive :: Int,         -- Max # of specialisations over recursive type.
-                                                -- Stops ForceSpecConstr from diverging.
+  , sc_uf_opts   :: !UnfoldingOpts
+  -- ^ Unfolding options
 
-                   sc_keen     :: Bool,         -- Specialise on arguments that are known
-                                                -- constructors, even if they are not
-                                                -- scrutinised in the body.  See
-                                                -- Note [Making SpecConstr keener]
+  , sc_module    :: !Module
+  -- ^ The name of the module being processed
 
+  , sc_size      :: !(Maybe Int)
+  -- ^ Size threshold: Nothing => no limit
+
+  , sc_count     :: !(Maybe Int)
+  -- ^ Max # of specialisations for any one function. Nothing => no limit.
+  -- See Note [Avoiding exponential blowup].
+
+  , sc_recursive :: !Int
+  -- ^ Max # of specialisations over recursive type. Stops
+  -- ForceSpecConstr from diverging.
+
+  , sc_keen      :: !Bool
+  -- ^ Specialise on arguments that are known constructors, even if they are
+  -- not scrutinised in the body. See Note [Making SpecConstr keener].
+  }
+
+data ScEnv = SCE { sc_opts      :: !SpecConstrOpts,
                    sc_force     :: Bool,        -- Force specialisation?
                                                 -- See Note [Forcing specialisation]
 
@@ -957,15 +971,21 @@ instance Outputable Value where
    ppr LambdaVal         = text "<Lambda>"
 
 ---------------------
-initScEnv :: DynFlags -> Module -> UniqFM Name SpecConstrAnnotation -> ScEnv
-initScEnv dflags this_mod anns
-  = SCE { sc_dflags      = dflags,
+initScOpts :: DynFlags -> Module -> SpecConstrOpts
+initScOpts dflags this_mod = SpecConstrOpts
+        { sc_max_args    = maxWorkerArgs dflags,
+          sc_debug       = hasPprDebug dflags,
           sc_uf_opts     = unfoldingOpts dflags,
           sc_module      = this_mod,
           sc_size        = specConstrThreshold dflags,
           sc_count       = specConstrCount     dflags,
           sc_recursive   = specConstrRecursive dflags,
-          sc_keen        = gopt Opt_SpecConstrKeen dflags,
+          sc_keen        = gopt Opt_SpecConstrKeen dflags
+        }
+
+initScEnv :: SpecConstrOpts -> UniqFM Name SpecConstrAnnotation -> ScEnv
+initScEnv opts anns
+  = SCE { sc_opts        = opts,
           sc_force       = False,
           sc_subst       = emptySubst,
           sc_how_bound   = emptyVarEnv,
@@ -1091,9 +1111,12 @@ decreaseSpecCount :: ScEnv -> Int -> ScEnv
 -- See Note [Avoiding exponential blowup]
 decreaseSpecCount env n_specs
   = env { sc_force = False   -- See Note [Forcing specialisation]
-        , sc_count = case sc_count env of
+        , sc_opts = (sc_opts env)
+            { sc_count = case sc_count $ sc_opts env of
                        Nothing -> Nothing
-                       Just n  -> Just (n `div` (n_specs + 1)) }
+                       Just n  -> Just $! (n `div` (n_specs + 1))
+            }
+        }
         -- The "+1" takes account of the original function;
         -- See Note [Avoiding exponential blowup]
 
@@ -1506,9 +1529,9 @@ scTopBindEnv env (NonRec bndr rhs)
 scTopBind :: ScEnv -> ScUsage -> CoreBind -> UniqSM (ScUsage, CoreBind)
 
 scTopBind env body_usage (Rec prs)
-  | Just threshold <- sc_size env
+  | Just threshold <- sc_size $ sc_opts env
   , not force_spec
-  , not (all (couldBeSmallEnoughToInline (sc_uf_opts env) threshold) rhss)
+  , not (all (couldBeSmallEnoughToInline (sc_uf_opts $ sc_opts env) threshold) rhss)
                 -- No specialisation
   = -- pprTrace "scTopBind: nospec" (ppr bndrs) $
     do  { (rhs_usgs, rhss')   <- mapAndUnzipM (scExpr env) rhss
@@ -1623,6 +1646,7 @@ specRec :: TopLevelFlag -> ScEnv
 specRec top_lvl env body_usg rhs_infos
   = go 1 seed_calls nullUsage init_spec_infos
   where
+    opts = sc_opts env
     (seed_calls, init_spec_infos)    -- Note [Seeding top-level recursive groups]
        | isTopLevel top_lvl
        , any (isExportedId . ri_fn) rhs_infos   -- Seed from body and RHSs
@@ -1652,8 +1676,8 @@ specRec top_lvl env body_usg rhs_infos
 
       -- Limit recursive specialisation
       -- See Note [Limit recursive specialisation]
-      | n_iter > sc_recursive env  -- Too many iterations of the 'go' loop
-      , sc_force env || isNothing (sc_count env)
+      | n_iter > sc_recursive opts  -- Too many iterations of the 'go' loop
+      , sc_force env || isNothing (sc_count opts)
            -- If both of these are false, the sc_count
            -- threshold will prevent non-termination
       , any ((> the_limit) . si_n_specs) spec_infos
@@ -1672,7 +1696,7 @@ specRec top_lvl env body_usg rhs_infos
             ; go (n_iter + 1) (scu_calls extra_usg) all_usg new_spec_infos }
 
     -- See Note [Limit recursive specialisation]
-    the_limit = case sc_count env of
+    the_limit = case sc_count opts of
                   Nothing  -> 10    -- Ugh!
                   Just max -> max
 
@@ -1860,7 +1884,7 @@ spec_one env fn arg_bndrs body (call_pat, rule_number)
                               -- since `length(qvars) + void + length(extra_bndrs) = length spec_call_args`
                               dropTail (length extra_bndrs) spec_call_args
               inline_act = idInlineActivation fn
-              this_mod   = sc_module env
+              this_mod   = sc_module $ sc_opts env
               rule       = mkRule this_mod True {- Auto -} True {- Local -}
                                   rule_name inline_act fn_name qvars pats rule_rhs
                            -- See Note [Transfer activation]
@@ -2205,9 +2229,8 @@ callsToNewPats env fn spec_info@(SI { si_specs = done_specs }) bndr_occs calls
 
               -- Remove ones that have too many worker variables
               small_pats = filterOut too_big non_dups
-              max_args = maxWorkerArgs (sc_dflags env)
               too_big (CP { cp_qvars = vars, cp_args = args })
-                = not (isWorkerSmallEnough max_args (valArgCount args) vars)
+                = not (isWorkerSmallEnough (sc_max_args $ sc_opts env) (valArgCount args) vars)
                   -- We are about to construct w/w pair in 'spec_one'.
                   -- Omit specialisation leading to high arity workers.
                   -- See Note [Limit w/w arity] in GHC.Core.Opt.WorkWrap.Utils
@@ -2244,7 +2267,7 @@ trim_pats env fn (SI { si_n_specs = done_spec_count }) pats
     n_pats         = length pats
     spec_count'    = n_pats + done_spec_count
     n_remaining    = max_specs - done_spec_count
-    mb_scc         = sc_count env
+    mb_scc         = sc_count $ sc_opts env
     Just max_specs = mb_scc
 
     sorted_pats = map fst $
@@ -2269,7 +2292,7 @@ trim_pats env fn (SI { si_n_specs = done_spec_count }) pats
           n_cons _           = 0
 
     emit_trace result
-       | debugIsOn || hasPprDebug (sc_dflags env)
+       | debugIsOn || sc_debug (sc_opts env)
          -- Suppress this scary message for ordinary users!  #5125
        = pprTrace "SpecConstr" msg result
        | otherwise
@@ -2480,7 +2503,7 @@ argToPat1 env in_scope val_env arg arg_occ _arg_str
     mb_scrut dc = case arg_occ of
                 ScrutOcc bs | Just occs <- lookupUFM bs dc
                             -> Just (occs)  -- See Note [Reboxing]
-                _other      | sc_force env || sc_keen env
+                _other      | sc_force env || sc_keen (sc_opts env)
                             -> Just (repeat UnkOcc)
                             | otherwise
                             -> Nothing
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 1e429a4c1e..74ee8d1f5f 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -16,7 +16,7 @@ import GHC.Driver.Session
 import GHC.Driver.Ppr
 import GHC.Driver.Config
 import GHC.Driver.Config.Diagnostic
-import GHC.Driver.Env
+import GHC.Driver.Config.Core.Rules ( initRuleOpts )
 
 import GHC.Tc.Utils.TcType hiding( substTy )
 
@@ -65,7 +65,6 @@ import GHC.Utils.Trace
 
 import GHC.Unit.Module( Module )
 import GHC.Unit.Module.ModGuts
-import GHC.Unit.External
 import GHC.Core.Unfold
 
 {-
@@ -736,10 +735,9 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _)
   = do {     -- Get rules from the external package state
              -- We keep doing this in case we "page-fault in"
              -- more rules as we go along
-       ; hsc_env <- getHscEnv
-       ; eps <- liftIO $ hscEPS hsc_env
+       ; external_rule_base <- getExternalRuleBase
        ; vis_orphs <- getVisibleOrphanMods
-       ; let rules_for_fn = getRules (RuleEnv [rb, eps_rule_base eps] vis_orphs) fn
+       ; let rules_for_fn = getRules (RuleEnv [rb, external_rule_base] vis_orphs) fn
 
        ; -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs])
        ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls })
diff --git a/compiler/GHC/Core/Rules.hs b/compiler/GHC/Core/Rules.hs
index a8c9cbef5a..451d1ac5c1 100644
--- a/compiler/GHC/Core/Rules.hs
+++ b/compiler/GHC/Core/Rules.hs
@@ -22,15 +22,11 @@ module GHC.Core.Rules (
         -- * Misc. CoreRule helpers
         rulesOfBinds, getRules, pprRulesForUser,
 
-        lookupRule, mkRule, roughTopNames, initRuleOpts
+        lookupRule, mkRule, roughTopNames
     ) where
 
 import GHC.Prelude
 
-import GHC.Driver.Session      ( DynFlags, gopt, targetPlatform, homeUnitId_ )
-import GHC.Driver.Flags
-
-import GHC.Unit.Types    ( primUnitId, bignumUnitId )
 import GHC.Unit.Module   ( Module )
 import GHC.Unit.Module.Env
 
@@ -546,18 +542,6 @@ matchRule _ rule_env is_active _ args rough_args
   | otherwise = matchN rule_env rule_name tpl_vars tpl_args args rhs
 
 
--- | Initialize RuleOpts from DynFlags
-initRuleOpts :: DynFlags -> RuleOpts
-initRuleOpts dflags = RuleOpts
-  { roPlatform                = targetPlatform dflags
-  , roNumConstantFolding      = gopt Opt_NumConstantFolding dflags
-  , roExcessRationalPrecision = gopt Opt_ExcessPrecision dflags
-    -- disable bignum rules in ghc-prim and ghc-bignum itself
-  , roBignumRules             = homeUnitId_ dflags /= primUnitId
-                                && homeUnitId_ dflags /= bignumUnitId
-  }
-
-
 ---------------------------------------
 matchN  :: InScopeEnv
         -> RuleName -> [Var] -> [CoreExpr]
diff --git a/compiler/GHC/Core/Rules/Config.hs b/compiler/GHC/Core/Rules/Config.hs
new file mode 100644
index 0000000000..2ae1e35a67
--- /dev/null
+++ b/compiler/GHC/Core/Rules/Config.hs
@@ -0,0 +1,13 @@
+module GHC.Core.Rules.Config where
+
+import GHC.Prelude
+import GHC.Platform
+
+-- | Rule options
+data RuleOpts = RuleOpts
+   { roPlatform                :: !Platform -- ^ Target platform
+   , roNumConstantFolding      :: !Bool     -- ^ Enable more advanced numeric constant folding
+   , roExcessRationalPrecision :: !Bool     -- ^ Cut down precision of Rational values to that of Float/Double if disabled
+   , roBignumRules             :: !Bool     -- ^ Enable rules for bignums
+   }
+
diff --git a/compiler/GHC/Driver/Config/Core/Rules.hs b/compiler/GHC/Driver/Config/Core/Rules.hs
new file mode 100644
index 0000000000..6663e4be8a
--- /dev/null
+++ b/compiler/GHC/Driver/Config/Core/Rules.hs
@@ -0,0 +1,23 @@
+module GHC.Driver.Config.Core.Rules
+  ( initRuleOpts
+  ) where
+
+import GHC.Prelude
+
+import GHC.Driver.Flags
+import GHC.Driver.Session ( DynFlags, gopt, targetPlatform, homeUnitId_ )
+
+import GHC.Core.Rules.Config
+
+import GHC.Unit.Types     ( primUnitId, bignumUnitId )
+
+-- | Initialize RuleOpts from DynFlags
+initRuleOpts :: DynFlags -> RuleOpts
+initRuleOpts dflags = RuleOpts
+  { roPlatform                = targetPlatform dflags
+  , roNumConstantFolding      = gopt Opt_NumConstantFolding dflags
+  , roExcessRationalPrecision = gopt Opt_ExcessPrecision dflags
+    -- disable bignum rules in ghc-prim and ghc-bignum itself
+  , roBignumRules             = homeUnitId_ dflags /= primUnitId
+                                && homeUnitId_ dflags /= bignumUnitId
+  }
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 74d95cdc65..d757925444 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -335,6 +335,7 @@ Library
         GHC.Core.Predicate
         GHC.Core.Reduction
         GHC.Core.Rules
+        GHC.Core.Rules.Config
         GHC.Core.Seq
         GHC.Core.SimpleOpt
         GHC.Core.Stats
@@ -399,6 +400,7 @@ Library
         GHC.Driver.Config.Core.Opt.Arity
         GHC.Driver.Config.Core.Opt.LiberateCase
         GHC.Driver.Config.Core.Opt.WorkWrap
+        GHC.Driver.Config.Core.Rules
         GHC.Driver.Config.Diagnostic
         GHC.Driver.Config.Finder
         GHC.Driver.Config.HsToCore
diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout
index 31cf9d458a..1cacba20b2 100644
--- a/testsuite/tests/count-deps/CountDepsAst.stdout
+++ b/testsuite/tests/count-deps/CountDepsAst.stdout
@@ -1,4 +1,4 @@
-Found 285 Language.Haskell.Syntax module dependencies
+Found 286 Language.Haskell.Syntax module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.PrimOps.Ids
@@ -46,6 +46,7 @@ GHC.Core.Predicate
 GHC.Core.Reduction
 GHC.Core.RoughMap
 GHC.Core.Rules
+GHC.Core.Rules.Config
 GHC.Core.Seq
 GHC.Core.SimpleOpt
 GHC.Core.Stats
diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout
index b3834a0f92..d6690e7306 100644
--- a/testsuite/tests/count-deps/CountDepsParser.stdout
+++ b/testsuite/tests/count-deps/CountDepsParser.stdout
@@ -1,4 +1,4 @@
-Found 292 GHC.Parser module dependencies
+Found 293 GHC.Parser module dependencies
 GHC.Builtin.Names
 GHC.Builtin.PrimOps
 GHC.Builtin.PrimOps.Ids
@@ -46,6 +46,7 @@ GHC.Core.Predicate
 GHC.Core.Reduction
 GHC.Core.RoughMap
 GHC.Core.Rules
+GHC.Core.Rules.Config
 GHC.Core.Seq
 GHC.Core.SimpleOpt
 GHC.Core.Stats