NCG: Dwarf configuration

* remove references to DynFlags in GHC.CmmToAsm.Dwarf
* add specific Dwarf options in NCGConfig instead of directly querying
  the debug level

13 files changed, 120 insertions, 72 deletions

diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 677c7bdcbf..4f19085ac9 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -152,7 +152,7 @@ nativeCodeGen dflags this_mod modLoc h us cmms
        platform = ncgPlatform config
        nCG' :: ( Outputable statics, Outputable jumpDest, Instruction instr)
             => NcgImpl statics instr jumpDest -> IO a
-       nCG' ncgImpl = nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
+       nCG' ncgImpl = nativeCodeGen' dflags config this_mod modLoc ncgImpl h us cmms
    in case platformArch platform of
       ArchX86       -> nCG' (X86.ncgX86     config)
       ArchX86_64    -> nCG' (X86.ncgX86_64  config)
@@ -216,39 +216,42 @@ See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
 
 nativeCodeGen' :: (Outputable statics, Outputable jumpDest, Instruction instr)
                => DynFlags
+               -> NCGConfig
                -> Module -> ModLocation
                -> NcgImpl statics instr jumpDest
                -> Handle
                -> UniqSupply
                -> Stream IO RawCmmGroup a
                -> IO a
-nativeCodeGen' dflags this_mod modLoc ncgImpl h us cmms
+nativeCodeGen' dflags config this_mod modLoc ncgImpl h us cmms
  = do
         -- BufHandle is a performance hack.  We could hide it inside
         -- Pretty if it weren't for the fact that we do lots of little
         -- printDocs here (in order to do codegen in constant space).
         bufh <- newBufHandle h
         let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty
-        (ngs, us', a) <- cmmNativeGenStream dflags this_mod modLoc ncgImpl bufh us
+        (ngs, us', a) <- cmmNativeGenStream dflags config this_mod modLoc ncgImpl bufh us
                                          cmms ngs0
-        _ <- finishNativeGen dflags modLoc bufh us' ngs
+        _ <- finishNativeGen dflags config modLoc bufh us' ngs
         return a
 
 finishNativeGen :: Instruction instr
                 => DynFlags
+                -> NCGConfig
                 -> ModLocation
                 -> BufHandle
                 -> UniqSupply
                 -> NativeGenAcc statics instr
                 -> IO UniqSupply
-finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
+finishNativeGen dflags config modLoc bufh@(BufHandle _ _ h) us ngs
  = withTimingSilent dflags (text "NCG") (`seq` ()) $ do
         -- Write debug data and finish
-        let emitDw = debugLevel dflags > 0
-        us' <- if not emitDw then return us else do
-          (dwarf, us') <- dwarfGen dflags modLoc us (ngs_debug ngs)
-          emitNativeCode dflags bufh dwarf
-          return us'
+        us' <- if not (ncgDwarfEnabled config)
+                  then return us
+                  else do
+                     (dwarf, us') <- dwarfGen config modLoc us (ngs_debug ngs)
+                     emitNativeCode dflags config bufh dwarf
+                     return us'
         bFlush bufh
 
         -- dump global NCG stats for graph coloring allocator
@@ -263,7 +266,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
 
           dump_stats (Color.pprStats stats graphGlobal)
 
-          let platform = targetPlatform dflags
+          let platform = ncgPlatform config
           dumpIfSet_dyn dflags
                   Opt_D_dump_asm_conflicts "Register conflict graph"
                   FormatText
@@ -281,7 +284,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
           dump_stats (Linear.pprStats (concat (ngs_natives ngs)) linearStats)
 
         -- write out the imports
-        let ctx = initSDocContext dflags (mkCodeStyle AsmStyle)
+        let ctx = ncgAsmContext config
         printSDocLn ctx Pretty.LeftMode h
                 $ makeImportsDoc dflags (concat (ngs_imports ngs))
         return us'
@@ -292,6 +295,7 @@ finishNativeGen dflags modLoc bufh@(BufHandle _ _ h) us ngs
 
 cmmNativeGenStream :: (Outputable statics, Outputable jumpDest, Instruction instr)
               => DynFlags
+              -> NCGConfig
               -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
               -> BufHandle
@@ -300,7 +304,7 @@ cmmNativeGenStream :: (Outputable statics, Outputable jumpDest, Instruction inst
               -> NativeGenAcc statics instr
               -> IO (NativeGenAcc statics instr, UniqSupply, a)
 
-cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
+cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us cmm_stream ngs
  = do r <- Stream.runStream cmm_stream
       case r of
         Left a ->
@@ -317,13 +321,12 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
                 dflags
                 ncglabel (\(a, b) -> a `seq` b `seq` ()) $ do
               -- Generate debug information
-              let debugFlag = debugLevel dflags > 0
-                  !ndbgs | debugFlag = cmmDebugGen modLoc cmms
-                         | otherwise = []
+              let !ndbgs | ncgDwarfEnabled config = cmmDebugGen modLoc cmms
+                         | otherwise              = []
                   dbgMap = debugToMap ndbgs
 
               -- Generate native code
-              (ngs',us') <- cmmNativeGens dflags this_mod modLoc ncgImpl h
+              (ngs',us') <- cmmNativeGens dflags config this_mod modLoc ncgImpl h
                                                dbgMap us cmms ngs 0
 
               -- Link native code information into debug blocks
@@ -337,7 +340,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
               let ngs'' = ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs, ngs_labels = [] }
               return (us', ngs'')
 
-          cmmNativeGenStream dflags this_mod modLoc ncgImpl h us'
+          cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us'
               cmm_stream' ngs''
 
     where ncglabel = text "NCG"
@@ -347,6 +350,7 @@ cmmNativeGenStream dflags this_mod modLoc ncgImpl h us cmm_stream ngs
 cmmNativeGens :: forall statics instr jumpDest.
                  (Outputable statics, Outputable jumpDest, Instruction instr)
               => DynFlags
+              -> NCGConfig
               -> Module -> ModLocation
               -> NcgImpl statics instr jumpDest
               -> BufHandle
@@ -357,7 +361,7 @@ cmmNativeGens :: forall statics instr jumpDest.
               -> Int
               -> IO (NativeGenAcc statics instr, UniqSupply)
 
-cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
+cmmNativeGens dflags config this_mod modLoc ncgImpl h dbgMap = go
   where
     go :: UniqSupply -> [RawCmmDecl]
        -> NativeGenAcc statics instr -> Int
@@ -382,14 +386,14 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
             pprDecl (f,n) = text "\t.file " <> ppr n <+>
                             pprFilePathString (unpackFS f)
 
-        emitNativeCode dflags h $ vcat $
+        emitNativeCode dflags config h $ vcat $
           map pprDecl newFileIds ++
           map (pprNatCmmDecl ncgImpl) native
 
         -- force evaluation all this stuff to avoid space leaks
         {-# SCC "seqString" #-} evaluate $ seqList (showSDoc dflags $ vcat $ map ppr imports) ()
 
-        let !labels' = if debugLevel dflags > 0
+        let !labels' = if ncgDwarfEnabled config
                        then cmmDebugLabels isMetaInstr native else []
             !natives' = if dopt Opt_D_dump_asm_stats dflags
                         then native : ngs_natives ngs else []
@@ -406,10 +410,10 @@ cmmNativeGens dflags this_mod modLoc ncgImpl h dbgMap = go
         go us' cmms ngs' (count + 1)
 
 
-emitNativeCode :: DynFlags -> BufHandle -> SDoc -> IO ()
-emitNativeCode dflags h sdoc = do
+emitNativeCode :: DynFlags -> NCGConfig -> BufHandle -> SDoc -> IO ()
+emitNativeCode dflags config h sdoc = do
 
-        let ctx = initSDocContext dflags (mkCodeStyle AsmStyle)
+        let ctx = ncgAsmContext config
         {-# SCC "pprNativeCode" #-} bufLeftRenderSDoc ctx h sdoc
 
         -- dump native code
@@ -791,10 +795,9 @@ makeImportsDoc dflags imports
                 | otherwise
                 = Outputable.empty
 
-        doPpr lbl = (lbl, renderWithStyle
-                              (initSDocContext dflags astyle)
+        doPpr lbl = (lbl, renderWithContext
+                              (ncgAsmContext config)
                               (pprCLabel_NCG platform lbl))
-        astyle = mkCodeStyle AsmStyle
 
 -- -----------------------------------------------------------------------------
 -- Generate jump tables
@@ -1140,8 +1143,8 @@ cmmExprNative referenceKind expr = do
 initNCGConfig :: DynFlags -> NCGConfig
 initNCGConfig dflags = NCGConfig
    { ncgPlatform              = targetPlatform dflags
+   , ncgAsmContext            = initSDocContext dflags (mkCodeStyle AsmStyle)
    , ncgProcAlignment         = cmmProcAlignment dflags
-   , ncgDebugLevel            = debugLevel dflags
    , ncgExternalDynamicRefs   = gopt Opt_ExternalDynamicRefs dflags
    , ncgPIC                   = positionIndependent dflags
    , ncgInlineThresholdMemcpy = fromIntegral $ maxInlineMemcpyInsns dflags
@@ -1180,5 +1183,9 @@ initNCGConfig dflags = NCGConfig
             ArchX86_64 -> v
             ArchX86    -> v
             _          -> Nothing
+
+   , ncgDwarfEnabled        = debugLevel dflags > 0
+   , ncgDwarfUnwindings     = debugLevel dflags >= 1
+   , ncgDwarfStripBlockInfo = debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1.
    }
 
diff --git a/compiler/GHC/CmmToAsm/Config.hs b/compiler/GHC/CmmToAsm/Config.hs
index 29d8bcad15..d4abafd402 100644
--- a/compiler/GHC/CmmToAsm/Config.hs
+++ b/compiler/GHC/CmmToAsm/Config.hs
@@ -11,12 +11,13 @@ import GHC.Prelude
 import GHC.Platform
 import GHC.Cmm.Type (Width(..))
 import GHC.CmmToAsm.CFG.Weight
+import GHC.Utils.Outputable
 
 -- | Native code generator configuration
 data NCGConfig = NCGConfig
    { ncgPlatform              :: !Platform        -- ^ Target platform
+   , ncgAsmContext            :: !SDocContext     -- ^ Context for ASM code generation
    , ncgProcAlignment         :: !(Maybe Int)     -- ^ Mandatory proc alignment
-   , ncgDebugLevel            :: !Int             -- ^ Debug level
    , ncgExternalDynamicRefs   :: !Bool            -- ^ Generate code to link against dynamic libraries
    , ncgPIC                   :: !Bool            -- ^ Enable Position-Independent Code
    , ncgInlineThresholdMemcpy :: !Word            -- ^ If inlining `memcpy` produces less than this threshold (in pseudo-instruction unit), do it
@@ -33,6 +34,9 @@ data NCGConfig = NCGConfig
    , ncgCfgWeights            :: !Weights         -- ^ CFG edge weights
    , ncgCfgBlockLayout        :: !Bool            -- ^ Use CFG based block layout algorithm
    , ncgCfgWeightlessLayout   :: !Bool            -- ^ Layout based on last instruction per block.
+   , ncgDwarfEnabled          :: !Bool            -- ^ Enable Dwarf generation
+   , ncgDwarfUnwindings       :: !Bool            -- ^ Enable unwindings
+   , ncgDwarfStripBlockInfo   :: !Bool            -- ^ Strip out block information from generated Dwarf
    }
 
 -- | Return Word size
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index ccf2cf8758..d09588841b 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -4,9 +4,6 @@ module GHC.CmmToAsm.Dwarf (
 
 import GHC.Prelude
 
-import GHC.Driver.Session
-import GHC.Driver.Ppr
-
 import GHC.Cmm.CLabel
 import GHC.Cmm.Expr        ( GlobalReg(..) )
 import GHC.Settings.Config ( cProjectName, cProjectVersion )
@@ -20,6 +17,7 @@ import GHC.Types.Unique.Supply
 
 import GHC.CmmToAsm.Dwarf.Constants
 import GHC.CmmToAsm.Dwarf.Types
+import GHC.CmmToAsm.Config
 
 import Control.Arrow    ( first )
 import Control.Monad    ( mfilter )
@@ -34,23 +32,22 @@ import qualified GHC.Cmm.Dataflow.Label as H
 import qualified GHC.Cmm.Dataflow.Collections as H
 
 -- | Generate DWARF/debug information
-dwarfGen :: DynFlags -> ModLocation -> UniqSupply -> [DebugBlock]
+dwarfGen :: NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock]
             -> IO (SDoc, UniqSupply)
-dwarfGen _  _      us [] = return (empty, us)
-dwarfGen df modLoc us blocks = do
-  let platform = targetPlatform df
+dwarfGen _      _      us []     = return (empty, us)
+dwarfGen config modLoc us blocks = do
+  let platform = ncgPlatform config
 
   -- Convert debug data structures to DWARF info records
-  -- We strip out block information when running with -g0 or -g1.
   let procs = debugSplitProcs blocks
       stripBlocks dbg
-        | debugLevel df < 2 = dbg { dblBlocks = [] }
-        | otherwise         = dbg
+        | ncgDwarfStripBlockInfo config = dbg { dblBlocks = [] }
+        | otherwise                     = dbg
   compPath <- getCurrentDirectory
   let lowLabel = dblCLabel $ head procs
       highLabel = mkAsmTempEndLabel $ dblCLabel $ last procs
       dwarfUnit = DwarfCompileUnit
-        { dwChildren = map (procToDwarf df) (map stripBlocks procs)
+        { dwChildren = map (procToDwarf config) (map stripBlocks procs)
         , dwName = fromMaybe "" (ml_hs_file modLoc)
         , dwCompDir = addTrailingPathSeparator compPath
         , dwProducer = cProjectName ++ " " ++ cProjectVersion
@@ -91,8 +88,8 @@ dwarfGen df modLoc us blocks = do
                  pprDwarfFrame platform (debugFrame framesU procs)
 
   -- .aranges section: Information about the bounds of compilation units
-  let aranges' | gopt Opt_SplitSections df = map mkDwarfARange procs
-               | otherwise                 = [DwarfARange lowLabel highLabel]
+  let aranges' | ncgSplitSections config = map mkDwarfARange procs
+               | otherwise               = [DwarfARange lowLabel highLabel]
   let aranges = dwarfARangesSection platform $$ pprDwarfARanges platform aranges' unitU
 
   return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
@@ -177,12 +174,14 @@ parent, B.
 -}
 
 -- | Generate DWARF info for a procedure debug block
-procToDwarf :: DynFlags -> DebugBlock -> DwarfInfo
-procToDwarf df prc
+procToDwarf :: NCGConfig -> DebugBlock -> DwarfInfo
+procToDwarf config prc
   = DwarfSubprogram { dwChildren = map blockToDwarf (dblBlocks prc)
                     , dwName     = case dblSourceTick prc of
                          Just s@SourceNote{} -> sourceName s
-                         _otherwise -> showSDocDump df $ ppr $ dblLabel prc
+                         _otherwise -> renderWithContext defaultSDocContext
+                                          $ withPprStyle defaultDumpStyle
+                                          $ ppr (dblLabel prc)
                     , dwLabel    = dblCLabel prc
                     , dwParent   = fmap mkAsmTempDieLabel
                                    $ mfilter goodParent
@@ -192,9 +191,9 @@ procToDwarf df prc
   goodParent a | a == dblCLabel prc = False
                -- Omit parent if it would be self-referential
   goodParent a | not (externallyVisibleCLabel a)
-               , debugLevel df < 2 = False
-               -- We strip block information when running -g0 or -g1, don't
-               -- refer to blocks in that case. Fixes #14894.
+               , ncgDwarfStripBlockInfo config = False
+               -- If we strip block information, don't refer to blocks.
+               -- Fixes #14894.
   goodParent _ = True
 
 -- | Generate DWARF info for a block
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 3622121e6c..259159aa44 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -64,7 +64,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
             _ -> pprLabel platform lbl) $$ -- blocks guaranteed not null,
                                            -- so label needed
          vcat (map (pprBasicBlock config top_info) blocks) $$
-         (if ncgDebugLevel config > 0
+         (if ncgDwarfEnabled config
           then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
          pprSizeDecl platform lbl
 
@@ -131,7 +131,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
     pprLabel platform asmLbl $$
     vcat (map (pprInstr platform) instrs) $$
-    (if  ncgDebugLevel config > 0
+    (if  ncgDwarfEnabled config
       then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
       else empty
     )
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index cbf3da9925..31b111eab6 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -229,7 +229,7 @@ basicBlockCodeGen block = do
 addSpUnwindings :: Instr -> NatM (OrdList Instr)
 addSpUnwindings instr@(DELTA d) = do
     config <- getConfig
-    if ncgDebugLevel config >= 1
+    if ncgDwarfUnwindings config
         then do lbl <- mkAsmTempLabel <$> getUniqueM
                 let unwind = M.singleton MachSp (Just $ UwReg MachSp $ negate d)
                 return $ toOL [ instr, UNWIND lbl unwind ]
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 410eddbf85..b5fb852512 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -91,7 +91,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
         pprProcAlignment config $$
         pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
         vcat (map (pprBasicBlock config top_info) blocks) $$
-        (if ncgDebugLevel config > 0
+        (if ncgDwarfEnabled config
          then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
         pprSizeDecl platform lbl
 
@@ -125,7 +125,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
   = maybe_infotable $
     pprLabel platform asmLbl $$
     vcat (map (pprInstr platform) instrs) $$
-    (if ncgDebugLevel config > 0
+    (if ncgDwarfEnabled config
       then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
       else empty
     )
@@ -140,7 +140,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
            vcat (map (pprData config) info) $$
            pprLabel platform infoLbl $$
            c $$
-           (if ncgDebugLevel config > 0
+           (if ncgDwarfEnabled config
                then ppr (mkAsmTempEndLabel infoLbl) <> char ':'
                else empty
            )
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index bdadaf49de..d7667bb073 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -498,7 +498,7 @@ strCLabel_llvm lbl = do
     dflags <- getDynFlags
     platform <- getPlatform
     let sdoc = pprCLabel_LLVM platform lbl
-        str = Outp.renderWithStyle
+        str = Outp.renderWithContext
                   (initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle))
                   sdoc
     return (fsLit str)
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index 916931eefa..34d0353681 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -1566,7 +1566,7 @@ genMachOp_slow opt op [x, y] = case op of
                     -- Error. Continue anyway so we can debug the generated ll file.
                     dflags <- getDynFlags
                     let style = mkCodeStyle CStyle
-                        toString doc = renderWithStyle (initSDocContext dflags style) doc
+                        toString doc = renderWithContext (initSDocContext dflags style) doc
                         cmmToStr = (lines . toString . PprCmm.pprExpr platform)
                     statement $ Comment $ map fsLit $ cmmToStr x
                     statement $ Comment $ map fsLit $ cmmToStr y
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 2523fb55d5..1ae745ffe3 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -539,7 +539,7 @@ msgUnitId pk = do
     dflags <- getDynFlags
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
-        $ "Instantiating " ++ renderWithStyle
+        $ "Instantiating " ++ renderWithContext
                                 (initSDocContext dflags backpackStyle)
                                 (ppr pk)
 
@@ -550,7 +550,7 @@ msgInclude (i,n) uid = do
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
         $ showModuleIndex (i, n) ++ "Including " ++
-          renderWithStyle (initSDocContext dflags backpackStyle)
+          renderWithContext (initSDocContext dflags backpackStyle)
             (ppr uid)
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/Driver/Ppr.hs b/compiler/GHC/Driver/Ppr.hs
index fe95b56860..6fe4ea91cc 100644
--- a/compiler/GHC/Driver/Ppr.hs
+++ b/compiler/GHC/Driver/Ppr.hs
@@ -36,7 +36,7 @@ import Control.Monad.IO.Class
 
 -- | Show a SDoc as a String with the default user style
 showSDoc :: DynFlags -> SDoc -> String
-showSDoc dflags sdoc = renderWithStyle (initSDocContext dflags defaultUserStyle) sdoc
+showSDoc dflags sdoc = renderWithContext (initSDocContext dflags defaultUserStyle) sdoc
 
 showPpr :: Outputable a => DynFlags -> a -> String
 showPpr dflags thing = showSDoc dflags (ppr thing)
@@ -46,13 +46,13 @@ showPprUnsafe a = showPpr unsafeGlobalDynFlags a
 
 -- | Allows caller to specify the PrintUnqualified to use
 showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
-showSDocForUser dflags unqual doc = renderWithStyle (initSDocContext dflags (mkUserStyle unqual AllTheWay)) doc
+showSDocForUser dflags unqual doc = renderWithContext (initSDocContext dflags (mkUserStyle unqual AllTheWay)) doc
 
 showSDocDump :: DynFlags -> SDoc -> String
-showSDocDump dflags d = renderWithStyle (initSDocContext dflags defaultDumpStyle) d
+showSDocDump dflags d = renderWithContext (initSDocContext dflags defaultDumpStyle) d
 
 showSDocDebug :: DynFlags -> SDoc -> String
-showSDocDebug dflags d = renderWithStyle ctx d
+showSDocDebug dflags d = renderWithContext ctx d
    where
       ctx = (initSDocContext dflags defaultDumpStyle)
                { sdocPprDebug = True
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 727b37fa32..f35437be11 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -980,7 +980,7 @@ packageFlagErr' :: SDocContext
                -> [(UnitInfo, UnusableUnitReason)]
                -> IO a
 packageFlagErr' ctx flag_doc reasons
-  = throwGhcExceptionIO (CmdLineError (renderWithStyle ctx $ err))
+  = throwGhcExceptionIO (CmdLineError (renderWithContext ctx $ err))
   where err = text "cannot satisfy " <> flag_doc <>
                 (if null reasons then Outputable.empty else text ": ") $$
               nest 4 (ppr_reasons $$
@@ -1712,7 +1712,7 @@ mkModuleNameProvidersMap ctx cfg pkg_map closure vis_map =
     rnBinding (orig, new) = (new, setOrigins origEntry fromFlag)
      where origEntry = case lookupUFM esmap orig of
             Just r -> r
-            Nothing -> throwGhcException (CmdLineError (renderWithStyle ctx
+            Nothing -> throwGhcException (CmdLineError (renderWithContext ctx
                         (text "package flag: could not find module name" <+>
                             ppr orig <+> text "in package" <+> ppr pk)))
 
@@ -2058,7 +2058,7 @@ getPreloadUnitsAnd ctx unit_state home_unit ids0 =
 
 throwErr :: SDocContext -> MaybeErr MsgDoc a -> IO a
 throwErr ctx m = case m of
-   Failed e    -> throwGhcExceptionIO (CmdLineError (renderWithStyle ctx e))
+   Failed e    -> throwGhcExceptionIO (CmdLineError (renderWithContext ctx e))
    Succeeded r -> return r
 
 -- | Takes a list of UnitIds (and their "parent" dependency, used for error
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index e83f0af927..1875d8faf9 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -47,7 +47,7 @@ module GHC.Utils.Outputable (
         bufLeftRenderSDoc,
         pprCode, mkCodeStyle,
         showSDocOneLine,
-        renderWithStyle,
+        renderWithContext,
 
         pprInfixVar, pprPrefixVar,
         pprHsChar, pprHsString, pprHsBytes,
@@ -71,7 +71,7 @@ module GHC.Utils.Outputable (
         QualifyName(..), queryQual,
         sdocWithDynFlags, sdocOption,
         updSDocContext,
-        SDocContext (..), sdocWithContext,
+        SDocContext (..), sdocWithContext, defaultSDocContext,
         getPprStyle, withPprStyle, setStyleColoured,
         pprDeeper, pprDeeperList, pprSetDepth,
         codeStyle, userStyle, dumpStyle, asmStyle,
@@ -302,7 +302,7 @@ code (either C or assembly), or generating interface files.
 -- | Represents a pretty-printable document.
 --
 -- To display an 'SDoc', use 'printSDoc', 'printSDocLn', 'bufLeftRenderSDoc',
--- or 'renderWithStyle'.  Avoid calling 'runSDoc' directly as it breaks the
+-- or 'renderWithContext'.  Avoid calling 'runSDoc' directly as it breaks the
 -- abstraction layer.
 newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }
 
@@ -354,6 +354,44 @@ instance IsString SDoc where
 instance Outputable SDoc where
   ppr = id
 
+-- | Default pretty-printing options
+defaultSDocContext :: SDocContext
+defaultSDocContext = SDC
+  { sdocStyle                       = defaultDumpStyle
+  , sdocColScheme                   = Col.defaultScheme
+  , sdocLastColour                  = Col.colReset
+  , sdocShouldUseColor              = False
+  , sdocDefaultDepth                = 5
+  , sdocLineLength                  = 100
+  , sdocCanUseUnicode               = False
+  , sdocHexWordLiterals             = False
+  , sdocPprDebug                    = False
+  , sdocPrintUnicodeSyntax          = False
+  , sdocPrintCaseAsLet              = False
+  , sdocPrintTypecheckerElaboration = False
+  , sdocPrintAxiomIncomps           = False
+  , sdocPrintExplicitKinds          = False
+  , sdocPrintExplicitCoercions      = False
+  , sdocPrintExplicitRuntimeReps    = False
+  , sdocPrintExplicitForalls        = False
+  , sdocPrintPotentialInstances     = False
+  , sdocPrintEqualityRelations      = False
+  , sdocSuppressTicks               = False
+  , sdocSuppressTypeSignatures      = False
+  , sdocSuppressTypeApplications    = False
+  , sdocSuppressIdInfo              = False
+  , sdocSuppressCoercions           = False
+  , sdocSuppressUnfoldings          = False
+  , sdocSuppressVarKinds            = False
+  , sdocSuppressUniques             = False
+  , sdocSuppressModulePrefixes      = False
+  , sdocSuppressStgExts             = False
+  , sdocErrorSpans                  = False
+  , sdocStarIsType                  = False
+  , sdocImpredicativeTypes          = False
+  , sdocLinearTypes                 = False
+  , sdocDynFlags                    = error "defaultSDocContext: DynFlags not available"
+  }
 
 withPprStyle :: PprStyle -> SDoc -> SDoc
 withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
@@ -490,8 +528,8 @@ pprCode cs d = withPprStyle (PprCode cs) d
 mkCodeStyle :: CodeStyle -> PprStyle
 mkCodeStyle = PprCode
 
-renderWithStyle :: SDocContext -> SDoc -> String
-renderWithStyle ctx sdoc
+renderWithContext :: SDocContext -> SDoc -> String
+renderWithContext ctx sdoc
   = let s = Pretty.style{ Pretty.mode       = PageMode,
                           Pretty.lineLength = sdocLineLength ctx }
     in Pretty.renderStyle s $ runSDoc sdoc ctx
diff --git a/testsuite/tests/hiefile/should_run/HieQueries.hs b/testsuite/tests/hiefile/should_run/HieQueries.hs
index f0b3ee5ba2..2446be5963 100644
--- a/testsuite/tests/hiefile/should_run/HieQueries.hs
+++ b/testsuite/tests/hiefile/should_run/HieQueries.hs
@@ -14,7 +14,7 @@ import GHC.Iface.Ext.Utils
 import Data.Maybe (fromJust)
 import GHC.Driver.Session
 import GHC.SysTools
-import GHC.Utils.Outputable                 ( Outputable, renderWithStyle, ppr, defaultUserStyle, text)
+import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
 import qualified Data.Map as M
 import Data.Foldable
 
@@ -78,5 +78,5 @@ explainEv df hf refmap point = do
 
     pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
 
-    pprint = pretty . renderWithStyle (initSDocContext df sty) . ppr
+    pprint = pretty . renderWithContext (initSDocContext df sty) . ppr
     sty = defaultUserStyle