Avoid DynFlags in Ppr code (#17957)

* replace `DynFlags` parameters with `SDocContext` parameters for a few
  Ppr related functions: `bufLeftRenderSDoc`, `printSDoc`,
  `printSDocLn`, `showSDocOneLine`.

* remove the use of `pprCols :: DynFlags -> Int` in Outputable. We
  already have the information via `sdocLineLength :: SDocContext ->
  Int`

7 files changed, 49 insertions, 42 deletions

diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 4ccdad826d..558d422ba1 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -387,7 +387,8 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
           dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)
 
         -- write out the imports
-        printSDocLn Pretty.LeftMode dflags h (mkCodeStyle AsmStyle)
+        let ctx = initSDocContext dflags (mkCodeStyle AsmStyle)
+        printSDocLn ctx Pretty.LeftMode h
                 $ makeImportsDoc dflags (concat (ngs_imports ngs))
         return us'
   where
@@ -516,8 +517,8 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
 emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
 emitNativeCode dflags h sdoc = do
 
-        {-# SCC "pprNativeCode" #-} bufLeftRenderSDoc dflags h
-                                      (mkCodeStyle AsmStyle) sdoc
+        let ctx = initSDocContext dflags (mkCodeStyle AsmStyle)
+        {-# SCC "pprNativeCode" #-} bufLeftRenderSDoc ctx h sdoc
 
         -- dump native code
         dumpIfSet_dyn dflags
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index 981535e993..b36b4814f1 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -447,8 +447,8 @@ renderLlvm sdoc = do
     -- Write to output
     dflags <- getDynFlags
     out <- getEnv envOutput
-    liftIO $ Outp.bufLeftRenderSDoc dflags out
-               (Outp.mkCodeStyle Outp.CStyle) sdoc
+    let ctx = initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle)
+    liftIO $ Outp.bufLeftRenderSDoc ctx out sdoc
 
     -- Dump, if requested
     dumpIfSetLlvm Opt_D_dump_llvm "LLVM Code" FormatLLVM sdoc
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 5ed6e093d7..8f64966131 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -230,7 +230,7 @@ module GHC.Driver.Session (
         IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
 
         -- * SDoc
-        initSDocContext,
+        initSDocContext, initDefaultSDocContext,
 
         -- * Make use of the Cmm CFG
         CfgWeights(..)
@@ -1588,7 +1588,8 @@ defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO ()
 defaultLogActionHPutStrDoc dflags h d sty
   -- Don't add a newline at the end, so that successive
   -- calls to this log-action can output all on the same line
-  = printSDoc Pretty.PageMode dflags h sty d
+  = printSDoc ctx Pretty.PageMode h d
+    where ctx = initSDocContext dflags sty
 
 newtype FlushOut = FlushOut (IO ())
 
@@ -5184,7 +5185,7 @@ emptyFilesToClean :: FilesToClean
 emptyFilesToClean = FilesToClean Set.empty Set.empty
 
 
-
+-- | Initialize the pretty-printing options
 initSDocContext :: DynFlags -> PprStyle -> SDocContext
 initSDocContext dflags style = SDC
   { sdocStyle                       = style
@@ -5220,3 +5221,7 @@ initSDocContext dflags style = SDC
   , sdocImpredicativeTypes          = xopt LangExt.ImpredicativeTypes dflags
   , sdocDynFlags                    = dflags
   }
+
+-- | Initialize the pretty-printing options using the default user style
+initDefaultSDocContext :: DynFlags -> SDocContext
+initDefaultSDocContext dflags = initSDocContext dflags (defaultUserStyle dflags)
diff --git a/compiler/GHC/Driver/Session.hs-boot b/compiler/GHC/Driver/Session.hs-boot
index 23458ee1eb..2bc44dc3c6 100644
--- a/compiler/GHC/Driver/Session.hs-boot
+++ b/compiler/GHC/Driver/Session.hs-boot
@@ -8,7 +8,6 @@ data DynFlags
 
 targetPlatform           :: DynFlags -> Platform
 pprUserLength            :: DynFlags -> Int
-pprCols                  :: DynFlags -> Int
 unsafeGlobalDynFlags     :: DynFlags
 hasPprDebug              :: DynFlags -> Bool
 hasNoDebugOutput         :: DynFlags -> Bool
diff --git a/compiler/GHC/Tc/Deriv/Generate.hs b/compiler/GHC/Tc/Deriv/Generate.hs
index 4f00de2427..5156bb0aa1 100644
--- a/compiler/GHC/Tc/Deriv/Generate.hs
+++ b/compiler/GHC/Tc/Deriv/Generate.hs
@@ -1342,8 +1342,9 @@ gen_data dflags data_type_name constr_names loc rep_tc
                      L loc (TypeSig noExtField [L loc data_type_name] sig_ty))
 
     sig_ty = mkLHsSigWcType (nlHsTyVar dataType_RDR)
+    ctx    = initDefaultSDocContext dflags
     rhs    = nlHsVar mkDataType_RDR
-             `nlHsApp` nlHsLit (mkHsString (showSDocOneLine dflags (ppr rep_tc)))
+             `nlHsApp` nlHsLit (mkHsString (showSDocOneLine ctx (ppr rep_tc)))
              `nlHsApp` nlList (map nlHsVar constr_names)
 
     genDataDataCon :: DataCon -> RdrName -> DerivStuff
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index 0096891e54..2a4168302b 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -729,12 +729,13 @@ withTiming' dflags what force_result prtimings action
           then do whenPrintTimings $
                     logInfo dflags (defaultUserStyle dflags) $
                       text "***" <+> what <> colon
-                  eventBegins dflags what
+                  let ctx = initDefaultSDocContext dflags
+                  eventBegins ctx what
                   alloc0 <- liftIO getAllocationCounter
                   start <- liftIO getCPUTime
                   !r <- action
                   () <- pure $ force_result r
-                  eventEnds dflags what
+                  eventEnds ctx what
                   end <- liftIO getCPUTime
                   alloc1 <- liftIO getAllocationCounter
                   -- recall that allocation counter counts down
@@ -753,7 +754,7 @@ withTiming' dflags what force_result prtimings action
 
                   whenPrintTimings $
                       dumpIfSet_dyn dflags Opt_D_dump_timings "" FormatText
-                          $ text $ showSDocOneLine dflags
+                          $ text $ showSDocOneLine ctx
                           $ hsep [ what <> colon
                                  , text "alloc=" <> ppr alloc
                                  , text "time=" <> doublePrec 3 time
@@ -762,15 +763,15 @@ withTiming' dflags what force_result prtimings action
            else action
 
     where whenPrintTimings = liftIO . when (prtimings == PrintTimings)
-          eventBegins dflags w = do
-            whenPrintTimings $ traceMarkerIO (eventBeginsDoc dflags w)
-            liftIO $ traceEventIO (eventBeginsDoc dflags w)
-          eventEnds dflags w = do
-            whenPrintTimings $ traceMarkerIO (eventEndsDoc dflags w)
-            liftIO $ traceEventIO (eventEndsDoc dflags w)
-
-          eventBeginsDoc dflags w = showSDocOneLine dflags $ text "GHC:started:" <+> w
-          eventEndsDoc dflags w = showSDocOneLine dflags $ text "GHC:finished:" <+> w
+          eventBegins ctx w = do
+            whenPrintTimings $ traceMarkerIO (eventBeginsDoc ctx w)
+            liftIO $ traceEventIO (eventBeginsDoc ctx w)
+          eventEnds ctx w = do
+            whenPrintTimings $ traceMarkerIO (eventEndsDoc ctx w)
+            liftIO $ traceEventIO (eventEndsDoc ctx w)
+
+          eventBeginsDoc ctx w = showSDocOneLine ctx $ text "GHC:started:" <+> w
+          eventEndsDoc   ctx w = showSDocOneLine ctx $ text "GHC:finished:" <+> w
 
 debugTraceMsg :: DynFlags -> Int -> MsgDoc -> IO ()
 debugTraceMsg dflags val msg = ifVerbose dflags val $
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index c23f6ed180..d36faa4724 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -96,7 +96,7 @@ import GhcPrelude
 
 import {-# SOURCE #-}   GHC.Driver.Session
                            ( DynFlags, hasPprDebug, hasNoDebugOutput
-                           , pprUserLength, pprCols
+                           , pprUserLength
                            , unsafeGlobalDynFlags, initSDocContext
                            )
 import {-# SOURCE #-}   GHC.Types.Module( UnitId, Module, ModuleName, moduleName )
@@ -484,43 +484,43 @@ whenPprDebug d = ifPprDebug d empty
 -- | The analog of 'Pretty.printDoc_' for 'SDoc', which tries to make sure the
 --   terminal doesn't get screwed up by the ANSI color codes if an exception
 --   is thrown during pretty-printing.
-printSDoc :: Mode -> DynFlags -> Handle -> PprStyle -> SDoc -> IO ()
-printSDoc mode dflags handle sty doc =
+printSDoc :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
+printSDoc ctx mode handle doc =
   Pretty.printDoc_ mode cols handle (runSDoc doc ctx)
     `finally`
       Pretty.printDoc_ mode cols handle
         (runSDoc (coloured Col.colReset empty) ctx)
   where
-    cols = pprCols dflags
-    ctx = initSDocContext dflags sty
+    cols = sdocLineLength ctx
 
 -- | Like 'printSDoc' but appends an extra newline.
-printSDocLn :: Mode -> DynFlags -> Handle -> PprStyle -> SDoc -> IO ()
-printSDocLn mode dflags handle sty doc =
-  printSDoc mode dflags handle sty (doc $$ text "")
+printSDocLn :: SDocContext -> Mode -> Handle -> SDoc -> IO ()
+printSDocLn ctx mode handle doc =
+  printSDoc ctx mode handle (doc $$ text "")
 
 printForUser :: DynFlags -> Handle -> PrintUnqualified -> SDoc -> IO ()
 printForUser dflags handle unqual doc
-  = printSDocLn PageMode dflags handle
-               (mkUserStyle dflags unqual AllTheWay) doc
+  = printSDocLn ctx PageMode handle doc
+    where ctx = initSDocContext dflags (mkUserStyle dflags unqual AllTheWay)
 
 printForUserPartWay :: DynFlags -> Handle -> Int -> PrintUnqualified -> SDoc
                     -> IO ()
 printForUserPartWay dflags handle d unqual doc
-  = printSDocLn PageMode dflags handle
-                (mkUserStyle dflags unqual (PartWay d)) doc
+  = printSDocLn ctx PageMode handle doc
+    where ctx = initSDocContext dflags (mkUserStyle dflags unqual (PartWay d))
 
 -- | Like 'printSDocLn' but specialized with 'LeftMode' and
 -- @'PprCode' 'CStyle'@.  This is typically used to output C-- code.
 printForC :: DynFlags -> Handle -> SDoc -> IO ()
 printForC dflags handle doc =
-  printSDocLn LeftMode dflags handle (PprCode CStyle) doc
+  printSDocLn ctx LeftMode handle doc
+  where ctx = initSDocContext dflags (PprCode CStyle)
 
 -- | An efficient variant of 'printSDoc' specialized for 'LeftMode' that
 -- outputs to a 'BufHandle'.
-bufLeftRenderSDoc :: DynFlags -> BufHandle -> PprStyle -> SDoc -> IO ()
-bufLeftRenderSDoc dflags bufHandle sty doc =
-  Pretty.bufLeftRender bufHandle (runSDoc doc (initSDocContext dflags sty))
+bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO ()
+bufLeftRenderSDoc ctx bufHandle doc =
+  Pretty.bufLeftRender bufHandle (runSDoc doc ctx)
 
 pprCode :: CodeStyle -> SDoc -> SDoc
 pprCode cs d = withPprStyle (PprCode cs) d
@@ -566,12 +566,12 @@ renderWithStyle ctx sdoc
 -- This shows an SDoc, but on one line only. It's cheaper than a full
 -- showSDoc, designed for when we're getting results like "Foo.bar"
 -- and "foo{uniq strictness}" so we don't want fancy layout anyway.
-showSDocOneLine :: DynFlags -> SDoc -> String
-showSDocOneLine dflags d
+showSDocOneLine :: SDocContext -> SDoc -> String
+showSDocOneLine ctx d
  = let s = Pretty.style{ Pretty.mode = OneLineMode,
-                         Pretty.lineLength = pprCols dflags } in
+                         Pretty.lineLength = sdocLineLength ctx } in
    Pretty.renderStyle s $
-      runSDoc d (initSDocContext dflags (defaultUserStyle dflags))
+      runSDoc d ctx
 
 showSDocDumpOneLine :: DynFlags -> SDoc -> String
 showSDocDumpOneLine dflags d