Refactored Simplify passwip/refactor-latecc

 * Removed references to driver from GHC.Core.LateCC, GHC.Core.Simplify
   namespace and GHC.Core.Opt.Stats.
   Also removed services from configuration records.

 * Renamed GHC.Core.Opt.Simplify to GHC.Core.Opt.Simplify.Iteration.

 * Inlined `simplifyPgm` and renamed `simplifyPgmIO` to `simplifyPgm`
   and moved the Simplify driver to GHC.Core.Opt.Simplify.

 * Moved `SimplMode` and `FloatEnable` to GHC.Core.Opt.Simplify.Env.

 * Added a configuration record `TopEnvConfig` for the `SimplTopEnv` environment
   in GHC.Core.Opt.Simplify.Monad.

 * Added `SimplifyOpts` and `SimplifyExprOpts`. Provide initialization functions
   for those in a new module GHC.Driver.Config.Core.Opt.Simplify.
   Also added initialization functions for `SimplMode` to that module.

 * Moved `CoreToDo` and friends to a new module GHC.Core.Pipeline.Types
   and the counting types and functions (`SimplCount` and `Tick`) to new
   module GHC.Core.Opt.Stats.

 * Added getter functions for the fields of `SimplMode`. The pedantic bottoms
   option and the platform are retrieved from the ArityOpts and RuleOpts and the
   getter functions allow us to retrieve values from `SpecEnv` without the
   knowledge where the data is stored exactly.

 * Moved the coercion optimization options from the top environment to
   `SimplMode`. This way the values left in the top environment are those
   dealing with monadic functionality, namely logging, IO related stuff and
   counting. Added a note "The environments of the Simplify pass".

 * Removed `CoreToDo` from GHC.Core.Lint and GHC.CoreToStg.Prep and got rid of
   `CoreDoSimplify`. Pass `SimplifyOpts` in the `CoreToDo` type instead.

 * Prep work before removing `InteractiveContext` from `HscEnv`.

1 files changed, 30 insertions, 87 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 00636ec444..c6f4fdf42f 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -19,11 +19,9 @@ module GHC.Core.Lint (
     WarnsAndErrs,
 
     lintCoreBindings', lintUnfolding,
-    lintPassResult', lintExpr,
+    lintPassResult, lintExpr,
     lintAnnots, lintAxioms,
 
-    interactiveInScope,
-
     -- ** Debug output
     EndPassConfig (..),
     endPassIO,
@@ -37,13 +35,11 @@ import GHC.Driver.Session
 import GHC.Tc.Utils.TcType ( isFloatingPrimTy, isTyFamFree )
 import GHC.Unit.Module.ModGuts
 import GHC.Platform
-import GHC.Runtime.Context
 
 import GHC.Core
 import GHC.Core.FVs
 import GHC.Core.Utils
 import GHC.Core.Stats ( coreBindsStats )
-import GHC.Core.Opt.Monad
 import GHC.Core.DataCon
 import GHC.Core.Ppr
 import GHC.Core.Coercion
@@ -57,10 +53,11 @@ import GHC.Core.TyCo.Ppr ( pprTyVar, pprTyVars )
 import GHC.Core.TyCon as TyCon
 import GHC.Core.Coercion.Axiom
 import GHC.Core.Unify
-import GHC.Core.InstEnv      ( instanceDFunId, instEnvElts )
 import GHC.Core.Coercion.Opt ( checkAxInstCo )
 import GHC.Core.Opt.Arity    ( typeArity )
 
+import GHC.Core.Opt.Monad
+
 import GHC.Types.Literal
 import GHC.Types.Var as Var
 import GHC.Types.Var.Env
@@ -74,7 +71,6 @@ import GHC.Types.Tickish
 import GHC.Types.RepType
 import GHC.Types.Basic
 import GHC.Types.Demand      ( splitDmdSig, isDeadEndDiv )
-import GHC.Types.TypeEnv
 
 import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim
@@ -283,24 +279,30 @@ data EndPassConfig = EndPassConfig
 
   , ep_lintPassResult :: !(Maybe LintPassResultConfig)
   -- ^ Whether we should lint the result of this pass.
+
+  , ep_printUnqual :: !PrintUnqualified
+
+  , ep_dumpFlag :: !(Maybe DumpFlag)
+
+  , ep_prettyPass :: !SDoc
+
+  , ep_passDetails :: !SDoc
   }
 
 endPassIO :: Logger
           -> EndPassConfig
-          -> PrintUnqualified
-          -> CoreToDo -> CoreProgram -> [CoreRule]
+          -> CoreProgram -> [CoreRule]
           -> IO ()
 -- Used by the IO-is CorePrep too
-endPassIO logger cfg print_unqual
-           pass binds rules
-  = do { dumpPassResult logger (ep_dumpCoreSizes cfg) print_unqual mb_flag
-                        (renderWithContext defaultSDocContext (ppr pass))
-                        (pprPassDetails pass) binds rules
+endPassIO logger cfg binds rules
+  = do { dumpPassResult logger (ep_dumpCoreSizes cfg) (ep_printUnqual cfg) mb_flag
+                        (renderWithContext defaultSDocContext (ep_prettyPass cfg))
+                        (ep_passDetails cfg) binds rules
        ; for_ (ep_lintPassResult cfg) $ \lp_cfg ->
-           lintPassResult' logger lp_cfg pass binds
+           lintPassResult logger lp_cfg binds
        }
   where
-    mb_flag = case coreDumpFlag pass of
+    mb_flag = case ep_dumpFlag cfg of
                 Just flag | logHasDumpFlag logger flag                    -> Just flag
                           | logHasDumpFlag logger Opt_D_verbose_core2core -> Just flag
                 _ -> Nothing
@@ -338,33 +340,6 @@ dumpPassResult logger dump_core_sizes unqual mb_flag hdr extra_info binds rules
                     , text "------ Local rules for imported ids --------"
                     , pprRules rules ]
 
-coreDumpFlag :: CoreToDo -> Maybe DumpFlag
-coreDumpFlag (CoreDoSimplify {})      = Just Opt_D_verbose_core2core
-coreDumpFlag (CoreDoPluginPass {})    = Just Opt_D_verbose_core2core
-coreDumpFlag CoreDoFloatInwards       = Just Opt_D_verbose_core2core
-coreDumpFlag (CoreDoFloatOutwards {}) = Just Opt_D_verbose_core2core
-coreDumpFlag CoreLiberateCase         = Just Opt_D_verbose_core2core
-coreDumpFlag CoreDoStaticArgs         = Just Opt_D_verbose_core2core
-coreDumpFlag CoreDoCallArity          = Just Opt_D_dump_call_arity
-coreDumpFlag CoreDoExitify            = Just Opt_D_dump_exitify
-coreDumpFlag CoreDoDemand             = Just Opt_D_dump_stranal
-coreDumpFlag CoreDoCpr                = Just Opt_D_dump_cpranal
-coreDumpFlag CoreDoWorkerWrapper      = Just Opt_D_dump_worker_wrapper
-coreDumpFlag CoreDoSpecialising       = Just Opt_D_dump_spec
-coreDumpFlag CoreDoSpecConstr         = Just Opt_D_dump_spec
-coreDumpFlag CoreCSE                  = Just Opt_D_dump_cse
-coreDumpFlag CoreDesugar              = Just Opt_D_dump_ds_preopt
-coreDumpFlag CoreDesugarOpt           = Just Opt_D_dump_ds
-coreDumpFlag CoreTidy                 = Just Opt_D_dump_simpl
-coreDumpFlag CorePrep                 = Just Opt_D_dump_prep
-
-coreDumpFlag CoreAddCallerCcs         = Nothing
-coreDumpFlag CoreAddLateCcs           = Nothing
-coreDumpFlag CoreDoPrintCore          = Nothing
-coreDumpFlag (CoreDoRuleCheck {})     = Nothing
-coreDumpFlag CoreDoNothing            = Nothing
-coreDumpFlag (CoreDoPasses {})        = Nothing
-
 {-
 ************************************************************************
 *                                                                      *
@@ -374,28 +349,30 @@ coreDumpFlag (CoreDoPasses {})        = Nothing
 -}
 
 data LintPassResultConfig = LintPassResultConfig
-  { lpr_diagOpts      :: !DiagOpts
-  , lpr_platform      :: !Platform
-  , lpr_makeLintFlags :: !(CoreToDo -> LintFlags)
-  , lpr_localsInScope :: ![Var]
+  { lpr_diagOpts         :: !DiagOpts
+  , lpr_platform         :: !Platform
+  , lpr_makeLintFlags    :: !LintFlags
+  , lpr_showLintWarnings :: !Bool
+  , lpr_passPpr          :: !SDoc
+  , lpr_localsInScope    :: ![Var]
   }
 
-lintPassResult' :: Logger -> LintPassResultConfig
-                -> CoreToDo -> CoreProgram -> IO ()
-lintPassResult' logger cfg pass binds
+lintPassResult :: Logger -> LintPassResultConfig
+               -> CoreProgram -> IO ()
+lintPassResult logger cfg binds
   = do { let warns_and_errs = lintCoreBindings'
                (LintConfig
                 { l_diagOpts = lpr_diagOpts cfg
                 , l_platform = lpr_platform cfg
-                , l_flags    = lpr_makeLintFlags cfg pass
+                , l_flags    = lpr_makeLintFlags cfg
                 , l_vars     = lpr_localsInScope cfg
                 })
                binds
        ; Err.showPass logger $
            "Core Linted result of " ++
-           renderWithContext defaultSDocContext (ppr pass)
+           renderWithContext defaultSDocContext (lpr_passPpr cfg)
        ; displayLintResults logger
-                            (showLintWarnings pass) (ppr pass)
+                            (lpr_showLintWarnings cfg) (lpr_passPpr cfg)
                             (pprCoreBindings binds) warns_and_errs
        }
 
@@ -432,40 +409,6 @@ lint_banner string pass = text "*** Core Lint"      <+> text string
                           <+> text ": in result of" <+> pass
                           <+> text "***"
 
-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 cfg) = case sm_phase (cds_mode cfg) of
-  InitialPhase -> False
-  _ -> True
-showLintWarnings _ = True
-
-interactiveInScope :: InteractiveContext -> [Var]
--- In GHCi we may lint expressions, or bindings arising from 'deriving'
--- clauses, that mention variables bound in the interactive context.
--- These are Local things (see Note [Interactively-bound Ids in GHCi] in GHC.Runtime.Context).
--- So we have to tell Lint about them, lest it reports them as out of scope.
---
--- 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 (hsc_IC hsc_env) is empty
--- so this is a (cheap) no-op.
---
--- See #8215 for an example
-interactiveInScope ictxt
-  = tyvars ++ ids
-  where
-    -- C.f. GHC.Tc.Module.setInteractiveContext, Desugar.deSugarExpr
-    (cls_insts, _fam_insts) = ic_instances ictxt
-    te1    = mkTypeEnvWithImplicits (ic_tythings ictxt)
-    te     = extendTypeEnvWithIds te1 (map instanceDFunId $ instEnvElts cls_insts)
-    ids    = typeEnvIds te
-    tyvars = tyCoVarsOfTypesList $ map idType ids
-              -- Why the type variables?  How can the top level envt have free tyvars?
-              -- I think it's because of the GHCi debugger, which can bind variables
-              --   f :: [t] -> [t]
-              -- where t is a RuntimeUnk (see TcType)
-
 -- | Type-check a 'CoreProgram'. See Note [Core Lint guarantee].
 lintCoreBindings' :: LintConfig -> CoreProgram -> WarnsAndErrs
 --   Returns (warnings, errors)