Make Logger independent of DynFlags

Introduce LogFlags as a independent subset of DynFlags used for logging.
As a consequence in many places we don't have to pass both Logger and
DynFlags anymore.

The main reason for this refactoring is that I want to refactor the
systools interfaces: for now many systools functions use DynFlags both
to use the Logger and to fetch their parameters (e.g. ldInputs for the
linker). I'm interested in refactoring the way they fetch their
parameters (i.e. use dedicated XxxOpts data types instead of DynFlags)
for #19877. But if I did this refactoring before refactoring the Logger,
we would have duplicate parameters (e.g. ldInputs from DynFlags and
linkerInputs from LinkerOpts). Hence this patch first.

Some flags don't really belong to LogFlags because they are subsystem
specific (e.g. most DumpFlags). For example -ddump-asm should better be
passed in NCGConfig somehow. This patch doesn't fix this tight coupling:
the dump flags are part of the UI but they are passed all the way down
for example to infer the file name for the dumps.

Because LogFlags are a subset of the DynFlags, we must update the former
when the latter changes (not so often). As a consequence we now use
accessors to read/write DynFlags in HscEnv instead of using `hsc_dflags`
directly.

In the process I've also made some subsystems less dependent on DynFlags:

- CmmToAsm: by passing some missing flags via NCGConfig (see new fields
  in GHC.CmmToAsm.Config)
- Core.Opt.*:
    - by passing -dinline-check value into UnfoldingOpts
    - by fixing some Core passes interfaces (e.g. CallArity, FloatIn)
      that took DynFlags argument for no good reason.
    - as a side-effect GHC.Core.Opt.Pipeline.doCorePass is much less
      convoluted.

10 files changed, 149 insertions, 231 deletions

diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index ad3bad1d7d..fdef694cec 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -20,8 +20,7 @@ module GHC.Core.Lint (
 
     -- ** Debug output
     endPass, endPassIO,
-    displayLintResults, dumpPassResult,
-    dumpIfSet,
+    displayLintResults, dumpPassResult
  ) where
 
 import GHC.Prelude
@@ -67,8 +66,7 @@ import GHC.Core.Unify
 import GHC.Types.Basic
 import GHC.Utils.Error
 import qualified GHC.Utils.Error as Err
-import GHC.Utils.Logger (Logger, putLogMsg, putDumpMsg, DumpFormat (..), getLogger)
-import qualified GHC.Utils.Logger as Logger
+import GHC.Utils.Logger
 import GHC.Data.List.SetOps
 import GHC.Builtin.Names
 import GHC.Utils.Outputable as Outputable
@@ -290,44 +288,37 @@ endPassIO :: HscEnv -> PrintUnqualified
           -> CoreToDo -> CoreProgram -> [CoreRule] -> IO ()
 -- Used by the IO-is CorePrep too
 endPassIO hsc_env print_unqual pass binds rules
-  = do { dumpPassResult logger dflags print_unqual mb_flag
-                        (ppr pass) (pprPassDetails pass) binds rules
+  = do { dumpPassResult logger print_unqual mb_flag
+                        (showSDoc dflags (ppr pass)) (pprPassDetails pass) binds rules
        ; lintPassResult hsc_env pass binds }
   where
     logger  = hsc_logger hsc_env
     dflags  = hsc_dflags hsc_env
     mb_flag = case coreDumpFlag pass of
-                Just flag | dopt flag dflags                    -> Just flag
-                          | dopt Opt_D_verbose_core2core dflags -> Just flag
+                Just flag | logHasDumpFlag logger flag                    -> Just flag
+                          | logHasDumpFlag logger Opt_D_verbose_core2core -> Just flag
                 _ -> Nothing
 
-dumpIfSet :: Logger -> DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO ()
-dumpIfSet logger dflags dump_me pass extra_info doc
-  = Logger.dumpIfSet logger dflags dump_me (showSDoc dflags (ppr pass <+> extra_info)) doc
-
 dumpPassResult :: Logger
-               -> DynFlags
                -> PrintUnqualified
                -> Maybe DumpFlag        -- Just df => show details in a file whose
                                         --            name is specified by df
-               -> SDoc                  -- Header
+               -> String                -- Header
                -> SDoc                  -- Extra info to appear after header
                -> CoreProgram -> [CoreRule]
                -> IO ()
-dumpPassResult logger dflags unqual mb_flag hdr extra_info binds rules
+dumpPassResult logger unqual mb_flag hdr extra_info binds rules
   = do { forM_ mb_flag $ \flag -> do
-           let sty = mkDumpStyle unqual
-           putDumpMsg logger dflags sty flag
-              (showSDoc dflags hdr) FormatCore dump_doc
+           logDumpFile logger (mkDumpStyle unqual) flag hdr FormatCore dump_doc
 
          -- Report result size
          -- This has the side effect of forcing the intermediate to be evaluated
          -- if it's not already forced by a -ddump flag.
-       ; Err.debugTraceMsg logger dflags 2 size_doc
+       ; Err.debugTraceMsg logger 2 size_doc
        }
 
   where
-    size_doc = sep [text "Result size of" <+> hdr, nest 2 (equals <+> ppr (coreBindsStats binds))]
+    size_doc = sep [text "Result size of" <+> text hdr, nest 2 (equals <+> ppr (coreBindsStats binds))]
 
     dump_doc  = vcat [ nest 2 extra_info
                      , size_doc
@@ -379,37 +370,36 @@ lintPassResult hsc_env pass binds
   = return ()
   | otherwise
   = do { let warns_and_errs = lintCoreBindings dflags pass (interactiveInScope $ hsc_IC hsc_env) binds
-       ; Err.showPass logger dflags ("Core Linted result of " ++ showPpr dflags pass)
-       ; displayLintResults logger dflags (showLintWarnings pass) (ppr pass)
+       ; Err.showPass logger ("Core Linted result of " ++ showPpr dflags pass)
+       ; displayLintResults logger (showLintWarnings pass) (ppr pass)
                             (pprCoreBindings binds) warns_and_errs }
   where
     dflags = hsc_dflags hsc_env
     logger = hsc_logger hsc_env
 
 displayLintResults :: Logger
-                   -> DynFlags
                    -> Bool -- ^ If 'True', display linter warnings.
                            --   If 'False', ignore linter warnings.
                    -> SDoc -- ^ The source of the linted program
                    -> SDoc -- ^ The linted program, pretty-printed
                    -> WarnsAndErrs
                    -> IO ()
-displayLintResults logger dflags display_warnings pp_what pp_pgm (warns, errs)
+displayLintResults logger display_warnings pp_what pp_pgm (warns, errs)
   | not (isEmptyBag errs)
-  = do { putLogMsg logger dflags Err.MCDump noSrcSpan
+  = do { logMsg logger Err.MCDump noSrcSpan
            $ withPprStyle defaultDumpStyle
            (vcat [ lint_banner "errors" pp_what, Err.pprMessageBag errs
                  , text "*** Offending Program ***"
                  , pp_pgm
                  , text "*** End of Offense ***" ])
-       ; Err.ghcExit logger dflags 1 }
+       ; Err.ghcExit logger 1 }
 
   | not (isEmptyBag warns)
-  , not (hasNoDebugOutput dflags)
+  , log_enable_debug (logFlags logger)
   , display_warnings
   -- If the Core linter encounters an error, output to stderr instead of
   -- stdout (#13342)
-  = putLogMsg logger dflags Err.MCInfo noSrcSpan
+  = logMsg logger Err.MCInfo noSrcSpan
       $ withPprStyle defaultDumpStyle
         (lint_banner "warnings" pp_what $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
 
@@ -432,7 +422,7 @@ lintInteractiveExpr what hsc_env expr
   | not (gopt Opt_DoCoreLinting dflags)
   = return ()
   | Just err <- lintExpr dflags (interactiveInScope $ hsc_IC hsc_env) expr
-  = displayLintResults logger dflags False what (pprCoreExpr expr) (emptyBag, err)
+  = displayLintResults logger False what (pprCoreExpr expr) (emptyBag, err)
   | otherwise
   = return ()
   where
@@ -2357,7 +2347,7 @@ lintAxioms :: Logger
            -> [CoAxiom Branched]
            -> IO ()
 lintAxioms logger dflags what axioms =
-  displayLintResults logger dflags True what (vcat $ map pprCoAxiom axioms) $
+  displayLintResults logger True what (vcat $ map pprCoAxiom axioms) $
   initL dflags (defaultLintFlags dflags) [] $
   do { mapM_ lint_axiom axioms
      ; let axiom_groups = groupWith coAxiomTyCon axioms
@@ -3306,15 +3296,15 @@ lintAnnots pname pass guts = do
   dflags <- getDynFlags
   logger <- getLogger
   when (gopt Opt_DoAnnotationLinting dflags) $
-    liftIO $ Err.showPass logger dflags "Annotation linting - first run"
+    liftIO $ Err.showPass logger "Annotation linting - first run"
   nguts <- pass guts
   -- If appropriate re-run it without debug annotations to make sure
   -- that they made no difference.
   when (gopt Opt_DoAnnotationLinting dflags) $ do
-    liftIO $ Err.showPass logger dflags "Annotation linting - second run"
+    liftIO $ Err.showPass logger "Annotation linting - second run"
     nguts' <- withoutAnnots pass guts
     -- Finally compare the resulting bindings
-    liftIO $ Err.showPass logger dflags "Annotation linting - comparison"
+    liftIO $ Err.showPass logger "Annotation linting - comparison"
     let binds = flattenBinds $ mg_binds nguts
         binds' = flattenBinds $ mg_binds nguts'
         (diffs,_) = diffBinds True (mkRnEnv2 emptyInScopeSet) binds binds'
@@ -3333,7 +3323,7 @@ withoutAnnots :: (ModGuts -> CoreM ModGuts) -> ModGuts -> CoreM ModGuts
 withoutAnnots pass guts = do
   -- Remove debug flag from environment.
   dflags <- getDynFlags
-  let removeFlag env = env{ hsc_dflags = dflags{ debugLevel = 0} }
+  let removeFlag env = hscSetFlags (dflags { debugLevel = 0}) env
       withoutFlag corem =
           -- TODO: supply tag here as well ?
         liftIO =<< runCoreM <$> fmap removeFlag getHscEnv <*> getRuleBase <*>
diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs
index 53b5983758..254b215537 100644
--- a/compiler/GHC/Core/Opt/CallArity.hs
+++ b/compiler/GHC/Core/Opt/CallArity.hs
@@ -13,7 +13,6 @@ import GHC.Prelude
 
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
-import GHC.Driver.Session ( DynFlags )
 
 import GHC.Types.Basic
 import GHC.Core
@@ -434,8 +433,8 @@ choice, and hence Call Arity sets the call arity for join points as well.
 
 -- Main entry point
 
-callArityAnalProgram :: DynFlags -> CoreProgram -> CoreProgram
-callArityAnalProgram _dflags binds = binds'
+callArityAnalProgram :: CoreProgram -> CoreProgram
+callArityAnalProgram binds = binds'
   where
     (_, binds') = callArityTopLvl [] emptyVarSet binds
 
diff --git a/compiler/GHC/Core/Opt/CprAnal.hs b/compiler/GHC/Core/Opt/CprAnal.hs
index a697dd65d0..91f6abef0d 100644
--- a/compiler/GHC/Core/Opt/CprAnal.hs
+++ b/compiler/GHC/Core/Opt/CprAnal.hs
@@ -30,7 +30,7 @@ import GHC.Core.Type
 import GHC.Core.Utils   ( exprIsHNF, dumpIdInfoOfProgram, normSplitTyConApp_maybe )
 import GHC.Utils.Misc
 import GHC.Utils.Panic.Plain
-import GHC.Utils.Logger  ( Logger, dumpIfSet_dyn, DumpFormat (..) )
+import GHC.Utils.Logger  ( Logger, putDumpFileMaybe, DumpFormat (..) )
 import GHC.Data.Graph.UnVar -- for UnVarSet
 import GHC.Data.Maybe   ( isJust )
 
@@ -108,11 +108,11 @@ So currently we have
 -- * Analysing programs
 --
 
-cprAnalProgram :: Logger -> DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram
-cprAnalProgram logger dflags fam_envs binds = do
+cprAnalProgram :: Logger -> FamInstEnvs -> CoreProgram -> IO CoreProgram
+cprAnalProgram logger fam_envs binds = do
   let env            = emptyAnalEnv fam_envs
   let binds_plus_cpr = snd $ mapAccumL cprAnalTopBind env binds
-  dumpIfSet_dyn logger dflags Opt_D_dump_cpr_signatures "Cpr signatures" FormatText $
+  putDumpFileMaybe logger Opt_D_dump_cpr_signatures "Cpr signatures" FormatText $
     dumpIdInfoOfProgram (ppr . cprSigInfo) binds_plus_cpr
   -- See Note [Stamp out space leaks in demand analysis] in GHC.Core.Opt.DmdAnal
   seqBinds binds_plus_cpr `seq` return binds_plus_cpr
diff --git a/compiler/GHC/Core/Opt/FloatIn.hs b/compiler/GHC/Core/Opt/FloatIn.hs
index 6826e9da8f..6e4b724310 100644
--- a/compiler/GHC/Core/Opt/FloatIn.hs
+++ b/compiler/GHC/Core/Opt/FloatIn.hs
@@ -21,13 +21,10 @@ module GHC.Core.Opt.FloatIn ( floatInwards ) where
 import GHC.Prelude
 import GHC.Platform
 
-import GHC.Driver.Session
-
 import GHC.Core
 import GHC.Core.Make hiding ( wrapFloats )
 import GHC.Core.Utils
 import GHC.Core.FVs
-import GHC.Core.Opt.Monad   ( CoreM )
 import GHC.Core.Type
 
 import GHC.Types.Basic      ( RecFlag(..), isRec )
@@ -36,8 +33,6 @@ import GHC.Types.Tickish
 import GHC.Types.Var
 import GHC.Types.Var.Set
 
-import GHC.Unit.Module.ModGuts
-
 import GHC.Utils.Misc
 import GHC.Utils.Panic
 import GHC.Utils.Panic.Plain
@@ -47,11 +42,8 @@ Top-level interface function, @floatInwards@.  Note that we do not
 actually float any bindings downwards from the top-level.
 -}
 
-floatInwards :: ModGuts -> CoreM ModGuts
-floatInwards pgm@(ModGuts { mg_binds = binds })
-  = do { dflags <- getDynFlags
-       ; let platform = targetPlatform dflags
-       ; return (pgm { mg_binds = map (fi_top_bind platform) binds }) }
+floatInwards :: Platform -> CoreProgram -> CoreProgram
+floatInwards platform binds = map (fi_top_bind platform) binds
   where
     fi_top_bind platform (NonRec binder rhs)
       = NonRec binder (fiExpr platform [] (freeVars rhs))
diff --git a/compiler/GHC/Core/Opt/FloatOut.hs b/compiler/GHC/Core/Opt/FloatOut.hs
index 9f579a0a2e..fbed53fbf3 100644
--- a/compiler/GHC/Core/Opt/FloatOut.hs
+++ b/compiler/GHC/Core/Opt/FloatOut.hs
@@ -19,7 +19,7 @@ import GHC.Core.Opt.Arity ( exprArity, etaExpand )
 import GHC.Core.Opt.Monad ( FloatOutSwitches(..) )
 
 import GHC.Driver.Session
-import GHC.Utils.Logger  ( dumpIfSet_dyn, DumpFormat (..), Logger )
+import GHC.Utils.Logger
 import GHC.Types.Id      ( Id, idArity, idType, isDeadEndId,
                            isJoinId, isJoinId_maybe )
 import GHC.Types.Tickish
@@ -164,23 +164,22 @@ Without floating, we're stuck with three loops instead of one.
 
 floatOutwards :: Logger
               -> FloatOutSwitches
-              -> DynFlags
               -> UniqSupply
               -> CoreProgram -> IO CoreProgram
 
-floatOutwards logger float_sws dflags us pgm
+floatOutwards logger float_sws us pgm
   = do {
         let { annotated_w_levels = setLevels float_sws pgm us ;
               (fss, binds_s')    = unzip (map floatTopBind annotated_w_levels)
             } ;
 
-        dumpIfSet_dyn logger dflags Opt_D_verbose_core2core "Levels added:"
+        putDumpFileMaybe logger Opt_D_verbose_core2core "Levels added:"
                   FormatCore
                   (vcat (map ppr annotated_w_levels));
 
         let { (tlets, ntlets, lams) = get_stats (sum_stats fss) };
 
-        dumpIfSet_dyn logger dflags Opt_D_dump_simpl_stats "FloatOut stats:"
+        putDumpFileMaybe logger Opt_D_dump_simpl_stats "FloatOut stats:"
                 FormatText
                 (hcat [ int tlets,  text " Lets floated to top level; ",
                         int ntlets, text " Lets floated elsewhere; from ",
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index e8f1fb11e3..c0102961b5 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -45,7 +45,6 @@ module GHC.Core.Opt.Monad (
     putMsg, putMsgS, errorMsg, errorMsgS, msg,
     fatalErrorMsg, fatalErrorMsgS,
     debugTraceMsg, debugTraceMsgS,
-    dumpIfSet_dyn
   ) where
 
 import GHC.Prelude hiding ( read )
@@ -66,7 +65,7 @@ import GHC.Types.Error
 
 import GHC.Utils.Error ( errorDiagnostic )
 import GHC.Utils.Outputable as Outputable
-import GHC.Utils.Logger ( HasLogger (..), DumpFormat (..), putLogMsg, putDumpMsg, Logger )
+import GHC.Utils.Logger
 import GHC.Utils.Monad
 
 import GHC.Data.FastString
@@ -182,7 +181,6 @@ data SimplMode             -- See comments in GHC.Core.Opt.Simplify.Monad
             --    - target platform (for `exprIsDupable` and `mkDupableAlt`)
             --    - Opt_DictsCheap and Opt_PedanticBottoms general flags
             --    - rules options (initRuleOpts)
-            --    - verbose_core2core, dump_inlinings, dump_rule_rewrites/firings
             --    - inlineCheck
         }
 
@@ -794,7 +792,6 @@ we aren't using annotations heavily.
 
 msg :: MessageClass -> SDoc -> CoreM ()
 msg msg_class doc = do
-    dflags <- getDynFlags
     logger <- getLogger
     loc    <- getSrcSpanM
     unqual <- getPrintUnqualified
@@ -805,7 +802,7 @@ msg msg_class doc = do
         err_sty  = mkErrStyle unqual
         user_sty = mkUserStyle unqual AllTheWay
         dump_sty = mkDumpStyle unqual
-    liftIO $ putLogMsg logger dflags msg_class loc (withPprStyle sty doc)
+    liftIO $ logMsg logger msg_class loc (withPprStyle sty doc)
 
 -- | Output a String message to the screen
 putMsgS :: String -> CoreM ()
@@ -838,13 +835,3 @@ debugTraceMsgS = debugTraceMsg . text
 -- | Outputs a debugging message at verbosity level of @-v@ or higher
 debugTraceMsg :: SDoc -> CoreM ()
 debugTraceMsg = msg MCDump
-
--- | Show some labelled 'SDoc' if a particular flag is set or at a verbosity level of @-v -ddump-most@ or higher
-dumpIfSet_dyn :: DumpFlag -> String -> DumpFormat -> SDoc -> CoreM ()
-dumpIfSet_dyn flag str fmt doc = do
-    dflags <- getDynFlags
-    logger <- getLogger
-    unqual <- getPrintUnqualified
-    when (dopt flag dflags) $ liftIO $ do
-        let sty = mkDumpStyle unqual
-        putDumpMsg logger dflags sty flag str fmt doc
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index 90b5968a2f..6e2f3aceee 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -47,7 +47,6 @@ import GHC.Core.Opt.CallerCC     ( addCallerCostCentres )
 import GHC.Core.Seq (seqBinds)
 import GHC.Core.FamInstEnv
 
-import qualified GHC.Utils.Error as Err
 import GHC.Utils.Error  ( withTiming )
 import GHC.Utils.Logger as Logger
 import GHC.Utils.Outputable
@@ -61,7 +60,6 @@ import GHC.Unit.Module.Deps
 
 import GHC.Runtime.Context
 
-import GHC.Types.SrcLoc
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Types.Basic
@@ -69,7 +67,6 @@ import GHC.Types.Demand ( zapDmdEnvSig )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Tickish
-import GHC.Types.Unique.Supply ( UniqSupply )
 import GHC.Types.Unique.FM
 import GHC.Types.Name.Ppr
 
@@ -100,7 +97,7 @@ core2core hsc_env guts@(ModGuts { mg_module  = mod
                                                 builtin_passes
                               ; runCorePasses all_passes guts }
 
-       ; Logger.dumpIfSet_dyn logger dflags Opt_D_dump_simpl_stats
+       ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
              "Grand total simplifier statistics"
              FormatText
              (pprSimplCount stats)
@@ -465,9 +462,8 @@ runCorePasses passes guts
     do_pass guts CoreDoNothing = return guts
     do_pass guts (CoreDoPasses ps) = runCorePasses ps guts
     do_pass guts pass = do
-      dflags <- getDynFlags
       logger <- getLogger
-      withTiming logger dflags (ppr pass <+> brackets (ppr mod))
+      withTiming logger (ppr pass <+> brackets (ppr mod))
                    (const ()) $ do
             guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
             endPass pass (mg_binds guts') (mg_rules guts')
@@ -477,40 +473,48 @@ runCorePasses passes guts
 
 doCorePass :: CoreToDo -> ModGuts -> CoreM ModGuts
 doCorePass pass guts = do
-  logger <- getLogger
+  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" #-}
-                                 doPass cseProgram guts
+                                 updateBinds cseProgram
 
     CoreLiberateCase          -> {-# SCC "LiberateCase" #-}
-                                 doPassD liberateCase guts
+                                 updateBinds (liberateCase dflags)
 
     CoreDoFloatInwards        -> {-# SCC "FloatInwards" #-}
-                                 floatInwards guts
+                                 updateBinds (floatInwards platform)
 
     CoreDoFloatOutwards f     -> {-# SCC "FloatOutwards" #-}
-                                 doPassDUM (floatOutwards logger f) guts
+                                 updateBindsM (liftIO . floatOutwards logger f us)
 
     CoreDoStaticArgs          -> {-# SCC "StaticArgs" #-}
-                                 doPassU doStaticArgs guts
+                                 updateBinds (doStaticArgs us)
 
     CoreDoCallArity           -> {-# SCC "CallArity" #-}
-                                 doPassD callArityAnalProgram guts
+                                 updateBinds callArityAnalProgram
 
     CoreDoExitify             -> {-# SCC "Exitify" #-}
-                                 doPass exitifyProgram guts
+                                 updateBinds exitifyProgram
 
     CoreDoDemand              -> {-# SCC "DmdAnal" #-}
-                                 doPassDFRM (dmdAnal logger) guts
+                                 updateBindsM (liftIO . dmdAnal logger dflags fam_envs (mg_rules guts))
 
     CoreDoCpr                 -> {-# SCC "CprAnal" #-}
-                                 doPassDFM (cprAnalProgram logger) guts
+                                 updateBindsM (liftIO . cprAnalProgram logger fam_envs)
 
     CoreDoWorkerWrapper       -> {-# SCC "WorkWrap" #-}
-                                 doPassDFU wwTopBinds guts
+                                 updateBinds (wwTopBinds dflags fam_envs us)
 
     CoreDoSpecialising        -> {-# SCC "Specialise" #-}
                                  specProgram guts
@@ -521,7 +525,7 @@ doCorePass pass guts = do
     CoreAddCallerCcs          -> {-# SCC "AddCallerCcs" #-}
                                  addCallerCostCentres guts
 
-    CoreDoPrintCore           -> observe (printCore logger) guts
+    CoreDoPrintCore           -> liftIO $ printCore logger (mg_binds guts) >> return guts
 
     CoreDoRuleCheck phase pat -> ruleCheckPass phase pat guts
     CoreDoNothing             -> return guts
@@ -543,84 +547,26 @@ doCorePass pass guts = do
 ************************************************************************
 -}
 
-printCore :: Logger -> DynFlags -> CoreProgram -> IO ()
-printCore logger dflags binds
-    = Logger.dumpIfSet logger dflags True "Print Core" (pprCoreBindings binds)
+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 dflags (text "RuleCheck"<+>brackets (ppr $ mg_module guts))
+    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 $ putLogMsg logger dflags Err.MCDump noSrcSpan
-                     $ withPprStyle defaultDumpStyle
+        liftIO $ logDumpMsg logger "Rule check"
                      (ruleCheckProgram ropts current_phase pat
                         rule_fn (mg_binds guts))
         return guts
 
-doPassDUM :: (DynFlags -> UniqSupply -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDUM do_pass = doPassM $ \binds -> do
-    dflags <- getDynFlags
-    us     <- getUniqueSupplyM
-    liftIO $ do_pass dflags us binds
-
-doPassDM :: (DynFlags -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDM do_pass = doPassDUM (\dflags -> const (do_pass dflags))
-
-doPassD :: (DynFlags -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassD do_pass = doPassDM (\dflags -> return . do_pass dflags)
-
-doPassDU :: (DynFlags -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDU do_pass = doPassDUM (\dflags us -> return . do_pass dflags us)
-
-doPassU :: (UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassU do_pass = doPassDU (const do_pass)
-
-doPassDFM :: (DynFlags -> FamInstEnvs -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDFM do_pass guts = do
-    dflags <- getDynFlags
-    p_fam_env <- getPackageFamInstEnv
-    let fam_envs = (p_fam_env, mg_fam_inst_env guts)
-    doPassM (liftIO . do_pass dflags fam_envs) guts
-
-doPassDFRM :: (DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDFRM do_pass guts = do
-    dflags <- getDynFlags
-    p_fam_env <- getPackageFamInstEnv
-    let fam_envs = (p_fam_env, mg_fam_inst_env guts)
-    doPassM (liftIO . do_pass dflags fam_envs (mg_rules guts)) guts
-
-doPassDFU :: (DynFlags -> FamInstEnvs -> UniqSupply -> CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
-doPassDFU do_pass guts = do
-    dflags <- getDynFlags
-    us     <- getUniqueSupplyM
-    p_fam_env <- getPackageFamInstEnv
-    let fam_envs = (p_fam_env, mg_fam_inst_env guts)
-    doPass (do_pass dflags fam_envs us) guts
-
--- Most passes return no stats and don't change rules: these combinators
--- let us lift them to the full blown ModGuts+CoreM world
-doPassM :: Monad m => (CoreProgram -> m CoreProgram) -> ModGuts -> m ModGuts
-doPassM bind_f guts = do
-    binds' <- bind_f (mg_binds guts)
-    return (guts { mg_binds = binds' })
-
-doPass :: (CoreProgram -> CoreProgram) -> ModGuts -> CoreM ModGuts
-doPass bind_f guts = return $ guts { mg_binds = bind_f (mg_binds guts) }
-
--- Observer passes just peek; don't modify the bindings at all
-observe :: (DynFlags -> CoreProgram -> IO a) -> ModGuts -> CoreM ModGuts
-observe do_pass = doPassM $ \binds -> do
-    dflags <- getDynFlags
-    _ <- liftIO $ do_pass dflags binds
-    return binds
-
 {-
 ************************************************************************
 *                                                                      *
@@ -635,7 +581,7 @@ simplifyExpr :: HscEnv -- includes spec of what core-to-core passes to do
 -- simplifyExpr is called by the driver to simplify an
 -- expression typed in at the interactive prompt
 simplifyExpr hsc_env expr
-  = withTiming logger dflags (text "Simplify [expr]") (const ()) $
+  = withTiming logger (text "Simplify [expr]") (const ()) $
     do  { eps <- hscEPS hsc_env ;
         ; let rule_env  = mkRuleEnv (eps_rule_base eps) []
               fi_env    = ( eps_fam_inst_env eps
@@ -648,10 +594,10 @@ simplifyExpr hsc_env expr
         ; (expr', counts) <- initSmpl logger dflags rule_env fi_env sz $
                              simplExprGently simpl_env expr
 
-        ; Logger.dumpIfSet logger dflags (dopt Opt_D_dump_simpl_stats dflags)
-                  "Simplifier statistics" (pprSimplCount counts)
+        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl_stats
+                  "Simplifier statistics" FormatText (pprSimplCount counts)
 
-        ; Logger.dumpIfSet_dyn logger dflags Opt_D_dump_simpl "Simplified expression"
+        ; Logger.putDumpFileMaybe logger Opt_D_dump_simpl "Simplified expression"
                         FormatCore
                         (pprCoreExpr expr')
 
@@ -714,8 +660,9 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
   = do { (termination_msg, it_count, counts_out, guts')
            <- do_iteration 1 [] binds rules
 
-        ; Logger.dumpIfSet logger dflags (dopt Opt_D_verbose_core2core dflags &&
-                                dopt Opt_D_dump_simpl_stats  dflags)
+        ; 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",
@@ -766,7 +713,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
                      occurAnalysePgm this_mod active_unf active_rule rules
                                      binds
                } ;
-           Logger.dumpIfSet_dyn logger dflags Opt_D_dump_occur_anal "Occurrence analysis"
+           Logger.putDumpFileMaybe logger Opt_D_dump_occur_anal "Occurrence analysis"
                      FormatCore
                      (pprCoreBindings tagged_binds);
 
@@ -814,7 +761,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
            let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ;
 
                 -- Dump the result of this iteration
-           dump_end_iteration logger dflags print_unqual iteration_no counts1 binds2 rules1 ;
+           dump_end_iteration logger print_unqual iteration_no counts1 binds2 rules1 ;
            lintPassResult hsc_env pass binds2 ;
 
                 -- Loop
@@ -832,19 +779,19 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
 simplifyPgmIO _ _ _ _ = panic "simplifyPgmIO"
 
 -------------------
-dump_end_iteration :: Logger -> DynFlags -> PrintUnqualified -> Int
+dump_end_iteration :: Logger -> PrintUnqualified -> Int
                    -> SimplCount -> CoreProgram -> [CoreRule] -> IO ()
-dump_end_iteration logger dflags print_unqual iteration_no counts binds rules
-  = dumpPassResult logger dflags print_unqual mb_flag hdr pp_counts binds rules
+dump_end_iteration logger print_unqual iteration_no counts binds rules
+  = dumpPassResult logger print_unqual mb_flag hdr pp_counts binds rules
   where
-    mb_flag | dopt Opt_D_dump_simpl_iterations dflags = Just Opt_D_dump_simpl_iterations
-            | otherwise                               = Nothing
+    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 = text "Simplifier iteration=" <> int iteration_no
-    pp_counts = vcat [ text "---- Simplifier counts for" <+> hdr
+    hdr = "Simplifier iteration=" ++ show iteration_no
+    pp_counts = vcat [ text "---- Simplifier counts for" <+> text hdr
                      , pprSimplCount counts
-                     , text "---- End of simplifier counts for" <+> hdr ]
+                     , text "---- End of simplifier counts for" <+> text hdr ]
 
 {-
 ************************************************************************
@@ -1111,7 +1058,7 @@ dmdAnal logger dflags fam_envs rules binds = do
                { dmd_strict_dicts = gopt Opt_DictsStrict dflags
                }
       binds_plus_dmds = dmdAnalProgram opts fam_envs rules binds
-  Logger.dumpIfSet_dyn logger dflags Opt_D_dump_str_signatures "Strictness signatures" FormatText $
+  Logger.putDumpFileMaybe logger Opt_D_dump_str_signatures "Strictness signatures" FormatText $
     dumpIdInfoOfProgram (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/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 12b277beb2..19705f5541 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -302,16 +302,15 @@ simplRecOrTopPair env top_lvl is_rec mb_cont old_bndr new_bndr rhs
     simplLazyBind env top_lvl is_rec old_bndr new_bndr rhs env
 
   where
-    dflags = seDynFlags env
     logger = seLogger env
 
     -- trace_bind emits a trace for each top-level binding, which
     -- helps to locate the tracing for inlining and rule firing
     trace_bind what thing_inside
-      | not (dopt Opt_D_verbose_core2core dflags)
+      | not (logHasDumpFlag logger Opt_D_verbose_core2core)
       = thing_inside
       | otherwise
-      = putTraceMsg logger dflags ("SimplBind " ++ what)
+      = logTraceMsg logger ("SimplBind " ++ what)
          (ppr old_bndr) thing_inside
 
 --------------------------
@@ -1948,7 +1947,7 @@ simplIdF env var cont
 
 completeCall :: SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr)
 completeCall env var cont
-  | Just expr <- callSiteInline logger dflags case_depth var active_unf
+  | Just expr <- callSiteInline logger uf_opts case_depth var active_unf
                                 lone_variable arg_infos interesting_cont
   -- Inline the variable's RHS
   = do { checkedTick (UnfoldingDone var)
@@ -1965,7 +1964,7 @@ completeCall env var cont
        ; rebuildCall env info cont }
 
   where
-    dflags     = seDynFlags env
+    uf_opts    = seUnfoldingOpts env
     case_depth = seCaseDepth env
     logger     = seLogger env
     (lone_variable, arg_infos, call_cont) = contArgs cont
@@ -1974,14 +1973,13 @@ completeCall env var cont
     active_unf       = activeUnfolding (getMode env) var
 
     log_inlining doc
-      = liftIO $ putDumpMsg logger dflags
-           (mkDumpStyle alwaysQualify)
+      = liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify)
            Opt_D_dump_inlinings
            "" FormatText doc
 
     dump_inline unfolding cont
-      | not (dopt Opt_D_dump_inlinings dflags) = return ()
-      | not (dopt Opt_D_verbose_core2core dflags)
+      | not (logHasDumpFlag logger Opt_D_dump_inlinings) = return ()
+      | not (logHasDumpFlag logger Opt_D_verbose_core2core)
       = when (isExternalName (idName var)) $
             log_inlining $
                 sep [text "Inlining done:", nest 4 (ppr var)]
@@ -2248,8 +2246,8 @@ tryRules env rules fn args call_cont
                       (ruleModule rule))
 
     dump rule rule_rhs
-      | dopt Opt_D_dump_rule_rewrites dflags
-      = log_rule dflags Opt_D_dump_rule_rewrites "Rule fired" $ vcat
+      | logHasDumpFlag logger Opt_D_dump_rule_rewrites
+      = log_rule Opt_D_dump_rule_rewrites "Rule fired" $ vcat
           [ text "Rule:" <+> ftext (ruleName rule)
           , text "Module:" <+>  printRuleModule rule
           , text "Before:" <+> hang (ppr fn) 2 (sep (map ppr args))
@@ -2257,8 +2255,8 @@ tryRules env rules fn args call_cont
                                (sep $ map ppr $ drop (ruleArity rule) args)
           , text "Cont:  " <+> ppr call_cont ]
 
-      | dopt Opt_D_dump_rule_firings dflags
-      = log_rule dflags Opt_D_dump_rule_firings "Rule fired:" $
+      | logHasDumpFlag logger Opt_D_dump_rule_firings
+      = log_rule Opt_D_dump_rule_firings "Rule fired:" $
           ftext (ruleName rule)
             <+> printRuleModule rule
 
@@ -2266,22 +2264,20 @@ tryRules env rules fn args call_cont
       = return ()
 
     nodump
-      | dopt Opt_D_dump_rule_rewrites dflags
+      | logHasDumpFlag logger Opt_D_dump_rule_rewrites
       = liftIO $
-          touchDumpFile logger dflags Opt_D_dump_rule_rewrites
+          touchDumpFile logger Opt_D_dump_rule_rewrites
 
-      | dopt Opt_D_dump_rule_firings dflags
+      | logHasDumpFlag logger Opt_D_dump_rule_firings
       = liftIO $
-          touchDumpFile logger dflags Opt_D_dump_rule_firings
+          touchDumpFile logger Opt_D_dump_rule_firings
 
       | otherwise
       = return ()
 
-    log_rule dflags flag hdr details
-      = liftIO $ do
-          let sty = mkDumpStyle alwaysQualify
-          putDumpMsg logger dflags sty flag "" FormatText $
-              sep [text hdr, nest 4 details]
+    log_rule flag hdr details
+      = liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify) flag "" FormatText
+               $ sep [text hdr, nest 4 details]
 
 trySeqRules :: SimplEnv
             -> OutExpr -> InExpr   -- Scrutinee and RHS
diff --git a/compiler/GHC/Core/Opt/Simplify/Monad.hs b/compiler/GHC/Core/Opt/Simplify/Monad.hs
index 1705cd878f..c730a3e981 100644
--- a/compiler/GHC/Core/Opt/Simplify/Monad.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Monad.hs
@@ -169,9 +169,8 @@ thenSmpl_ m k
 
 traceSmpl :: String -> SDoc -> SimplM ()
 traceSmpl herald doc
-  = do dflags <- getDynFlags
-       logger <- getLogger
-       liftIO $ Logger.dumpIfSet_dyn logger dflags Opt_D_dump_simpl_trace "Simpl Trace"
+  = do logger <- getLogger
+       liftIO $ Logger.putDumpFileMaybe logger Opt_D_dump_simpl_trace "Simpl Trace"
          FormatText
          (hang (text herald) 2 doc)
 {-# INLINE traceSmpl #-}  -- see Note [INLINE conditional tracing utilities]
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 916eb79a45..bd02bd6fc1 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -26,7 +26,8 @@ module GHC.Core.Unfold (
         UnfoldingOpts (..), defaultUnfoldingOpts,
         updateCreationThreshold, updateUseThreshold,
         updateFunAppDiscount, updateDictDiscount,
-        updateVeryAggressive, updateCaseScaling, updateCaseThreshold,
+        updateVeryAggressive, updateCaseScaling,
+        updateCaseThreshold, updateReportPrefix,
 
         ArgSummary(..),
 
@@ -39,8 +40,9 @@ module GHC.Core.Unfold (
 
 import GHC.Prelude
 
-import GHC.Driver.Session
 import GHC.Driver.Ppr
+import GHC.Driver.Flags
+
 import GHC.Core
 import GHC.Core.Utils
 import GHC.Types.Id
@@ -82,11 +84,14 @@ data UnfoldingOpts = UnfoldingOpts
    , unfoldingVeryAggressive :: !Bool
       -- ^ Force inlining in many more cases
 
-      -- Don't consider depth up to x
    , unfoldingCaseThreshold :: !Int
+      -- ^ Don't consider depth up to x
 
-      -- Penalize depth with 1/x
    , unfoldingCaseScaling :: !Int
+      -- ^ Penalize depth with 1/x
+
+   , unfoldingReportPrefix :: !(Maybe String)
+      -- ^ Only report inlining decisions for names with this prefix
    }
 
 defaultUnfoldingOpts :: UnfoldingOpts
@@ -118,6 +123,9 @@ defaultUnfoldingOpts = UnfoldingOpts
 
       -- Penalize depth with (size*depth)/scaling
    , unfoldingCaseScaling = 30
+
+      -- Don't filter inlining decision reports
+   , unfoldingReportPrefix = Nothing
    }
 
 -- Helpers for "GHC.Driver.Session"
@@ -144,6 +152,9 @@ updateCaseThreshold n opts = opts { unfoldingCaseThreshold = n }
 updateCaseScaling :: Int -> UnfoldingOpts -> UnfoldingOpts
 updateCaseScaling n opts = opts { unfoldingCaseScaling = n }
 
+updateReportPrefix :: Maybe String -> UnfoldingOpts -> UnfoldingOpts
+updateReportPrefix n opts = opts { unfoldingReportPrefix = n }
+
 {-
 Note [Occurrence analysis of unfoldings]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1057,16 +1068,6 @@ them inlining is to give them a NOINLINE pragma, which we do in
 StrictAnal.addStrictnessInfoToTopId
 -}
 
-callSiteInline :: Logger
-               -> DynFlags
-               -> Int                   -- Case depth
-               -> Id                    -- The Id
-               -> Bool                  -- True <=> unfolding is active
-               -> Bool                  -- True if there are no arguments at all (incl type args)
-               -> [ArgSummary]          -- One for each value arg; True if it is interesting
-               -> CallCtxt              -- True <=> continuation is interesting
-               -> Maybe CoreExpr        -- Unfolding, if any
-
 data ArgSummary = TrivArg       -- Nothing interesting
                 | NonTrivArg    -- Arg has structure
                 | ValueArg      -- Arg is a con-app or PAP
@@ -1102,7 +1103,16 @@ instance Outputable CallCtxt where
   ppr DiscArgCtxt = text "DiscArgCtxt"
   ppr RuleArgCtxt = text "RuleArgCtxt"
 
-callSiteInline logger dflags !case_depth id active_unfolding lone_variable arg_infos cont_info
+callSiteInline :: Logger
+               -> UnfoldingOpts
+               -> Int                   -- Case depth
+               -> Id                    -- The Id
+               -> Bool                  -- True <=> unfolding is active
+               -> Bool                  -- True if there are no arguments at all (incl type args)
+               -> [ArgSummary]          -- One for each value arg; True if it is interesting
+               -> CallCtxt              -- True <=> continuation is interesting
+               -> Maybe CoreExpr        -- Unfolding, if any
+callSiteInline logger opts !case_depth id active_unfolding lone_variable arg_infos cont_info
   = case idUnfolding id of
       -- idUnfolding checks for loop-breakers, returning NoUnfolding
       -- Things with an INLINE pragma may have an unfolding *and*
@@ -1110,28 +1120,28 @@ callSiteInline logger dflags !case_depth id active_unfolding lone_variable arg_i
         CoreUnfolding { uf_tmpl = unf_template
                       , uf_is_work_free = is_wf
                       , uf_guidance = guidance, uf_expandable = is_exp }
-          | active_unfolding -> tryUnfolding logger dflags case_depth id lone_variable
+          | active_unfolding -> tryUnfolding logger opts case_depth id lone_variable
                                     arg_infos cont_info unf_template
                                     is_wf is_exp guidance
-          | otherwise -> traceInline logger dflags id "Inactive unfolding:" (ppr id) Nothing
+          | otherwise -> traceInline logger opts id "Inactive unfolding:" (ppr id) Nothing
         NoUnfolding      -> Nothing
         BootUnfolding    -> Nothing
         OtherCon {}      -> Nothing
         DFunUnfolding {} -> Nothing     -- Never unfold a DFun
 
 -- | Report the inlining of an identifier's RHS to the user, if requested.
-traceInline :: Logger -> DynFlags -> Id -> String -> SDoc -> a -> a
-traceInline logger dflags inline_id str doc result
+traceInline :: Logger -> UnfoldingOpts -> Id -> String -> SDoc -> a -> a
+traceInline logger opts inline_id str doc result
   -- We take care to ensure that doc is used in only one branch, ensuring that
   -- the simplifier can push its allocation into the branch. See Note [INLINE
   -- conditional tracing utilities].
-  | enable    = putTraceMsg logger dflags str doc result
+  | enable    = logTraceMsg logger str doc result
   | otherwise = result
   where
     enable
-      | dopt Opt_D_dump_verbose_inlinings dflags
+      | logHasDumpFlag logger Opt_D_dump_verbose_inlinings
       = True
-      | Just prefix <- inlineCheck dflags
+      | Just prefix <- unfoldingReportPrefix opts
       = prefix `isPrefixOf` occNameString (getOccName inline_id)
       | otherwise
       = False
@@ -1233,48 +1243,47 @@ needed on a per-module basis.
 
 -}
 
-tryUnfolding :: Logger -> DynFlags -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt
+tryUnfolding :: Logger -> UnfoldingOpts -> Int -> Id -> Bool -> [ArgSummary] -> CallCtxt
              -> CoreExpr -> Bool -> Bool -> UnfoldingGuidance
              -> Maybe CoreExpr
-tryUnfolding logger dflags !case_depth id lone_variable
+tryUnfolding logger opts !case_depth id lone_variable
              arg_infos cont_info unf_template
              is_wf is_exp guidance
  = case guidance of
-     UnfNever -> traceInline logger dflags id str (text "UnfNever") Nothing
+     UnfNever -> traceInline logger opts id str (text "UnfNever") Nothing
 
      UnfWhen { ug_arity = uf_arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
-        | enough_args && (boring_ok || some_benefit || unfoldingVeryAggressive uf_opts)
+        | enough_args && (boring_ok || some_benefit || unfoldingVeryAggressive opts)
                 -- See Note [INLINE for small functions (3)]
-        -> traceInline logger dflags id str (mk_doc some_benefit empty True) (Just unf_template)
+        -> traceInline logger opts id str (mk_doc some_benefit empty True) (Just unf_template)
         | otherwise
-        -> traceInline logger dflags id str (mk_doc some_benefit empty False) Nothing
+        -> traceInline logger opts id str (mk_doc some_benefit empty False) Nothing
         where
           some_benefit = calc_some_benefit uf_arity
           enough_args = (n_val_args >= uf_arity) || (unsat_ok && n_val_args > 0)
 
      UnfIfGoodArgs { ug_args = arg_discounts, ug_res = res_discount, ug_size = size }
-        | unfoldingVeryAggressive uf_opts
-        -> traceInline logger dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)
+        | unfoldingVeryAggressive opts
+        -> traceInline logger opts id str (mk_doc some_benefit extra_doc True) (Just unf_template)
         | is_wf && some_benefit && small_enough
-        -> traceInline logger dflags id str (mk_doc some_benefit extra_doc True) (Just unf_template)
+        -> traceInline logger opts id str (mk_doc some_benefit extra_doc True) (Just unf_template)
         | otherwise
-        -> traceInline logger dflags id str (mk_doc some_benefit extra_doc False) Nothing
+        -> traceInline logger opts id str (mk_doc some_benefit extra_doc False) Nothing
         where
           some_benefit = calc_some_benefit (length arg_discounts)
           extra_doc = vcat [ text "case depth =" <+> int case_depth
                            , text "depth based penalty =" <+> int depth_penalty
                            , text "discounted size =" <+> int adjusted_size ]
           -- See Note [Avoid inlining into deeply nested cases]
-          depth_treshold = unfoldingCaseThreshold uf_opts
-          depth_scaling = unfoldingCaseScaling uf_opts
+          depth_treshold = unfoldingCaseThreshold opts
+          depth_scaling = unfoldingCaseScaling opts
           depth_penalty | case_depth <= depth_treshold = 0
                         | otherwise       = (size * (case_depth - depth_treshold)) `div` depth_scaling
           adjusted_size = size + depth_penalty - discount
-          small_enough = adjusted_size <= unfoldingUseThreshold uf_opts
+          small_enough = adjusted_size <= unfoldingUseThreshold opts
           discount = computeDiscount arg_discounts res_discount arg_infos cont_info
 
   where
-    uf_opts = unfoldingOpts dflags
     mk_doc some_benefit extra_doc yes_or_no
       = vcat [ text "arg infos" <+> ppr arg_infos
              , text "interesting continuation" <+> ppr cont_info
@@ -1285,7 +1294,7 @@ tryUnfolding logger dflags !case_depth id lone_variable
              , extra_doc
              , text "ANSWER =" <+> if yes_or_no then text "YES" else text "NO"]
 
-    ctx = initSDocContext dflags defaultDumpStyle
+    ctx = log_default_dump_context (logFlags logger)
     str = "Considering inlining: " ++ showSDocDump ctx (ppr id)
     n_val_args = length arg_infos