Factor fields of `CoreDoSimplify` into separate data typewip/core-opt-less-partial

This avoids some partiality. The work @mmhat is doing cleaning up and
modularizing `Core.Opt` will build on this nicely.

3 files changed, 28 insertions, 20 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index d7c0c23b0f..7486086406 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -435,7 +435,9 @@ lint_banner string pass = text "*** Core Lint"      <+> text string
 showLintWarnings :: CoreToDo -> Bool
 -- Disable Lint warnings on the first simplifier pass, because
 -- there may be some INLINE knots still tied, which is tiresomely noisy
-showLintWarnings (CoreDoSimplify _ (SimplMode { sm_phase = InitialPhase })) = False
+showLintWarnings (CoreDoSimplify cfg) = case sm_phase (cds_mode cfg) of
+  InitialPhase -> False
+  _ -> True
 showLintWarnings _ = True
 
 interactiveInScope :: InteractiveContext -> [Var]
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index 777c3d36cf..7b44a6534e 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -11,7 +11,7 @@
 module GHC.Core.Opt.Monad (
     -- * Configuration of the core-to-core passes
     CoreToDo(..), runWhen, runMaybe,
-    SimplMode(..),
+    CoreDoSimplifyOpts(..), SimplMode(..),
     FloatOutSwitches(..),
     FloatEnable(..),
     floatEnable,
@@ -105,13 +105,17 @@ import GHC.Utils.Panic (throwGhcException, GhcException(..), panic)
 ************************************************************************
 -}
 
+data CoreDoSimplifyOpts = CoreDoSimplifyOpts
+  { cds_max_iterations :: Int -- ^ Max iterations
+  , cds_mode :: SimplMode
+  }
+
 data CoreToDo           -- These are diff core-to-core passes,
                         -- which may be invoked in any order,
                         -- as many times as you like.
 
-  = CoreDoSimplify      -- The core-to-core simplifier.
-        Int                    -- Max iterations
-        SimplMode
+  = CoreDoSimplify !CoreDoSimplifyOpts
+  -- ^ The core-to-core simplifier.
   | CoreDoPluginPass String CorePluginPass
   | CoreDoFloatInwards
   | CoreDoFloatOutwards FloatOutSwitches
@@ -141,7 +145,7 @@ data CoreToDo           -- These are diff core-to-core passes,
   | CoreAddLateCcs
 
 instance Outputable CoreToDo where
-  ppr (CoreDoSimplify _ _)     = text "Simplifier"
+  ppr (CoreDoSimplify _)       = text "Simplifier"
   ppr (CoreDoPluginPass s _)   = text "Core plugin: " <+> text s
   ppr CoreDoFloatInwards       = text "Float inwards"
   ppr (CoreDoFloatOutwards f)  = text "Float out" <> parens (ppr f)
@@ -167,8 +171,12 @@ instance Outputable CoreToDo where
   ppr (CoreDoPasses passes)    = text "CoreDoPasses" <+> ppr passes
 
 pprPassDetails :: CoreToDo -> SDoc
-pprPassDetails (CoreDoSimplify n md) = vcat [ text "Max iterations =" <+> int n
-                                            , ppr md ]
+pprPassDetails (CoreDoSimplify cfg) = vcat [ text "Max iterations =" <+> int n
+                                           , ppr md ]
+  where
+    n = cds_max_iterations cfg
+    md = cds_mode cfg
+
 pprPassDetails _ = Outputable.empty
 
 
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 910b24061b..b8ac982021 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -184,7 +184,7 @@ getCoreToDo logger dflags
     simpl_phase phase name iter
       = CoreDoPasses
       $   [ maybe_strictness_before phase
-          , CoreDoSimplify iter
+          , CoreDoSimplify $ CoreDoSimplifyOpts iter
                 (base_mode { sm_phase = phase
                            , sm_names = [name] })
 
@@ -195,7 +195,7 @@ getCoreToDo logger dflags
     simplify name = simpl_phase FinalPhase name max_iter
 
     -- initial simplify: mk specialiser happy: minimum effort please
-    simpl_gently = CoreDoSimplify max_iter
+    simpl_gently = CoreDoSimplify $ CoreDoSimplifyOpts max_iter
                        (base_mode { sm_phase = InitialPhase
                                   , sm_names = ["Gentle"]
                                   , sm_rules = rules_on   -- Note [RULEs enabled in InitialPhase]
@@ -491,8 +491,8 @@ doCorePass pass guts = do
   let updateBindsM f = f (mg_binds guts) >>= \b' -> return $ guts { mg_binds = b' }
 
   case pass of
-    CoreDoSimplify {}         -> {-# SCC "Simplify" #-}
-                                 simplifyPgm pass guts
+    CoreDoSimplify cfg        -> {-# SCC "Simplify" #-}
+                                 simplifyPgm cfg guts
 
     CoreCSE                   -> {-# SCC "CommonSubExpr" #-}
                                  updateBinds cseProgram
@@ -650,20 +650,20 @@ simplExprGently env expr = do
 ************************************************************************
 -}
 
-simplifyPgm :: CoreToDo -> ModGuts -> CoreM ModGuts
-simplifyPgm pass guts
+simplifyPgm :: CoreDoSimplifyOpts -> ModGuts -> CoreM ModGuts
+simplifyPgm cfg guts
   = do { hsc_env <- getHscEnv
        ; rb <- getRuleBase
        ; liftIOWithCount $
-         simplifyPgmIO pass hsc_env rb guts }
+         simplifyPgmIO cfg hsc_env rb guts }
 
-simplifyPgmIO :: CoreToDo
+simplifyPgmIO :: CoreDoSimplifyOpts
               -> HscEnv
               -> RuleBase
               -> ModGuts
               -> IO (SimplCount, ModGuts)  -- New bindings
 
-simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
+simplifyPgmIO cfg@(CoreDoSimplifyOpts max_iterations mode)
               hsc_env hpt_rule_base
               guts@(ModGuts { mg_module = this_mod
                             , mg_rdr_env = rdr_env
@@ -779,7 +779,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
                 -- 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 ;
-           lintPassResult hsc_env pass binds2 ;
+           lintPassResult hsc_env (CoreDoSimplify cfg) binds2 ;
 
                 -- Loop
            do_iteration (iteration_no + 1) (counts1:counts_so_far) binds2 rules1
@@ -793,8 +793,6 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
         totalise = foldr (\c acc -> acc `plusSimplCount` c)
                          (zeroSimplCount dflags)
 
-simplifyPgmIO _ _ _ _ = panic "simplifyPgmIO"
-
 -------------------
 dump_end_iteration :: Logger -> Bool -> PrintUnqualified -> Int
                    -> SimplCount -> CoreProgram -> [CoreRule] -> IO ()