Disentangle DynFlags and SDoc

Remove several uses of `sdocWithDynFlags`. The remaining ones are mostly
CodeGen related (e.g. depend on target platform constants) and will be
fixed separately.

Metric Decrease:
   T12425
   T9961
   WWRec
   T1969
   T14683

35 files changed, 433 insertions, 400 deletions

diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
index 891cbd9c6d..9f02cdcace 100644
--- a/compiler/GHC/Cmm/Ppr.hs
+++ b/compiler/GHC/Cmm/Ppr.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE GADTs, TypeFamilies, FlexibleContexts, FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 ----------------------------------------------------------------------------
@@ -45,7 +46,6 @@ import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.Cmm.Utils
 import GHC.Cmm.Switch
-import DynFlags
 import FastString
 import Outputable
 import GHC.Cmm.Ppr.Decl
@@ -181,22 +181,22 @@ pprNode :: CmmNode e x -> SDoc
 pprNode node = pp_node <+> pp_debug
   where
     pp_node :: SDoc
-    pp_node = sdocWithDynFlags $ \dflags -> case node of
+    pp_node = case node of
       -- label:
-      CmmEntry id tscope -> lbl <> colon <+>
-         (sdocWithDynFlags $ \dflags ->
-           ppUnless (gopt Opt_SuppressTicks dflags) (text "//" <+> ppr tscope))
-          where
-            lbl = if gopt Opt_SuppressUniques dflags
-                then text "_lbl_"
-                else ppr id
+      CmmEntry id tscope ->
+         (sdocOption sdocSuppressUniques $ \case
+            True  -> text "_lbl_"
+            False -> ppr id
+         )
+         <> colon
+         <+> ppUnlessOption sdocSuppressTicks (text "//" <+> ppr tscope)
 
       -- // text
       CmmComment s -> text "//" <+> ftext s
 
       -- //tick bla<...>
-      CmmTick t -> ppUnless (gopt Opt_SuppressTicks dflags) $
-                   text "//tick" <+> ppr t
+      CmmTick t -> ppUnlessOption sdocSuppressTicks
+                     (text "//tick" <+> ppr t)
 
       -- unwind reg = expr;
       CmmUnwind regs ->
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
index 53a335e561..fbd4cdb7f1 100644
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ b/compiler/GHC/Cmm/Ppr/Expr.hs
@@ -31,8 +31,9 @@
 --
 -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs
 --
-
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module GHC.Cmm.Ppr.Expr
     ( pprExpr, pprLit
     )
@@ -43,7 +44,6 @@ import GhcPrelude
 import GHC.Cmm.Expr
 
 import Outputable
-import DynFlags
 
 import Data.Maybe
 import Numeric ( fromRat )
@@ -227,18 +227,17 @@ pprReg r
 -- We only print the type of the local reg if it isn't wordRep
 --
 pprLocalReg :: LocalReg -> SDoc
-pprLocalReg (LocalReg uniq rep) = sdocWithDynFlags $ \dflags ->
+pprLocalReg (LocalReg uniq rep) =
 --   = ppr rep <> char '_' <> ppr uniq
 -- Temp Jan08
-    char '_' <> pprUnique dflags uniq <>
+    char '_' <> pprUnique uniq <>
        (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08               -- sigh
                     then dcolon <> ptr <> ppr rep
                     else dcolon <> ptr <> ppr rep)
    where
-     pprUnique dflags unique =
-        if gopt Opt_SuppressUniques dflags
-            then text "_locVar_"
-            else ppr unique
+     pprUnique unique = sdocOption sdocSuppressUniques $ \case
+       True  -> text "_locVar_"
+       False -> ppr unique
      ptr = empty
          --if isGcPtrType rep
          --      then doubleQuotes (text "ptr")
diff --git a/compiler/GHC/CmmToLlvm/Base.hs b/compiler/GHC/CmmToLlvm/Base.hs
index c0bd742840..5cfef04029 100644
--- a/compiler/GHC/CmmToLlvm/Base.hs
+++ b/compiler/GHC/CmmToLlvm/Base.hs
@@ -506,7 +506,9 @@ strCLabel_llvm :: CLabel -> LlvmM LMString
 strCLabel_llvm lbl = do
     dflags <- getDynFlags
     let sdoc = pprCLabel dflags lbl
-        str = Outp.renderWithStyle dflags sdoc (Outp.mkCodeStyle Outp.CStyle)
+        str = Outp.renderWithStyle
+                  (initSDocContext dflags (Outp.mkCodeStyle Outp.CStyle))
+                  sdoc
     return (fsLit str)
 
 strDisplayName_llvm :: CLabel -> LlvmM LMString
@@ -515,7 +517,7 @@ strDisplayName_llvm lbl = do
     let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
         style = Outp.mkUserStyle dflags Outp.reallyAlwaysQualify depth
-        str = Outp.renderWithStyle dflags sdoc style
+        str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
     return (fsLit (dropInfoSuffix str))
 
 dropInfoSuffix :: String -> String
@@ -532,7 +534,7 @@ strProcedureName_llvm lbl = do
     let sdoc = pprCLabel dflags lbl
         depth = Outp.PartWay 1
         style = Outp.mkUserStyle dflags Outp.neverQualify depth
-        str = Outp.renderWithStyle dflags sdoc style
+        str = Outp.renderWithStyle (initSDocContext dflags style) sdoc
     return (fsLit str)
 
 -- ----------------------------------------------------------------------------
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index 33dd82c418..947ba31f35 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -1505,7 +1505,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 dflags doc style
+                        toString doc = renderWithStyle (initSDocContext dflags style) doc
                         cmmToStr = (lines . toString . PprCmm.pprExpr)
                     statement $ Comment $ map fsLit $ cmmToStr x
                     statement $ Comment $ map fsLit $ cmmToStr y
diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs
index 2014d92c25..6796216c87 100644
--- a/compiler/GHC/Hs/Binds.hs
+++ b/compiler/GHC/Hs/Binds.hs
@@ -19,6 +19,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
 
 module GHC.Hs.Binds where
 
@@ -42,7 +43,6 @@ import Var
 import Bag
 import FastString
 import BooleanFormula (LBooleanFormula)
-import DynFlags
 
 import Data.Data hiding ( Fixity )
 import Data.List hiding ( foldr )
@@ -739,20 +739,19 @@ ppr_monobind (PatSynBind _ psb) = ppr psb
 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
                        , abs_exports = exports, abs_binds = val_binds
                        , abs_ev_binds = ev_binds })
-  = sdocWithDynFlags $ \ dflags ->
-    if gopt Opt_PrintTypecheckerElaboration dflags then
-      -- Show extra information (bug number: #10662)
-      hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
-                                    <+> brackets (interpp'SP dictvars))
-         2 $ braces $ vcat
-      [ text "Exports:" <+>
-          brackets (sep (punctuate comma (map ppr exports)))
-      , text "Exported types:" <+>
-          vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
-      , text "Binds:" <+> pprLHsBinds val_binds
-      , pprIfTc @idR (text "Evidence:" <+> ppr ev_binds) ]
-    else
-      pprLHsBinds val_binds
+  = sdocOption sdocPrintTypecheckerElaboration $ \case
+      False -> pprLHsBinds val_binds
+      True  -> -- Show extra information (bug number: #10662)
+               hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
+                                             <+> brackets (interpp'SP dictvars))
+                  2 $ braces $ vcat
+               [ text "Exports:" <+>
+                   brackets (sep (punctuate comma (map ppr exports)))
+               , text "Exported types:" <+>
+                   vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
+               , text "Binds:" <+> pprLHsBinds val_binds
+               , pprIfTc @idR (text "Evidence:" <+> ppr ev_binds)
+               ]
 ppr_monobind (XHsBindsLR x) = ppr x
 
 instance OutputableBndrId p => Outputable (ABExport (GhcPass p)) where
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 6890484472..308b112886 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -38,7 +38,6 @@ import GHC.Hs.Binds
 -- others:
 import TcEvidence
 import CoreSyn
-import DynFlags ( gopt, GeneralFlag(Opt_PrintExplicitCoercions) )
 import Name
 import NameSet
 import BasicTypes
@@ -186,9 +185,9 @@ instance Outputable SyntaxExprTc where
   ppr (SyntaxExprTc { syn_expr      = expr
                     , syn_arg_wraps = arg_wraps
                     , syn_res_wrap  = res_wrap })
-    = sdocWithDynFlags $ \ dflags ->
+    = sdocOption sdocPrintExplicitCoercions $ \print_co ->
       getPprStyle $ \s ->
-      if debugStyle s || gopt Opt_PrintExplicitCoercions dflags
+      if debugStyle s || print_co
       then ppr expr <> braces (pprWithCommas ppr arg_wraps)
                     <> braces (ppr res_wrap)
       else ppr expr
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index 50db04e92e..3e78ec4fb9 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -19,6 +19,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE LambdaCase #-}
 
 module GHC.Hs.Pat (
         Pat(..), InPat, OutPat, LPat,
@@ -67,7 +68,6 @@ import Outputable
 import Type
 import SrcLoc
 import Bag -- collect ev vars from pats
-import DynFlags( gopt, GeneralFlag(..) )
 import Maybes
 -- libraries:
 import Data.Data hiding (TyCon,Fixity)
@@ -498,13 +498,13 @@ pprParendLPat p = pprParendPat p . unLoc
 
 pprParendPat :: (OutputableBndrId p)
              => PprPrec -> Pat (GhcPass p) -> SDoc
-pprParendPat p pat = sdocWithDynFlags $ \ dflags ->
-                     if need_parens dflags pat
+pprParendPat p pat = sdocOption sdocPrintTypecheckerElaboration $ \print_tc_elab ->
+                     if need_parens print_tc_elab pat
                      then parens (pprPat pat)
                      else  pprPat pat
   where
-    need_parens dflags pat
-      | CoPat {} <- pat = gopt Opt_PrintTypecheckerElaboration dflags
+    need_parens print_tc_elab pat
+      | CoPat {} <- pat = print_tc_elab
       | otherwise       = patNeedsParens p pat
       -- For a CoPat we need parens if we are going to show it, which
       -- we do if -fprint-typechecker-elaboration is on (c.f. pprHsWrapper)
@@ -551,16 +551,15 @@ pprPat (ConPatOut { pat_con = con
                   , pat_dicts = dicts
                   , pat_binds = binds
                   , pat_args = details })
-  = sdocWithDynFlags $ \dflags ->
-       -- Tiresome; in TcBinds.tcRhs we print out a
-       -- typechecked Pat in an error message,
-       -- and we want to make sure it prints nicely
-    if gopt Opt_PrintTypecheckerElaboration dflags then
-        ppr con
-          <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
-                         , pprIfTc @p $ ppr binds ])
-          <+> pprConArgs details
-    else pprUserCon (unLoc con) details
+  = sdocOption sdocPrintTypecheckerElaboration $ \case
+      False -> pprUserCon (unLoc con) details
+      True  -> -- Tiresome; in TcBinds.tcRhs we print out a
+               -- typechecked Pat in an error message,
+               -- and we want to make sure it prints nicely
+               ppr con
+                  <> braces (sep [ hsep (map pprPatBndr (tvs ++ dicts))
+                                 , pprIfTc @p $ ppr binds ])
+                  <+> pprConArgs details
 pprPat (XPat n)                 = noExtCon n
 
 
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 0d927e4e59..f400a1fdf1 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -1191,12 +1191,11 @@ levPolyPrimopErr expr_doc ty bad_tys
   = errDs $ vcat
     [ hang (text "Cannot use function with levity-polymorphic arguments:")
          2 (expr_doc <+> dcolon <+> pprWithTYPE ty)
-    , sdocWithDynFlags $ \dflags ->
-      if not (gopt Opt_PrintTypecheckerElaboration dflags) then vcat
+    , ppUnlessOption sdocPrintTypecheckerElaboration $ vcat
         [ text "(Note that levity-polymorphic primops such as 'coerce' and unboxed tuples"
         , text "are eta-expanded internally because they must occur fully saturated."
         , text "Use -fprint-typechecker-elaboration to display the full expression.)"
-        ] else empty
+        ]
     , hang (text "Levity-polymorphic arguments:")
          2 $ vcat $ map
            (\t -> pprWithTYPE t <+> dcolon <+> pprWithTYPE (typeKind t))
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index b0d71f34b4..eba14f190a 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -11,7 +11,7 @@ import DynFlags                   ( DynFlags )
 import FastString                 ( FastString, mkFastString )
 import GHC.Iface.Type
 import Name hiding (varName)
-import Outputable                 ( renderWithStyle, ppr, defaultUserStyle )
+import Outputable                 ( renderWithStyle, ppr, defaultUserStyle, initSDocContext )
 import SrcLoc
 import GHC.CoreToIface
 import TyCon
@@ -44,7 +44,7 @@ generateReferencesMap = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty
         this = fmap (pure . (nodeSpan ast,)) $ nodeIdentifiers $ nodeInfo ast
 
 renderHieType :: DynFlags -> HieTypeFix -> String
-renderHieType df ht = renderWithStyle df (ppr $ hieTypeToIface ht) sty
+renderHieType df ht = renderWithStyle (initSDocContext df sty) (ppr $ hieTypeToIface ht)
   where sty = defaultUserStyle df
 
 resolveVisibility :: Type -> [Type] -> [(Bool,Type)]
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index 668ce1ec7b..c831d09c7f 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -47,7 +47,6 @@ import GhcPrelude
 import GHC.Iface.Type
 import BinFingerprint
 import CoreSyn( IsOrphan, isOrphan )
-import DynFlags( gopt, GeneralFlag (Opt_PrintAxiomIncomps) )
 import Demand
 import Cpr
 import Class
@@ -610,14 +609,13 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs
 
     -- See Note [Displaying axiom incompatibilities]
     maybe_index
-      = sdocWithDynFlags $ \dflags ->
-        ppWhen (gopt Opt_PrintAxiomIncomps dflags) $
+      = ppWhenOption sdocPrintAxiomIncomps $
           text "{-" <+> (text "#" <> ppr idx) <+> text "-}"
     maybe_incomps
-      = sdocWithDynFlags $ \dflags ->
-        ppWhen (gopt Opt_PrintAxiomIncomps dflags && notNull incomps) $
-          text "--" <+> text "incompatible with:"
-          <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps
+      = ppWhenOption sdocPrintAxiomIncomps $
+          ppWhen (notNull incomps) $
+            text "--" <+> text "incompatible with:"
+            <+> pprWithCommas (\incomp -> text "#" <> ppr incomp) incomps
 
 instance Outputable IfaceAnnotation where
   ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value
@@ -963,9 +961,9 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
                               ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
                               ifPatArgs = arg_tys,
                               ifPatTy = pat_ty} )
-  = sdocWithDynFlags mk_msg
+  = sdocWithContext mk_msg
   where
-    mk_msg dflags
+    mk_msg sdocCtx
       = hang (text "pattern" <+> pprPrefixOcc name)
            2 (dcolon <+> sep [univ_msg
                              , pprIfaceContextArr req_ctxt
@@ -978,7 +976,7 @@ pprIfaceDecl _ (IfacePatSyn { ifName = name,
         ex_msg   = pprUserIfaceForAll ex_bndrs
 
         insert_empty_ctxt = null req_ctxt
-            && not (null prov_ctxt && isEmpty dflags ex_msg)
+            && not (null prov_ctxt && isEmpty sdocCtx ex_msg)
 
 pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                               ifIdDetails = details, ifIdInfo = info })
@@ -1001,8 +999,8 @@ pprCType (Just cType) = text "C type:" <+> ppr cType
 pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]
          -> [Role] -> SDoc
 pprRoles suppress_if tyCon bndrs roles
-  = sdocWithDynFlags $ \dflags ->
-      let froles = suppressIfaceInvisibles dflags bndrs roles
+  = sdocOption sdocPrintExplicitKinds $ \print_kinds ->
+      let froles = suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs roles
       in ppUnless (all suppress_if froles || null froles) $
          text "type role" <+> tyCon <+> hsep (map ppr froles)
 
@@ -1064,11 +1062,11 @@ pprIfaceDeclHead :: SuppressBndrSig
                  -> [IfaceTyConBinder]   -- of the tycon, for invisible-suppression
                  -> SDoc
 pprIfaceDeclHead suppress_sig context ss tc_occ bndrs
-  = sdocWithDynFlags $ \ dflags ->
+  = sdocOption sdocPrintExplicitKinds $ \print_kinds ->
     sep [ pprIfaceContextArr context
         , pprPrefixIfDeclBndr (ss_how_much ss) (occName tc_occ)
           <+> pprIfaceTyConBinders suppress_sig
-                (suppressIfaceInvisibles dflags bndrs bndrs) ]
+                (suppressIfaceInvisibles (PrintExplicitKinds print_kinds) bndrs bndrs) ]
 
 pprIfaceConDecl :: ShowSub -> Bool
                 -> IfaceTopBndr
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 3ff25ba20e..3c08262ed8 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -39,6 +39,7 @@ module GHC.Iface.Type (
         -- Printing
         SuppressBndrSig(..),
         UseBndrParens(..),
+        PrintExplicitKinds(..),
         pprIfaceType, pprParendIfaceType, pprPrecIfaceType,
         pprIfaceContext, pprIfaceContextArr,
         pprIfaceIdBndr, pprIfaceLamBndr, pprIfaceTvBndr, pprIfaceTyConBinders,
@@ -65,7 +66,6 @@ import {-# SOURCE #-} TysWiredIn ( coercibleTyCon, heqTyCon
                                  , liftedRepDataConTyCon, tupleTyConName )
 import {-# SOURCE #-} Type       ( isRuntimeRepTy )
 
-import DynFlags
 import TyCon hiding ( pprPromotionQuote )
 import CoAxiom
 import Var
@@ -422,10 +422,9 @@ splitIfaceSigmaTy ty
         = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
 
-suppressIfaceInvisibles :: DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
-suppressIfaceInvisibles dflags tys xs
-  | gopt Opt_PrintExplicitKinds dflags = xs
-  | otherwise = suppress tys xs
+suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
+suppressIfaceInvisibles (PrintExplicitKinds True) _tys xs = xs
+suppressIfaceInvisibles (PrintExplicitKinds False) tys xs = suppress tys xs
     where
       suppress _       []      = []
       suppress []      a       = a
@@ -433,10 +432,10 @@ suppressIfaceInvisibles dflags tys xs
         | isInvisibleTyConBinder k =     suppress ks xs
         | otherwise                = x : suppress ks xs
 
-stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
-stripIfaceInvisVars dflags tyvars
-  | gopt Opt_PrintExplicitKinds dflags = tyvars
-  | otherwise = filterOut isInvisibleTyConBinder tyvars
+stripIfaceInvisVars :: PrintExplicitKinds -> [IfaceTyConBinder] -> [IfaceTyConBinder]
+stripIfaceInvisVars (PrintExplicitKinds True)  tyvars = tyvars
+stripIfaceInvisVars (PrintExplicitKinds False) tyvars
+  = filterOut isInvisibleTyConBinder tyvars
 
 -- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
 ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
@@ -555,10 +554,9 @@ substIfaceTyVar env tv
 ************************************************************************
 -}
 
-stripInvisArgs :: DynFlags -> IfaceAppArgs -> IfaceAppArgs
-stripInvisArgs dflags tys
-  | gopt Opt_PrintExplicitKinds dflags = tys
-  | otherwise = suppress_invis tys
+stripInvisArgs :: PrintExplicitKinds -> IfaceAppArgs -> IfaceAppArgs
+stripInvisArgs (PrintExplicitKinds True)  tys = tys
+stripInvisArgs (PrintExplicitKinds False) tys = suppress_invis tys
     where
       suppress_invis c
         = case c of
@@ -691,10 +689,9 @@ if_print_coercions :: SDoc  -- ^ if printing coercions
                    -> SDoc  -- ^ otherwise
                    -> SDoc
 if_print_coercions yes no
-  = sdocWithDynFlags $ \dflags ->
+  = sdocOption sdocPrintExplicitCoercions $ \print_co ->
     getPprStyle $ \style ->
-    if gopt Opt_PrintExplicitCoercions dflags
-         || dumpStyle style || debugStyle style
+    if print_co || dumpStyle style || debugStyle style
     then yes
     else no
 
@@ -757,7 +754,8 @@ Here we'd like to omit the kind annotation:
 -- See Note [Suppressing binder signatures]
 newtype SuppressBndrSig = SuppressBndrSig Bool
 
-newtype UseBndrParens = UseBndrParens Bool
+newtype UseBndrParens      = UseBndrParens Bool
+newtype PrintExplicitKinds = PrintExplicitKinds Bool
 
 pprIfaceTvBndr :: IfaceTvBndr -> SuppressBndrSig -> UseBndrParens -> SDoc
 pprIfaceTvBndr (tv, ki) (SuppressBndrSig suppress_sig) (UseBndrParens use_parens)
@@ -857,12 +855,13 @@ ppr_ty ctxt_prec (IfaceAppTy t ts)
       ppr_app_ty_no_casts
   where
     ppr_app_ty =
-        sdocWithDynFlags $ \dflags ->
-        pprIfacePrefixApp ctxt_prec
-                          (ppr_ty funPrec t)
-                          (map (ppr_app_arg appPrec) (tys_wo_kinds dflags))
+        sdocOption sdocPrintExplicitKinds $ \print_kinds ->
+        let tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs
+                              (PrintExplicitKinds print_kinds) ts
+        in pprIfacePrefixApp ctxt_prec
+                             (ppr_ty funPrec t)
+                             (map (ppr_app_arg appPrec) tys_wo_kinds)
 
-    tys_wo_kinds dflags = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags ts
 
     -- Strip any casts from the head of the application
     ppr_app_ty_no_casts =
@@ -1013,9 +1012,9 @@ defaultRuntimeRepVars ty = go False emptyFsEnv ty
 
 eliminateRuntimeRep :: (IfaceType -> SDoc) -> IfaceType -> SDoc
 eliminateRuntimeRep f ty
-  = sdocWithDynFlags $ \dflags ->
+  = sdocOption sdocPrintExplicitRuntimeReps $ \printExplicitRuntimeReps ->
     getPprStyle      $ \sty    ->
-    if userStyle sty && not (gopt Opt_PrintExplicitRuntimeReps dflags)
+    if userStyle sty && not printExplicitRuntimeReps
       then f (defaultRuntimeRepVars ty)
       else f ty
 
@@ -1036,9 +1035,8 @@ ppr_app_args ctx_prec = go
 -- See Note [Pretty-printing invisible arguments]
 ppr_app_arg :: PprPrec -> (IfaceType, ArgFlag) -> SDoc
 ppr_app_arg ctx_prec (t, argf) =
-  sdocWithDynFlags $ \dflags ->
-  let print_kinds = gopt Opt_PrintExplicitKinds dflags
-  in case argf of
+  sdocOption sdocPrintExplicitKinds $ \print_kinds ->
+  case argf of
        Required  -> ppr_ty ctx_prec t
        Specified |  print_kinds
                  -> char '@' <> ppr_ty appPrec t
@@ -1135,11 +1133,11 @@ pprIfaceSigmaType show_forall ty
 
 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprUserIfaceForAll tvs
-   = sdocWithDynFlags $ \dflags ->
+   = sdocOption sdocPrintExplicitForalls $ \print_foralls ->
      -- See Note [When to print foralls] in this module.
      ppWhen (any tv_has_kind_var tvs
              || any tv_is_required tvs
-             || gopt Opt_PrintExplicitForalls dflags) $
+             || print_foralls) $
      pprIfaceForAll tvs
    where
      tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)
@@ -1286,13 +1284,13 @@ pprIfaceTypeApp prec tc args = pprTyTcApp prec tc args
 
 pprTyTcApp :: PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
 pprTyTcApp ctxt_prec tc tys =
-    sdocWithDynFlags $ \dflags ->
+    sdocOption sdocPrintExplicitKinds $ \print_kinds ->
     getPprStyle $ \style ->
-    pprTyTcApp' ctxt_prec tc tys dflags style
+    pprTyTcApp' ctxt_prec tc tys (PrintExplicitKinds print_kinds) style
 
 pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs
-            -> DynFlags -> PprStyle -> SDoc
-pprTyTcApp' ctxt_prec tc tys dflags style
+            -> PrintExplicitKinds -> PprStyle -> SDoc
+pprTyTcApp' ctxt_prec tc tys printExplicitKinds style
   | ifaceTyConName tc `hasKey` ipClassKey
   , IA_Arg (IfaceLitTy (IfaceStrTyLit n))
            Required (IA_Arg ty Required IA_Nil) <- tys
@@ -1308,7 +1306,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style
   = pprSum arity (ifaceTyConIsPromoted info) tys
 
   | tc `ifaceTyConHasKey` consDataConKey
-  , not (gopt Opt_PrintExplicitKinds dflags)
+  , PrintExplicitKinds False <- printExplicitKinds
   , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys
   , isInvisibleArgFlag argf
   = pprIfaceTyList ctxt_prec ty1 ty2
@@ -1331,15 +1329,13 @@ pprTyTcApp' ctxt_prec tc tys dflags style
          -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds
   where
     info = ifaceTyConInfo tc
-    tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs dflags tys
+    tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs printExplicitKinds tys
 
 ppr_kind_type :: PprPrec -> SDoc
-ppr_kind_type ctxt_prec =
-  sdocWithDynFlags $ \dflags ->
-    if useStarIsType dflags
-    then maybeParen ctxt_prec starPrec $
-         unicodeSyntax (char '★') (char '*')
-    else text "Type"
+ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case
+   False -> text "Type"
+   True  -> maybeParen ctxt_prec starPrec $
+              unicodeSyntax (char '★') (char '*')
 
 -- | Pretty-print a type-level equality.
 -- Returns (Just doc) if the argument is a /saturated/ application
@@ -1382,11 +1378,13 @@ ppr_equality ctxt_prec tc args
     nominal_eq_tc = tc_name `hasKey` heqTyConKey       -- (~~)
                  || tc_name `hasKey` eqPrimTyConKey    -- (~#)
     print_equality args =
-        sdocWithDynFlags $ \dflags ->
+        sdocOption sdocPrintExplicitKinds $ \print_kinds ->
+        sdocOption sdocPrintEqualityRelations $ \print_eqs ->
         getPprStyle      $ \style  ->
-        print_equality' args style dflags
+        print_equality' args print_kinds
+          (print_eqs || dumpStyle style || debugStyle style)
 
-    print_equality' (ki1, ki2, ty1, ty2) style dflags
+    print_equality' (ki1, ki2, ty1, ty2) print_kinds print_eqs
       | -- If -fprint-equality-relations is on, just print the original TyCon
         print_eqs
       = ppr_infix_eq (ppr tc)
@@ -1421,10 +1419,6 @@ ppr_equality ctxt_prec tc args
               | otherwise
               = pp opPrec ty
 
-        print_kinds = gopt Opt_PrintExplicitKinds dflags
-        print_eqs   = gopt Opt_PrintEqualityRelations dflags ||
-                      dumpStyle style || debugStyle style
-
 
 pprIfaceCoTcApp :: PprPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
 pprIfaceCoTcApp ctxt_prec tc tys =
diff --git a/compiler/GHC/Llvm/Ppr.hs b/compiler/GHC/Llvm/Ppr.hs
index 0e8d279a50..092dec39fb 100644
--- a/compiler/GHC/Llvm/Ppr.hs
+++ b/compiler/GHC/Llvm/Ppr.hs
@@ -87,9 +87,8 @@ ppLlvmGlobal (LMGlobal var@(LMGlobalVar _ _ link x a c) dat) =
     in ppAssignment var $ ppr link <+> text const <+> rhs <> sect <> align
        $+$ newLine
 
-ppLlvmGlobal (LMGlobal var val) = sdocWithDynFlags $ \dflags ->
-  error $ "Non Global var ppr as global! "
-          ++ showSDoc dflags (ppr var) ++ " " ++ showSDoc dflags (ppr val)
+ppLlvmGlobal (LMGlobal var val) = pprPanic "ppLlvmGlobal" $
+  text "Non Global var ppr as global! " <> ppr var <> text "=" <> ppr val
 
 
 -- | Print out a list of LLVM type aliases.
diff --git a/compiler/GHC/Llvm/Types.hs b/compiler/GHC/Llvm/Types.hs
index f4fa9a9a56..61c2b2cb86 100644
--- a/compiler/GHC/Llvm/Types.hs
+++ b/compiler/GHC/Llvm/Types.hs
@@ -196,9 +196,9 @@ pprStaticArith s1 s2 int_op float_op op_name =
       op  = if isFloat ty1 then float_op else int_op
   in if ty1 == getStatType s2
      then ppr ty1 <+> ptext op <+> lparen <> ppr s1 <> comma <> ppr s2 <> rparen
-     else sdocWithDynFlags $ \dflags ->
-            error $ op_name ++ " with different types! s1: "
-                    ++ showSDoc dflags (ppr s1) ++ ", s2: " ++ showSDoc dflags (ppr s2)
+     else pprPanic "pprStaticArith" $
+            text op_name <> text " with different types! s1: " <> ppr s1
+                         <> text", s2: " <> ppr s2
 
 -- -----------------------------------------------------------------------------
 -- ** Operations on LLVM Basic Types and Variables
@@ -228,8 +228,7 @@ ppLit (LMIntLit i (LMInt 64))  = ppr (fromInteger i :: Int64)
 ppLit (LMIntLit   i _       )  = ppr ((fromInteger i)::Int)
 ppLit (LMFloatLit r LMFloat )  = ppFloat $ narrowFp r
 ppLit (LMFloatLit r LMDouble)  = ppDouble r
-ppLit f@(LMFloatLit _ _)       = sdocWithDynFlags (\dflags ->
-                                   error $ "Can't print this float literal!" ++ showSDoc dflags (ppr f))
+ppLit f@(LMFloatLit _ _)       = pprPanic "ppLit" (text "Can't print this float literal: " <> ppr f)
 ppLit (LMVectorLit ls  )       = char '<' <+> ppCommaJoin ls <+> char '>'
 ppLit (LMNullLit _     )       = text "null"
 -- #11487 was an issue where we passed undef for some arguments
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 5c57722a42..5f52784cb8 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -18,6 +18,7 @@ generation.
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE LambdaCase #-}
 
 module GHC.Stg.Syntax (
         StgArg(..),
@@ -756,10 +757,9 @@ pprStgExpr (StgLetNoEscape ext bind expr)
                 2 (ppr expr)]
 
 pprStgExpr (StgTick tickish expr)
-  = sdocWithDynFlags $ \dflags ->
-    if gopt Opt_SuppressTicks dflags
-    then pprStgExpr expr
-    else sep [ ppr tickish, pprStgExpr expr ]
+  = sdocOption sdocSuppressTicks $ \case
+      True  -> pprStgExpr expr
+      False -> sep [ ppr tickish, pprStgExpr expr ]
 
 
 -- Don't indent for a single case alternative.
@@ -804,8 +804,7 @@ pprStgRhs :: OutputablePass pass => GenStgRhs pass -> SDoc
 pprStgRhs (StgRhsClosure ext cc upd_flag args body)
   = sdocWithDynFlags $ \dflags ->
     hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty,
-                if not $ gopt Opt_SuppressStgExts dflags
-                  then ppr ext else empty,
+                ppUnlessOption sdocSuppressStgExts (ppr ext),
                 char '\\' <> ppr upd_flag, brackets (interppSP args)])
          4 (ppr body)
 
diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index ec2700b070..ee4d9fb5e4 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -538,8 +538,9 @@ msgUnitId pk = do
     dflags <- getDynFlags
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
-        $ "Instantiating " ++ renderWithStyle dflags (ppr pk)
-                                (backpackStyle dflags)
+        $ "Instantiating " ++ renderWithStyle
+                                (initSDocContext dflags (backpackStyle dflags))
+                                (ppr pk)
 
 -- | Message when we include a Backpack unit.
 msgInclude :: (Int,Int) -> UnitId -> BkpM ()
@@ -548,7 +549,8 @@ msgInclude (i,n) uid = do
     level <- getBkpLevel
     liftIO . backpackProgressMsg level dflags
         $ showModuleIndex (i, n) ++ "Including " ++
-          renderWithStyle dflags (ppr uid) (backpackStyle dflags)
+          renderWithStyle (initSDocContext dflags (backpackStyle dflags))
+            (ppr uid)
 
 -- ----------------------------------------------------------------------------
 -- Conversion from PackageName to HsComponentId
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs
index 341cc79bb6..2215a4d108 100644
--- a/compiler/basicTypes/Name.hs
+++ b/compiler/basicTypes/Name.hs
@@ -90,7 +90,6 @@ import Unique
 import Util
 import Maybes
 import Binary
-import DynFlags
 import FastString
 import Outputable
 
@@ -561,10 +560,8 @@ pprExternal sty uniq mod occ is_wired is_builtin
                     _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)
             else pprModulePrefix sty mod occ <> ppr_occ_name occ
   where
-    pp_mod = sdocWithDynFlags $ \dflags ->
-             if gopt Opt_SuppressModulePrefixes dflags
-             then empty
-             else ppr mod <> dot
+    pp_mod = ppUnlessOption sdocSuppressModulePrefixes
+               (ppr mod <> dot)
 
 pprInternal :: PprStyle -> Unique -> OccName -> SDoc
 pprInternal sty uniq occ
@@ -591,10 +588,7 @@ pprSystem sty uniq occ
 pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
 -- Print the "M." part of a name, based on whether it's in scope or not
 -- See Note [Printing original names] in HscTypes
-pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
-  if gopt Opt_SuppressModulePrefixes dflags
-  then empty
-  else
+pprModulePrefix sty mod occ = ppUnlessOption sdocSuppressModulePrefixes $
     case qualName sty mod occ of              -- See Outputable.QualifyName:
       NameQual modname -> ppr modname <> dot       -- Name is in scope
       NameNotInScope1  -> ppr mod <> dot           -- Not in scope
@@ -605,17 +599,15 @@ pprModulePrefix sty mod occ = sdocWithDynFlags $ \dflags ->
 pprUnique :: Unique -> SDoc
 -- Print a unique unless we are suppressing them
 pprUnique uniq
-  = sdocWithDynFlags $ \dflags ->
-    ppUnless (gopt Opt_SuppressUniques dflags) $
-    pprUniqueAlways uniq
+  = ppUnlessOption sdocSuppressUniques $
+      pprUniqueAlways uniq
 
 ppr_underscore_unique :: Unique -> SDoc
 -- Print an underscore separating the name from its unique
 -- But suppress it if we aren't printing the uniques anyway
 ppr_underscore_unique uniq
-  = sdocWithDynFlags $ \dflags ->
-    ppUnless (gopt Opt_SuppressUniques dflags) $
-    char '_' <> pprUniqueAlways uniq
+  = ppUnlessOption sdocSuppressUniques $
+      char '_' <> pprUniqueAlways uniq
 
 ppr_occ_name :: OccName -> SDoc
 ppr_occ_name occ = ftext (occNameFS occ)
diff --git a/compiler/basicTypes/OccName.hs b/compiler/basicTypes/OccName.hs
index ac2ad47100..3a45cf87dd 100644
--- a/compiler/basicTypes/OccName.hs
+++ b/compiler/basicTypes/OccName.hs
@@ -6,6 +6,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
 
 -- |
 -- #name_types#
@@ -104,7 +105,6 @@ import GhcPrelude
 
 import Util
 import Unique
-import DynFlags
 import UniqFM
 import UniqSet
 import FastString
@@ -278,10 +278,9 @@ pprOccName (OccName sp occ)
     pp_debug sty | debugStyle sty = braces (pprNameSpaceBrief sp)
                  | otherwise      = empty
 
-    pp_occ = sdocWithDynFlags $ \dflags ->
-             if gopt Opt_SuppressUniques dflags
-             then text (strip_th_unique (unpackFS occ))
-             else ftext occ
+    pp_occ = sdocOption sdocSuppressUniques $ \case
+               True  -> text (strip_th_unique (unpackFS occ))
+               False -> ftext occ
 
         -- See Note [Suppressing uniques in OccNames]
     strip_th_unique ('[' : c : _) | isAlphaNum c = []
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs
index 42628ad516..d20462c0b3 100644
--- a/compiler/basicTypes/RdrName.hs
+++ b/compiler/basicTypes/RdrName.hs
@@ -1376,12 +1376,12 @@ pprLoc (UnhelpfulSpan {}) = empty
 --
 starInfo :: Bool -> RdrName -> SDoc
 starInfo star_is_type rdr_name =
-  -- One might ask: if can use sdocWithDynFlags here, why bother to take
-  -- star_is_type as input? Why not refactor?
+  -- One might ask: if can use `sdocOption sdocStarIsType` here, why bother to
+  -- take star_is_type as input? Why not refactor?
   --
-  -- The reason is that sdocWithDynFlags would provide DynFlags that are active
-  -- in the module that tries to load the problematic definition, not
-  -- in the module that is being loaded.
+  -- The reason is that `sdocOption sdocStarIsType` would indicate that
+  -- StarIsType is enabled in the module that tries to load the problematic
+  -- definition, not in the module that is being loaded.
   --
   -- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
   -- must be displayed even if we load this definition from a module (or GHCi)
diff --git a/compiler/basicTypes/Var.hs b/compiler/basicTypes/Var.hs
index e9926d799d..cadbe070a4 100644
--- a/compiler/basicTypes/Var.hs
+++ b/compiler/basicTypes/Var.hs
@@ -102,7 +102,6 @@ import Unique ( Uniquable, Unique, getKey, getUnique
               , mkUniqueGrimily, nonDetCmpUnique )
 import Util
 import Binary
-import DynFlags
 import Outputable
 
 import Data.Data
@@ -300,9 +299,9 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds
 -}
 
 instance Outputable Var where
-  ppr var = sdocWithDynFlags $ \dflags ->
+  ppr var = sdocOption sdocSuppressVarKinds $ \supp_var_kinds ->
             getPprStyle $ \ppr_style ->
-            if |  debugStyle ppr_style && (not (gopt Opt_SuppressVarKinds dflags))
+            if |  debugStyle ppr_style && (not supp_var_kinds)
                  -> parens (ppr (varName var) <+> ppr_debug var ppr_style <+>
                           dcolon <+> pprKind (tyVarKind var))
                |  otherwise
diff --git a/compiler/coreSyn/PprCore.hs b/compiler/coreSyn/PprCore.hs
index 6a08b4a442..760c325d2b 100644
--- a/compiler/coreSyn/PprCore.hs
+++ b/compiler/coreSyn/PprCore.hs
@@ -7,7 +7,9 @@ Printing of Core syntax
 -}
 
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE LambdaCase #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module PprCore (
         pprCoreExpr, pprParendExpr,
         pprCoreBinding, pprCoreBindings, pprCoreAlt,
@@ -30,7 +32,6 @@ import DataCon
 import TyCon
 import TyCoPpr
 import Coercion
-import DynFlags
 import BasicTypes
 import Maybes
 import Util
@@ -116,13 +117,11 @@ ppr_bind ann (Rec binds)           = vcat (map pp binds)
 
 ppr_binding :: OutputableBndr b => Annotation b -> (b, Expr b) -> SDoc
 ppr_binding ann (val_bdr, expr)
-  = sdocWithDynFlags $ \dflags ->
-      vcat [ ann expr
-           , if gopt Opt_SuppressTypeSignatures dflags
-               then empty
-               else pprBndr LetBind val_bdr
-           , pp_bind
-           ]
+  = vcat [ ann expr
+         , ppUnlessOption sdocSuppressTypeSignatures
+             (pprBndr LetBind val_bdr)
+         , pp_bind
+         ]
   where
     pp_bind = case bndrIsJoin_maybe val_bdr of
                 Nothing -> pp_normal_bind
@@ -156,10 +155,9 @@ noParens pp = pp
 
 pprOptCo :: Coercion -> SDoc
 -- Print a coercion optionally; i.e. honouring -dsuppress-coercions
-pprOptCo co = sdocWithDynFlags $ \dflags ->
-              if gopt Opt_SuppressCoercions dflags
-              then angleBrackets (text "Co:" <> int (coercionSize co))
-              else parens (sep [ppr co, dcolon <+> ppr (coercionType co)])
+pprOptCo co = sdocOption sdocSuppressCoercions $ \case
+              True  -> angleBrackets (text "Co:" <> int (coercionSize co))
+              False -> parens $ sep [ppr co, dcolon <+> ppr (coercionType co)]
 
 ppr_expr :: OutputableBndr b => (SDoc -> SDoc) -> Expr b -> SDoc
         -- The function adds parens in context that need
@@ -184,15 +182,15 @@ ppr_expr add_par expr@(Lam _ _)
          2 (pprCoreExpr body)
 
 ppr_expr add_par expr@(App {})
-  = sdocWithDynFlags $ \dflags ->
+  = sdocOption sdocSuppressTypeApplications $ \supp_ty_app ->
     case collectArgs expr of { (fun, args) ->
     let
         pp_args     = sep (map pprArg args)
         val_args    = dropWhile isTypeArg args   -- Drop the type arguments for tuples
         pp_tup_args = pprWithCommas pprCoreExpr val_args
         args'
-          | gopt Opt_SuppressTypeApplications dflags = val_args
-          | otherwise = args
+          | supp_ty_app = val_args
+          | otherwise   = args
         parens
           | null args' = id
           | otherwise  = add_par
@@ -217,27 +215,26 @@ ppr_expr add_par expr@(App {})
     }
 
 ppr_expr add_par (Case expr var ty [(con,args,rhs)])
-  = sdocWithDynFlags $ \dflags ->
-    if gopt Opt_PprCaseAsLet dflags
-    then add_par $  -- See Note [Print case as let]
-         sep [ sep [ text "let! {"
-                     <+> ppr_case_pat con args
-                     <+> text "~"
-                     <+> ppr_bndr var
-                   , text "<-" <+> ppr_expr id expr
-                     <+> text "} in" ]
-             , pprCoreExpr rhs
-             ]
-    else add_par $
-         sep [sep [sep [ text "case" <+> pprCoreExpr expr
-                       , whenPprDebug (text "return" <+> ppr ty)
-                       , text "of" <+> ppr_bndr var
-                       ]
-                  , char '{' <+> ppr_case_pat con args <+> arrow
-                  ]
-              , pprCoreExpr rhs
-              , char '}'
-              ]
+  = sdocOption sdocPrintCaseAsLet $ \case
+      True -> add_par $  -- See Note [Print case as let]
+               sep [ sep [ text "let! {"
+                           <+> ppr_case_pat con args
+                           <+> text "~"
+                           <+> ppr_bndr var
+                         , text "<-" <+> ppr_expr id expr
+                           <+> text "} in" ]
+                   , pprCoreExpr rhs
+                   ]
+      False -> add_par $
+                sep [sep [sep [ text "case" <+> pprCoreExpr expr
+                              , whenPprDebug (text "return" <+> ppr ty)
+                              , text "of" <+> ppr_bndr var
+                              ]
+                         , char '{' <+> ppr_case_pat con args <+> arrow
+                         ]
+                     , pprCoreExpr rhs
+                     , char '}'
+                     ]
   where
     ppr_bndr = pprBndr CaseBind
 
@@ -291,10 +288,9 @@ ppr_expr add_par (Let bind expr)
      | otherwise                   = text "letrec"
 
 ppr_expr add_par (Tick tickish expr)
-  = sdocWithDynFlags $ \dflags ->
-  if gopt Opt_SuppressTicks dflags
-  then ppr_expr add_par expr
-  else add_par (sep [ppr tickish, pprCoreExpr expr])
+  = sdocOption sdocSuppressTicks $ \case
+      True  -> ppr_expr add_par expr
+      False -> add_par (sep [ppr tickish, pprCoreExpr expr])
 
 pprCoreAlt :: OutputableBndr a => (AltCon, [a] , Expr a) -> SDoc
 pprCoreAlt (con, args, rhs)
@@ -317,10 +313,8 @@ ppr_case_pat con args
 -- | Pretty print the argument in a function application.
 pprArg :: OutputableBndr a => Expr a -> SDoc
 pprArg (Type ty)
- = sdocWithDynFlags $ \dflags ->
-   if gopt Opt_SuppressTypeApplications dflags
-   then empty
-   else text "@" <> pprParendType ty
+ = ppUnlessOption sdocSuppressTypeApplications
+      (text "@" <> pprParendType ty)
 pprArg (Coercion co) = text "@~" <> pprOptCo co
 pprArg expr          = pprParendExpr expr
 
@@ -388,7 +382,7 @@ pprUntypedBinder binder
 pprTypedLamBinder :: BindingSite -> Bool -> Var -> SDoc
 -- For lambda and case binders, show the unfolding info (usually none)
 pprTypedLamBinder bind_site debug_on var
-  = sdocWithDynFlags $ \dflags ->
+  = sdocOption sdocSuppressTypeSignatures $ \suppress_sigs ->
     case () of
     _
       | not debug_on            -- Show case-bound wild binders only if debug is on
@@ -405,7 +399,7 @@ pprTypedLamBinder bind_site debug_on var
       | not debug_on
       , CasePatBind <- bind_site    -> pprUntypedBinder var
 
-      | suppress_sigs dflags    -> pprUntypedBinder var
+      | suppress_sigs -> pprUntypedBinder var
 
       | isTyVar var  -> parens (pprKindedTyVarBndr var)
 
@@ -413,8 +407,6 @@ pprTypedLamBinder bind_site debug_on var
                                    2 (vcat [ dcolon <+> pprType (idType var)
                                            , pp_unf]))
   where
-    suppress_sigs = gopt Opt_SuppressTypeSignatures
-
     unf_info = unfoldingInfo (idInfo var)
     pp_unf | hasSomeUnfolding unf_info = text "Unf=" <> ppr unf_info
            | otherwise                 = empty
@@ -422,12 +414,12 @@ pprTypedLamBinder bind_site debug_on var
 pprTypedLetBinder :: Var -> SDoc
 -- Print binder with a type or kind signature (not paren'd)
 pprTypedLetBinder binder
-  = sdocWithDynFlags $ \dflags ->
+  = sdocOption sdocSuppressTypeSignatures $ \suppress_sigs ->
     case () of
     _
-      | isTyVar binder                         -> pprKindedTyVarBndr binder
-      | gopt Opt_SuppressTypeSignatures dflags -> pprIdBndr binder
-      | otherwise                              -> hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
+      | isTyVar binder -> pprKindedTyVarBndr binder
+      | suppress_sigs  -> pprIdBndr binder
+      | otherwise      -> hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder))
 
 pprKindedTyVarBndr :: TyVar -> SDoc
 -- Print a type variable binder with its kind (but not if *)
@@ -441,9 +433,8 @@ pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id)
 
 pprIdBndrInfo :: IdInfo -> SDoc
 pprIdBndrInfo info
-  = sdocWithDynFlags $ \dflags ->
-    ppUnless (gopt Opt_SuppressIdInfo dflags) $
-    info `seq` doc -- The seq is useful for poking on black holes
+  = ppUnlessOption sdocSuppressIdInfo
+      (info `seq` doc) -- The seq is useful for poking on black holes
   where
     prag_info = inlinePragInfo info
     occ_info  = occInfo info
@@ -514,8 +505,7 @@ instance Outputable IdInfo where
 
 ppIdInfo :: Id -> IdInfo -> SDoc
 ppIdInfo id info
-  = sdocWithDynFlags $ \dflags ->
-    ppUnless (gopt Opt_SuppressIdInfo dflags) $
+  = ppUnlessOption sdocSuppressIdInfo $
     showAttributes
     [ (True, pp_scope <> ppr (idDetails id))
     , (has_arity,        text "Arity=" <> int arity)
@@ -606,9 +596,8 @@ instance Outputable Unfolding where
                 , text "WorkFree="   <> ppr wf
                 , text "Expandable=" <> ppr exp
                 , text "Guidance="   <> ppr g ]
-      pp_tmpl = sdocWithDynFlags $ \dflags ->
-                ppUnless (gopt Opt_SuppressUnfoldings dflags) $
-                text "Tmpl=" <+> ppr rhs
+      pp_tmpl = ppUnlessOption sdocSuppressUnfoldings
+                  (text "Tmpl=" <+> ppr rhs)
       pp_rhs | isStableSource src = pp_tmpl
              | otherwise          = empty
             -- Don't print the RHS or we get a quadratic
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f5e2fd93aa..97bc2fece1 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -38,8 +38,6 @@ module DynFlags (
         xopt, xopt_set, xopt_unset,
         xopt_set_unlessExplSpec,
         lang_set,
-        useUnicodeSyntax,
-        useStarIsType,
         whenGeneratingDynamicToo, ifGeneratingDynamicToo,
         whenCannotGenerateDynamicToo,
         dynamicTooMkDynamicDynFlags,
@@ -62,8 +60,6 @@ module DynFlags (
         wWarningFlags,
         dynFlagDependencies,
         makeDynFlagsConsistent,
-        shouldUseColor,
-        shouldUseHexWordLiterals,
         positionIndependent,
         optimisationFlags,
         setFlagsFromEnvFile,
@@ -241,6 +237,8 @@ module DynFlags (
         -- * Include specifications
         IncludeSpecs(..), addGlobalInclude, addQuoteInclude, flattenIncludes,
 
+        -- * SDoc
+        initSDocContext,
 
         -- * Make use of the Cmm CFG
         CfgWeights(..), backendMaintainsCfg
@@ -1707,13 +1705,6 @@ data RtsOptsEnabled
   | RtsOptsAll
   deriving (Show)
 
-shouldUseColor :: DynFlags -> Bool
-shouldUseColor dflags = overrideWith (canUseColor dflags) (useColor dflags)
-
-shouldUseHexWordLiterals :: DynFlags -> Bool
-shouldUseHexWordLiterals dflags =
-  Opt_HexWordLiterals `EnumSet.member` generalFlags dflags
-
 -- | Are we building with @-fPIE@ or @-fPIC@ enabled?
 positionIndependent :: DynFlags -> Bool
 positionIndependent dflags = gopt Opt_PIC dflags || gopt Opt_PIE dflags
@@ -1920,10 +1911,8 @@ initDynFlags dflags = do
                           do str' <- peekCString enc cstr
                              return (str == str'))
                          `catchIOError` \_ -> return False
- maybeGhcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
- let adjustNoUnicode (Just _) = False
-     adjustNoUnicode Nothing = True
- let useUnicode' = (adjustNoUnicode maybeGhcNoUnicodeEnv) && canUseUnicode
+ ghcNoUnicodeEnv <- lookupEnv "GHC_NO_UNICODE"
+ let useUnicode' = isNothing ghcNoUnicodeEnv && canUseUnicode
  canUseColor <- stderrSupportsAnsiColors
  maybeGhcColorsEnv  <- lookupEnv "GHC_COLORS"
  maybeGhcColoursEnv <- lookupEnv "GHC_COLOURS"
@@ -2498,16 +2487,6 @@ lang_set dflags lang =
             extensionFlags = flattenExtensionFlags lang (extensions dflags)
           }
 
--- | An internal helper to check whether to use unicode syntax for output.
---
--- Note: You should very likely be using 'Outputable.unicodeSyntax' instead
--- of this function.
-useUnicodeSyntax :: DynFlags -> Bool
-useUnicodeSyntax = gopt Opt_PrintUnicodeSyntax
-
-useStarIsType :: DynFlags -> Bool
-useStarIsType = xopt LangExt.StarIsType
-
 -- | Set the Haskell language standard to use
 setLanguage :: Language -> DynP ()
 setLanguage l = upd (`lang_set` Just l)
@@ -5918,3 +5897,42 @@ data FilesToClean = FilesToClean {
 -- | An empty FilesToClean
 emptyFilesToClean :: FilesToClean
 emptyFilesToClean = FilesToClean Set.empty Set.empty
+
+
+
+initSDocContext :: DynFlags -> PprStyle -> SDocContext
+initSDocContext dflags style = SDC
+  { sdocStyle                       = style
+  , sdocColScheme                   = colScheme dflags
+  , sdocLastColour                  = Col.colReset
+  , sdocShouldUseColor              = overrideWith (canUseColor dflags) (useColor dflags)
+  , sdocLineLength                  = pprCols dflags
+  , sdocCanUseUnicode               = useUnicode dflags
+  , sdocHexWordLiterals             = gopt Opt_HexWordLiterals dflags
+  , sdocDebugLevel                  = debugLevel dflags
+  , sdocPprDebug                    = dopt Opt_D_ppr_debug dflags
+  , sdocPrintUnicodeSyntax          = gopt Opt_PrintUnicodeSyntax dflags
+  , sdocPrintCaseAsLet              = gopt Opt_PprCaseAsLet dflags
+  , sdocPrintTypecheckerElaboration = gopt Opt_PrintTypecheckerElaboration dflags
+  , sdocPrintAxiomIncomps           = gopt Opt_PrintAxiomIncomps dflags
+  , sdocPrintExplicitKinds          = gopt Opt_PrintExplicitKinds dflags
+  , sdocPrintExplicitCoercions      = gopt Opt_PrintExplicitCoercions dflags
+  , sdocPrintExplicitRuntimeReps    = gopt Opt_PrintExplicitRuntimeReps dflags
+  , sdocPrintExplicitForalls        = gopt Opt_PrintExplicitForalls dflags
+  , sdocPrintPotentialInstances     = gopt Opt_PrintPotentialInstances dflags
+  , sdocPrintEqualityRelations      = gopt Opt_PrintEqualityRelations dflags
+  , sdocSuppressTicks               = gopt Opt_SuppressTicks dflags
+  , sdocSuppressTypeSignatures      = gopt Opt_SuppressTypeSignatures dflags
+  , sdocSuppressTypeApplications    = gopt Opt_SuppressTypeApplications dflags
+  , sdocSuppressIdInfo              = gopt Opt_SuppressIdInfo dflags
+  , sdocSuppressCoercions           = gopt Opt_SuppressCoercions dflags
+  , sdocSuppressUnfoldings          = gopt Opt_SuppressUnfoldings dflags
+  , sdocSuppressVarKinds            = gopt Opt_SuppressVarKinds dflags
+  , sdocSuppressUniques             = gopt Opt_SuppressUniques dflags
+  , sdocSuppressModulePrefixes      = gopt Opt_SuppressModulePrefixes dflags
+  , sdocSuppressStgExts             = gopt Opt_SuppressStgExts dflags
+  , sdocErrorSpans                  = gopt Opt_ErrorSpans dflags
+  , sdocStarIsType                  = xopt LangExt.StarIsType dflags
+  , sdocImpredicativeTypes          = xopt LangExt.ImpredicativeTypes dflags
+  , sdocDynFlags                    = dflags
+  }
diff --git a/compiler/main/DynFlags.hs-boot b/compiler/main/DynFlags.hs-boot
index 6f9bdc5138..6d471f3970 100644
--- a/compiler/main/DynFlags.hs-boot
+++ b/compiler/main/DynFlags.hs-boot
@@ -2,6 +2,7 @@ module DynFlags where
 
 import GhcPrelude
 import GHC.Platform
+import {-# SOURCE #-} Outputable
 
 data DynFlags
 data DumpFlag
@@ -11,9 +12,6 @@ targetPlatform           :: DynFlags -> Platform
 pprUserLength            :: DynFlags -> Int
 pprCols                  :: DynFlags -> Int
 unsafeGlobalDynFlags     :: DynFlags
-useUnicode               :: DynFlags -> Bool
-useUnicodeSyntax         :: DynFlags -> Bool
-shouldUseColor           :: DynFlags -> Bool
-shouldUseHexWordLiterals :: DynFlags -> Bool
 hasPprDebug              :: DynFlags -> Bool
 hasNoDebugOutput         :: DynFlags -> Bool
+initSDocContext          :: DynFlags -> PprStyle -> SDocContext
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index b5dab7ea35..320912ba59 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -8,6 +8,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE LambdaCase #-}
 
 module ErrUtils (
         -- * Basic types
@@ -209,12 +210,12 @@ mkLocMessageAnn
   -- are supposed to be in a standard format, and one without a location
   -- would look strange.  Better to say explicitly "<no location info>".
 mkLocMessageAnn ann severity locn msg
-    = sdocWithDynFlags $ \dflags ->
-      let locn' = if gopt Opt_ErrorSpans dflags
-                  then ppr locn
-                  else ppr (srcSpanStart locn)
+    = sdocOption sdocColScheme $ \col_scheme ->
+      let locn' = sdocOption sdocErrorSpans $ \case
+                     True  -> ppr locn
+                     False -> ppr (srcSpanStart locn)
 
-          sevColour = getSeverityColour severity (colScheme dflags)
+          sevColour = getSeverityColour severity col_scheme
 
           -- Add optional information
           optAnn = case ann of
@@ -226,8 +227,8 @@ mkLocMessageAnn ann severity locn msg
           header = locn' <> colon <+>
                    coloured sevColour sevText <> optAnn
 
-      in coloured (Col.sMessage (colScheme dflags))
-                  (hang (coloured (Col.sHeader (colScheme dflags)) header) 4
+      in coloured (Col.sMessage col_scheme)
+                  (hang (coloured (Col.sHeader col_scheme) header) 4
                         msg)
 
   where
@@ -279,9 +280,9 @@ getCaretDiagnostic severity (RealSrcSpan span) = do
 
     caretDiagnostic Nothing = empty
     caretDiagnostic (Just srcLineWithNewline) =
-      sdocWithDynFlags $ \ dflags ->
-      let sevColour = getSeverityColour severity (colScheme dflags)
-          marginColour = Col.sMargin (colScheme dflags)
+      sdocOption sdocColScheme$ \col_scheme ->
+      let sevColour = getSeverityColour severity col_scheme
+          marginColour = Col.sMargin col_scheme
       in
       coloured marginColour (text marginSpace) <>
       text ("\n") <>
@@ -377,7 +378,8 @@ warningsToMessages dflags =
 printBagOfErrors :: DynFlags -> Bag ErrMsg -> IO ()
 printBagOfErrors dflags bag_of_errors
   = sequence_ [ let style = mkErrStyle dflags unqual
-                in putLogMsg dflags reason sev s style (formatErrDoc dflags doc)
+                    ctx   = initSDocContext dflags style
+                in putLogMsg dflags reason sev s style (formatErrDoc ctx doc)
               | ErrMsg { errMsgSpan      = s,
                          errMsgDoc       = doc,
                          errMsgSeverity  = sev,
@@ -385,13 +387,13 @@ printBagOfErrors dflags bag_of_errors
                          errMsgContext   = unqual } <- sortMsgBag (Just dflags)
                                                                   bag_of_errors ]
 
-formatErrDoc :: DynFlags -> ErrDoc -> SDoc
-formatErrDoc dflags (ErrDoc important context supplementary)
+formatErrDoc :: SDocContext -> ErrDoc -> SDoc
+formatErrDoc ctx (ErrDoc important context supplementary)
   = case msgs of
         [msg] -> vcat msg
         _ -> vcat $ map starred msgs
     where
-    msgs = filter (not . null) $ map (filter (not . Outputable.isEmpty dflags))
+    msgs = filter (not . null) $ map (filter (not . Outputable.isEmpty ctx))
         [important, context, supplementary]
     starred = (bullet<+>) . vcat
 
@@ -403,9 +405,8 @@ pprLocErrMsg (ErrMsg { errMsgSpan      = s
                      , errMsgDoc       = doc
                      , errMsgSeverity  = sev
                      , errMsgContext   = unqual })
-  = sdocWithDynFlags $ \dflags ->
-    withPprStyle (mkErrStyle dflags unqual) $
-    mkLocMessage sev s (formatErrDoc dflags doc)
+  = sdocWithContext $ \ctx ->
+    withErrStyle unqual $ mkLocMessage sev s (formatErrDoc ctx doc)
 
 sortMsgBag :: Maybe DynFlags -> Bag ErrMsg -> [ErrMsg]
 sortMsgBag dflags = maybeLimit . sortBy (maybeFlip cmp) . bagToList
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 88f666c375..4653deaab6 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -888,7 +888,9 @@ makeImportsDoc dflags imports
                 | otherwise
                 = Outputable.empty
 
-        doPpr lbl = (lbl, renderWithStyle dflags (pprCLabel dflags lbl) astyle)
+        doPpr lbl = (lbl, renderWithStyle
+                              (initSDocContext dflags astyle)
+                              (pprCLabel dflags lbl))
         astyle = mkCodeStyle AsmStyle
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/nativeGen/Dwarf/Types.hs b/compiler/nativeGen/Dwarf/Types.hs
index df578e2671..c006081872 100644
--- a/compiler/nativeGen/Dwarf/Types.hs
+++ b/compiler/nativeGen/Dwarf/Types.hs
@@ -177,7 +177,7 @@ pprDwarfInfoOpen _ (DwarfSubprogram _ name label
   ppr (mkAsmTempDieLabel label) <> colon
   $$ pprAbbrev abbrev
   $$ pprString name
-  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))
+  $$ pprString (renderWithStyle (initSDocContext df (mkCodeStyle CStyle)) (ppr label))
   $$ pprFlag (externallyVisibleCLabel label)
   $$ pprWord (ppr label)
   $$ pprWord (ppr $ mkAsmTempEndLabel label)
@@ -192,11 +192,11 @@ pprDwarfInfoOpen _ (DwarfSubprogram _ name label
 pprDwarfInfoOpen _ (DwarfBlock _ label Nothing) = sdocWithDynFlags $ \df ->
   ppr (mkAsmTempDieLabel label) <> colon
   $$ pprAbbrev DwAbbrBlockWithoutCode
-  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))
+  $$ pprString (renderWithStyle (initSDocContext df (mkCodeStyle CStyle)) (ppr label))
 pprDwarfInfoOpen _ (DwarfBlock _ label (Just marker)) = sdocWithDynFlags $ \df ->
   ppr (mkAsmTempDieLabel label) <> colon
   $$ pprAbbrev DwAbbrBlock
-  $$ pprString (renderWithStyle df (ppr label) (mkCodeStyle CStyle))
+  $$ pprString (renderWithStyle (initSDocContext df (mkCodeStyle CStyle)) (ppr label))
   $$ pprWord (ppr marker)
   $$ pprWord (ppr $ mkAsmTempEndLabel marker)
 pprDwarfInfoOpen _ (DwarfSrcNote ss) =
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 8b73cdffc1..4df7287b5a 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -120,15 +120,17 @@ pprSizeDecl lbl
 
 pprBasicBlock :: LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
-  = sdocWithDynFlags $ \dflags ->
-    maybe_infotable dflags $
+  = maybe_infotable $
     pprLabel asmLbl $$
     vcat (map pprInstr instrs) $$
-    (if debugLevel dflags > 0
-     then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)
+    (sdocOption sdocDebugLevel $ \level ->
+        if level > 0
+           then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
+           else empty
+    )
   where
     asmLbl = blockLbl blockid
-    maybe_infotable dflags c = case mapLookup blockid info_env of
+    maybe_infotable c = case mapLookup blockid info_env of
        Nothing -> c
        Just (RawCmmStatics infoLbl info) ->
            pprAlignForSection Text $$
@@ -136,8 +138,11 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
            vcat (map pprData info) $$
            pprLabel infoLbl $$
            c $$
-           (if debugLevel dflags > 0
-            then ppr (mkAsmTempEndLabel infoLbl) <> char ':' else empty)
+           (sdocOption sdocDebugLevel $ \level ->
+               if level > 0
+                  then ppr (mkAsmTempEndLabel infoLbl) <> char ':'
+                  else empty
+           )
     -- Make sure the info table has the right .loc for the block
     -- coming right after it. See [Note: Info Offset]
     infoTableLoc = case instrs of
diff --git a/compiler/typecheck/TcBackpack.hs b/compiler/typecheck/TcBackpack.hs
index 29f5e616df..93de957b27 100644
--- a/compiler/typecheck/TcBackpack.hs
+++ b/compiler/typecheck/TcBackpack.hs
@@ -168,9 +168,8 @@ checkHsigIface tcg_env gr sig_iface
                          -- info for the *specific* name we matched.
                          -> getLoc e
                        _ -> nameSrcSpan name
-            dflags <- getDynFlags
             addErrAt loc
-                (badReexportedBootThing dflags False name name')
+                (badReexportedBootThing False name name')
       -- This should actually never happen, but whatever...
       | otherwise =
         addErrAt (nameSrcSpan name)
diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 3fd70d0a2b..24aea54adb 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
@@ -1196,10 +1197,8 @@ mkHoleError tidy_simples ctxt ct@(CHoleCan { cc_occ = occ, cc_hole = hole_sort }
            MetaTv {} -> quotes (ppr tv) <+> text "is an ambiguous type variable"
            _         -> empty  -- Skolems dealt with already
        | otherwise  -- A coercion variable can be free in the hole type
-       = sdocWithDynFlags $ \dflags ->
-         if gopt Opt_PrintExplicitCoercions dflags
-         then quotes (ppr tv) <+> text "is a coercion variable"
-         else empty
+       = ppWhenOption sdocPrintExplicitCoercions $
+           quotes (ppr tv) <+> text "is a coercion variable"
 
 mkHoleError _ _ ct = pprPanic "mkHoleError" (ppr ct)
 
@@ -1353,10 +1352,10 @@ mkEqErr1 ctxt ct   -- Wanted or derived;
             where
               sub_what = case sub_t_or_k of Just KindLevel -> text "kinds"
                                             _              -> text "types"
-              msg1 = sdocWithDynFlags $ \dflags ->
+              msg1 = sdocOption sdocPrintExplicitCoercions $ \printExplicitCoercions ->
                      case mb_cty2 of
                        Just cty2
-                         |  gopt Opt_PrintExplicitCoercions dflags
+                         |  printExplicitCoercions
                          || not (cty1 `pickyEqType` cty2)
                          -> hang (text "When matching" <+> sub_what)
                                2 (vcat [ ppr cty1 <+> dcolon <+>
@@ -1921,10 +1920,9 @@ mkExpectedActualMsg ty1 ty2 ct@(TypeEqOrigin { uo_actual = act
 
                     -- TYPE t0
                   | Just arg <- kindRep_maybe exp
-                  , tcIsTyVarTy arg = sdocWithDynFlags $ \dflags ->
-                                      if gopt Opt_PrintExplicitRuntimeReps dflags
-                                      then text "kind" <+> quotes (ppr exp)
-                                      else text "a type"
+                  , tcIsTyVarTy arg = sdocOption sdocPrintExplicitRuntimeReps $ \case
+                                       True  -> text "kind" <+> quotes (ppr exp)
+                                       False -> text "a type"
 
                   | otherwise       = text "kind" <+> quotes (ppr exp)
 
@@ -2347,9 +2345,9 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
 
         potential_msg
           = ppWhen (not (null unifiers) && want_potential orig) $
-            sdocWithDynFlags $ \dflags ->
+            sdocOption sdocPrintPotentialInstances $ \print_insts ->
             getPprStyle $ \sty ->
-            pprPotentials dflags sty potential_hdr unifiers
+            pprPotentials (PrintPotentialInstances print_insts) sty potential_hdr unifiers
 
         potential_hdr
           = vcat [ ppWhen lead_with_ambig $
@@ -2408,9 +2406,9 @@ mk_dict_err ctxt@(CEC {cec_encl = implics}) (ct, (matches, unifiers, unsafe_over
                   sep [text "Matching givens (or their superclasses):"
                       , nest 2 (vcat matching_givens)]
 
-             ,  sdocWithDynFlags $ \dflags ->
+             ,  sdocOption sdocPrintPotentialInstances $ \print_insts ->
                 getPprStyle $ \sty ->
-                pprPotentials dflags sty (text "Matching instances:") $
+                pprPotentials (PrintPotentialInstances print_insts) sty (text "Matching instances:") $
                 ispecs ++ unifiers
 
              ,  ppWhen (null matching_givens && isSingleton matches && null unifiers) $
@@ -2599,9 +2597,13 @@ show_fixes []     = empty
 show_fixes (f:fs) = sep [ text "Possible fix:"
                         , nest 2 (vcat (f : map (text "or" <+>) fs))]
 
-pprPotentials :: DynFlags -> PprStyle -> SDoc -> [ClsInst] -> SDoc
+
+-- Avoid boolean blindness
+newtype PrintPotentialInstances = PrintPotentialInstances Bool
+
+pprPotentials :: PrintPotentialInstances -> PprStyle -> SDoc -> [ClsInst] -> SDoc
 -- See Note [Displaying potential instances]
-pprPotentials dflags sty herald insts
+pprPotentials (PrintPotentialInstances show_potentials) sty herald insts
   | null insts
   = empty
 
@@ -2620,7 +2622,6 @@ pprPotentials dflags sty herald insts
                , flag_hint ])
   where
     n_show = 3 :: Int
-    show_potentials = gopt Opt_PrintPotentialInstances dflags
 
     (in_scope, not_in_scope) = partition inst_in_scope insts
     sorted = sortBy fuzzyClsInstCmp in_scope
diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index f60405e8be..fb6fa71ada 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -1,6 +1,7 @@
 -- (c) The University of Glasgow 2006
 
 {-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE LambdaCase #-}
 
 module TcEvidence (
 
@@ -64,7 +65,6 @@ import TyCon
 import DataCon( DataCon, dataConWrapId )
 import Class( Class )
 import PrelNames
-import DynFlags   ( gopt, GeneralFlag(Opt_PrintTypecheckerElaboration) )
 import VarEnv
 import VarSet
 import Predicate
@@ -912,10 +912,9 @@ pprHsWrapper :: HsWrapper -> (Bool -> SDoc) -> SDoc
 -- The pp_thing_inside function takes Bool to say whether
 --    it's in a position that needs parens for a non-atomic thing
 pprHsWrapper wrap pp_thing_inside
-  = sdocWithDynFlags $ \ dflags ->
-    if gopt Opt_PrintTypecheckerElaboration dflags
-    then help pp_thing_inside wrap False
-    else pp_thing_inside False
+  = sdocOption sdocPrintTypecheckerElaboration $ \case
+      True  -> help pp_thing_inside wrap False
+      False -> pp_thing_inside False
   where
     help :: (Bool -> SDoc) -> HsWrapper -> Bool -> SDoc
     -- True  <=> appears in function application position
diff --git a/compiler/typecheck/TcOrigin.hs b/compiler/typecheck/TcOrigin.hs
index df7a39f72e..c69013917c 100644
--- a/compiler/typecheck/TcOrigin.hs
+++ b/compiler/typecheck/TcOrigin.hs
@@ -6,6 +6,7 @@ The datatypes here are mainly used for error message generation.
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
@@ -42,8 +43,6 @@ import PatSyn
 import Module
 import Name
 import RdrName
-import qualified GHC.LanguageExtensions as LangExt
-import DynFlags
 
 import SrcLoc
 import FastString
@@ -608,13 +607,13 @@ pprCtOrigin (FailablePattern pat)
       text "(this will become an error in a future GHC release)"
 
 pprCtOrigin (Shouldn'tHappenOrigin note)
-  = sdocWithDynFlags $ \dflags ->
-    if xopt LangExt.ImpredicativeTypes dflags
-    then text "a situation created by impredicative types"
-    else
-    vcat [ text "<< This should not appear in error messages. If you see this"
-         , text "in an error message, please report a bug mentioning" <+> quotes (text note) <+> text "at"
-         , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>" ]
+  = sdocOption sdocImpredicativeTypes $ \case
+      True  -> text "a situation created by impredicative types"
+      False -> vcat [ text "<< This should not appear in error messages. If you see this"
+                    , text "in an error message, please report a bug mentioning"
+                        <+> quotes (text note) <+> text "at"
+                    , text "https://gitlab.haskell.org/ghc/ghc/wikis/report-a-bug >>"
+                    ]
 
 pprCtOrigin (ProvCtxtOrigin PSB{ psb_id = (L _ name) })
   = hang (ctoHerald <+> text "the \"provided\" constraints claimed by")
diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs
index 2caee7df9f..8d8d135d71 100644
--- a/compiler/typecheck/TcRnDriver.hs
+++ b/compiler/typecheck/TcRnDriver.hs
@@ -1321,9 +1321,9 @@ missingBootThing is_boot name what
     <+> text "file, but not"
     <+> text what <+> text "the module"
 
-badReexportedBootThing :: DynFlags -> Bool -> Name -> Name -> SDoc
-badReexportedBootThing dflags is_boot name name'
-  = withPprStyle (mkUserStyle dflags alwaysQualify AllTheWay) $ vcat
+badReexportedBootThing :: Bool -> Name -> Name -> SDoc
+badReexportedBootThing is_boot name name'
+  = withUserStyle alwaysQualify AllTheWay $ vcat
         [ text "The" <+> (if is_boot then text "hs-boot" else text "hsig")
            <+> text "file (re)exports" <+> quotes (ppr name)
         , text "but the implementing module exports a different identifier" <+> quotes (ppr name')
diff --git a/compiler/typecheck/TcRnDriver.hs-boot b/compiler/typecheck/TcRnDriver.hs-boot
index 6ffc409e22..cdbdca50af 100644
--- a/compiler/typecheck/TcRnDriver.hs-boot
+++ b/compiler/typecheck/TcRnDriver.hs-boot
@@ -1,7 +1,6 @@
 module TcRnDriver where
 
 import GhcPrelude
-import DynFlags (DynFlags)
 import Type (TyThing)
 import TcRnTypes (TcM)
 import Outputable (SDoc)
@@ -10,4 +9,4 @@ import Name (Name)
 checkBootDeclM :: Bool  -- ^ True <=> an hs-boot file (could also be a sig)
                -> TyThing -> TyThing -> TcM ()
 missingBootThing :: Bool -> Name -> String -> SDoc
-badReexportedBootThing :: DynFlags -> Bool -> Name -> Name -> SDoc
+badReexportedBootThing :: Bool -> Name -> Name -> SDoc
diff --git a/compiler/types/TyCoPpr.hs b/compiler/types/TyCoPpr.hs
index f7a768210b..e3581ba02a 100644
--- a/compiler/types/TyCoPpr.hs
+++ b/compiler/types/TyCoPpr.hs
@@ -49,8 +49,6 @@ import GHC.Iface.Type
 import VarSet
 import VarEnv
 
-import DynFlags   ( gopt_set,
-                    GeneralFlag(Opt_PrintExplicitKinds, Opt_PrintExplicitRuntimeReps) )
 import Outputable
 import BasicTypes ( PprPrec(..), topPrec, sigPrec, opPrec
                   , funPrec, appPrec, maybeParen )
@@ -318,14 +316,14 @@ pprTypeApp tc tys
 -- See @Note [Kind arguments in error messages]@ in TcErrors.
 pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
 pprWithExplicitKindsWhen b
-  = updSDocDynFlags $ \dflags ->
-      if b then gopt_set dflags Opt_PrintExplicitKinds
-           else dflags
+  = updSDocContext $ \ctx ->
+      if b then ctx { sdocPrintExplicitKinds = True }
+           else ctx
 
 -- | This variant preserves any use of TYPE in a type, effectively
 -- locally setting -fprint-explicit-runtime-reps.
 pprWithTYPE :: Type -> SDoc
-pprWithTYPE ty = updSDocDynFlags (flip gopt_set Opt_PrintExplicitRuntimeReps) $
+pprWithTYPE ty = updSDocContext (\ctx -> ctx { sdocPrintExplicitRuntimeReps = True }) $
                  ppr ty
 
 -- | Pretty prints a 'TyCon', using the family instance in case of a
diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs
index 02805c6c7c..ba595757e9 100644
--- a/compiler/utils/Outputable.hs
+++ b/compiler/utils/Outputable.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+
 {-
 (c) The University of Glasgow 2006-2012
 (c) The GRASP Project, Glasgow University, 1992-1998
@@ -34,6 +36,7 @@ module Outputable (
         sep, cat,
         fsep, fcat,
         hang, hangNotEmpty, punctuate, ppWhen, ppUnless,
+        ppWhenOption, ppUnlessOption,
         speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, itsOrTheir,
         unicodeSyntax,
 
@@ -68,14 +71,16 @@ module Outputable (
         neverQualify, neverQualifyNames, neverQualifyModules,
         alwaysQualifyPackages, neverQualifyPackages,
         QualifyName(..), queryQual,
-        sdocWithDynFlags, sdocWithPlatform,
-        updSDocDynFlags,
-        getPprStyle, withPprStyle, withPprStyleDoc, setStyleColoured,
+        sdocWithDynFlags, sdocWithPlatform, sdocOption,
+        updSDocContext,
+        SDocContext (..), sdocWithContext,
+        getPprStyle, withPprStyle, setStyleColoured,
         pprDeeper, pprDeeperList, pprSetDepth,
         codeStyle, userStyle, debugStyle, dumpStyle, asmStyle,
         qualName, qualModule, qualPackage,
         mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
         mkUserStyle, cmdlineParserStyle, Depth(..),
+        withUserStyle, withErrStyle,
 
         ifPprDebug, whenPprDebug, getPprDebug,
 
@@ -91,9 +96,8 @@ import GhcPrelude
 
 import {-# SOURCE #-}   DynFlags( DynFlags, hasPprDebug, hasNoDebugOutput,
                                   targetPlatform, pprUserLength, pprCols,
-                                  useUnicode, useUnicodeSyntax,
-                                  shouldUseColor, unsafeGlobalDynFlags,
-                                  shouldUseHexWordLiterals )
+                                  unsafeGlobalDynFlags,
+                                  initSDocContext)
 import {-# SOURCE #-}   Module( UnitId, Module, ModuleName, moduleName )
 import {-# SOURCE #-}   OccName( OccName )
 
@@ -281,6 +285,16 @@ mkUserStyle dflags unqual depth
    | hasPprDebug dflags = PprDebug
    | otherwise          = PprUser unqual depth Uncoloured
 
+withUserStyle :: PrintUnqualified -> Depth -> SDoc -> SDoc
+withUserStyle unqual depth doc = sdocOption sdocPprDebug $ \case
+   True  -> withPprStyle PprDebug doc
+   False -> withPprStyle (PprUser unqual depth Uncoloured) doc
+
+withErrStyle :: PrintUnqualified -> SDoc -> SDoc
+withErrStyle unqual doc =
+   sdocWithDynFlags $ \dflags ->
+   withPprStyle (mkErrStyle dflags unqual) doc
+
 setStyleColoured :: Bool -> PprStyle -> PprStyle
 setStyleColoured col style =
   case style of
@@ -320,10 +334,43 @@ code (either C or assembly), or generating interface files.
 newtype SDoc = SDoc { runSDoc :: SDocContext -> Doc }
 
 data SDocContext = SDC
-  { sdocStyle      :: !PprStyle
-  , sdocLastColour :: !Col.PprColour
-    -- ^ The most recently used colour.  This allows nesting colours.
-  , sdocDynFlags   :: !DynFlags
+  { sdocStyle                       :: !PprStyle
+  , sdocColScheme                   :: !Col.Scheme
+  , sdocLastColour                  :: !Col.PprColour
+      -- ^ The most recently used colour.
+      -- This allows nesting colours.
+  , sdocShouldUseColor              :: !Bool
+  , sdocLineLength                  :: !Int
+  , sdocCanUseUnicode               :: !Bool
+      -- ^ True if Unicode encoding is supported
+      -- and not disable by GHC_NO_UNICODE environment variable
+  , sdocHexWordLiterals             :: !Bool
+  , sdocDebugLevel                  :: !Int
+  , sdocPprDebug                    :: !Bool
+  , sdocPrintUnicodeSyntax          :: !Bool
+  , sdocPrintCaseAsLet              :: !Bool
+  , sdocPrintTypecheckerElaboration :: !Bool
+  , sdocPrintAxiomIncomps           :: !Bool
+  , sdocPrintExplicitKinds          :: !Bool
+  , sdocPrintExplicitCoercions      :: !Bool
+  , sdocPrintExplicitRuntimeReps    :: !Bool
+  , sdocPrintExplicitForalls        :: !Bool
+  , sdocPrintPotentialInstances     :: !Bool
+  , sdocPrintEqualityRelations      :: !Bool
+  , sdocSuppressTicks               :: !Bool
+  , sdocSuppressTypeSignatures      :: !Bool
+  , sdocSuppressTypeApplications    :: !Bool
+  , sdocSuppressIdInfo              :: !Bool
+  , sdocSuppressCoercions           :: !Bool
+  , sdocSuppressUnfoldings          :: !Bool
+  , sdocSuppressVarKinds            :: !Bool
+  , sdocSuppressUniques             :: !Bool
+  , sdocSuppressModulePrefixes      :: !Bool
+  , sdocSuppressStgExts             :: !Bool
+  , sdocErrorSpans                  :: !Bool
+  , sdocStarIsType                  :: !Bool
+  , sdocImpredicativeTypes          :: !Bool
+  , sdocDynFlags                    :: DynFlags -- TODO: remove
   }
 
 instance IsString SDoc where
@@ -333,22 +380,10 @@ instance IsString SDoc where
 instance Outputable SDoc where
   ppr = id
 
-initSDocContext :: DynFlags -> PprStyle -> SDocContext
-initSDocContext dflags sty = SDC
-  { sdocStyle = sty
-  , sdocLastColour = Col.colReset
-  , sdocDynFlags = dflags
-  }
 
 withPprStyle :: PprStyle -> SDoc -> SDoc
 withPprStyle sty d = SDoc $ \ctxt -> runSDoc d ctxt{sdocStyle=sty}
 
--- | This is not a recommended way to render 'SDoc', since it breaks the
--- abstraction layer of 'SDoc'.  Prefer to use 'printSDoc', 'printSDocLn',
--- 'bufLeftRenderSDoc', or 'renderWithStyle' instead.
-withPprStyleDoc :: DynFlags -> PprStyle -> SDoc -> Doc
-withPprStyleDoc dflags sty d = runSDoc d (initSDocContext dflags sty)
-
 pprDeeper :: SDoc -> SDoc
 pprDeeper d = SDoc $ \ctx -> case ctx of
   SDC{sdocStyle=PprUser _ (PartWay 0) _} -> Pretty.text "..."
@@ -389,9 +424,15 @@ sdocWithDynFlags f = SDoc $ \ctx -> runSDoc (f (sdocDynFlags ctx)) ctx
 sdocWithPlatform :: (Platform -> SDoc) -> SDoc
 sdocWithPlatform f = sdocWithDynFlags (f . targetPlatform)
 
-updSDocDynFlags :: (DynFlags -> DynFlags) -> SDoc -> SDoc
-updSDocDynFlags upd doc
-  = SDoc $ \ctx -> runSDoc doc (ctx { sdocDynFlags = upd (sdocDynFlags ctx) })
+sdocWithContext :: (SDocContext -> SDoc) -> SDoc
+sdocWithContext f = SDoc $ \ctx -> runSDoc (f ctx) ctx
+
+sdocOption :: (SDocContext -> a) -> (a -> SDoc) -> SDoc
+sdocOption f g = sdocWithContext (g . f)
+
+updSDocContext :: (SDocContext -> SDocContext) -> SDoc -> SDoc
+updSDocContext upd doc
+  = SDoc $ \ctx -> runSDoc doc (upd ctx)
 
 qualName :: PprStyle -> QueryQualifyName
 qualName (PprUser q _ _) mod occ = queryQualifyName q mod occ
@@ -495,7 +536,7 @@ mkCodeStyle = PprCode
 -- However, Doc *is* an instance of Show
 -- showSDoc just blasts it out as a string
 showSDoc :: DynFlags -> SDoc -> String
-showSDoc dflags sdoc = renderWithStyle dflags sdoc (defaultUserStyle dflags)
+showSDoc dflags sdoc = renderWithStyle (initSDocContext dflags (defaultUserStyle dflags)) sdoc
 
 -- showSDocUnsafe is unsafe, because `unsafeGlobalDynFlags` might not be
 -- initialised yet.
@@ -512,19 +553,19 @@ showSDocUnqual dflags sdoc = showSDoc dflags sdoc
 showSDocForUser :: DynFlags -> PrintUnqualified -> SDoc -> String
 -- Allows caller to specify the PrintUnqualified to use
 showSDocForUser dflags unqual doc
- = renderWithStyle dflags doc (mkUserStyle dflags unqual AllTheWay)
+ = renderWithStyle (initSDocContext dflags (mkUserStyle dflags unqual AllTheWay)) doc
 
 showSDocDump :: DynFlags -> SDoc -> String
-showSDocDump dflags d = renderWithStyle dflags d (defaultDumpStyle dflags)
+showSDocDump dflags d = renderWithStyle (initSDocContext dflags (defaultDumpStyle dflags)) d
 
 showSDocDebug :: DynFlags -> SDoc -> String
-showSDocDebug dflags d = renderWithStyle dflags d PprDebug
+showSDocDebug dflags d = renderWithStyle (initSDocContext dflags PprDebug) d
 
-renderWithStyle :: DynFlags -> SDoc -> PprStyle -> String
-renderWithStyle dflags sdoc sty
-  = let s = Pretty.style{ Pretty.mode = PageMode,
-                          Pretty.lineLength = pprCols dflags }
-    in Pretty.renderStyle s $ runSDoc sdoc (initSDocContext dflags sty)
+renderWithStyle :: SDocContext -> SDoc -> String
+renderWithStyle ctx sdoc
+  = let s = Pretty.style{ Pretty.mode       = PageMode,
+                          Pretty.lineLength = sdocLineLength ctx }
+    in Pretty.renderStyle s $ runSDoc sdoc ctx
 
 -- 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"
@@ -547,9 +588,8 @@ irrelevantNCols :: Int
 -- Used for OneLineMode and LeftMode when number of cols isn't used
 irrelevantNCols = 1
 
-isEmpty :: DynFlags -> SDoc -> Bool
-isEmpty dflags sdoc = Pretty.isEmpty $ runSDoc sdoc dummySDocContext
-   where dummySDocContext = initSDocContext dflags PprDebug
+isEmpty :: SDocContext -> SDoc -> Bool
+isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocStyle = PprDebug})
 
 docToSDoc :: Doc -> SDoc
 docToSDoc d = SDoc (\_ -> d)
@@ -581,11 +621,10 @@ integer n   = docToSDoc $ Pretty.integer n
 float n     = docToSDoc $ Pretty.float n
 double n    = docToSDoc $ Pretty.double n
 rational n  = docToSDoc $ Pretty.rational n
-word n      = sdocWithDynFlags $ \dflags ->
-    -- See Note [Print Hexadecimal Literals] in Pretty.hs
-    if shouldUseHexWordLiterals dflags
-        then docToSDoc $ Pretty.hex n
-        else docToSDoc $ Pretty.integer n
+              -- See Note [Print Hexadecimal Literals] in Pretty.hs
+word n      = sdocOption sdocHexWordLiterals $ \case
+               True  -> docToSDoc $ Pretty.hex n
+               False -> docToSDoc $ Pretty.integer n
 
 -- | @doublePrec p n@ shows a floating point number @n@ with @p@
 -- digits of precision after the decimal point.
@@ -608,17 +647,15 @@ cparen b d = SDoc $ Pretty.maybeParens b . runSDoc d
 -- 'quotes' encloses something in single quotes...
 -- but it omits them if the thing begins or ends in a single quote
 -- so that we don't get `foo''.  Instead we just have foo'.
-quotes d =
-      sdocWithDynFlags $ \dflags ->
-      if useUnicode dflags
-      then char '‘' <> d <> char '’'
-      else SDoc $ \sty ->
-           let pp_d = runSDoc d sty
-               str  = show pp_d
-           in case (str, lastMaybe str) of
-             (_, Just '\'') -> pp_d
-             ('\'' : _, _)       -> pp_d
-             _other              -> Pretty.quotes pp_d
+quotes d = sdocOption sdocCanUseUnicode $ \case
+   True  -> char '‘' <> d <> char '’'
+   False -> SDoc $ \sty ->
+      let pp_d = runSDoc d sty
+          str  = show pp_d
+      in case (str, lastMaybe str) of
+        (_, Just '\'') -> pp_d
+        ('\'' : _, _)       -> pp_d
+        _other              -> Pretty.quotes pp_d
 
 semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc
 arrow, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt :: SDoc
@@ -655,16 +692,17 @@ bullet :: SDoc
 bullet = unicode (char '•') (char '*')
 
 unicodeSyntax :: SDoc -> SDoc -> SDoc
-unicodeSyntax unicode plain = sdocWithDynFlags $ \dflags ->
-    if useUnicode dflags && useUnicodeSyntax dflags
+unicodeSyntax unicode plain =
+   sdocOption sdocCanUseUnicode $ \can_use_unicode ->
+   sdocOption sdocPrintUnicodeSyntax $ \print_unicode_syntax ->
+    if can_use_unicode && print_unicode_syntax
     then unicode
     else plain
 
 unicode :: SDoc -> SDoc -> SDoc
-unicode unicode plain = sdocWithDynFlags $ \dflags ->
-    if useUnicode dflags
-    then unicode
-    else plain
+unicode unicode plain = sdocOption sdocCanUseUnicode $ \case
+   True  -> unicode
+   False -> plain
 
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
@@ -737,22 +775,29 @@ ppWhen False _   = empty
 ppUnless True  _   = empty
 ppUnless False doc = doc
 
+ppWhenOption :: (SDocContext -> Bool) -> SDoc -> SDoc
+ppWhenOption f doc = sdocOption f $ \case
+   True  -> doc
+   False -> empty
+
+ppUnlessOption :: (SDocContext -> Bool) -> SDoc -> SDoc
+ppUnlessOption f doc = sdocOption f $ \case
+   True  -> empty
+   False -> doc
+
 -- | Apply the given colour\/style for the argument.
 --
 -- Only takes effect if colours are enabled.
 coloured :: Col.PprColour -> SDoc -> SDoc
-coloured col sdoc =
-  sdocWithDynFlags $ \dflags ->
-    if shouldUseColor dflags
-    then SDoc $ \ctx@SDC{ sdocLastColour = lastCol } ->
-         case ctx of
-           SDC{ sdocStyle = PprUser _ _ Coloured } ->
-             let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in
-             Pretty.zeroWidthText (Col.renderColour col)
-               Pretty.<> runSDoc sdoc ctx'
-               Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)
-           _ -> runSDoc sdoc ctx
-    else sdoc
+coloured col sdoc = sdocOption sdocShouldUseColor $ \case
+   True -> SDoc $ \case
+      ctx@SDC{ sdocLastColour = lastCol, sdocStyle = PprUser _ _ Coloured } ->
+         let ctx' = ctx{ sdocLastColour = lastCol `mappend` col } in
+         Pretty.zeroWidthText (Col.renderColour col)
+           Pretty.<> runSDoc sdoc ctx'
+           Pretty.<> Pretty.zeroWidthText (Col.renderColourAfresh lastCol)
+      ctx -> runSDoc sdoc ctx
+   False -> sdoc
 
 keyword :: SDoc -> SDoc
 keyword = coloured Col.colBold
diff --git a/compiler/utils/Outputable.hs-boot b/compiler/utils/Outputable.hs-boot
index fb3c173a33..77e0982826 100644
--- a/compiler/utils/Outputable.hs-boot
+++ b/compiler/utils/Outputable.hs-boot
@@ -4,6 +4,8 @@ import GhcPrelude
 import GHC.Stack( HasCallStack )
 
 data SDoc
+data PprStyle
+data SDocContext
 
 showSDocUnsafe :: SDoc -> String