Use a more efficient printer for code generation (#21853)wip/efficient-codegen

The changes in `GHC.Utils.Outputable` are the bulk of the patch
and drive the rest.
The types `HLine` and `HDoc` in Outputable can be used instead of `SDoc`
and support printing directly to a handle with `bPutHDoc`.
See Note [SDoc versus HDoc] and Note [HLine versus HDoc].

The classes `IsLine` and `IsDoc` are used to make the existing code polymorphic
over `HLine`/`HDoc` and `SDoc`. This is done for X86, PPC, AArch64, DWARF
and dependencies (printing module names, labels etc.).

Co-authored-by: Alexis King <lexi.lambda@gmail.com>

Metric Decrease:
    CoOpt_Read
    ManyAlternatives
    ManyConstructors
    T10421
    T12425
    T12707
    T13035
    T13056
    T13253
    T13379
    T18140
    T18282
    T18698a
    T18698b
    T1969
    T20049
    T21839c
    T21839r
    T3064
    T3294
    T4801
    T5321FD
    T5321Fun
    T5631
    T6048
    T783
    T9198
    T9233

37 files changed, 1224 insertions, 706 deletions

diff --git a/compiler/GHC/Builtin/PrimOps.hs b/compiler/GHC/Builtin/PrimOps.hs
index ecd9da0ac2..8b4fc099cd 100644
--- a/compiler/GHC/Builtin/PrimOps.hs
+++ b/compiler/GHC/Builtin/PrimOps.hs
@@ -11,6 +11,7 @@ module GHC.Builtin.PrimOps (
         primOpType, primOpSig, primOpResultType,
         primOpTag, maxPrimOpTag, primOpOcc,
         primOpWrapperId,
+        pprPrimOp,
 
         tagToEnumKey,
 
@@ -788,8 +789,10 @@ compare_fun_ty ty = mkVisFunTysMany [ty, ty] intPrimTy
 
 -- Output stuff:
 
-pprPrimOp  :: PrimOp -> SDoc
+pprPrimOp  :: IsLine doc => PrimOp -> doc
 pprPrimOp other_op = pprOccName (primOpOcc other_op)
+{-# SPECIALIZE pprPrimOp :: PrimOp -> SDoc #-}
+{-# SPECIALIZE pprPrimOp :: PrimOp -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/ByteCode/Types.hs b/compiler/GHC/ByteCode/Types.hs
index 6eb661ac18..830b60a4ca 100644
--- a/compiler/GHC/ByteCode/Types.hs
+++ b/compiler/GHC/ByteCode/Types.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE TypeApplications           #-}
 --
 --  (c) The University of Glasgow 2002-2006
 --
@@ -115,7 +116,7 @@ instance Outputable TupleInfo where
   ppr TupleInfo{..} = text "<size" <+> ppr tupleSize <+>
                       text "stack" <+> ppr tupleNativeStackSize <+>
                       text "regs"  <+>
-                      ppr (map (text.show) $ regSetToList tupleRegs) <>
+                      ppr (map (text @SDoc . show) $ regSetToList tupleRegs) <>
                       char '>'
 
 voidTupleInfo :: TupleInfo
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 6d4397e62b..5fd6378678 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -307,12 +307,14 @@ data ModuleLabelKind
     | MLK_IPEBuffer
     deriving (Eq, Ord)
 
-instance Outputable ModuleLabelKind where
-    ppr MLK_InitializerArray = text "init_arr"
-    ppr (MLK_Initializer s)  = text ("init__" ++ s)
-    ppr MLK_FinalizerArray   = text "fini_arr"
-    ppr (MLK_Finalizer s)    = text ("fini__" ++ s)
-    ppr MLK_IPEBuffer        = text "ipe_buf"
+pprModuleLabelKind :: IsLine doc => ModuleLabelKind -> doc
+pprModuleLabelKind MLK_InitializerArray = text "init_arr"
+pprModuleLabelKind (MLK_Initializer s)  = text ("init__" ++ s)
+pprModuleLabelKind MLK_FinalizerArray   = text "fini_arr"
+pprModuleLabelKind (MLK_Finalizer s)    = text ("fini__" ++ s)
+pprModuleLabelKind MLK_IPEBuffer        = text "ipe_buf"
+{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> SDoc #-}
+{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 isIdLabel :: CLabel -> Bool
 isIdLabel IdLabel{} = True
@@ -1416,7 +1418,7 @@ allocation.  Take care if you want to remove them!
 
 -}
 
-pprAsmLabel :: Platform -> CLabel -> SDoc
+pprAsmLabel :: IsLine doc => Platform -> CLabel -> doc
 pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl
 
 instance OutputableP Platform CLabel where
@@ -1426,19 +1428,19 @@ instance OutputableP Platform CLabel where
                           PprDump{} -> pprCLabel platform CStyle lbl
                           _         -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl)
 
-pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
+pprCLabel :: forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
 pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
   let
     !use_leading_underscores = platformLeadingUnderscore platform
 
     -- some platform (e.g. Darwin) require a leading "_" for exported asm
     -- symbols
-    maybe_underscore :: SDoc -> SDoc
+    maybe_underscore :: doc -> doc
     maybe_underscore doc = case sty of
       AsmStyle | use_leading_underscores -> pp_cSEP <> doc
       _                                  -> doc
 
-    tempLabelPrefixOrUnderscore :: SDoc
+    tempLabelPrefixOrUnderscore :: doc
     tempLabelPrefixOrUnderscore = case sty of
       AsmStyle -> asmTempLabelPrefix platform
       CStyle   -> char '_'
@@ -1490,14 +1492,14 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
 
 
    IdLabel name _cafs flavor -> case sty of
-      AsmStyle -> maybe_underscore $ internalNamePrefix <> ppr name <> ppIdFlavor flavor
+      AsmStyle -> maybe_underscore $ internalNamePrefix <> pprName name <> ppIdFlavor flavor
                    where
                       isRandomGenerated = not (isExternalName name)
                       internalNamePrefix =
                          if isRandomGenerated
                             then asmTempLabelPrefix platform
                             else empty
-      CStyle   -> ppr name <> ppIdFlavor flavor
+      CStyle   -> pprName name <> ppIdFlavor flavor
 
    SRTLabel u
       -> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt"
@@ -1534,7 +1536,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
                                  ]
 
    RtsLabel (RtsPrimOp primop)
-      -> maybe_underscore $ text "stg_" <> ppr primop
+      -> maybe_underscore $ text "stg_" <> pprPrimOp primop
 
    RtsLabel (RtsSlowFastTickyCtr pat)
       -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
@@ -1552,12 +1554,12 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
                             -- with a letter so the label will be legal assembly code.
 
    HpcTicksLabel mod
-      -> maybe_underscore $ text "_hpc_tickboxes_"  <> ppr mod <> text "_hpc"
+      -> maybe_underscore $ text "_hpc_tickboxes_"  <> pprModule mod <> text "_hpc"
 
-   CC_Label cc   -> maybe_underscore $ ppr cc
-   CCS_Label ccs -> maybe_underscore $ ppr ccs
-   IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> ppr m <> text "_ipe")
-   ModuleLabel mod kind        -> maybe_underscore $ ppr mod <> text "_" <> ppr kind
+   CC_Label cc   -> maybe_underscore $ pprCostCentre cc
+   CCS_Label ccs -> maybe_underscore $ pprCostCentreStack ccs
+   IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> pprModule m <> text "_ipe")
+   ModuleLabel mod kind        -> maybe_underscore $ pprModule mod <> text "_" <> pprModuleLabelKind kind
 
    CmmLabel _ _ fs CmmCode     -> maybe_underscore $ ftext fs
    CmmLabel _ _ fs CmmData     -> maybe_underscore $ ftext fs
@@ -1567,6 +1569,8 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
    CmmLabel _ _ fs CmmRetInfo  -> maybe_underscore $ ftext fs <> text "_info"
    CmmLabel _ _ fs CmmRet      -> maybe_underscore $ ftext fs <> text "_ret"
    CmmLabel _ _ fs CmmClosure  -> maybe_underscore $ ftext fs <> text "_closure"
+{-# SPECIALIZE pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprCLabel :: Platform -> LabelStyle -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- Note [Internal proc labels]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1587,21 +1591,24 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
 -- | Generate a label for a procedure internal to a module (if
 -- 'Opt_ExposeAllSymbols' is enabled).
 -- See Note [Internal proc labels].
-ppInternalProcLabel :: Module     -- ^ the current module
+ppInternalProcLabel :: IsLine doc
+                    => Module     -- ^ the current module
                     -> CLabel
-                    -> Maybe SDoc -- ^ the internal proc label
+                    -> Maybe doc -- ^ the internal proc label
 ppInternalProcLabel this_mod (IdLabel nm _ flavour)
   | isInternalName nm
   = Just
-     $ text "_" <> ppr this_mod
+     $ text "_" <> pprModule this_mod
     <> char '_'
     <> ztext (zEncodeFS (occNameFS (occName nm)))
     <> char '_'
     <> pprUniqueAlways (getUnique nm)
     <> ppIdFlavor flavour
 ppInternalProcLabel _ _ = Nothing
+{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe SDoc #-}
+{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-ppIdFlavor :: IdLabelInfo -> SDoc
+ppIdFlavor :: IsLine doc => IdLabelInfo -> doc
 ppIdFlavor x = pp_cSEP <> case x of
    Closure          -> text "closure"
    InfoTable        -> text "info"
@@ -1612,22 +1619,22 @@ ppIdFlavor x = pp_cSEP <> case x of
    IdTickyInfo TickyRednCounts
       -> text "ct"
    IdTickyInfo (TickyInferedTag unique)
-      -> text "ct_inf_tag" <> char '_' <> ppr unique
+      -> text "ct_inf_tag" <> char '_' <> pprUniqueAlways unique
    ConEntry loc      ->
       case loc of
         DefinitionSite -> text "con_entry"
         UsageSite m n ->
-          ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_entry"
+          pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_entry"
    ConInfoTable k   ->
     case k of
       DefinitionSite -> text "con_info"
       UsageSite m n ->
-        ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_info"
+        pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_info"
    ClosureTable     -> text "closure_tbl"
    Bytes            -> text "bytes"
    BlockInfoTable   -> text "info"
 
-pp_cSEP :: SDoc
+pp_cSEP :: IsLine doc => doc
 pp_cSEP = char '_'
 
 
@@ -1641,13 +1648,13 @@ instance Outputable ForeignLabelSource where
 -- -----------------------------------------------------------------------------
 -- Machine-dependent knowledge about labels.
 
-asmTempLabelPrefix :: Platform -> SDoc  -- for formatting labels
+asmTempLabelPrefix :: IsLine doc => Platform -> doc  -- for formatting labels
 asmTempLabelPrefix !platform = case platformOS platform of
     OSDarwin -> text "L"
     OSAIX    -> text "__L" -- follow IBM XL C's convention
     _        -> text ".L"
 
-pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
+pprDynamicLinkerAsmLabel :: IsLine doc => Platform -> DynamicLinkerLabelInfo -> doc -> doc
 pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
     case platformOS platform of
       OSDarwin
diff --git a/compiler/GHC/Cmm/CLabel.hs-boot b/compiler/GHC/Cmm/CLabel.hs-boot
index 8fb1b74423..4a5ec3dde3 100644
--- a/compiler/GHC/Cmm/CLabel.hs-boot
+++ b/compiler/GHC/Cmm/CLabel.hs-boot
@@ -5,5 +5,5 @@ import GHC.Platform
 
 data CLabel
 
-pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
+pprCLabel :: IsLine doc => Platform -> LabelStyle -> CLabel -> doc
 
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 3a7ceb7746..bfcb16bff9 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -29,7 +29,8 @@ module GHC.Cmm.DebugBlock (
 
   -- * Unwinding information
   UnwindTable, UnwindPoint(..),
-  UnwindExpr(..), toUnwindExpr
+  UnwindExpr(..), toUnwindExpr,
+  pprUnwindTable
   ) where
 
 import GHC.Prelude
@@ -38,6 +39,7 @@ import GHC.Platform
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
 import GHC.Cmm
+import GHC.Cmm.Reg ( pprGlobalReg )
 import GHC.Cmm.Utils
 import GHC.Data.FastString ( nilFS, mkFastString )
 import GHC.Unit.Module
@@ -522,10 +524,18 @@ data UnwindExpr = UwConst !Int                  -- ^ literal value
 instance OutputableP Platform UnwindExpr where
   pdoc = pprUnwindExpr 0
 
-pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc
+pprUnwindTable :: IsLine doc => Platform -> UnwindTable -> doc
+pprUnwindTable platform u = brackets (fsep (punctuate comma (map print_entry (Map.toList u))))
+  where print_entry (reg, Nothing) =
+          parens (sep [pprGlobalReg reg, text "Nothing"])
+        print_entry (reg, Just x)  =
+          parens (sep [pprGlobalReg reg, text "Just" <+> pprUnwindExpr 0 platform x])
+  -- Follow instance Outputable (Map.Map GlobalReg (Maybe UnwindExpr))
+
+pprUnwindExpr :: IsLine doc => Rational -> Platform -> UnwindExpr -> doc
 pprUnwindExpr p env = \case
   UwConst i     -> int i
-  UwReg g 0     -> ppr g
+  UwReg g 0     -> pprGlobalReg g
   UwReg g x     -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x))
   UwDeref e     -> char '*' <> pprUnwindExpr 3 env e
   UwLabel l     -> pprAsmLabel env l
@@ -536,6 +546,8 @@ pprUnwindExpr p env = \case
   UwTimes e0 e1
    | p <= 1     -> pprUnwindExpr 2 env e0 <> char '*' <> pprUnwindExpr 2 env e1
   other         -> parens (pprUnwindExpr 0 env other)
+{-# SPECIALIZE pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc #-}
+{-# SPECIALIZE pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Conversion of Cmm expressions to unwind expressions. We check for
 -- unsupported operator usages and simplify the expression as far as
diff --git a/compiler/GHC/Cmm/Reg.hs b/compiler/GHC/Cmm/Reg.hs
index 6c94ecb2eb..a9b3fce101 100644
--- a/compiler/GHC/Cmm/Reg.hs
+++ b/compiler/GHC/Cmm/Reg.hs
@@ -12,6 +12,7 @@ module GHC.Cmm.Reg
     , localRegType
       -- * Global registers
     , GlobalReg(..), isArgReg, globalRegType
+    , pprGlobalReg
     , spReg, hpReg, spLimReg, hpLimReg, nodeReg
     , currentTSOReg, currentNurseryReg, hpAllocReg, cccsReg
     , node, baseReg
@@ -296,7 +297,7 @@ instance Outputable GlobalReg where
 instance OutputableP env GlobalReg where
     pdoc _ = ppr
 
-pprGlobalReg :: GlobalReg -> SDoc
+pprGlobalReg :: IsLine doc => GlobalReg -> doc
 pprGlobalReg gr
     = case gr of
         VanillaReg n _ -> char 'R' <> int n
@@ -324,6 +325,8 @@ pprGlobalReg gr
         GCFun          -> text "stg_gc_fun"
         BaseReg        -> text "BaseReg"
         PicBaseReg     -> text "PicBaseReg"
+{-# SPECIALIZE pprGlobalReg :: GlobalReg -> SDoc #-}
+{-# SPECIALIZE pprGlobalReg :: GlobalReg -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 
 -- convenient aliases
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 9fed66053a..db3cc222b3 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -125,7 +125,6 @@ import GHC.Driver.Ppr
 import GHC.Utils.Misc
 import GHC.Utils.Logger
 
-import qualified GHC.Utils.Ppr as Pretty
 import GHC.Utils.BufHandle
 import GHC.Utils.Outputable as Outputable
 import GHC.Utils.Panic
@@ -145,6 +144,7 @@ import Data.Maybe
 import Data.Ord         ( comparing )
 import Control.Monad
 import System.IO
+import System.Directory ( getCurrentDirectory )
 
 --------------------
 nativeCodeGen :: forall a . Logger -> NCGConfig -> ModLocation -> Handle -> UniqSupply
@@ -242,16 +242,17 @@ finishNativeGen :: Instruction instr
                 -> UniqSupply
                 -> NativeGenAcc statics instr
                 -> IO UniqSupply
-finishNativeGen logger config modLoc bufh@(BufHandle _ _ h) us ngs
+finishNativeGen logger config modLoc bufh us ngs
  = withTimingSilent logger (text "NCG") (`seq` ()) $ do
         -- Write debug data and finish
         us' <- if not (ncgDwarfEnabled config)
                   then return us
                   else do
-                     (dwarf, us') <- dwarfGen config modLoc us (ngs_debug ngs)
-                     emitNativeCode logger config bufh dwarf
+                     compPath <- getCurrentDirectory
+                     let (dwarf_h, us') = dwarfGen compPath config modLoc us (ngs_debug ngs)
+                         (dwarf_s, _)   = dwarfGen compPath config modLoc us (ngs_debug ngs)
+                     emitNativeCode logger config bufh dwarf_h dwarf_s
                      return us'
-        bFlush bufh
 
         -- dump global NCG stats for graph coloring allocator
         let stats = concat (ngs_colorStats ngs)
@@ -284,8 +285,9 @@ finishNativeGen logger config modLoc bufh@(BufHandle _ _ h) us ngs
 
         -- write out the imports
         let ctx = ncgAsmContext config
-        printSDocLn ctx Pretty.LeftMode h
-                $ makeImportsDoc config (concat (ngs_imports ngs))
+        bPutHDoc bufh ctx $ makeImportsDoc config (concat (ngs_imports ngs))
+        bFlush bufh
+
         return us'
   where
     dump_stats = logDumpFile logger (mkDumpStyle alwaysQualify)
@@ -387,12 +389,17 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
         let newFileIds = sortBy (comparing snd) $
                          nonDetEltsUFM $ fileIds' `minusUFM` fileIds
             -- See Note [Unique Determinism and code generation]
-            pprDecl (f,n) = text "\t.file " <> int n <+>
-                            pprFilePathString (unpackFS f)
-
-        emitNativeCode logger config h $ vcat $
-          map pprDecl newFileIds ++
-          map (pprNatCmmDecl ncgImpl) native
+            pprDecl (f,n) = line $ text "\t.file " <> int n <+>
+                                   pprFilePathString (unpackFS f)
+
+        -- see Note [pprNatCmmDeclS and pprNatCmmDeclH] in GHC.CmmToAsm.Monad
+        emitNativeCode logger config h
+          (vcat $
+           map pprDecl newFileIds ++
+           map (pprNatCmmDeclH ncgImpl) native)
+          (vcat $
+           map pprDecl newFileIds ++
+           map (pprNatCmmDeclS ncgImpl) native)
 
         -- force evaluation all this stuff to avoid space leaks
         let platform = ncgPlatform config
@@ -415,11 +422,11 @@ cmmNativeGens logger config ncgImpl h dbgMap = go
         go us' cmms ngs' (count + 1)
 
 
-emitNativeCode :: Logger -> NCGConfig -> BufHandle -> SDoc -> IO ()
-emitNativeCode logger config h sdoc = do
-
+-- see Note [pprNatCmmDeclS and pprNatCmmDeclH] in GHC.CmmToAsm.Monad
+emitNativeCode :: Logger -> NCGConfig -> BufHandle -> HDoc -> SDoc -> IO ()
+emitNativeCode logger config h hdoc sdoc = do
         let ctx = ncgAsmContext config
-        {-# SCC "pprNativeCode" #-} bufLeftRenderSDoc ctx h sdoc
+        {-# SCC "pprNativeCode" #-} bPutHDoc h ctx hdoc
 
         -- dump native code
         putDumpFileMaybe logger
@@ -483,7 +490,7 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
 
         putDumpFileMaybe logger
                 Opt_D_dump_asm_native "Native code" FormatASM
-                (vcat $ map (pprNatCmmDecl ncgImpl) native)
+                (vcat $ map (pprNatCmmDeclS ncgImpl) native)
 
         maybeDumpCfg logger (Just nativeCfgWeights) "CFG Weights - Native" proc_name
 
@@ -540,7 +547,7 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
                 putDumpFileMaybe logger
                         Opt_D_dump_asm_regalloc "Registers allocated"
                         FormatCMM
-                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
+                        (vcat $ map (pprNatCmmDeclS ncgImpl) alloced)
 
                 putDumpFileMaybe logger
                         Opt_D_dump_asm_regalloc_stages "Build/spill stages"
@@ -584,7 +591,7 @@ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
                 putDumpFileMaybe logger
                         Opt_D_dump_asm_regalloc "Registers allocated"
                         FormatCMM
-                        (vcat $ map (pprNatCmmDecl ncgImpl) alloced)
+                        (vcat $ map (pprNatCmmDeclS ncgImpl) alloced)
 
                 let mPprStats =
                         if logHasDumpFlag logger Opt_D_dump_asm_stats
@@ -736,7 +743,7 @@ computeUnwinding _ ncgImpl (CmmProc _ _ _ (ListGraph blks)) =
 
 -- | Build a doc for all the imports.
 --
-makeImportsDoc :: NCGConfig -> [CLabel] -> SDoc
+makeImportsDoc :: NCGConfig -> [CLabel] -> HDoc
 makeImportsDoc config imports
  = dyld_stubs imports
             $$
@@ -744,7 +751,7 @@ makeImportsDoc config imports
             -- dead-stripping of code and data on a per-symbol basis.
             -- There's a hack to make this work in PprMach.pprNatCmmDecl.
             (if platformHasSubsectionsViaSymbols platform
-             then text ".subsections_via_symbols"
+             then line $ text ".subsections_via_symbols"
              else Outputable.empty)
             $$
                 -- On recent GNU ELF systems one can mark an object file
@@ -754,14 +761,14 @@ makeImportsDoc config imports
                 -- security. GHC generated code does not need an executable
                 -- stack so add the note in:
             (if platformHasGnuNonexecStack platform
-             then text ".section .note.GNU-stack,\"\"," <> sectionType platform "progbits"
+             then line $ text ".section .note.GNU-stack,\"\"," <> sectionType platform "progbits"
              else Outputable.empty)
             $$
                 -- And just because every other compiler does, let's stick in
                 -- an identifier directive: .ident "GHC x.y.z"
             (if platformHasIdentDirective platform
              then let compilerIdent = text "GHC" <+> text cProjectVersion
-                   in text ".ident" <+> doubleQuotes compilerIdent
+                   in line $ text ".ident" <+> doubleQuotes compilerIdent
              else Outputable.empty)
 
  where
@@ -769,7 +776,7 @@ makeImportsDoc config imports
 
         -- Generate "symbol stubs" for all external symbols that might
         -- come from a dynamic library.
-        dyld_stubs :: [CLabel] -> SDoc
+        dyld_stubs :: [CLabel] -> HDoc
         -- (Hack) sometimes two Labels pretty-print the same, but have
         -- different uniques; so we compare their text versions...
         dyld_stubs imps
diff --git a/compiler/GHC/CmmToAsm/AArch64.hs b/compiler/GHC/CmmToAsm/AArch64.hs
index 8b85b12ff6..d814764b2d 100644
--- a/compiler/GHC/CmmToAsm/AArch64.hs
+++ b/compiler/GHC/CmmToAsm/AArch64.hs
@@ -11,6 +11,7 @@ import GHC.CmmToAsm.Instr
 import GHC.CmmToAsm.Monad
 import GHC.CmmToAsm.Config
 import GHC.CmmToAsm.Types
+import GHC.Utils.Outputable (ftext)
 
 import qualified GHC.CmmToAsm.AArch64.Instr   as AArch64
 import qualified GHC.CmmToAsm.AArch64.Ppr     as AArch64
@@ -28,7 +29,8 @@ ncgAArch64 config
        ,canShortcut               = AArch64.canShortcut
        ,shortcutStatics           = AArch64.shortcutStatics
        ,shortcutJump              = AArch64.shortcutJump
-       ,pprNatCmmDecl             = AArch64.pprNatCmmDecl config
+       ,pprNatCmmDeclS            = AArch64.pprNatCmmDecl config
+       ,pprNatCmmDeclH            = AArch64.pprNatCmmDecl config
        ,maxSpillSlots             = AArch64.maxSpillSlots config
        ,allocatableRegs           = AArch64.allocatableRegs platform
        ,ncgAllocMoreStack         = AArch64.allocMoreStack platform
@@ -55,5 +57,5 @@ instance Instruction AArch64.Instr where
         mkJumpInstr             = AArch64.mkJumpInstr
         mkStackAllocInstr       = AArch64.mkStackAllocInstr
         mkStackDeallocInstr     = AArch64.mkStackDeallocInstr
-        mkComment               = pure . AArch64.COMMENT
+        mkComment               = pure . AArch64.COMMENT . ftext
         pprInstr                = AArch64.pprInstr
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index 5ca443f08e..e782bc41a0 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -29,12 +29,12 @@ import GHC.Utils.Outputable
 
 import GHC.Utils.Panic
 
-pprProcAlignment :: NCGConfig -> SDoc
+pprProcAlignment :: IsDoc doc => NCGConfig -> doc
 pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config)
    where
       platform = ncgPlatform config
 
-pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
+pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
 pprNatCmmDecl config (CmmData section dats) =
   pprSectionAlign config section $$ pprDatas config dats
 
@@ -50,42 +50,45 @@ 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 ncgDwarfEnabled config
-         then pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
+         then line (pprAsmLabel platform (mkAsmTempEndLabel lbl) <> char ':') else empty) $$
         pprSizeDecl platform lbl
 
     Just (CmmStaticsRaw info_lbl _) ->
       pprSectionAlign config (Section Text info_lbl) $$
       -- pprProcAlignment config $$
       (if platformHasSubsectionsViaSymbols platform
-          then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
+          then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':')
           else empty) $$
       vcat (map (pprBasicBlock config top_info) blocks) $$
       -- above: Even the first block gets a label, because with branch-chain
       -- elimination, it might be the target of a goto.
       (if platformHasSubsectionsViaSymbols platform
        then -- See Note [Subsections Via Symbols]
-                text "\t.long "
+                line
+              $ text "\t.long "
             <+> pprAsmLabel platform info_lbl
             <+> char '-'
             <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
        else empty) $$
       pprSizeDecl platform info_lbl
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc #-}
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-pprLabel :: Platform -> CLabel -> SDoc
+pprLabel :: IsDoc doc => Platform -> CLabel -> doc
 pprLabel platform lbl =
    pprGloblDecl platform lbl
    $$ pprTypeDecl platform lbl
-   $$ (pprAsmLabel platform lbl <> char ':')
+   $$ line (pprAsmLabel platform lbl <> char ':')
 
-pprAlign :: Platform -> Alignment -> SDoc
+pprAlign :: IsDoc doc => Platform -> Alignment -> doc
 pprAlign _platform alignment
-        = text "\t.balign " <> int (alignmentBytes alignment)
+        = line $ text "\t.balign " <> int (alignmentBytes alignment)
 
 -- | Print appropriate alignment for the given section type.
-pprAlignForSection :: Platform -> SectionType -> SDoc
+pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc
 pprAlignForSection _platform _seg
     -- .balign is stable, whereas .align is platform dependent.
-    = text "\t.balign 8" --  always 8
+    = line (text "\t.balign 8") --  always 8
 
 -- | Print section header and appropriate alignment for that section.
 --
@@ -94,28 +97,28 @@ pprAlignForSection _platform _seg
 --     .section .text
 --     .balign 8
 --
-pprSectionAlign :: NCGConfig -> Section -> SDoc
+pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
 pprSectionAlign _config (Section (OtherSection _) _) =
      panic "AArch64.Ppr.pprSectionAlign: unknown section"
 pprSectionAlign config sec@(Section seg _) =
-    pprSectionHeader config sec
+    line (pprSectionHeader config sec)
     $$ pprAlignForSection (ncgPlatform config) seg
 
 -- | Output the ELF .size directive.
-pprSizeDecl :: Platform -> CLabel -> SDoc
+pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprSizeDecl platform lbl
  = if osElfTarget (platformOS platform)
-   then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl
+   then line (text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl)
    else empty
 
-pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
-              -> SDoc
+pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
+              -> doc
 pprBasicBlock config info_env (BasicBlock blockid instrs)
   = maybe_infotable $
     pprLabel platform asmLbl $$
     vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
     (if  ncgDwarfEnabled config
-      then pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':'
+      then line (pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':')
       else empty
     )
   where
@@ -135,7 +138,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
            pprLabel platform info_lbl $$
            c $$
            (if ncgDwarfEnabled config
-             then pprAsmLabel platform (mkAsmTempEndLabel info_lbl) <> char ':'
+             then line (pprAsmLabel platform (mkAsmTempEndLabel info_lbl) <> char ':')
              else empty)
     -- Make sure the info table has the right .loc for the block
     -- coming right after it. See Note [Info Offset]
@@ -143,7 +146,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
       (l@LOCATION{} : _) -> pprInstr platform l
       _other             -> empty
 
-pprDatas :: NCGConfig -> RawCmmStatics -> SDoc
+pprDatas :: IsDoc doc => NCGConfig -> RawCmmStatics -> doc
 -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
 pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
   | lbl == mkIndStaticInfoLabel
@@ -153,29 +156,29 @@ pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit
   , Just ind' <- labelInd ind
   , alias `mayRedirectTo` ind'
   = pprGloblDecl (ncgPlatform config) alias
-    $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind'
+    $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind')
 
 pprDatas config (CmmStaticsRaw lbl dats)
   = vcat (pprLabel platform lbl : map (pprData config) dats)
    where
       platform = ncgPlatform config
 
-pprData :: NCGConfig -> CmmStatic -> SDoc
-pprData _config (CmmString str) = pprString str
-pprData _config (CmmFileEmbed path) = pprFileEmbed path
+pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc
+pprData _config (CmmString str) = line (pprString str)
+pprData _config (CmmFileEmbed path) = line (pprFileEmbed path)
 
 pprData config (CmmUninitialised bytes)
- = let platform = ncgPlatform config
-   in if platformOS platform == OSDarwin
-         then text ".space " <> int bytes
-         else text ".skip "  <> int bytes
+ = line $ let platform = ncgPlatform config
+          in if platformOS platform == OSDarwin
+                then text ".space " <> int bytes
+                else text ".skip "  <> int bytes
 
 pprData config (CmmStaticLit lit) = pprDataItem config lit
 
-pprGloblDecl :: Platform -> CLabel -> SDoc
+pprGloblDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = text "\t.globl " <> pprAsmLabel platform lbl
+  | otherwise = line (text "\t.globl " <> pprAsmLabel platform lbl)
 
 -- Note [Always use objects for info tables]
 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -187,7 +190,7 @@ pprGloblDecl platform lbl
 --
 -- Fun fact: The LLVMMangler exists to patch this issue su on the LLVM side as
 -- well.
-pprLabelType' :: Platform -> CLabel -> SDoc
+pprLabelType' :: IsLine doc => Platform -> CLabel -> doc
 pprLabelType' platform lbl =
   if isCFunctionLabel lbl || functionOkInfoTable then
     text "@function"
@@ -198,15 +201,15 @@ pprLabelType' platform lbl =
       isInfoTableLabel lbl && not (isCmmInfoTableLabel lbl) && not (isConInfoTableLabel lbl)
 
 -- this is called pprTypeAndSizeDecl in PPC.Ppr
-pprTypeDecl :: Platform -> CLabel -> SDoc
+pprTypeDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprTypeDecl platform lbl
     = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
-      then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl
+      then line (text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl)
       else empty
 
-pprDataItem :: NCGConfig -> CmmLit -> SDoc
+pprDataItem :: IsDoc doc => NCGConfig -> CmmLit -> doc
 pprDataItem config lit
-  = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
+  = lines_ (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
     where
         platform = ncgPlatform config
 
@@ -227,7 +230,7 @@ pprDataItem config lit
 
         ppr_item _ _ = pprPanic "pprDataItem:ppr_item" (text $ show lit)
 
-pprImm :: Platform -> Imm -> SDoc
+pprImm :: IsLine doc => Platform -> Imm -> doc
 pprImm _ (ImmInt i)     = int i
 pprImm _ (ImmInteger i) = integer i
 pprImm p (ImmCLbl l)    = pprAsmLabel p l
@@ -257,7 +260,7 @@ asmDoubleslashComment c = whenPprDebug $ text "//" <+> c
 asmMultilineComment :: SDoc -> SDoc
 asmMultilineComment c = whenPprDebug $ text "/*" $+$ c $+$ text "*/"
 
-pprIm :: Platform -> Imm -> SDoc
+pprIm :: IsLine doc => Platform -> Imm -> doc
 pprIm platform im = case im of
   ImmInt i     -> char '#' <> int i
   ImmInteger i -> char '#' <> integer i
@@ -283,7 +286,7 @@ pprIm platform im = case im of
   ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']'
   _            -> panic "AArch64.pprIm"
 
-pprExt :: ExtMode -> SDoc
+pprExt :: IsLine doc => ExtMode -> doc
 pprExt EUXTB = text "uxtb"
 pprExt EUXTH = text "uxth"
 pprExt EUXTW = text "uxtw"
@@ -293,13 +296,13 @@ pprExt ESXTH = text "sxth"
 pprExt ESXTW = text "sxtw"
 pprExt ESXTX = text "sxtx"
 
-pprShift :: ShiftMode -> SDoc
+pprShift :: IsLine doc => ShiftMode -> doc
 pprShift SLSL = text "lsl"
 pprShift SLSR = text "lsr"
 pprShift SASR = text "asr"
 pprShift SROR = text "ror"
 
-pprOp :: Platform -> Operand -> SDoc
+pprOp :: IsLine doc => Platform -> Operand -> doc
 pprOp plat op = case op of
   OpReg w r           -> pprReg w r
   OpRegExt w r x 0 -> pprReg w r <> comma <+> pprExt x
@@ -312,7 +315,7 @@ pprOp plat op = case op of
   OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm plat im <+> char ']'
   OpAddr (AddrReg r1)       -> char '[' <+> pprReg W64 r1 <+> char ']'
 
-pprReg :: Width -> Reg -> SDoc
+pprReg :: forall doc. IsLine doc => Width -> Reg -> doc
 pprReg w r = case r of
   RegReal    (RealRegSingle i) -> ppr_reg_no w i
   -- virtual regs should not show up, but this is helpful for debugging.
@@ -322,7 +325,7 @@ pprReg w r = case r of
   _                            -> pprPanic "AArch64.pprReg" (text $ show r)
 
   where
-    ppr_reg_no :: Width -> Int -> SDoc
+    ppr_reg_no :: Width -> Int -> doc
     ppr_reg_no w 31
          | w == W64 = text "sp"
          | w == W32 = text "wsp"
@@ -351,24 +354,27 @@ isFloatOp (OpReg _ (RegVirtual (VirtualRegF _))) = True
 isFloatOp (OpReg _ (RegVirtual (VirtualRegD _))) = True
 isFloatOp _ = False
 
-pprInstr :: Platform -> Instr -> SDoc
+pprInstr :: IsDoc doc => Platform -> Instr -> doc
 pprInstr platform instr = case instr of
   -- Meta Instructions ---------------------------------------------------------
-  COMMENT s  -> asmComment s
-  MULTILINE_COMMENT s -> asmMultilineComment s
-  ANN d i -> pprInstr platform i <+> asmDoubleslashComment d
-  LOCATION file line col _name
-    -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
-  DELTA d    -> asmComment $ text ("\tdelta = " ++ show d)
+  -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable
+  COMMENT s  -> dualDoc (asmComment s) empty
+  MULTILINE_COMMENT s -> dualDoc (asmMultilineComment s) empty
+  ANN d i -> dualDoc (pprInstr platform i <+> asmDoubleslashComment d) (pprInstr platform i)
+
+  LOCATION file line' col _name
+    -> line (text "\t.loc" <+> int file <+> int line' <+> int col)
+  DELTA d   -> dualDoc (asmComment $ text "\tdelta = " <> int d) empty
+               -- see Note [dualLine and dualDoc] in GHC.Utils.Outputable
   NEWBLOCK _ -> panic "PprInstr: NEWBLOCK"
   LDATA _ _  -> panic "pprInstr: LDATA"
 
   -- Pseudo Instructions -------------------------------------------------------
 
-  PUSH_STACK_FRAME -> text "\tstp x29, x30, [sp, #-16]!"
-                   $$ text "\tmov x29, sp"
+  PUSH_STACK_FRAME -> lines_ [text "\tstp x29, x30, [sp, #-16]!",
+                              text "\tmov x29, sp"]
 
-  POP_STACK_FRAME -> text "\tldp x29, x30, [sp], #16"
+  POP_STACK_FRAME -> line $ text "\tldp x29, x30, [sp], #16"
   -- ===========================================================================
   -- AArch64 Instruction Set
   -- 1. Arithmetic Instructions ------------------------------------------------
@@ -430,28 +436,28 @@ pprInstr platform instr = case instr of
 
   -- 4. Branch Instructions ----------------------------------------------------
   J t            -> pprInstr platform (B t)
-  B (TBlock bid) -> text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  B (TLabel lbl) -> text "\tb" <+> pprAsmLabel platform lbl
-  B (TReg r)     -> text "\tbr" <+> pprReg W64 r
+  B (TBlock bid) -> line $ text "\tb" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  B (TLabel lbl) -> line $ text "\tb" <+> pprAsmLabel platform lbl
+  B (TReg r)     -> line $ text "\tbr" <+> pprReg W64 r
 
-  BL (TBlock bid) _ _ -> text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  BL (TLabel lbl) _ _ -> text "\tbl" <+> pprAsmLabel platform lbl
-  BL (TReg r)     _ _ -> text "\tblr" <+> pprReg W64 r
+  BL (TBlock bid) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  BL (TLabel lbl) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl
+  BL (TReg r)     _ _ -> line $ text "\tblr" <+> pprReg W64 r
 
-  BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pprAsmLabel platform lbl
+  BCOND c (TBlock bid) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  BCOND c (TLabel lbl) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform lbl
   BCOND _ (TReg _)     -> panic "AArch64.ppr: No conditional branching to registers!"
 
   -- 5. Atomic Instructions ----------------------------------------------------
   -- 6. Conditional Instructions -----------------------------------------------
-  CSET o c  -> text "\tcset" <+> pprOp platform o <> comma <+> pprCond c
+  CSET o c  -> line $ text "\tcset" <+> pprOp platform o <> comma <+> pprCond c
 
-  CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
+  CBZ o (TBlock bid) -> line $ text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  CBZ o (TLabel lbl) -> line $ text "\tcbz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
   CBZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"
 
-  CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
-  CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
+  CBNZ o (TBlock bid) -> line $ text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+  CBNZ o (TLabel lbl) -> line $ text "\tcbnz" <+> pprOp platform o <> comma <+> pprAsmLabel platform lbl
   CBNZ _ (TReg _)     -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
 
   -- 7. Load and Store Instructions --------------------------------------------
@@ -532,23 +538,23 @@ pprInstr platform instr = case instr of
   LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3
 
   -- 8. Synchronization Instructions -------------------------------------------
-  DMBSY -> text "\tdmb sy"
+  DMBSY -> line $ text "\tdmb sy"
   -- 9. Floating Point Instructions --------------------------------------------
   FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2
   SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2
   FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2
   FABS o1 o2 -> op2 (text "\tfabs") o1 o2
- where op2 op o1 o2 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2
-       op3 op o1 o2 o3 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
-       op4 op o1 o2 o3 o4 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
-       op_ldr o1 rest = text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> rest <> text "]"
-       op_adrp o1 rest = text "\tadrp" <+> pprOp platform o1 <> comma <+> rest
-       op_add o1 rest = text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest
-
-pprBcond :: Cond -> SDoc
+ where op2 op o1 o2        = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2
+       op3 op o1 o2 o3     = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3
+       op4 op o1 o2 o3 o4  = line $ op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4
+       op_ldr o1 rest      = line $ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> rest <> text "]"
+       op_adrp o1 rest     = line $ text "\tadrp" <+> pprOp platform o1 <> comma <+> rest
+       op_add o1 rest      = line $ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest
+
+pprBcond :: IsLine doc => Cond -> doc
 pprBcond c = text "b." <> pprCond c
 
-pprCond :: Cond -> SDoc
+pprCond :: IsLine doc => Cond -> doc
 pprCond c = case c of
   ALWAYS -> text "al" -- Always
   EQ     -> text "eq" -- Equal
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 407050d045..0eef6ecb49 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -26,50 +26,47 @@ import Data.List        ( sortBy )
 import Data.Ord         ( comparing )
 import qualified Data.Map as Map
 import System.FilePath
-import System.Directory ( getCurrentDirectory )
 
 import qualified GHC.Cmm.Dataflow.Label as H
 import qualified GHC.Cmm.Dataflow.Collections as H
 
 -- | Generate DWARF/debug information
-dwarfGen :: NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock]
-            -> IO (SDoc, UniqSupply)
-dwarfGen _      _      us []     = return (empty, us)
-dwarfGen config modLoc us blocks = do
+dwarfGen :: IsDoc doc => String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock]
+            -> (doc, UniqSupply)
+dwarfGen _        _      _      us []     = (empty, us)
+dwarfGen compPath config modLoc us blocks =
   let platform = ncgPlatform config
 
-  -- Convert debug data structures to DWARF info records
-  let procs = debugSplitProcs blocks
+      -- Convert debug data structures to DWARF info records
+      procs = debugSplitProcs blocks
       stripBlocks dbg
         | ncgDwarfStripBlockInfo config = dbg { dblBlocks = [] }
         | otherwise                     = dbg
-  compPath <- getCurrentDirectory
-  let lowLabel = dblCLabel $ head procs
+      lowLabel = dblCLabel $ head procs
       highLabel = mkAsmTempProcEndLabel $ dblCLabel $ last procs
       dwarfUnit = DwarfCompileUnit
         { dwChildren = map (procToDwarf config) (map stripBlocks procs)
         , dwName = fromMaybe "" (ml_hs_file modLoc)
         , dwCompDir = addTrailingPathSeparator compPath
         , dwProducer = cProjectName ++ " " ++ cProjectVersion
-        , dwLowLabel = pprAsmLabel platform lowLabel
-        , dwHighLabel = pprAsmLabel platform highLabel
-        , dwLineLabel = dwarfLineLabel
+        , dwLowLabel = lowLabel
+        , dwHighLabel = highLabel
         }
 
-  -- Check whether we have any source code information, so we do not
-  -- end up writing a pointer to an empty .debug_line section
-  -- (dsymutil on Mac Os gets confused by this).
-  let haveSrcIn blk = isJust (dblSourceTick blk) && isJust (dblPosition blk)
+      -- Check whether we have any source code information, so we do not
+      -- end up writing a pointer to an empty .debug_line section
+      -- (dsymutil on Mac Os gets confused by this).
+      haveSrcIn blk = isJust (dblSourceTick blk) && isJust (dblPosition blk)
                       || any haveSrcIn (dblBlocks blk)
       haveSrc = any haveSrcIn procs
 
   -- .debug_abbrev section: Declare the format we're using
-  let abbrevSct = pprAbbrevDecls platform haveSrc
+      abbrevSct = pprAbbrevDecls platform haveSrc
 
   -- .debug_info section: Information records on procedures and blocks
-  let -- unique to identify start and end compilation unit .debug_inf
+      -- unique to identify start and end compilation unit .debug_inf
       (unitU, us') = takeUniqFromSupply us
-      infoSct = vcat [ dwarfInfoLabel <> colon
+      infoSct = vcat [ line (dwarfInfoLabel <> colon)
                      , dwarfInfoSection platform
                      , compileUnitHeader platform unitU
                      , pprDwarfInfo platform haveSrc dwarfUnit
@@ -78,21 +75,23 @@ dwarfGen config modLoc us blocks = do
 
   -- .debug_line section: Generated mainly by the assembler, but we
   -- need to label it
-  let lineSct = dwarfLineSection platform $$
-                dwarfLineLabel <> colon
+      lineSct = dwarfLineSection platform $$
+                line (dwarfLineLabel <> colon)
 
   -- .debug_frame section: Information about the layout of the GHC stack
-  let (framesU, us'') = takeUniqFromSupply us'
+      (framesU, us'') = takeUniqFromSupply us'
       frameSct = dwarfFrameSection platform $$
-                 dwarfFrameLabel <> colon $$
+                 line (dwarfFrameLabel <> colon) $$
                  pprDwarfFrame platform (debugFrame framesU procs)
 
   -- .aranges section: Information about the bounds of compilation units
-  let aranges' | ncgSplitSections config = map mkDwarfARange procs
+      aranges' | ncgSplitSections config = map mkDwarfARange procs
                | otherwise               = [DwarfARange lowLabel highLabel]
-  let aranges = dwarfARangesSection platform $$ pprDwarfARanges platform aranges' unitU
+      aranges = dwarfARangesSection platform $$ pprDwarfARanges platform aranges' unitU
 
-  return (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
+  in (infoSct $$ abbrevSct $$ lineSct $$ frameSct $$ aranges, us'')
+{-# SPECIALIZE dwarfGen :: String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock] -> (SDoc, UniqSupply) #-}
+{-# SPECIALIZE dwarfGen :: String -> NCGConfig -> ModLocation -> UniqSupply -> [DebugBlock] -> (HDoc, UniqSupply) #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Build an address range entry for one proc.
 -- With split sections, each proc needs its own entry, since they may get
@@ -106,24 +105,24 @@ mkDwarfARange proc = DwarfARange lbl end
 
 -- | Header for a compilation unit, establishing global format
 -- parameters
-compileUnitHeader :: Platform -> Unique -> SDoc
+compileUnitHeader :: IsDoc doc => Platform -> Unique -> doc
 compileUnitHeader platform unitU =
   let cuLabel = mkAsmTempLabel unitU  -- sits right before initialLength field
       length = pprAsmLabel platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pprAsmLabel platform cuLabel
                <> text "-4"       -- length of initialLength field
-  in vcat [ pprAsmLabel platform cuLabel <> colon
-          , text "\t.long " <> length  -- compilation unit size
+  in vcat [ line (pprAsmLabel platform cuLabel <> colon)
+          , line (text "\t.long " <> length)  -- compilation unit size
           , pprHalf 3                          -- DWARF version
           , sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel
                                                -- abbrevs offset
-          , text "\t.byte " <> ppr (platformWordSizeInBytes platform) -- word size
+          , line (text "\t.byte " <> int (platformWordSizeInBytes platform)) -- word size
           ]
 
 -- | Compilation unit footer, mainly establishing size of debug sections
-compileUnitFooter :: Platform -> Unique -> SDoc
+compileUnitFooter :: IsDoc doc => Platform -> Unique -> doc
 compileUnitFooter platform unitU =
   let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU
-  in pprAsmLabel platform cuEndLabel <> colon
+  in line (pprAsmLabel platform cuEndLabel <> colon)
 
 -- | Splits the blocks by procedures. In the result all nested blocks
 -- will come from the same procedure as the top-level block. See
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
index b8fb5706cb..58e123176e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
@@ -144,17 +144,29 @@ dW_OP_call_frame_cfa = 0x9c
 
 -- * Dwarf section declarations
 dwarfInfoSection, dwarfAbbrevSection, dwarfLineSection,
-  dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: Platform -> SDoc
+  dwarfFrameSection, dwarfGhcSection, dwarfARangesSection :: IsDoc doc => Platform -> doc
 dwarfInfoSection    platform = dwarfSection platform "info"
 dwarfAbbrevSection  platform = dwarfSection platform "abbrev"
 dwarfLineSection    platform = dwarfSection platform "line"
 dwarfFrameSection   platform = dwarfSection platform "frame"
 dwarfGhcSection     platform = dwarfSection platform "ghc"
 dwarfARangesSection platform = dwarfSection platform "aranges"
+{-# SPECIALIZE dwarfInfoSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfInfoSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfAbbrevSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfAbbrevSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfLineSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfLineSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfFrameSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfFrameSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfGhcSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfGhcSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfARangesSection :: Platform -> SDoc #-}
+{-# SPECIALIZE dwarfARangesSection :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-dwarfSection :: Platform -> String -> SDoc
+dwarfSection :: IsDoc doc => Platform -> String -> doc
 dwarfSection platform name =
-  case platformOS platform of
+  line $ case platformOS platform of
     os | osElfTarget os
        -> text "\t.section .debug_" <> text name <> text ",\"\","
           <> sectionType platform "progbits"
@@ -162,13 +174,24 @@ dwarfSection platform name =
        -> text "\t.section __DWARF,__debug_" <> text name <> text ",regular,debug"
        | otherwise
        -> text "\t.section .debug_" <> text name <> text ",\"dr\""
+{-# SPECIALIZE dwarfSection :: Platform -> String -> SDoc #-}
+{-# SPECIALIZE dwarfSection :: Platform -> String -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+
 
 -- * Dwarf section labels
-dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: SDoc
+dwarfInfoLabel, dwarfAbbrevLabel, dwarfLineLabel, dwarfFrameLabel :: IsLine doc => doc
 dwarfInfoLabel   = text ".Lsection_info"
 dwarfAbbrevLabel = text ".Lsection_abbrev"
 dwarfLineLabel   = text ".Lsection_line"
 dwarfFrameLabel  = text ".Lsection_frame"
+{-# SPECIALIZE dwarfInfoLabel :: SDoc #-}
+{-# SPECIALIZE dwarfInfoLabel :: HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfAbbrevLabel :: SDoc #-}
+{-# SPECIALIZE dwarfAbbrevLabel :: HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfLineLabel :: SDoc #-}
+{-# SPECIALIZE dwarfLineLabel :: HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE dwarfFrameLabel :: SDoc #-}
+{-# SPECIALIZE dwarfFrameLabel :: HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Mapping of registers to DWARF register numbers
 dwarfRegNo :: Platform -> Reg -> Word8
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index 236ddb5ffc..5722e07a3a 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -59,9 +59,8 @@ data DwarfInfo
                      , dwName :: String
                      , dwProducer :: String
                      , dwCompDir :: String
-                     , dwLowLabel :: SDoc
-                     , dwHighLabel :: SDoc
-                     , dwLineLabel :: SDoc }
+                     , dwLowLabel :: CLabel
+                     , dwHighLabel :: CLabel }
   | DwarfSubprogram { dwChildren :: [DwarfInfo]
                     , dwName :: String
                     , dwLabel :: CLabel
@@ -88,13 +87,13 @@ data DwarfAbbrev
   deriving (Eq, Enum)
 
 -- | Generate assembly for the given abbreviation code
-pprAbbrev :: DwarfAbbrev -> SDoc
+pprAbbrev :: IsDoc doc => DwarfAbbrev -> doc
 pprAbbrev = pprLEBWord . fromIntegral . fromEnum
 
 -- | Abbreviation declaration. This explains the binary encoding we
 -- use for representing 'DwarfInfo'. Be aware that this must be updated
 -- along with 'pprDwarfInfo'.
-pprAbbrevDecls :: Platform -> Bool -> SDoc
+pprAbbrevDecls :: IsDoc doc => Platform -> Bool -> doc
 pprAbbrevDecls platform haveDebugLine =
   let mkAbbrev abbr tag chld flds =
         let fld (tag, form) = pprLEBWord tag $$ pprLEBWord form
@@ -111,7 +110,7 @@ pprAbbrevDecls platform haveDebugLine =
            , (dW_AT_frame_base, dW_FORM_block1)
            ]
   in dwarfAbbrevSection platform $$
-     dwarfAbbrevLabel <> colon $$
+     line (dwarfAbbrevLabel <> colon) $$
      mkAbbrev DwAbbrCompileUnit dW_TAG_compile_unit dW_CHILDREN_yes
        ([(dW_AT_name,     dW_FORM_string)
        , (dW_AT_producer, dW_FORM_string)
@@ -144,9 +143,11 @@ pprAbbrevDecls platform haveDebugLine =
        , (dW_AT_ghc_span_end_col, dW_FORM_data2)
        ] $$
      pprByte 0
+{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> SDoc #-}
+{-# SPECIALIZE pprAbbrevDecls :: Platform -> Bool -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Generate assembly for DWARF data
-pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc
+pprDwarfInfo :: IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
 pprDwarfInfo platform haveSrc d
   = case d of
       DwarfCompileUnit {}  -> hasChildren
@@ -159,9 +160,11 @@ pprDwarfInfo platform haveSrc d
         vcat (map (pprDwarfInfo platform haveSrc) (dwChildren d)) $$
         pprDwarfInfoClose
     noChildren = pprDwarfInfoOpen platform haveSrc d
+{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> SDoc #-}
+{-# SPECIALIZE pprDwarfInfo :: Platform -> Bool -> DwarfInfo -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Print a CLabel name in a ".stringz \"LABEL\""
-pprLabelString :: Platform -> CLabel -> SDoc
+pprLabelString :: IsDoc doc => Platform -> CLabel -> doc
 pprLabelString platform label =
    pprString'                         -- we don't need to escape the string as labels don't contain exotic characters
     $ pprCLabel platform CStyle label -- pretty-print as C label (foreign labels may be printed differently in Asm)
@@ -169,22 +172,22 @@ pprLabelString platform label =
 -- | Prints assembler data corresponding to DWARF info records. Note
 -- that the binary format of this is parameterized in @abbrevDecls@ and
 -- has to be kept in synch.
-pprDwarfInfoOpen :: Platform -> Bool -> DwarfInfo -> SDoc
+pprDwarfInfoOpen :: IsDoc doc => Platform -> Bool -> DwarfInfo -> doc
 pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowLabel
-                                           highLabel lineLbl) =
+                                           highLabel) =
   pprAbbrev DwAbbrCompileUnit
   $$ pprString name
   $$ pprString producer
   $$ pprData4 dW_LANG_Haskell
   $$ pprString compDir
      -- Offset due to Note [Info Offset]
-  $$ pprWord platform (lowLabel <> text "-1")
-  $$ pprWord platform highLabel
+  $$ pprWord platform (pprAsmLabel platform lowLabel <> text "-1")
+  $$ pprWord platform (pprAsmLabel platform highLabel)
   $$ if haveSrc
-     then sectionOffset platform lineLbl dwarfLineLabel
+     then sectionOffset platform dwarfLineLabel dwarfLineLabel
      else empty
 pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
-  pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
+  line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon)
   $$ pprAbbrev abbrev
   $$ pprString name
   $$ pprLabelString platform label
@@ -201,11 +204,11 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
     parentValue = maybe empty pprParentDie parent
     pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel
 pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) =
-  pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
+  line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon)
   $$ pprAbbrev DwAbbrBlockWithoutCode
   $$ pprLabelString platform label
 pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) =
-  pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
+  line (pprAsmLabel platform (mkAsmTempDieLabel label) <> colon)
   $$ pprAbbrev DwAbbrBlock
   $$ pprLabelString platform label
   $$ pprWord platform (pprAsmLabel platform marker)
@@ -219,7 +222,7 @@ pprDwarfInfoOpen _ _ (DwarfSrcNote ss) =
   $$ pprHalf (fromIntegral $ srcSpanEndCol ss)
 
 -- | Close a DWARF info record with children
-pprDwarfInfoClose :: SDoc
+pprDwarfInfoClose :: IsDoc doc => doc
 pprDwarfInfoClose = pprAbbrev DwAbbrNull
 
 -- | A DWARF address range. This is used by the debugger to quickly locate
@@ -233,7 +236,7 @@ data DwarfARange
 
 -- | Print assembler directives corresponding to a DWARF @.debug_aranges@
 -- address table entry.
-pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc
+pprDwarfARanges :: IsDoc doc => Platform -> [DwarfARange] -> Unique -> doc
 pprDwarfARanges platform arngs unitU =
   let wordSize = platformWordSizeInBytes platform
       paddingSize = 4 :: Int
@@ -243,7 +246,7 @@ pprDwarfARanges platform arngs unitU =
       pad n = vcat $ replicate n $ pprByte 0
       -- Fix for #17428
       initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize
-  in pprDwWord (ppr initialLength)
+  in pprDwWord (int initialLength)
      $$ pprHalf 2
      $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel
      $$ pprByte (fromIntegral wordSize)
@@ -254,8 +257,10 @@ pprDwarfARanges platform arngs unitU =
      -- terminus
      $$ pprWord platform (char '0')
      $$ pprWord platform (char '0')
+{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> SDoc #-}
+{-# SPECIALIZE pprDwarfARanges :: Platform -> [DwarfARange] -> Unique -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-pprDwarfARange :: Platform -> DwarfARange -> SDoc
+pprDwarfARange :: IsDoc doc => Platform -> DwarfARange -> doc
 pprDwarfARange platform arng =
     -- Offset due to Note [Info Offset].
     pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1")
@@ -299,7 +304,7 @@ instance OutputableP Platform DwarfFrameBlock where
 -- | Header for the @.debug_frame@ section. Here we emit the "Common
 -- Information Entry" record that establishes general call frame
 -- parameters and the default stack layout.
-pprDwarfFrame :: Platform -> DwarfFrame -> SDoc
+pprDwarfFrame :: forall doc. IsDoc doc => Platform -> DwarfFrame -> doc
 pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs}
   = let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start")
         cieEndLabel = mkAsmTempEndLabel cieLabel
@@ -307,7 +312,7 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro
         spReg       = dwarfGlobalRegNo platform Sp
         retReg      = dwarfReturnRegNo platform
         wordSize    = platformWordSizeInBytes platform
-        pprInit :: (GlobalReg, Maybe UnwindExpr) -> SDoc
+        pprInit :: (GlobalReg, Maybe UnwindExpr) -> doc
         pprInit (g, uw) = pprSetUnwind platform g (Nothing, uw)
 
         -- Preserve C stack pointer: This necessary to override that default
@@ -316,9 +321,9 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro
           ArchX86    -> pprByte dW_CFA_same_value $$ pprLEBWord 4
           ArchX86_64 -> pprByte dW_CFA_same_value $$ pprLEBWord 7
           _          -> empty
-    in vcat [ pprAsmLabel platform cieLabel <> colon
+    in vcat [ line (pprAsmLabel platform cieLabel <> colon)
             , pprData4' length -- Length of CIE
-            , pprAsmLabel platform cieStartLabel <> colon
+            , line (pprAsmLabel platform cieStartLabel <> colon)
             , pprData4' (text "-1")
                                -- Common Information Entry marker (-1 = 0xf..f)
             , pprByte 3        -- CIE version (we require DWARF 3)
@@ -346,23 +351,25 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro
             , pprLEBWord 0
             ] $$
        wordAlign platform $$
-       pprAsmLabel platform cieEndLabel <> colon $$
+       line (pprAsmLabel platform cieEndLabel <> colon) $$
        -- Procedure unwind tables
        vcat (map (pprFrameProc platform cieLabel cieInit) procs)
+{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> SDoc #-}
+{-# SPECIALIZE pprDwarfFrame :: Platform -> DwarfFrame -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Writes a "Frame Description Entry" for a procedure. This consists
 -- mainly of referencing the CIE and writing state machine
 -- instructions to describe how the frame base (CFA) changes.
-pprFrameProc :: Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> SDoc
+pprFrameProc :: IsDoc doc => Platform -> CLabel -> UnwindTable -> DwarfFrameProc -> doc
 pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
   = let fdeLabel    = mkAsmTempDerivedLabel procLbl (fsLit "_fde")
         fdeEndLabel = mkAsmTempDerivedLabel procLbl (fsLit "_fde_end")
         procEnd     = mkAsmTempProcEndLabel procLbl
         ifInfo str  = if hasInfo then text str else empty
                       -- see Note [Info Offset]
-    in vcat [ whenPprDebug $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon
+    in vcat [ whenPprDebug $ line $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon
             , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel)
-            , pprAsmLabel platform fdeLabel <> colon
+            , line (pprAsmLabel platform fdeLabel <> colon)
             , pprData4' (pprAsmLabel platform frameLbl <> char '-' <> dwarfFrameLabel)    -- Reference to CIE
             , pprWord platform (pprAsmLabel platform procLbl <> ifInfo "-1") -- Code pointer
             , pprWord platform (pprAsmLabel platform procEnd <> char '-' <>
@@ -370,17 +377,17 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
             ] $$
        vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$
        wordAlign platform $$
-       pprAsmLabel platform fdeEndLabel <> colon
+       line (pprAsmLabel platform fdeEndLabel <> colon)
 
 -- | Generates unwind information for a block. We only generate
 -- instructions where unwind information actually changes. This small
 -- optimisations saves a lot of space, as subsequent blocks often have
 -- the same unwind information.
-pprFrameBlock :: Platform -> DwarfFrameBlock -> S.State UnwindTable SDoc
+pprFrameBlock :: forall doc. IsDoc doc => Platform -> DwarfFrameBlock -> S.State UnwindTable doc
 pprFrameBlock platform (DwarfFrameBlock hasInfo uws0) =
     vcat <$> zipWithM pprFrameDecl (True : repeat False) uws0
   where
-    pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable SDoc
+    pprFrameDecl :: Bool -> UnwindPoint -> S.State UnwindTable doc
     pprFrameDecl firstDecl (UnwindPoint lbl uws) = S.state $ \oldUws ->
         let -- Did a register's unwind expression change?
             isChanged :: GlobalReg -> Maybe UnwindExpr
@@ -450,12 +457,12 @@ dwarfGlobalRegNo p reg = maybe 0 (dwarfRegNo p . RegReal) $ globalRegMaybe p reg
 -- | Generate code for setting the unwind information for a register,
 -- optimized using its known old value in the table. Note that "Sp" is
 -- special: We see it as synonym for the CFA.
-pprSetUnwind :: Platform
+pprSetUnwind :: IsDoc doc => Platform
              -> GlobalReg
                 -- ^ the register to produce an unwinding table entry for
              -> (Maybe UnwindExpr, Maybe UnwindExpr)
                 -- ^ the old and new values of the register
-             -> SDoc
+             -> doc
 pprSetUnwind plat g  (_, Nothing)
   = pprUndefUnwind plat g
 pprSetUnwind _    Sp (Just (UwReg s _), Just (UwReg s' o')) | s == s'
@@ -495,13 +502,13 @@ pprSetUnwind plat g  (_, Just uw)
 
 -- | Print the register number of the given 'GlobalReg' as an unsigned LEB128
 -- encoded number.
-pprLEBRegNo :: Platform -> GlobalReg -> SDoc
+pprLEBRegNo :: IsDoc doc => Platform -> GlobalReg -> doc
 pprLEBRegNo plat = pprLEBWord . fromIntegral . dwarfGlobalRegNo plat
 
 -- | Generates a DWARF expression for the given unwind expression. If
 -- @spIsCFA@ is true, we see @Sp@ as the frame base CFA where it gets
 -- mentioned.
-pprUnwindExpr :: Platform -> Bool -> UnwindExpr -> SDoc
+pprUnwindExpr :: IsDoc doc => Platform -> Bool -> UnwindExpr -> doc
 pprUnwindExpr platform spIsCFA expr
   = let pprE (UwConst i)
           | i >= 0 && i < 32 = pprByte (dW_OP_lit0 + fromIntegral i)
@@ -517,84 +524,100 @@ pprUnwindExpr platform spIsCFA expr
         pprE (UwPlus u1 u2)   = pprE u1 $$ pprE u2 $$ pprByte dW_OP_plus
         pprE (UwMinus u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_minus
         pprE (UwTimes u1 u2)  = pprE u1 $$ pprE u2 $$ pprByte dW_OP_mul
-    in text "\t.uleb128 2f-1f" $$ -- DW_FORM_block length
+    in line (text "\t.uleb128 2f-1f") $$ -- DW_FORM_block length
        -- computed as the difference of the following local labels 2: and 1:
-       text "1:" $$
+       line (text "1:") $$
        pprE expr $$
-       text "2:"
+       line (text "2:")
 
 -- | Generate code for re-setting the unwind information for a
 -- register to @undefined@
-pprUndefUnwind :: Platform -> GlobalReg -> SDoc
+pprUndefUnwind :: IsDoc doc => Platform -> GlobalReg -> doc
 pprUndefUnwind plat g  = pprByte dW_CFA_undefined $$
                          pprLEBRegNo plat g
 
 
 -- | Align assembly at (machine) word boundary
-wordAlign :: Platform -> SDoc
+wordAlign :: IsDoc doc => Platform -> doc
 wordAlign plat =
-  text "\t.align " <> case platformOS plat of
+  line $ text "\t.align " <> case platformOS plat of
     OSDarwin -> case platformWordSize plat of
       PW8 -> char '3'
       PW4 -> char '2'
-    _other   -> ppr (platformWordSizeInBytes plat)
+    _other   -> int (platformWordSizeInBytes plat)
+{-# SPECIALIZE wordAlign :: Platform -> SDoc #-}
+{-# SPECIALIZE wordAlign :: Platform -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Assembly for a single byte of constant DWARF data
-pprByte :: Word8 -> SDoc
-pprByte x = text "\t.byte " <> ppr (fromIntegral x :: Word)
+pprByte :: IsDoc doc => Word8 -> doc
+pprByte x = line $ text "\t.byte " <> integer (fromIntegral x)
+{-# SPECIALIZE pprByte :: Word8 -> SDoc #-}
+{-# SPECIALIZE pprByte :: Word8 -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Assembly for a two-byte constant integer
-pprHalf :: Word16 -> SDoc
-pprHalf x = text "\t.short" <+> ppr (fromIntegral x :: Word)
+pprHalf :: IsDoc doc => Word16 -> doc
+pprHalf x = line $ text "\t.short" <+> integer (fromIntegral x)
+{-# SPECIALIZE pprHalf :: Word16 -> SDoc #-}
+{-# SPECIALIZE pprHalf :: Word16 -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Assembly for a constant DWARF flag
-pprFlag :: Bool -> SDoc
+pprFlag :: IsDoc doc => Bool -> doc
 pprFlag f = pprByte (if f then 0xff else 0x00)
 
 -- | Assembly for 4 bytes of dynamic DWARF data
-pprData4' :: SDoc -> SDoc
-pprData4' x = text "\t.long " <> x
+pprData4' :: IsDoc doc => Line doc -> doc
+pprData4' x = line (text "\t.long " <> x)
+{-# SPECIALIZE pprData4' :: SDoc -> SDoc #-}
+{-# SPECIALIZE pprData4' :: HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Assembly for 4 bytes of constant DWARF data
-pprData4 :: Word -> SDoc
-pprData4 = pprData4' . ppr
+pprData4 :: IsDoc doc => Word -> doc
+pprData4 = pprData4' . integer . fromIntegral
 
 -- | Assembly for a DWARF word of dynamic data. This means 32 bit, as
 -- we are generating 32 bit DWARF.
-pprDwWord :: SDoc -> SDoc
+pprDwWord :: IsDoc doc => Line doc -> doc
 pprDwWord = pprData4'
+{-# SPECIALIZE pprDwWord :: SDoc -> SDoc #-}
+{-# SPECIALIZE pprDwWord :: HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Assembly for a machine word of dynamic data. Depends on the
 -- architecture we are currently generating code for.
-pprWord :: Platform -> SDoc -> SDoc
+pprWord :: IsDoc doc => Platform -> Line doc -> doc
 pprWord plat s =
-  case platformWordSize plat of
+  line $ case platformWordSize plat of
     PW4 -> text "\t.long " <> s
     PW8 -> text "\t.quad " <> s
+{-# SPECIALIZE pprWord :: Platform -> SDoc -> SDoc #-}
+{-# SPECIALIZE pprWord :: Platform -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Prints a number in "little endian base 128" format. The idea is
 -- to optimize for small numbers by stopping once all further bytes
 -- would be 0. The highest bit in every byte signals whether there
 -- are further bytes to read.
-pprLEBWord :: Word -> SDoc
+pprLEBWord :: IsDoc doc => Word -> doc
 pprLEBWord x | x < 128   = pprByte (fromIntegral x)
              | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$
                            pprLEBWord (x `shiftR` 7)
+{-# SPECIALIZE pprLEBWord :: Word -> SDoc #-}
+{-# SPECIALIZE pprLEBWord :: Word -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Same as @pprLEBWord@, but for a signed number
-pprLEBInt :: Int -> SDoc
+pprLEBInt :: IsDoc doc => Int -> doc
 pprLEBInt x | x >= -64 && x < 64
                         = pprByte (fromIntegral (x .&. 127))
             | otherwise = pprByte (fromIntegral $ 128 .|. (x .&. 127)) $$
                           pprLEBInt (x `shiftR` 7)
+{-# SPECIALIZE pprLEBInt :: Int -> SDoc #-}
+{-# SPECIALIZE pprLEBInt :: Int -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Generates a dynamic null-terminated string. If required the
 -- caller needs to make sure that the string is escaped properly.
-pprString' :: SDoc -> SDoc
-pprString' str = text "\t.asciz \"" <> str <> char '"'
+pprString' :: IsDoc doc => Line doc -> doc
+pprString' str = line (text "\t.asciz \"" <> str <> char '"')
 
 -- | Generate a string constant. We take care to escape the string.
-pprString :: String -> SDoc
+pprString :: IsDoc doc => String -> doc
 pprString str
   = pprString' $ hcat $ map escapeChar $
     if str `lengthIs` utf8EncodedLength str
@@ -602,7 +625,7 @@ pprString str
     else map (chr . fromIntegral) $ BS.unpack $ utf8EncodeByteString str
 
 -- | Escape a single non-unicode character
-escapeChar :: Char -> SDoc
+escapeChar :: IsLine doc => Char -> doc
 escapeChar '\\' = text "\\\\"
 escapeChar '\"' = text "\\\""
 escapeChar '\n' = text "\\n"
@@ -621,9 +644,11 @@ escapeChar c
 -- us to just reference the target directly, and will figure out on
 -- their own that we actually need an offset. Finally, Windows has
 -- a special directive to refer to relative offsets. Fun.
-sectionOffset :: Platform -> SDoc -> SDoc -> SDoc
+sectionOffset :: IsDoc doc => Platform -> Line doc -> Line doc -> doc
 sectionOffset plat target section =
   case platformOS plat of
     OSDarwin  -> pprDwWord (target <> char '-' <> section)
-    OSMinGW32 -> text "\t.secrel32 " <> target
+    OSMinGW32 -> line (text "\t.secrel32 " <> target)
     _other    -> pprDwWord target
+{-# SPECIALIZE sectionOffset :: Platform -> SDoc -> SDoc -> SDoc #-}
+{-# SPECIALIZE sectionOffset :: Platform -> HLine -> HLine -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
diff --git a/compiler/GHC/CmmToAsm/Instr.hs b/compiler/GHC/CmmToAsm/Instr.hs
index bc2e2969e6..aa8f538e07 100644
--- a/compiler/GHC/CmmToAsm/Instr.hs
+++ b/compiler/GHC/CmmToAsm/Instr.hs
@@ -15,6 +15,7 @@ import GHC.Utils.Outputable (SDoc)
 import GHC.Cmm.BlockId
 
 import GHC.CmmToAsm.Config
+import GHC.Data.FastString
 
 -- | Holds a list of source and destination registers used by a
 --      particular instruction.
@@ -160,4 +161,4 @@ class Instruction instr where
         pprInstr :: Platform -> instr -> SDoc
 
         -- Create a comment instruction
-        mkComment :: SDoc -> [instr]
+        mkComment :: FastString -> [instr]
diff --git a/compiler/GHC/CmmToAsm/Monad.hs b/compiler/GHC/CmmToAsm/Monad.hs
index eb445649c3..2a61ff0314 100644
--- a/compiler/GHC/CmmToAsm/Monad.hs
+++ b/compiler/GHC/CmmToAsm/Monad.hs
@@ -67,7 +67,7 @@ import GHC.Types.Unique.Supply
 import GHC.Types.Unique         ( Unique )
 import GHC.Unit.Module
 
-import GHC.Utils.Outputable (SDoc, ppr)
+import GHC.Utils.Outputable (SDoc, HDoc, ppr)
 import GHC.Utils.Panic      (pprPanic)
 import GHC.Utils.Monad.State.Strict (State (..), runState, state)
 import GHC.Utils.Misc
@@ -84,7 +84,9 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     shortcutJump              :: (BlockId -> Maybe jumpDest) -> instr -> instr,
     -- | 'Module' is only for printing internal labels. See Note [Internal proc
     -- labels] in CLabel.
-    pprNatCmmDecl             :: NatCmmDecl statics instr -> SDoc,
+    pprNatCmmDeclS            :: NatCmmDecl statics instr -> SDoc,
+    pprNatCmmDeclH            :: NatCmmDecl statics instr -> HDoc,
+        -- see Note [pprNatCmmDeclS and pprNatCmmDeclH]
     maxSpillSlots             :: Int,
     allocatableRegs           :: [RealReg],
     ncgAllocMoreStack         :: Int -> NatCmmDecl statics instr
@@ -103,6 +105,38 @@ data NcgImpl statics instr jumpDest = NcgImpl {
     -- when possible.
     }
 
+{- Note [pprNatCmmDeclS and pprNatCmmDeclH]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Each NcgImpl provides two implementations of its CmmDecl printer, pprNatCmmDeclS
+and pprNatCmmDeclH, which are specialized to SDoc and HDoc, respectively
+(see Note [SDoc versus HDoc] in GHC.Utils.Outputable). These are both internally
+implemented as a single, polymorphic function, but they need to be stored using
+monomorphic types to ensure the specialized versions are used, which is
+essential for performance (see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable).
+
+One might wonder why we bother with pprNatCmmDeclS and SDoc at all, since we
+have a perfectly serviceable HDoc-based implementation that is more efficient.
+However, it turns out we benefit from keeping both, for two (related) reasons:
+
+  1. Although we absolutely want to take care to use pprNatCmmDeclH for actual
+     code generation (the improved performance there is why we have HDoc at
+     all!), we also sometimes print assembly for debug dumps, when requested via
+     -ddump-asm. In this case, it’s more convenient to produce an SDoc, which
+     can be concatenated with other SDocs for consistency with the general-
+     purpose dump file infrastructure.
+
+  2. Some debug information is sometimes useful to include in -ddump-asm that is
+     neither necessary nor useful in normal code generation, and it turns out to
+     be tricky to format neatly using the one-line-at-a-time model of HLine/HDoc.
+
+Therefore, we provide both pprNatCmmDeclS and pprNatCmmDeclH, and we sometimes
+include additional information in the SDoc variant using dualDoc
+(see Note [dualLine and dualDoc] in GHC.Utils.Outputable). However, it is
+absolutely *critical* that pprNatCmmDeclS is not actually used unless -ddump-asm
+is provided, as that would rather defeat the whole point. (Fortunately, the
+difference in allocations between the two implementations is so vast that such a
+mistake would readily show up in performance tests). -}
+
 data NatM_State
         = NatM_State {
                 natm_us          :: UniqSupply,
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 0b92afbfe6..e4b47f91f9 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -532,11 +532,11 @@ gotLabel
 --
 -- We don't need to declare any offset tables.
 -- However, for PIC on x86, we need a small helper function.
-pprGotDeclaration :: NCGConfig -> SDoc
+pprGotDeclaration :: NCGConfig -> HDoc
 pprGotDeclaration config = case (arch,os) of
    (ArchX86, OSDarwin)
         | ncgPIC config
-        -> vcat [
+        -> lines_ [
                 text ".section __TEXT,__textcoal_nt,coalesced,no_toc",
                 text ".weak_definition ___i686.get_pc_thunk.ax",
                 text ".private_extern ___i686.get_pc_thunk.ax",
@@ -548,26 +548,26 @@ pprGotDeclaration config = case (arch,os) of
 
    -- Emit XCOFF TOC section
    (_, OSAIX)
-        -> vcat $ [ text ".toc"
-                  , text ".tc ghc_toc_table[TC],.LCTOC1"
-                  , text ".csect ghc_toc_table[RW]"
-                    -- See Note [.LCTOC1 in PPC PIC code]
-                  , text ".set .LCTOC1,$+0x8000"
-                  ]
+        -> lines_ $ [ text ".toc"
+                    , text ".tc ghc_toc_table[TC],.LCTOC1"
+                    , text ".csect ghc_toc_table[RW]"
+                      -- See Note [.LCTOC1 in PPC PIC code]
+                    , text ".set .LCTOC1,$+0x8000"
+                    ]
 
 
    -- PPC 64 ELF v1 needs a Table Of Contents (TOC)
    (ArchPPC_64 ELF_V1, _)
-        -> text ".section \".toc\",\"aw\""
+        -> line $ text ".section \".toc\",\"aw\""
 
    -- In ELF v2 we also need to tell the assembler that we want ABI
    -- version 2. This would normally be done at the top of the file
    -- right after a file directive, but I could not figure out how
    -- to do that.
    (ArchPPC_64 ELF_V2, _)
-        -> vcat [ text ".abiversion 2",
-                  text ".section \".toc\",\"aw\""
-                ]
+        -> lines_ [ text ".abiversion 2",
+                    text ".section \".toc\",\"aw\""
+                  ]
 
    (arch, os)
         | osElfTarget os
@@ -577,7 +577,7 @@ pprGotDeclaration config = case (arch,os) of
 
         | osElfTarget os
         , arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
-        -> vcat [
+        -> lines_ [
                 -- See Note [.LCTOC1 in PPC PIC code]
                 text ".section \".got2\",\"aw\"",
                 text ".LCTOC1 = .+32768" ]
@@ -595,15 +595,16 @@ pprGotDeclaration config = case (arch,os) of
 -- and one for non-PIC.
 --
 
-pprImportedSymbol :: NCGConfig -> CLabel -> SDoc
+pprImportedSymbol :: NCGConfig -> CLabel -> HDoc
 pprImportedSymbol config importedLbl = case (arch,os) of
+
    (ArchX86, OSDarwin)
         | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
         -> if not pic
              then
-              vcat [
+              lines_ [
                   text ".symbol_stub",
-                  text "L" <> ppr_lbl lbl <> text "$stub:",
+                  (text "L" <> ppr_lbl lbl <> text "$stub:"),
                       text "\t.indirect_symbol" <+> ppr_lbl lbl,
                       text "\tjmp *L" <> ppr_lbl lbl
                           <> text "$lazy_ptr",
@@ -614,7 +615,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
                       text "\tjmp dyld_stub_binding_helper"
               ]
              else
-              vcat [
+              lines_ [
                   text ".section __TEXT,__picsymbolstub2,"
                       <> text "symbol_stubs,pure_instructions,25",
                   text "L" <> ppr_lbl lbl <> text "$stub:",
@@ -631,7 +632,8 @@ pprImportedSymbol config importedLbl = case (arch,os) of
                       text "\tpushl %eax",
                       text "\tjmp dyld_stub_binding_helper"
               ]
-           $+$ vcat [        text ".section __DATA, __la_sym_ptr"
+           $$ lines_ [
+                text ".section __DATA, __la_sym_ptr"
                     <> (if pic then int 2 else int 3)
                     <> text ",lazy_symbol_pointers",
                 text "L" <> ppr_lbl lbl <> text "$lazy_ptr:",
@@ -640,7 +642,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
                     <> text "$stub_binder"]
 
         | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
-        -> vcat [
+        -> lines_ [
                 text ".non_lazy_symbol_pointer",
                 char 'L' <> ppr_lbl lbl <> text "$non_lazy_ptr:",
                 text "\t.indirect_symbol" <+> ppr_lbl lbl,
@@ -667,7 +669,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
 
    (_, OSAIX) -> case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
-              -> vcat [
+              -> lines_ [
                    text "LC.." <> ppr_lbl lbl <> char ':',
                    text "\t.long" <+> ppr_lbl lbl ]
             _ -> empty
@@ -700,12 +702,11 @@ pprImportedSymbol config importedLbl = case (arch,os) of
    -- When needImportedSymbols is defined,
    -- the NCG will keep track of all DynamicLinkerLabels it uses
    -- and output each of them using pprImportedSymbol.
-
    (ArchPPC_64 _, _)
         | osElfTarget os
         -> case dynamicLinkerLabelInfo importedLbl of
             Just (SymbolPtr, lbl)
-              -> vcat [
+              -> lines_ [
                    text ".LC_" <> ppr_lbl lbl <> char ':',
                    text "\t.quad" <+> ppr_lbl lbl ]
             _ -> empty
@@ -718,7 +719,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
                          W64 -> text "\t.quad"
                          _ -> panic "Unknown wordRep in pprImportedSymbol"
 
-                 in vcat [
+                 in lines_ [
                       text ".section \".got2\", \"aw\"",
                       text ".LC_" <> ppr_lbl lbl <> char ':',
                       symbolSize <+> ppr_lbl lbl ]
@@ -729,6 +730,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
    _ -> panic "PIC.pprImportedSymbol: no match"
  where
    platform = ncgPlatform config
+   ppr_lbl :: CLabel -> HLine
    ppr_lbl  = pprAsmLabel   platform
    arch     = platformArch  platform
    os       = platformOS    platform
diff --git a/compiler/GHC/CmmToAsm/PPC.hs b/compiler/GHC/CmmToAsm/PPC.hs
index cbfbdb539c..40a629907f 100644
--- a/compiler/GHC/CmmToAsm/PPC.hs
+++ b/compiler/GHC/CmmToAsm/PPC.hs
@@ -28,7 +28,8 @@ ncgPPC config = NcgImpl
    , canShortcut               = PPC.canShortcut
    , shortcutStatics           = PPC.shortcutStatics
    , shortcutJump              = PPC.shortcutJump
-   , pprNatCmmDecl             = PPC.pprNatCmmDecl config
+   , pprNatCmmDeclH            = PPC.pprNatCmmDecl config
+   , pprNatCmmDeclS            = PPC.pprNatCmmDecl config
    , maxSpillSlots             = PPC.maxSpillSlots config
    , allocatableRegs           = PPC.allocatableRegs platform
    , ncgAllocMoreStack         = PPC.allocMoreStack platform
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index f8563004b5..9ddcdc32dd 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -162,7 +162,7 @@ stmtToInstrs stmt = do
   config <- getConfig
   platform <- getPlatform
   case stmt of
-    CmmComment s   -> return (unitOL (COMMENT $ ftext s))
+    CmmComment s   -> return (unitOL (COMMENT s))
     CmmTick {}     -> return nilOL
     CmmUnwind {}   -> return nilOL
 
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index c852789bbe..639ae979f8 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Instr.hs
@@ -52,7 +52,6 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
 import GHC.Cmm.Info
 import GHC.Cmm.CLabel
-import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Platform
 import GHC.Types.Unique.FM (listToUFM, lookupUFM)
@@ -60,6 +59,7 @@ import GHC.Types.Unique.Supply
 
 import Data.Foldable (toList)
 import qualified Data.List.NonEmpty as NE
+import GHC.Data.FastString (FastString)
 import Data.Maybe (fromMaybe)
 
 
@@ -179,7 +179,7 @@ data RI
 
 data Instr
     -- comment pseudo-op
-    = COMMENT SDoc
+    = COMMENT FastString
 
     -- location pseudo-op (file, line, col, name)
     | LOCATION Int Int Int String
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index 19de3cd1e2..f03f56f6d8 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -46,7 +46,7 @@ import Data.Int
 -- -----------------------------------------------------------------------------
 -- Printing this stuff out
 
-pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
+pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
 pprNatCmmDecl config (CmmData section dats) =
   pprSectionAlign config section
   $$ pprDatas (ncgPlatform config) dats
@@ -63,15 +63,15 @@ 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) $$
-         ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel lbl)
-                                          <> char ':' $$
-                                          pprProcEndLabel platform lbl) $$
+         ppWhen (ncgDwarfEnabled config) (line (pprAsmLabel platform (mkAsmTempEndLabel lbl)
+                                                <> char ':') $$
+                                          line (pprProcEndLabel platform lbl)) $$
          pprSizeDecl platform lbl
 
     Just (CmmStaticsRaw info_lbl _) ->
       pprSectionAlign config (Section Text info_lbl) $$
       (if platformHasSubsectionsViaSymbols platform
-          then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
+          then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> char ':')
           else empty) $$
       vcat (map (pprBasicBlock config top_info) blocks) $$
       -- above: Even the first block gets a label, because with branch-chain
@@ -79,18 +79,20 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
       (if platformHasSubsectionsViaSymbols platform
        then
        -- See Note [Subsections Via Symbols] in X86/Ppr.hs
-                text "\t.long "
-            <+> pprAsmLabel platform info_lbl
-            <+> char '-'
-            <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
+                line (text "\t.long "
+                      <+> pprAsmLabel platform info_lbl
+                      <+> char '-'
+                      <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl))
        else empty) $$
       pprSizeDecl platform info_lbl
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc #-}
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Output the ELF .size directive.
-pprSizeDecl :: Platform -> CLabel -> SDoc
+pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprSizeDecl platform lbl
  = if osElfTarget (platformOS platform)
-   then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl
+   then line (text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl)
    else empty
   where
     prettyLbl = pprAsmLabel platform lbl
@@ -98,47 +100,45 @@ pprSizeDecl platform lbl
       | platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl
       | otherwise                                  = prettyLbl
 
-pprFunctionDescriptor :: Platform -> CLabel -> SDoc
-pprFunctionDescriptor platform lab = pprGloblDecl platform lab
-                        $$  text "\t.section \".opd\", \"aw\""
-                        $$  text "\t.align 3"
-                        $$  pprAsmLabel platform lab <> char ':'
-                        $$  text "\t.quad ."
-                        <>  pprAsmLabel platform lab
-                        <>  text ",.TOC.@tocbase,0"
-                        $$  text "\t.previous"
-                        $$  text "\t.type"
-                        <+> pprAsmLabel platform lab
-                        <>  text ", @function"
-                        $$  char '.' <> pprAsmLabel platform lab <> char ':'
-
-pprFunctionPrologue :: Platform -> CLabel ->SDoc
-pprFunctionPrologue platform lab =  pprGloblDecl platform lab
-                        $$  text ".type "
-                        <> pprAsmLabel platform lab
-                        <> text ", @function"
-                        $$ pprAsmLabel platform lab <> char ':'
-                        $$ text "0:\taddis\t" <> pprReg toc
-                        <> text ",12,.TOC.-0b@ha"
-                        $$ text "\taddi\t" <> pprReg toc
-                        <> char ',' <> pprReg toc <> text ",.TOC.-0b@l"
-                        $$ text "\t.localentry\t" <> pprAsmLabel platform lab
-                        <> text ",.-" <> pprAsmLabel platform lab
-
-pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
-                -> SDoc
+pprFunctionDescriptor :: IsDoc doc => Platform -> CLabel -> doc
+pprFunctionDescriptor platform lab =
+  vcat [pprGloblDecl platform lab,
+        line (text "\t.section \".opd\", \"aw\""),
+        line (text "\t.align 3"),
+        line (pprAsmLabel platform lab <> char ':'),
+        line (text "\t.quad ."
+              <>  pprAsmLabel platform lab
+              <>  text ",.TOC.@tocbase,0"),
+        line (text "\t.previous"),
+        line (text "\t.type"
+              <+> pprAsmLabel platform lab
+              <>  text ", @function"),
+        line (char '.' <> pprAsmLabel platform lab <> char ':')]
+
+pprFunctionPrologue :: IsDoc doc => Platform -> CLabel -> doc
+pprFunctionPrologue platform lab =
+  vcat [pprGloblDecl platform lab,
+        line (text ".type " <> pprAsmLabel platform lab <> text ", @function"),
+        line (pprAsmLabel platform lab <> char ':'),
+        line (text "0:\taddis\t" <> pprReg toc <> text ",12,.TOC.-0b@ha"),
+        line (text "\taddi\t" <> pprReg toc <> char ',' <> pprReg toc <> text ",.TOC.-0b@l"),
+        line (text "\t.localentry\t" <> pprAsmLabel platform lab <>
+              text ",.-" <> pprAsmLabel platform lab)]
+
+pprProcEndLabel :: IsLine doc => Platform -> CLabel -- ^ Procedure name
+                -> doc
 pprProcEndLabel platform lbl =
     pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> char ':'
 
-pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
-              -> SDoc
+pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
+              -> doc
 pprBasicBlock config info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
     pprLabel platform asmLbl $$
     vcat (map (pprInstr platform) instrs) $$
     ppWhen (ncgDwarfEnabled config) (
-      pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':'
-      <> pprProcEndLabel platform asmLbl
+      line (pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':'
+            <> pprProcEndLabel platform asmLbl)
     )
   where
     asmLbl = blockLbl blockid
@@ -152,7 +152,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
 
 
 
-pprDatas :: Platform -> RawCmmStatics -> SDoc
+pprDatas :: IsDoc doc => Platform -> RawCmmStatics -> doc
 -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
 pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
   | lbl == mkIndStaticInfoLabel
@@ -162,38 +162,38 @@ pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLi
   , Just ind' <- labelInd ind
   , alias `mayRedirectTo` ind'
   = pprGloblDecl platform alias
-    $$ text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind'
+    $$ line (text ".equiv" <+> pprAsmLabel platform alias <> comma <> pprAsmLabel platform ind')
 pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
 
-pprData :: Platform -> CmmStatic -> SDoc
+pprData :: IsDoc doc => Platform -> CmmStatic -> doc
 pprData platform d = case d of
-   CmmString str          -> pprString str
-   CmmFileEmbed path      -> pprFileEmbed path
-   CmmUninitialised bytes -> text ".space " <> int bytes
+   CmmString str          -> line (pprString str)
+   CmmFileEmbed path      -> line (pprFileEmbed path)
+   CmmUninitialised bytes -> line (text ".space " <> int bytes)
    CmmStaticLit lit       -> pprDataItem platform lit
 
-pprGloblDecl :: Platform -> CLabel -> SDoc
+pprGloblDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = text ".globl " <> pprAsmLabel platform lbl
+  | otherwise = line (text ".globl " <> pprAsmLabel platform lbl)
 
-pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
+pprTypeAndSizeDecl :: IsLine doc => Platform -> CLabel -> doc
 pprTypeAndSizeDecl platform lbl
   = if platformOS platform == OSLinux && externallyVisibleCLabel lbl
     then text ".type " <>
          pprAsmLabel platform lbl <> text ", @object"
     else empty
 
-pprLabel :: Platform -> CLabel -> SDoc
+pprLabel :: IsDoc doc => Platform -> CLabel -> doc
 pprLabel platform lbl =
    pprGloblDecl platform lbl
-   $$ pprTypeAndSizeDecl platform lbl
-   $$ (pprAsmLabel platform lbl <> char ':')
+   $$ line (pprTypeAndSizeDecl platform lbl)
+   $$ line (pprAsmLabel platform lbl <> char ':')
 
 -- -----------------------------------------------------------------------------
 -- pprInstr: print an 'Instr'
 
-pprReg :: Reg -> SDoc
+pprReg :: forall doc. IsLine doc => Reg -> doc
 
 pprReg r
   = case r of
@@ -204,7 +204,7 @@ pprReg r
       RegVirtual (VirtualRegD  u)  -> text "%vD_"   <> pprUniqueAlways u
 
   where
-    ppr_reg_no :: Int -> SDoc
+    ppr_reg_no :: Int -> doc
     ppr_reg_no i
          | i <= 31   = int i      -- GPRs
          | i <= 63   = int (i-32) -- FPRs
@@ -212,7 +212,7 @@ pprReg r
 
 
 
-pprFormat :: Format -> SDoc
+pprFormat :: IsLine doc => Format -> doc
 pprFormat x
  = case x of
                 II8  -> text "b"
@@ -223,7 +223,7 @@ pprFormat x
                 FF64 -> text "fd"
 
 
-pprCond :: Cond -> SDoc
+pprCond :: IsLine doc => Cond -> doc
 pprCond c
  = case c of {
                 ALWAYS  -> text "";
@@ -234,7 +234,7 @@ pprCond c
                 GU      -> text "gt";  LEU   -> text "le"; }
 
 
-pprImm :: Platform -> Imm -> SDoc
+pprImm :: IsLine doc => Platform -> Imm -> doc
 pprImm platform = \case
    ImmInt i       -> int i
    ImmInteger i   -> integer i
@@ -264,7 +264,7 @@ pprImm platform = \case
    HIGHESTA i  -> pprImm platform i <> text "@highesta"
 
 
-pprAddr :: Platform -> AddrMode -> SDoc
+pprAddr :: IsLine doc => Platform -> AddrMode -> doc
 pprAddr platform = \case
    AddrRegReg r1 r2             -> pprReg r1 <> char ',' <+> pprReg r2
    AddrRegImm r1 (ImmInt i)     -> hcat [ int i, char '(', pprReg r1, char ')' ]
@@ -272,14 +272,14 @@ pprAddr platform = \case
    AddrRegImm r1 imm            -> hcat [ pprImm platform imm, char '(', pprReg r1, char ')' ]
 
 
-pprSectionAlign :: NCGConfig -> Section -> SDoc
+pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
 pprSectionAlign config sec@(Section seg _) =
-   pprSectionHeader config sec $$
+   line (pprSectionHeader config sec) $$
    pprAlignForSection (ncgPlatform config) seg
 
 -- | Print appropriate alignment for the given section type.
-pprAlignForSection :: Platform -> SectionType -> SDoc
-pprAlignForSection platform seg =
+pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc
+pprAlignForSection platform seg = line $
  let ppc64    = not $ target32Bit platform
  in case seg of
        Text              -> text ".align 2"
@@ -304,9 +304,9 @@ pprAlignForSection platform seg =
         | otherwise      -> text ".align 2"
        OtherSection _    -> panic "PprMach.pprSectionAlign: unknown section"
 
-pprDataItem :: Platform -> CmmLit -> SDoc
+pprDataItem :: IsDoc doc => Platform -> CmmLit -> doc
 pprDataItem platform lit
-  = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
+  = lines_ (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
     where
         imm = litToImm lit
         archPPC_64 = not $ target32Bit platform
@@ -333,21 +333,21 @@ pprDataItem platform lit
                 = panic "PPC.Ppr.pprDataItem: no match"
 
 
-asmComment :: SDoc -> SDoc
+asmComment :: IsLine doc => doc -> doc
 asmComment c = whenPprDebug $ text "#" <+> c
 
 
-pprInstr :: Platform -> Instr -> SDoc
+pprInstr :: IsDoc doc => Platform -> Instr -> doc
 pprInstr platform instr = case instr of
 
    COMMENT s
-      -> asmComment s
+      -> line (asmComment (ftext s))
 
-   LOCATION file line col _name
-      -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
+   LOCATION file line' col _name
+      -> line (text "\t.loc" <+> int file <+> int line' <+> int col)
 
    DELTA d
-      -> asmComment $ text ("\tdelta = " ++ show d)
+      -> line (asmComment $ text ("\tdelta = " ++ show d))
 
    NEWBLOCK _
       -> panic "PprMach.pprInstr: NEWBLOCK"
@@ -374,7 +374,7 @@ pprInstr platform instr = case instr of
 -}
 
    LD fmt reg addr
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "l",
            (case fmt of
@@ -403,7 +403,7 @@ pprInstr platform instr = case instr of
       -> panic "PPC.Ppr.pprInstr LDFAR: no match"
 
    LDR fmt reg1 addr
-      -> hcat [
+      -> line $ hcat [
            text "\tl",
            case fmt of
              II32 -> char 'w'
@@ -416,7 +416,7 @@ pprInstr platform instr = case instr of
            ]
 
    LA fmt reg addr
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "l",
            (case fmt of
@@ -436,7 +436,7 @@ pprInstr platform instr = case instr of
            ]
 
    ST fmt reg addr
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "st",
            pprFormat fmt,
@@ -457,7 +457,7 @@ pprInstr platform instr = case instr of
       -> panic "PPC.Ppr.pprInstr STFAR: no match"
 
    STU fmt reg addr
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "st",
            pprFormat fmt,
@@ -471,7 +471,7 @@ pprInstr platform instr = case instr of
            ]
 
    STC fmt reg1 addr
-      -> hcat [
+      -> line $ hcat [
            text "\tst",
            case fmt of
              II32 -> char 'w'
@@ -484,7 +484,7 @@ pprInstr platform instr = case instr of
            ]
 
    LIS reg imm
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "lis",
            char '\t',
@@ -494,7 +494,7 @@ pprInstr platform instr = case instr of
            ]
 
    LI reg imm
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "li",
            char '\t',
@@ -505,7 +505,7 @@ pprInstr platform instr = case instr of
 
    MR reg1 reg2
     | reg1 == reg2 -> empty
-    | otherwise    -> hcat [
+    | otherwise    -> line $ hcat [
         char '\t',
         case targetClassOfReg platform reg1 of
             RcInteger -> text "mr"
@@ -517,7 +517,7 @@ pprInstr platform instr = case instr of
         ]
 
    CMP fmt reg ri
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            op,
            char '\t',
@@ -535,7 +535,7 @@ pprInstr platform instr = case instr of
                ]
 
    CMPL fmt reg ri
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            op,
            char '\t',
@@ -553,7 +553,7 @@ pprInstr platform instr = case instr of
                   ]
 
    BCC cond blockid prediction
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "b",
            pprCond cond,
@@ -568,7 +568,7 @@ pprInstr platform instr = case instr of
                  Just False -> char '-'
 
    BCCFAR cond blockid prediction
-      -> vcat [
+      -> lines_ [
            hcat [
                text "\tb",
                pprCond (condNegate cond),
@@ -590,7 +590,7 @@ pprInstr platform instr = case instr of
      -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
      | isForeignLabel lbl -> panic "PPC.Ppr.pprInstr: JMP to ForeignLabel"
      | otherwise ->
-       hcat [ -- an alias for b that takes a CLabel
+       lines_ [ -- an alias for b that takes a CLabel
            char '\t',
            text "b",
            char '\t',
@@ -598,7 +598,7 @@ pprInstr platform instr = case instr of
        ]
 
    MTCTR reg
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "mtctr",
            char '\t',
@@ -606,7 +606,7 @@ pprInstr platform instr = case instr of
         ]
 
    BCTR _ _ _
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "bctr"
          ]
@@ -623,18 +623,18 @@ pprInstr platform instr = case instr of
              -- but when profiling the codegen inserts calls via
              -- 'emitRtsCallGen' which are 'CmmLabel's even though
              -- they'd technically be more like 'ForeignLabel's.
-             hcat [
+             line $ hcat [
                text "\tbl\t.",
                pprAsmLabel platform lbl
              ]
            _ ->
-             hcat [
+             line $ hcat [
                text "\tbl\t",
                pprAsmLabel platform lbl
              ]
 
    BCTRL _
-      -> hcat [
+      -> line $ hcat [
              char '\t',
              text "bctrl"
          ]
@@ -643,7 +643,7 @@ pprInstr platform instr = case instr of
       -> pprLogic platform (text "add") reg1 reg2 ri
 
    ADDIS reg1 reg2 imm
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "addis",
            char '\t',
@@ -673,7 +673,7 @@ pprInstr platform instr = case instr of
       -> pprLogic platform (text "subfo") reg1 reg2 (RIReg reg3)
 
    SUBFC reg1 reg2 ri
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "subf",
            case ri of
@@ -694,7 +694,7 @@ pprInstr platform instr = case instr of
       -> pprMul platform fmt reg1 reg2 ri
 
    MULLO fmt reg1 reg2 reg3
-      -> hcat [
+      -> line $ hcat [
              char '\t',
              text "mull",
              case fmt of
@@ -711,13 +711,13 @@ pprInstr platform instr = case instr of
 
    MFOV fmt reg
       -> vcat [
-           hcat [
+           lines_ [
                char '\t',
                text "mfxer",
                char '\t',
                pprReg reg
                ],
-           hcat [
+           lines_ [
                char '\t',
                text "extr",
                case fmt of
@@ -737,7 +737,7 @@ pprInstr platform instr = case instr of
            ]
 
    MULHU fmt reg1 reg2 reg3
-      -> hcat [
+      -> line $ hcat [
             char '\t',
             text "mulh",
             case fmt of
@@ -758,7 +758,7 @@ pprInstr platform instr = case instr of
         -- for some reason, "andi" doesn't exist.
         -- we'll use "andi." instead.
    AND reg1 reg2 (RIImm imm)
-      -> hcat [
+      -> line $ hcat [
             char '\t',
             text "andi.",
             char '\t',
@@ -785,7 +785,7 @@ pprInstr platform instr = case instr of
       -> pprLogic platform (text "xor") reg1 reg2 ri
 
    ORIS reg1 reg2 imm
-      -> hcat [
+      -> line $ hcat [
             char '\t',
             text "oris",
             char '\t',
@@ -797,7 +797,7 @@ pprInstr platform instr = case instr of
         ]
 
    XORIS reg1 reg2 imm
-      -> hcat [
+      -> line $ hcat [
             char '\t',
             text "xoris",
             char '\t',
@@ -809,7 +809,7 @@ pprInstr platform instr = case instr of
         ]
 
    EXTS fmt reg1 reg2
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "exts",
            pprFormat fmt,
@@ -820,7 +820,7 @@ pprInstr platform instr = case instr of
          ]
 
    CNTLZ fmt reg1 reg2
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "cntlz",
            case fmt of
@@ -881,7 +881,7 @@ pprInstr platform instr = case instr of
          in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
 
    RLWINM reg1 reg2 sh mb me
-      -> hcat [
+      -> line $ hcat [
              text "\trlwinm\t",
              pprReg reg1,
              text ", ",
@@ -895,7 +895,7 @@ pprInstr platform instr = case instr of
          ]
 
    CLRLI fmt reg1 reg2 n
-      -> hcat [
+      -> line $ hcat [
             text "\tclrl",
             pprFormat fmt,
             text "i ",
@@ -907,7 +907,7 @@ pprInstr platform instr = case instr of
         ]
 
    CLRRI fmt reg1 reg2 n
-      -> hcat [
+      -> line $ hcat [
             text "\tclrr",
             pprFormat fmt,
             text "i ",
@@ -937,7 +937,7 @@ pprInstr platform instr = case instr of
       -> pprUnary (text "fneg") reg1 reg2
 
    FCMP reg1 reg2
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "fcmpu\t0, ",
                -- Note: we're using fcmpu, not fcmpo
@@ -965,7 +965,7 @@ pprInstr platform instr = case instr of
       -> pprUnary (text "frsp") reg1 reg2
 
    CRNOR dst src1 src2
-      -> hcat [
+      -> line $ hcat [
            text "\tcrnor\t",
            int dst,
            text ", ",
@@ -975,7 +975,7 @@ pprInstr platform instr = case instr of
          ]
 
    MFCR reg
-      -> hcat [
+      -> line $ hcat [
              char '\t',
              text "mfcr",
              char '\t',
@@ -983,7 +983,7 @@ pprInstr platform instr = case instr of
          ]
 
    MFLR reg
-      -> hcat [
+      -> line $ hcat [
            char '\t',
            text "mflr",
            char '\t',
@@ -991,25 +991,25 @@ pprInstr platform instr = case instr of
          ]
 
    FETCHPC reg
-      -> vcat [
+      -> lines_ [
              text "\tbcl\t20,31,1f",
              hcat [ text "1:\tmflr\t", pprReg reg ]
          ]
 
    HWSYNC
-      -> text "\tsync"
+      -> line $ text "\tsync"
 
    ISYNC
-      -> text "\tisync"
+      -> line $ text "\tisync"
 
    LWSYNC
-      -> text "\tlwsync"
+      -> line $ text "\tlwsync"
 
    NOP
-      -> text "\tnop"
+      -> line $ text "\tnop"
 
-pprLogic :: Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
-pprLogic platform op reg1 reg2 ri = hcat [
+pprLogic :: IsDoc doc => Platform -> Line doc -> Reg -> Reg -> RI -> doc
+pprLogic platform op reg1 reg2 ri = line $ hcat [
         char '\t',
         op,
         case ri of
@@ -1024,8 +1024,8 @@ pprLogic platform op reg1 reg2 ri = hcat [
     ]
 
 
-pprMul :: Platform -> Format -> Reg -> Reg -> RI -> SDoc
-pprMul platform fmt reg1 reg2 ri = hcat [
+pprMul :: IsDoc doc => Platform -> Format -> Reg -> Reg -> RI -> doc
+pprMul platform fmt reg1 reg2 ri = line $ hcat [
         char '\t',
         text "mull",
         case ri of
@@ -1043,8 +1043,8 @@ pprMul platform fmt reg1 reg2 ri = hcat [
     ]
 
 
-pprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc
-pprDiv fmt sgn reg1 reg2 reg3 = hcat [
+pprDiv :: IsDoc doc => Format -> Bool -> Reg -> Reg -> Reg -> doc
+pprDiv fmt sgn reg1 reg2 reg3 = line $ hcat [
         char '\t',
         text "div",
         case fmt of
@@ -1061,8 +1061,8 @@ pprDiv fmt sgn reg1 reg2 reg3 = hcat [
     ]
 
 
-pprUnary :: SDoc -> Reg -> Reg -> SDoc
-pprUnary op reg1 reg2 = hcat [
+pprUnary :: IsDoc doc => Line doc -> Reg -> Reg -> doc
+pprUnary op reg1 reg2 = line $ hcat [
         char '\t',
         op,
         char '\t',
@@ -1072,8 +1072,8 @@ pprUnary op reg1 reg2 = hcat [
     ]
 
 
-pprBinaryF :: SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
-pprBinaryF op fmt reg1 reg2 reg3 = hcat [
+pprBinaryF :: IsDoc doc => Line doc -> Format -> Reg -> Reg -> Reg -> doc
+pprBinaryF op fmt reg1 reg2 reg3 = line $ hcat [
         char '\t',
         op,
         pprFFormat fmt,
@@ -1085,12 +1085,12 @@ pprBinaryF op fmt reg1 reg2 reg3 = hcat [
         pprReg reg3
     ]
 
-pprRI :: Platform -> RI -> SDoc
+pprRI :: IsLine doc => Platform -> RI -> doc
 pprRI _        (RIReg r) = pprReg r
 pprRI platform (RIImm r) = pprImm platform r
 
 
-pprFFormat :: Format -> SDoc
+pprFFormat :: IsLine doc => Format -> doc
 pprFFormat FF64     = empty
 pprFFormat FF32     = char 's'
 pprFFormat _        = panic "PPC.Ppr.pprFFormat: no match"
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index c54ce8f906..7959db8d69 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -27,7 +27,6 @@ import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.CmmToAsm.Config
 import GHC.Utils.Outputable as SDoc
-import qualified GHC.Utils.Ppr as Pretty
 import GHC.Utils.Panic
 import GHC.Platform
 
@@ -89,7 +88,7 @@ doubleToBytes d = runST $ do
 -- Print as a string and escape non-printable characters.
 -- This is similar to charToC in GHC.Utils.Misc
 
-pprASCII :: ByteString -> SDoc
+pprASCII :: forall doc. IsLine doc => ByteString -> doc
 pprASCII str
   -- Transform this given literal bytestring to escaped string and construct
   -- the literal SDoc directly.
@@ -98,19 +97,19 @@ pprASCII str
   --
   -- We work with a `Doc` instead of an `SDoc` because there is no need to carry
   -- an `SDocContext` that we don't use. It leads to nicer (STG) code.
-  = docToSDoc (BS.foldr f Pretty.empty str)
+  = BS.foldr f empty str
     where
-       f :: Word8 -> Pretty.Doc -> Pretty.Doc
-       f w s = do1 w Pretty.<> s
-
-       do1 :: Word8 -> Pretty.Doc
-       do1 w | 0x09 == w = Pretty.text "\\t"
-             | 0x0A == w = Pretty.text "\\n"
-             | 0x22 == w = Pretty.text "\\\""
-             | 0x5C == w = Pretty.text "\\\\"
+       f :: Word8 -> doc -> doc
+       f w s = do1 w <> s
+
+       do1 :: Word8 -> doc
+       do1 w | 0x09 == w = text "\\t"
+             | 0x0A == w = text "\\n"
+             | 0x22 == w = text "\\\""
+             | 0x5C == w = text "\\\\"
                -- ASCII printable characters range
-             | w >= 0x20 && w <= 0x7E = Pretty.char (chr' w)
-             | otherwise = Pretty.sizedText 4 xs
+             | w >= 0x20 && w <= 0x7E = char (chr' w)
+             | otherwise = text xs
                 where
                  !xs = [ '\\', x0, x1, x2] -- octal
                  !x0 = chr' (ord0 + (w `unsafeShiftR` 6) .&. 0x07)
@@ -122,20 +121,25 @@ pprASCII str
        -- so we bypass the check in "chr"
        chr' :: Word8 -> Char
        chr' (W8# w#) = C# (chr# (word2Int# (word8ToWord# w#)))
-
+{-# SPECIALIZE pprASCII :: ByteString -> SDoc #-}
+{-# SPECIALIZE pprASCII :: ByteString -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Emit a ".string" directive
-pprString :: ByteString -> SDoc
+pprString :: IsLine doc => ByteString -> doc
 pprString bs = text "\t.string " <> doubleQuotes (pprASCII bs)
+{-# SPECIALIZE pprString :: ByteString -> SDoc #-}
+{-# SPECIALIZE pprString :: ByteString -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Emit a ".incbin" directive
 --
 -- A NULL byte is added after the binary data.
-pprFileEmbed :: FilePath -> SDoc
+pprFileEmbed :: IsLine doc => FilePath -> doc
 pprFileEmbed path
    = text "\t.incbin "
      <> pprFilePathString path -- proper escape (see #16389)
      <> text "\n\t.byte 0"
+{-# SPECIALIZE pprFileEmbed :: FilePath -> SDoc #-}
+{-# SPECIALIZE pprFileEmbed :: FilePath -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 {-
 Note [Embedding large binary blobs]
@@ -193,14 +197,16 @@ string in source code. See #14741 for profiling results.
 -- identical strings in the linker. With -split-sections each string also gets
 -- a unique section to allow strings from unused code to be GC'd.
 
-pprSectionHeader :: NCGConfig -> Section -> SDoc
+pprSectionHeader :: IsLine doc => NCGConfig -> Section -> doc
 pprSectionHeader config (Section t suffix) =
  case platformOS (ncgPlatform config) of
    OSAIX     -> pprXcoffSectionHeader t
    OSDarwin  -> pprDarwinSectionHeader t
    _         -> pprGNUSectionHeader config t suffix
+{-# SPECIALIZE pprSectionHeader :: NCGConfig -> Section -> SDoc #-}
+{-# SPECIALIZE pprSectionHeader :: NCGConfig -> Section -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc
+pprGNUSectionHeader :: IsLine doc => NCGConfig -> SectionType -> CLabel -> doc
 pprGNUSectionHeader config t suffix =
   hcat [text ".section ", header, subsection, flags]
   where
@@ -244,10 +250,12 @@ pprGNUSectionHeader config t suffix =
                     -> empty
         | otherwise -> text ",\"aMS\"," <> sectionType platform "progbits" <> text ",1"
       _ -> empty
+{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprGNUSectionHeader :: NCGConfig -> SectionType -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- XCOFF doesn't support relocating label-differences, so we place all
 -- RO sections into .text[PR] sections
-pprXcoffSectionHeader :: SectionType -> SDoc
+pprXcoffSectionHeader :: IsLine doc => SectionType -> doc
 pprXcoffSectionHeader t = case t of
   Text                    -> text ".csect .text[PR]"
   Data                    -> text ".csect .data[RW]"
@@ -256,8 +264,10 @@ pprXcoffSectionHeader t = case t of
   CString                 -> text ".csect .text[PR] # CString"
   UninitialisedData       -> text ".csect .data[BS]"
   _                       -> panic "pprXcoffSectionHeader: unknown section type"
+{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> SDoc #-}
+{-# SPECIALIZE pprXcoffSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
-pprDarwinSectionHeader :: SectionType -> SDoc
+pprDarwinSectionHeader :: IsLine doc => SectionType -> doc
 pprDarwinSectionHeader t = case t of
   Text                    -> text ".text"
   Data                    -> text ".data"
@@ -268,3 +278,5 @@ pprDarwinSectionHeader t = case t of
   FiniArray               -> panic "pprDarwinSectionHeader: fini not supported"
   CString                 -> text ".section\t__TEXT,__cstring,cstring_literals"
   OtherSection _          -> panic "pprDarwinSectionHeader: unknown section type"
+{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> SDoc #-}
+{-# SPECIALIZE pprDarwinSectionHeader :: SectionType -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
diff --git a/compiler/GHC/CmmToAsm/X86.hs b/compiler/GHC/CmmToAsm/X86.hs
index 91b571f4de..a82674afe8 100644
--- a/compiler/GHC/CmmToAsm/X86.hs
+++ b/compiler/GHC/CmmToAsm/X86.hs
@@ -33,7 +33,8 @@ ncgX86_64 config = NcgImpl
    , canShortcut               = X86.canShortcut
    , shortcutStatics           = X86.shortcutStatics
    , shortcutJump              = X86.shortcutJump
-   , pprNatCmmDecl             = X86.pprNatCmmDecl config
+   , pprNatCmmDeclS            = X86.pprNatCmmDecl config
+   , pprNatCmmDeclH            = X86.pprNatCmmDecl config
    , maxSpillSlots             = X86.maxSpillSlots config
    , allocatableRegs           = X86.allocatableRegs platform
    , ncgAllocMoreStack         = X86.allocMoreStack platform
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index fd85ae6154..67c5504295 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -326,7 +326,7 @@ stmtToInstrs bid stmt = do
        -> genForeignCall target result_regs args bid
 
     _ -> (,Nothing) <$> case stmt of
-      CmmComment s   -> return (unitOL (COMMENT $ ftext s))
+      CmmComment s   -> return (unitOL (COMMENT s))
       CmmTick {}     -> return nilOL
 
       CmmUnwind regs -> do
diff --git a/compiler/GHC/CmmToAsm/X86/Instr.hs b/compiler/GHC/CmmToAsm/X86/Instr.hs
index 42b9543204..59c4770c9b 100644
--- a/compiler/GHC/CmmToAsm/X86/Instr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Instr.hs
@@ -67,6 +67,7 @@ import GHC.Types.Basic (Alignment)
 import GHC.Cmm.DebugBlock (UnwindTable)
 
 import Data.Maybe       (fromMaybe)
+import GHC.Data.FastString (FastString)
 
 -- Format of an x86/x86_64 memory address, in bytes.
 --
@@ -170,7 +171,7 @@ bit precision.
 
 data Instr
         -- comment pseudo-op
-        = COMMENT SDoc
+        = COMMENT FastString
 
         -- location pseudo-op (file, line, col, name)
         | LOCATION Int Int Int String
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 0b19665857..11c882e547 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -1,5 +1,6 @@
 
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 --
@@ -11,11 +12,7 @@
 
 module GHC.CmmToAsm.X86.Ppr (
         pprNatCmmDecl,
-        pprData,
         pprInstr,
-        pprFormat,
-        pprImm,
-        pprDataItem,
 )
 
 where
@@ -39,6 +36,7 @@ import GHC.Cmm.Dataflow.Collections
 import GHC.Cmm.Dataflow.Label
 import GHC.Cmm.BlockId
 import GHC.Cmm.CLabel
+import GHC.Cmm.DebugBlock (pprUnwindTable)
 
 import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
 import GHC.Types.Unique ( pprUniqueAlways )
@@ -65,12 +63,12 @@ import Data.Word
 -- .subsections_via_symbols and -dead_strip can be found at
 -- <https://developer.apple.com/library/mac/documentation/DeveloperTools/Reference/Assembler/040-Assembler_Directives/asm_directives.html#//apple_ref/doc/uid/TP30000823-TPXREF101>
 
-pprProcAlignment :: NCGConfig -> SDoc
+pprProcAlignment :: IsDoc doc => NCGConfig -> doc
 pprProcAlignment config = maybe empty (pprAlign platform . mkAlignment) (ncgProcAlignment config)
    where
       platform = ncgPlatform config
 
-pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> SDoc
+pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> doc
 pprNatCmmDecl config (CmmData section dats) =
   pprSectionAlign config section $$ pprDatas config dats
 
@@ -85,7 +83,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
         pprProcLabel config lbl $$
         pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
         vcat (map (pprBasicBlock config top_info) blocks) $$
-        ppWhen (ncgDwarfEnabled config) (pprBlockEndLabel platform lbl $$ pprProcEndLabel platform lbl) $$
+        ppWhen (ncgDwarfEnabled config) (line (pprBlockEndLabel platform lbl) $$ line (pprProcEndLabel platform lbl)) $$
         pprSizeDecl platform lbl
 
     Just (CmmStaticsRaw info_lbl _) ->
@@ -93,48 +91,51 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
       pprProcAlignment config $$
       pprProcLabel config lbl $$
       (if platformHasSubsectionsViaSymbols platform
-          then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon
+          then line (pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon)
           else empty) $$
       vcat (map (pprBasicBlock config top_info) blocks) $$
-      ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$
+      ppWhen (ncgDwarfEnabled config) (line (pprProcEndLabel platform info_lbl)) $$
       -- above: Even the first block gets a label, because with branch-chain
       -- elimination, it might be the target of a goto.
       (if platformHasSubsectionsViaSymbols platform
        then -- See Note [Subsections Via Symbols]
-                text "\t.long "
+                line
+              $ text "\t.long "
             <+> pprAsmLabel platform info_lbl
             <+> char '-'
             <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
        else empty) $$
       pprSizeDecl platform info_lbl
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> SDoc #-}
+{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Output an internal proc label. See Note [Internal proc labels] in CLabel.
-pprProcLabel :: NCGConfig -> CLabel -> SDoc
+pprProcLabel :: IsDoc doc => NCGConfig -> CLabel -> doc
 pprProcLabel config lbl
   | ncgExposeInternalSymbols config
   , Just lbl' <- ppInternalProcLabel (ncgThisModule config) lbl
-  = lbl' <> colon
+  = line (lbl' <> colon)
   | otherwise
   = empty
 
-pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
-                -> SDoc
+pprProcEndLabel :: IsLine doc => Platform -> CLabel -- ^ Procedure name
+                -> doc
 pprProcEndLabel platform lbl =
     pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon
 
-pprBlockEndLabel :: Platform -> CLabel -- ^ Block name
-                 -> SDoc
+pprBlockEndLabel :: IsLine doc => Platform -> CLabel -- ^ Block name
+                 -> doc
 pprBlockEndLabel platform lbl =
     pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon
 
 -- | Output the ELF .size directive.
-pprSizeDecl :: Platform -> CLabel -> SDoc
+pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprSizeDecl platform lbl
  = if osElfTarget (platformOS platform)
-   then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl
+   then line (text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl)
    else empty
 
-pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
+pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> doc
 pprBasicBlock config info_env (BasicBlock blockid instrs)
   = maybe_infotable $
     pprLabel platform asmLbl $$
@@ -142,8 +143,8 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
     ppWhen (ncgDwarfEnabled config) (
       -- Emit both end labels since this may end up being a standalone
       -- top-level block
-      pprBlockEndLabel platform asmLbl
-      <> pprProcEndLabel platform asmLbl
+      line (pprBlockEndLabel platform asmLbl
+         <> pprProcEndLabel platform asmLbl)
     )
   where
     asmLbl = blockLbl blockid
@@ -156,7 +157,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
            vcat (map (pprData config) info) $$
            pprLabel platform infoLbl $$
            c $$
-           ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon)
+           ppWhen (ncgDwarfEnabled config) (line (pprAsmLabel platform (mkAsmTempEndLabel infoLbl) <> colon))
 
     -- Make sure the info table has the right .loc for the block
     -- coming right after it. See Note [Info Offset]
@@ -165,7 +166,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
       _other             -> empty
 
 
-pprDatas :: NCGConfig -> (Alignment, RawCmmStatics) -> SDoc
+pprDatas :: IsDoc doc => NCGConfig -> (Alignment, RawCmmStatics) -> doc
 -- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
 pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
   | lbl == mkIndStaticInfoLabel
@@ -175,31 +176,32 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
   , Just ind' <- labelInd ind
   , alias `mayRedirectTo` ind'
   = pprGloblDecl (ncgPlatform config) alias
-    $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind'
+    $$ line (text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind')
 
 pprDatas config (align, (CmmStaticsRaw lbl dats))
  = vcat (pprAlign platform align : pprLabel platform lbl : map (pprData config) dats)
    where
       platform = ncgPlatform config
 
-pprData :: NCGConfig -> CmmStatic -> SDoc
-pprData _config (CmmString str) = pprString str
-pprData _config (CmmFileEmbed path) = pprFileEmbed path
+pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc
+pprData _config (CmmString str) = line (pprString str)
+pprData _config (CmmFileEmbed path) = line (pprFileEmbed path)
 
 pprData config (CmmUninitialised bytes)
- = let platform = ncgPlatform config
+ = line
+ $ let platform = ncgPlatform config
    in if platformOS platform == OSDarwin
          then text ".space " <> int bytes
          else text ".skip "  <> int bytes
 
 pprData config (CmmStaticLit lit) = pprDataItem config lit
 
-pprGloblDecl :: Platform -> CLabel -> SDoc
+pprGloblDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprGloblDecl platform lbl
   | not (externallyVisibleCLabel lbl) = empty
-  | otherwise = text ".globl " <> pprAsmLabel platform lbl
+  | otherwise = line (text ".globl " <> pprAsmLabel platform lbl)
 
-pprLabelType' :: Platform -> CLabel -> SDoc
+pprLabelType' :: IsLine doc => Platform -> CLabel -> doc
 pprLabelType' platform lbl =
   if isCFunctionLabel lbl || functionOkInfoTable then
     text "@function"
@@ -257,21 +259,21 @@ pprLabelType' platform lbl =
       isInfoTableLabel lbl && not (isCmmInfoTableLabel lbl) && not (isConInfoTableLabel lbl)
 
 
-pprTypeDecl :: Platform -> CLabel -> SDoc
+pprTypeDecl :: IsDoc doc => Platform -> CLabel -> doc
 pprTypeDecl platform lbl
     = if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
-      then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl
+      then line (text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl)
       else empty
 
-pprLabel :: Platform -> CLabel -> SDoc
+pprLabel :: IsDoc doc => Platform -> CLabel -> doc
 pprLabel platform lbl =
    pprGloblDecl platform lbl
    $$ pprTypeDecl platform lbl
-   $$ (pprAsmLabel platform lbl <> colon)
+   $$ line (pprAsmLabel platform lbl <> colon)
 
-pprAlign :: Platform -> Alignment -> SDoc
+pprAlign :: IsDoc doc => Platform -> Alignment -> doc
 pprAlign platform alignment
-        = text ".align " <> int (alignmentOn platform)
+        = line $ text ".align " <> int (alignmentOn platform)
   where
         bytes = alignmentBytes alignment
         alignmentOn platform = if platformOS platform == OSDarwin
@@ -285,7 +287,7 @@ pprAlign platform alignment
         log2 8 = 3
         log2 n = 1 + log2 (n `quot` 2)
 
-pprReg :: Platform -> Format -> Reg -> SDoc
+pprReg :: forall doc. IsLine doc => Platform -> Format -> Reg -> doc
 pprReg platform f r
   = case r of
       RegReal    (RealRegSingle i) ->
@@ -297,7 +299,7 @@ pprReg platform f r
       RegVirtual (VirtualRegD  u)  -> text "%vD_"   <> pprUniqueAlways u
 
   where
-    ppr32_reg_no :: Format -> Int -> SDoc
+    ppr32_reg_no :: Format -> Int -> doc
     ppr32_reg_no II8   = ppr32_reg_byte
     ppr32_reg_no II16  = ppr32_reg_word
     ppr32_reg_no _     = ppr32_reg_long
@@ -327,7 +329,7 @@ pprReg platform f r
          _  -> ppr_reg_float i
       }
 
-    ppr64_reg_no :: Format -> Int -> SDoc
+    ppr64_reg_no :: Format -> Int -> doc
     ppr64_reg_no II8   = ppr64_reg_byte
     ppr64_reg_no II16  = ppr64_reg_word
     ppr64_reg_no II32  = ppr64_reg_long
@@ -385,7 +387,7 @@ pprReg platform f r
         _  -> ppr_reg_float i
       }
 
-ppr_reg_float :: Int -> SDoc
+ppr_reg_float :: IsLine doc => Int -> doc
 ppr_reg_float i = case i of
         16 -> text "%xmm0" ;   17 -> text "%xmm1"
         18 -> text "%xmm2" ;   19 -> text "%xmm3"
@@ -397,7 +399,7 @@ ppr_reg_float i = case i of
         30 -> text "%xmm14";   31 -> text "%xmm15"
         _  -> text "very naughty x86 register"
 
-pprFormat :: Format -> SDoc
+pprFormat :: IsLine doc => Format -> doc
 pprFormat x = case x of
   II8   -> text "b"
   II16  -> text "w"
@@ -406,14 +408,14 @@ pprFormat x = case x of
   FF32  -> text "ss"      -- "scalar single-precision float" (SSE2)
   FF64  -> text "sd"      -- "scalar double-precision float" (SSE2)
 
-pprFormat_x87 :: Format -> SDoc
+pprFormat_x87 :: IsLine doc => Format -> doc
 pprFormat_x87 x = case x of
   FF32  -> text "s"
   FF64  -> text "l"
   _     -> panic "X86.Ppr.pprFormat_x87"
 
 
-pprCond :: Cond -> SDoc
+pprCond :: IsLine doc => Cond -> doc
 pprCond c = case c of {
   GEU     -> text "ae";   LU   -> text "b";
   EQQ     -> text "e";    GTT  -> text "g";
@@ -426,7 +428,7 @@ pprCond c = case c of {
   ALWAYS  -> text "mp"}
 
 
-pprImm :: Platform -> Imm -> SDoc
+pprImm :: IsLine doc => Platform -> Imm -> doc
 pprImm platform = \case
    ImmInt i            -> int i
    ImmInteger i        -> integer i
@@ -440,7 +442,7 @@ pprImm platform = \case
 
 
 
-pprAddr :: Platform -> AddrMode -> SDoc
+pprAddr :: IsLine doc => Platform -> AddrMode -> doc
 pprAddr platform (ImmAddr imm off)
   = let pp_imm = pprImm platform imm
     in
@@ -471,16 +473,16 @@ pprAddr platform (AddrBaseIndex base index displacement)
     ppr_disp imm        = pprImm platform imm
 
 -- | Print section header and appropriate alignment for that section.
-pprSectionAlign :: NCGConfig -> Section -> SDoc
+pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
 pprSectionAlign _config (Section (OtherSection _) _) =
      panic "X86.Ppr.pprSectionAlign: unknown section"
 pprSectionAlign config sec@(Section seg _) =
-    pprSectionHeader config sec $$
+    line (pprSectionHeader config sec) $$
     pprAlignForSection (ncgPlatform config) seg
 
 -- | Print appropriate alignment for the given section type.
-pprAlignForSection :: Platform -> SectionType -> SDoc
-pprAlignForSection platform seg =
+pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc
+pprAlignForSection platform seg = line $
     text ".align " <>
     case platformOS platform of
       -- Darwin: alignments are given as shifts.
@@ -505,9 +507,9 @@ pprAlignForSection platform seg =
            CString           -> int 1
            _                 -> int 8
 
-pprDataItem :: NCGConfig -> CmmLit -> SDoc
+pprDataItem :: IsDoc doc => NCGConfig -> CmmLit -> doc
 pprDataItem config lit
-  = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
+  = lines_ (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
     where
         platform = ncgPlatform config
         imm = litToImm lit
@@ -557,26 +559,26 @@ pprDataItem config lit
                       [text "\t.quad\t" <> pprImm platform imm]
 
 
-asmComment :: SDoc -> SDoc
+asmComment :: IsLine doc => doc -> doc
 asmComment c = whenPprDebug $ text "# " <> c
 
-pprInstr :: Platform -> Instr -> SDoc
+pprInstr :: forall doc. IsDoc doc => Platform -> Instr -> doc
 pprInstr platform i = case i of
    COMMENT s
-      -> asmComment s
+      -> line (asmComment (ftext s))
 
-   LOCATION file line col _name
-      -> text "\t.loc " <> ppr file <+> ppr line <+> ppr col
+   LOCATION file line' col _name
+      -> line (text "\t.loc " <> int file <+> int line' <+> int col)
 
    DELTA d
-      -> asmComment $ text ("\tdelta = " ++ show d)
+      -> line (asmComment $ text ("\tdelta = " ++ show d))
 
    NEWBLOCK _
       -> panic "pprInstr: NEWBLOCK"
 
    UNWIND lbl d
-      -> asmComment (text "\tunwind = " <> pdoc platform d)
-         $$ pprAsmLabel platform lbl <> colon
+      -> line (asmComment (text "\tunwind = " <> pprUnwindTable platform d))
+         $$ line (pprAsmLabel platform lbl <> colon)
 
    LDATA _ _
       -> panic "pprInstr: LDATA"
@@ -794,19 +796,19 @@ pprInstr platform i = case i of
 -- POPA  -> text "\tpopal"
 
    NOP
-      -> text "\tnop"
+      -> line $ text "\tnop"
 
    CLTD II8
-      -> text "\tcbtw"
+      -> line $ text "\tcbtw"
 
    CLTD II16
-      -> text "\tcwtd"
+      -> line $ text "\tcwtd"
 
    CLTD II32
-      -> text "\tcltd"
+      -> line $ text "\tcltd"
 
    CLTD II64
-      -> text "\tcqto"
+      -> line $ text "\tcqto"
 
    CLTD x
       -> panic $ "pprInstr: CLTD " ++ show x
@@ -825,19 +827,19 @@ pprInstr platform i = case i of
       -> pprCondInstr (text "j") cond (pprImm platform imm)
 
    JMP (OpImm imm) _
-      -> text "\tjmp " <> pprImm platform imm
+      -> line $ text "\tjmp " <> pprImm platform imm
 
    JMP op _
-      -> text "\tjmp *" <> pprOperand platform (archWordFormat (target32Bit platform)) op
+      -> line $ text "\tjmp *" <> pprOperand platform (archWordFormat (target32Bit platform)) op
 
    JMP_TBL op _ _ _
       -> pprInstr platform (JMP op [])
 
    CALL (Left imm) _
-      -> text "\tcall " <> pprImm platform imm
+      -> line $ text "\tcall " <> pprImm platform imm
 
    CALL (Right reg) _
-      -> text "\tcall *" <> pprReg platform (archWordFormat (target32Bit platform)) reg
+      -> line $ text "\tcall *" <> pprReg platform (archWordFormat (target32Bit platform)) reg
 
    IDIV fmt op
       -> pprFormatOp (text "idiv") fmt op
@@ -881,20 +883,20 @@ pprInstr platform i = case i of
 
        -- FETCHGOT for PIC on ELF platforms
    FETCHGOT reg
-      -> vcat [ text "\tcall 1f",
-                hcat [ text "1:\tpopl\t", pprReg platform II32 reg ],
-                hcat [ text "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
-                       pprReg platform II32 reg ]
-              ]
+      -> lines_ [ text "\tcall 1f",
+                  hcat [ text "1:\tpopl\t", pprReg platform II32 reg ],
+                  hcat [ text "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
+                         pprReg platform II32 reg ]
+                ]
 
     -- FETCHPC for PIC on Darwin/x86
     -- get the instruction pointer into a register
     -- (Terminology note: the IP is called Program Counter on PPC,
     --  and it's a good thing to use the same name on both platforms)
    FETCHPC reg
-      -> vcat [ text "\tcall 1f",
-                hcat [ text "1:\tpopl\t", pprReg platform II32 reg ]
-              ]
+      -> lines_ [ text "\tcall 1f",
+                  hcat [ text "1:\tpopl\t", pprReg platform II32 reg ]
+                ]
 
    -- the
    -- GST fmt src addr ==> FLD dst ; FSTPsz addr
@@ -903,10 +905,10 @@ pprInstr platform i = case i of
 
    -- Atomics
    LOCK i
-      -> text "\tlock" $$ pprInstr platform i
+      -> line (text "\tlock") $$ pprInstr platform i
 
    MFENCE
-      -> text "\tmfence"
+      -> line $ text "\tmfence"
 
    XADD format src dst
       -> pprFormatOpOp (text "xadd") format src dst
@@ -916,46 +918,46 @@ pprInstr platform i = case i of
 
 
   where
-   gtab :: SDoc
+   gtab :: Line doc
    gtab  = char '\t'
 
-   gsp :: SDoc
+   gsp :: Line doc
    gsp   = char ' '
 
 
 
-   pprX87 :: Instr -> SDoc -> SDoc
+   pprX87 :: Instr -> Line doc -> doc
    pprX87 fake actual
-      = (char '#' <> pprX87Instr fake) $$ actual
+      = line (char '#' <> pprX87Instr fake) $$ line actual
 
-   pprX87Instr :: Instr -> SDoc
+   pprX87Instr :: Instr -> Line doc
    pprX87Instr (X87Store fmt dst) = pprFormatAddr (text "gst") fmt dst
    pprX87Instr _ = panic "X86.Ppr.pprX87Instr: no match"
 
-   pprDollImm :: Imm -> SDoc
+   pprDollImm :: Imm -> Line doc
    pprDollImm i = text "$" <> pprImm platform i
 
 
-   pprOperand :: Platform -> Format -> Operand -> SDoc
+   pprOperand :: Platform -> Format -> Operand -> Line doc
    pprOperand platform f op = case op of
       OpReg r   -> pprReg platform f r
       OpImm i   -> pprDollImm i
       OpAddr ea -> pprAddr platform ea
 
 
-   pprMnemonic_  :: SDoc -> SDoc
+   pprMnemonic_  :: Line doc -> Line doc
    pprMnemonic_ name =
       char '\t' <> name <> space
 
 
-   pprMnemonic  :: SDoc -> Format -> SDoc
+   pprMnemonic  :: Line doc -> Format -> Line doc
    pprMnemonic name format =
       char '\t' <> name <> pprFormat format <> space
 
 
-   pprFormatImmOp :: SDoc -> Format -> Imm -> Operand -> SDoc
+   pprFormatImmOp :: Line doc -> Format -> Imm -> Operand -> doc
    pprFormatImmOp name format imm op1
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            char '$',
            pprImm platform imm,
@@ -964,24 +966,24 @@ pprInstr platform i = case i of
        ]
 
 
-   pprFormatOp_ :: SDoc -> Format -> Operand -> SDoc
+   pprFormatOp_ :: Line doc -> Format -> Operand -> doc
    pprFormatOp_ name format op1
-     = hcat [
+     = line $ hcat [
            pprMnemonic_ name ,
            pprOperand platform format op1
        ]
 
-   pprFormatOp :: SDoc -> Format -> Operand -> SDoc
+   pprFormatOp :: Line doc -> Format -> Operand -> doc
    pprFormatOp name format op1
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            pprOperand platform format op1
        ]
 
 
-   pprFormatOpOp :: SDoc -> Format -> Operand -> Operand -> SDoc
+   pprFormatOpOp :: Line doc -> Format -> Operand -> Operand -> doc
    pprFormatOpOp name format op1 op2
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            pprOperand platform format op1,
            comma,
@@ -989,18 +991,18 @@ pprInstr platform i = case i of
        ]
 
 
-   pprOpOp :: SDoc -> Format -> Operand -> Operand -> SDoc
+   pprOpOp :: Line doc -> Format -> Operand -> Operand -> doc
    pprOpOp name format op1 op2
-     = hcat [
+     = line $ hcat [
            pprMnemonic_ name,
            pprOperand platform format op1,
            comma,
            pprOperand platform format op2
        ]
 
-   pprRegReg :: SDoc -> Reg -> Reg -> SDoc
+   pprRegReg :: Line doc -> Reg -> Reg -> doc
    pprRegReg name reg1 reg2
-     = hcat [
+     = line $ hcat [
            pprMnemonic_ name,
            pprReg platform (archWordFormat (target32Bit platform)) reg1,
            comma,
@@ -1008,18 +1010,18 @@ pprInstr platform i = case i of
        ]
 
 
-   pprFormatOpReg :: SDoc -> Format -> Operand -> Reg -> SDoc
+   pprFormatOpReg :: Line doc -> Format -> Operand -> Reg -> doc
    pprFormatOpReg name format op1 reg2
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            pprOperand platform format op1,
            comma,
            pprReg platform (archWordFormat (target32Bit platform)) reg2
        ]
 
-   pprCondOpReg :: SDoc -> Format -> Cond -> Operand -> Reg -> SDoc
+   pprCondOpReg :: Line doc -> Format -> Cond -> Operand -> Reg -> doc
    pprCondOpReg name format cond op1 reg2
-     = hcat [
+     = line $ hcat [
            char '\t',
            name,
            pprCond cond,
@@ -1029,18 +1031,18 @@ pprInstr platform i = case i of
            pprReg platform format reg2
        ]
 
-   pprFormatFormatOpReg :: SDoc -> Format -> Format -> Operand -> Reg -> SDoc
+   pprFormatFormatOpReg :: Line doc -> Format -> Format -> Operand -> Reg -> doc
    pprFormatFormatOpReg name format1 format2 op1 reg2
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format2,
            pprOperand platform format1 op1,
            comma,
            pprReg platform format2 reg2
        ]
 
-   pprFormatOpOpReg :: SDoc -> Format -> Operand -> Operand -> Reg -> SDoc
+   pprFormatOpOpReg :: Line doc -> Format -> Operand -> Operand -> Reg -> doc
    pprFormatOpOpReg name format op1 op2 reg3
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            pprOperand platform format op1,
            comma,
@@ -1051,7 +1053,7 @@ pprInstr platform i = case i of
 
 
 
-   pprFormatAddr :: SDoc -> Format -> AddrMode -> SDoc
+   pprFormatAddr :: Line doc -> Format -> AddrMode -> Line doc
    pprFormatAddr name format  op
      = hcat [
            pprMnemonic name format,
@@ -1059,9 +1061,9 @@ pprInstr platform i = case i of
            pprAddr platform op
        ]
 
-   pprShift :: SDoc -> Format -> Operand -> Operand -> SDoc
+   pprShift :: Line doc -> Format -> Operand -> Operand -> doc
    pprShift name format src dest
-     = hcat [
+     = line $ hcat [
            pprMnemonic name format,
            pprOperand platform II8 src,  -- src is 8-bit sized
            comma,
@@ -1069,15 +1071,15 @@ pprInstr platform i = case i of
        ]
 
 
-   pprFormatOpOpCoerce :: SDoc -> Format -> Format -> Operand -> Operand -> SDoc
+   pprFormatOpOpCoerce :: Line doc -> Format -> Format -> Operand -> Operand -> doc
    pprFormatOpOpCoerce name format1 format2 op1 op2
-     = hcat [ char '\t', name, pprFormat format1, pprFormat format2, space,
+     = line $ hcat [ char '\t', name, pprFormat format1, pprFormat format2, space,
            pprOperand platform format1 op1,
            comma,
            pprOperand platform format2 op2
        ]
 
 
-   pprCondInstr :: SDoc -> Cond -> SDoc -> SDoc
+   pprCondInstr :: Line doc -> Cond -> Line doc -> doc
    pprCondInstr name cond arg
-     = hcat [ char '\t', name, pprCond cond, space, arg]
+     = line $ hcat [ char '\t', name, pprCond cond, space, arg]
diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
index f3fb5c2f0b..dc7dc13637 100644
--- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs
@@ -3276,6 +3276,7 @@ addEvals _scrut con vs = go vs the_strs
         where
           ppr_with_length list
             = ppr list <+> parens (text "length =" <+> ppr (length list))
+          strdisp :: StrictnessMark -> SDoc
           strdisp MarkedStrict = text "MarkedStrict"
           strdisp NotMarkedStrict = text "NotMarkedStrict"
 
diff --git a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
index fa22807358..e9c8c66033 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs
@@ -766,7 +766,7 @@ it's already overloaded.
 
 instance Outputable PmLitValue where
   ppr (PmLitInt i)        = ppr i
-  ppr (PmLitRat r)        = ppr (double (fromRat r)) -- good enough
+  ppr (PmLitRat r)        = double (fromRat r) -- good enough
   ppr (PmLitChar c)       = pprHsChar c
   ppr (PmLitString s)     = pprHsString s
   ppr (PmLitOverInt n i)  = minuses n (ppr i)
diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs
index 605754b0ae..c26cdb0dad 100644
--- a/compiler/GHC/Linker/Types.hs
+++ b/compiler/GHC/Linker/Types.hs
@@ -5,7 +5,7 @@
 -- (c) The University of Glasgow 2019
 --
 -----------------------------------------------------------------------------
-
+{-# LANGUAGE TypeApplications #-}
 module GHC.Linker.Types
    ( Loader (..)
    , LoaderState (..)
@@ -254,7 +254,7 @@ data LibrarySpec
    | Framework String   -- Only used for darwin, but does no harm
 
 instance Outputable LibrarySpec where
-  ppr (Objects objs) = text "Objects" <+> ppr (map text objs)
+  ppr (Objects objs) = text "Objects" <+> ppr (map (text @SDoc) objs)
   ppr (Archive a) = text "Archive" <+> text a
   ppr (DLL s) = text "DLL" <+> text s
   ppr (DLLPath f) = text "DLLPath" <+> text f
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
index 092b727d8d..2031f33d50 100644
--- a/compiler/GHC/Types/CostCentre.hs
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -3,7 +3,9 @@ module GHC.Types.CostCentre (
         CostCentre(..), CcName, CCFlavour(..),
                 -- All abstract except to friend: ParseIface.y
 
+        pprCostCentre,
         CostCentreStack,
+        pprCostCentreStack,
         CollectedCCs, emptyCollectedCCs, collectCC,
         currentCCS, dontCareCCS,
         isCurrentCCS,
@@ -236,10 +238,14 @@ mkSingletonCCS cc = SingletonCCS cc
 -- expression.
 
 instance Outputable CostCentreStack where
-  ppr CurrentCCS        = text "CCCS"
-  ppr DontCareCCS       = text "CCS_DONT_CARE"
-  ppr (SingletonCCS cc) = ppr cc <> text "_ccs"
+  ppr = pprCostCentreStack
 
+pprCostCentreStack :: IsLine doc => CostCentreStack -> doc
+pprCostCentreStack CurrentCCS        = text "CCCS"
+pprCostCentreStack DontCareCCS       = text "CCS_DONT_CARE"
+pprCostCentreStack (SingletonCCS cc) = pprCostCentre cc <> text "_ccs"
+{-# SPECIALISE pprCostCentreStack :: CostCentreStack -> SDoc #-}
+{-# SPECIALISE pprCostCentreStack :: CostCentreStack -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -----------------------------------------------------------------------------
 -- Printing Cost Centres
@@ -256,10 +262,15 @@ instance Outputable CostCentreStack where
 -- by costCentreName.
 
 instance Outputable CostCentre where
-  ppr cc = getPprStyle $ \ sty ->
-           if codeStyle sty
-           then ppCostCentreLbl cc
-           else text (costCentreUserName cc)
+  ppr = pprCostCentre
+
+pprCostCentre :: IsLine doc => CostCentre -> doc
+pprCostCentre cc = docWithContext $ \ sty ->
+  if codeStyle (sdocStyle sty)
+  then ppCostCentreLbl cc
+  else text (costCentreUserName cc)
+{-# SPECIALISE pprCostCentre :: CostCentre -> SDoc #-}
+{-# SPECIALISE pprCostCentre :: CostCentre -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- Printing in Core
 pprCostCentreCore :: CostCentre -> SDoc
@@ -284,26 +295,32 @@ pprIdxCore 0 = empty
 pprIdxCore idx = whenPprDebug $ ppr idx
 
 -- Printing as a C label
-ppCostCentreLbl :: CostCentre -> SDoc
-ppCostCentreLbl (AllCafsCC  {cc_mod = m}) = ppr m <> text "_CAFs_cc"
+ppCostCentreLbl :: IsLine doc => CostCentre -> doc
+ppCostCentreLbl (AllCafsCC  {cc_mod = m}) = pprModule m <> text "_CAFs_cc"
 ppCostCentreLbl (NormalCC {cc_flavour = f, cc_name = n, cc_mod = m})
-  = ppr m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>
+  = pprModule m <> char '_' <> ztext (zEncodeFS n) <> char '_' <>
         ppFlavourLblComponent f <> text "_cc"
+{-# SPECIALISE ppCostCentreLbl :: CostCentre -> SDoc #-}
+{-# SPECIALISE ppCostCentreLbl :: CostCentre -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- ^ Print the flavour component of a C label
-ppFlavourLblComponent :: CCFlavour -> SDoc
+ppFlavourLblComponent :: IsLine doc => CCFlavour -> doc
 ppFlavourLblComponent CafCC = text "CAF"
 ppFlavourLblComponent (ExprCC i) = text "EXPR" <> ppIdxLblComponent i
 ppFlavourLblComponent (DeclCC i) = text "DECL" <> ppIdxLblComponent i
 ppFlavourLblComponent (HpcCC i)  = text "HPC"  <> ppIdxLblComponent i
 ppFlavourLblComponent (LateCC i) = text "LATECC" <> ppIdxLblComponent i
+{-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> SDoc #-}
+{-# SPECIALISE ppFlavourLblComponent :: CCFlavour -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- ^ Print the flavour index component of a C label
-ppIdxLblComponent :: CostCentreIndex -> SDoc
+ppIdxLblComponent :: IsLine doc => CostCentreIndex -> doc
 ppIdxLblComponent n =
   case unCostCentreIndex n of
     0 -> empty
-    n -> ppr n
+    n -> int n
+{-# SPECIALISE ppIdxLblComponent :: CostCentreIndex -> SDoc #-}
+{-# SPECIALISE ppIdxLblComponent :: CostCentreIndex -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- This is the name to go in the user-displayed string,
 -- recorded in the cost centre declaration
diff --git a/compiler/GHC/Types/ForeignStubs.hs b/compiler/GHC/Types/ForeignStubs.hs
index b92bfd9b64..99dfcf61da 100644
--- a/compiler/GHC/Types/ForeignStubs.hs
+++ b/compiler/GHC/Types/ForeignStubs.hs
@@ -1,5 +1,6 @@
 -- | Foreign export stubs
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE TypeApplications #-}
 module GHC.Types.ForeignStubs
    ( ForeignStubs (..)
    , CHeader(..)
@@ -68,10 +69,10 @@ newtype CHeader = CHeader { getCHeader :: SDoc }
 
 instance Monoid CHeader where
   mempty = CHeader empty
-  mconcat = coerce vcat
+  mconcat = coerce (vcat @SDoc)
 
 instance Semigroup CHeader where
-    (<>) = coerce ($$)
+    (<>) = coerce (($$) @SDoc)
 
 -- | Foreign export stubs
 data ForeignStubs
diff --git a/compiler/GHC/Types/Name.hs b/compiler/GHC/Types/Name.hs
index 9f82fd42a8..9ee9ee322c 100644
--- a/compiler/GHC/Types/Name.hs
+++ b/compiler/GHC/Types/Name.hs
@@ -56,6 +56,7 @@ module GHC.Types.Name (
         localiseName,
         namePun_maybe,
 
+        pprName,
         nameSrcLoc, nameSrcSpan, pprNameDefnLoc, pprDefinedAt,
         pprFullName, pprTickyName,
 
@@ -624,12 +625,13 @@ instance OutputableBndr Name where
     pprInfixOcc  = pprInfixName
     pprPrefixOcc = pprPrefixName
 
-pprName :: Name -> SDoc
+pprName :: forall doc. IsLine doc => Name -> doc
 pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
-  = getPprStyle $ \sty ->
-    getPprDebug $ \debug ->
-    sdocOption sdocListTuplePuns $ \listTuplePuns ->
-    handlePuns listTuplePuns (namePun_maybe name) $
+  = docWithContext $ \ctx ->
+    let sty = sdocStyle ctx
+        debug = sdocPprDebug ctx
+        listTuplePuns = sdocListTuplePuns ctx
+    in handlePuns listTuplePuns (namePun_maybe name) $
     case sort of
       WiredIn mod _ builtin   -> pprExternal debug sty uniq mod occ True  builtin
       External mod            -> pprExternal debug sty uniq mod occ False UserSyntax
@@ -637,9 +639,11 @@ pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
       Internal                -> pprInternal debug sty uniq occ
   where
     -- Print GHC.Types.List as [], etc.
-    handlePuns :: Bool -> Maybe FastString -> SDoc -> SDoc
+    handlePuns :: Bool -> Maybe FastString -> doc -> doc
     handlePuns True (Just pun) _ = ftext pun
     handlePuns _    _          r = r
+{-# SPECIALISE pprName :: Name -> SDoc #-}
+{-# SPECIALISE pprName :: Name -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Print fully qualified name (with unit-id, module and unique)
 pprFullName :: Module -> Name -> SDoc
@@ -670,9 +674,9 @@ pprTickyName this_mod name
 pprNameUnqualified :: Name -> SDoc
 pprNameUnqualified Name { n_occ = occ } = ppr_occ_name occ
 
-pprExternal :: Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> SDoc
+pprExternal :: IsLine doc => Bool -> PprStyle -> Unique -> Module -> OccName -> Bool -> BuiltInSyntax -> doc
 pprExternal debug sty uniq mod occ is_wired is_builtin
-  | codeStyle sty = ppr mod <> char '_' <> ppr_z_occ_name occ
+  | codeStyle sty = pprModule mod <> char '_' <> ppr_z_occ_name occ
         -- In code style, always qualify
         -- ToDo: maybe we could print all wired-in things unqualified
         --       in code style, to reduce symbol table bloat?
@@ -685,13 +689,13 @@ pprExternal debug sty uniq mod occ is_wired is_builtin
         if isHoleModule mod
             then case qualName sty mod occ of
                     NameUnqual -> ppr_occ_name occ
-                    _ -> braces (ppr (moduleName mod) <> dot <> ppr_occ_name occ)
+                    _ -> braces (pprModuleName (moduleName mod) <> dot <> ppr_occ_name occ)
             else pprModulePrefix sty mod occ <> ppr_occ_name occ
   where
     pp_mod = ppUnlessOption sdocSuppressModulePrefixes
-               (ppr mod <> dot)
+               (pprModule mod <> dot)
 
-pprInternal :: Bool -> PprStyle -> Unique -> OccName -> SDoc
+pprInternal :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
 pprInternal debug sty uniq occ
   | codeStyle sty  = pprUniqueAlways uniq
   | debug          = ppr_occ_name occ <> braces (hsep [pprNameSpaceBrief (occNameSpace occ),
@@ -702,7 +706,7 @@ pprInternal debug sty uniq occ
   | otherwise      = ppr_occ_name occ   -- User style
 
 -- Like Internal, except that we only omit the unique in Iface style
-pprSystem :: Bool -> PprStyle -> Unique -> OccName -> SDoc
+pprSystem :: IsLine doc => Bool -> PprStyle -> Unique -> OccName -> doc
 pprSystem debug sty uniq occ
   | codeStyle sty  = pprUniqueAlways uniq
   | debug          = ppr_occ_name occ <> ppr_underscore_unique uniq
@@ -713,38 +717,38 @@ pprSystem debug sty uniq occ
                                 -- so print the unique
 
 
-pprModulePrefix :: PprStyle -> Module -> OccName -> SDoc
+pprModulePrefix :: IsLine doc => PprStyle -> Module -> OccName -> doc
 -- Print the "M." part of a name, based on whether it's in scope or not
 -- See Note [Printing original names] in GHC.Types.Name.Ppr
 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
-      NameNotInScope2  -> ppr (moduleUnit mod) <> colon     -- Module not in
-                          <> ppr (moduleName mod) <> dot          -- scope either
+      NameQual modname -> pprModuleName modname <> dot       -- Name is in scope
+      NameNotInScope1  -> pprModule mod <> dot               -- Not in scope
+      NameNotInScope2  -> pprUnit (moduleUnit mod) <> colon           -- Module not in
+                          <> pprModuleName (moduleName mod) <> dot    -- scope either
       NameUnqual       -> empty                   -- In scope unqualified
 
-pprUnique :: Unique -> SDoc
+pprUnique :: IsLine doc => Unique -> doc
 -- Print a unique unless we are suppressing them
 pprUnique uniq
   = ppUnlessOption sdocSuppressUniques $
       pprUniqueAlways uniq
 
-ppr_underscore_unique :: Unique -> SDoc
+ppr_underscore_unique :: IsLine doc => Unique -> doc
 -- Print an underscore separating the name from its unique
 -- But suppress it if we aren't printing the uniques anyway
 ppr_underscore_unique uniq
   = ppUnlessOption sdocSuppressUniques $
       char '_' <> pprUniqueAlways uniq
 
-ppr_occ_name :: OccName -> SDoc
+ppr_occ_name :: IsLine doc => OccName -> doc
 ppr_occ_name occ = ftext (occNameFS occ)
         -- Don't use pprOccName; instead, just print the string of the OccName;
         -- we print the namespace in the debug stuff above
 
 -- In code style, we Z-encode the strings.  The results of Z-encoding each FastString are
 -- cached behind the scenes in the FastString implementation.
-ppr_z_occ_name :: OccName -> SDoc
+ppr_z_occ_name :: IsLine doc => OccName -> doc
 ppr_z_occ_name occ = ztext (zEncodeFS (occNameFS occ))
 
 -- Prints (if mod information is available) "Defined at <loc>" or
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index 947982b53d..92691f3f2f 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -200,7 +200,7 @@ pprNonVarNameSpace :: NameSpace -> SDoc
 pprNonVarNameSpace VarName = empty
 pprNonVarNameSpace ns = pprNameSpace ns
 
-pprNameSpaceBrief :: NameSpace -> SDoc
+pprNameSpaceBrief :: IsLine doc => NameSpace -> doc
 pprNameSpaceBrief DataName  = char 'd'
 pprNameSpaceBrief VarName   = char 'v'
 pprNameSpaceBrief TvName    = text "tv"
@@ -276,10 +276,10 @@ instance OutputableBndr OccName where
     pprInfixOcc n = pprInfixVar (isSymOcc n) (ppr n)
     pprPrefixOcc n = pprPrefixVar (isSymOcc n) (ppr n)
 
-pprOccName :: OccName -> SDoc
+pprOccName :: IsLine doc => OccName -> doc
 pprOccName (OccName sp occ)
-  = getPprStyle $ \ sty ->
-    if codeStyle sty
+  = docWithContext $ \ sty ->
+    if codeStyle (sdocStyle sty)
     then ztext (zEncodeFS occ)
     else ftext occ <> whenPprDebug (braces (pprNameSpaceBrief sp))
 
diff --git a/compiler/GHC/Types/Unique.hs b/compiler/GHC/Types/Unique.hs
index 60d1c452e2..c17d080f6f 100644
--- a/compiler/GHC/Types/Unique.hs
+++ b/compiler/GHC/Types/Unique.hs
@@ -281,13 +281,15 @@ showUnique uniq
   = case unpkUnique uniq of
       (tag, u) -> tag : iToBase62 u
 
-pprUniqueAlways :: Unique -> SDoc
+pprUniqueAlways :: IsLine doc => Unique -> doc
 -- The "always" means regardless of -dsuppress-uniques
 -- It replaces the old pprUnique to remind callers that
 -- they should consider whether they want to consult
 -- Opt_SuppressUniques
 pprUniqueAlways u
   = text (showUnique u)
+{-# SPECIALIZE pprUniqueAlways :: Unique -> SDoc #-}
+{-# SPECIALIZE pprUniqueAlways :: Unique -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 instance Outputable Unique where
     ppr = pprUniqueAlways
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index c0d314baa0..573801434d 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -50,6 +50,7 @@ module GHC.Unit.Types
    , stableUnitCmp
    , unitIsDefinite
    , isHoleUnit
+   , pprUnit
 
      -- * Unit Ids
    , unitIdString
@@ -162,19 +163,24 @@ instance Outputable InstantiatedModule where
   ppr = pprInstantiatedModule
 
 instance Outputable InstantiatedUnit where
-    ppr uid =
+  ppr = pprInstantiatedUnit
+
+pprInstantiatedUnit :: IsLine doc => InstantiatedUnit -> doc
+pprInstantiatedUnit uid =
       -- getPprStyle $ \sty ->
-      ppr cid <>
+      pprUnitId cid <>
         (if not (null insts) -- pprIf
           then
             brackets (hcat
                 (punctuate comma $
-                    [ ppr modname <> text "=" <> pprModule m
+                    [ pprModuleName modname <> text "=" <> pprModule m
                     | (modname, m) <- insts]))
           else empty)
      where
       cid   = instUnitInstanceOf uid
       insts = instUnitInsts uid
+{-# SPECIALIZE pprInstantiatedUnit :: InstantiatedUnit -> SDoc #-}
+{-# SPECIALIZE pprInstantiatedUnit :: InstantiatedUnit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | Class for types that are used as unit identifiers (UnitKey, UnitId, Unit)
 --
@@ -195,8 +201,8 @@ instance IsUnitId u => IsUnitId (GenUnit u) where
    unitFS (RealUnit (Definite x)) = unitFS x
    unitFS HoleUnit                = holeFS
 
-pprModule :: Module -> SDoc
-pprModule mod@(Module p n)  = getPprStyle doc
+pprModule :: IsLine doc => Module -> doc
+pprModule mod@(Module p n) = docWithContext (doc . sdocStyle)
  where
   doc sty
     | codeStyle sty =
@@ -207,10 +213,11 @@ pprModule mod@(Module p n)  = getPprStyle doc
     | qualModule sty mod =
         case p of
           HoleUnit -> angleBrackets (pprModuleName n)
-          _        -> ppr p <> char ':' <> pprModuleName n
+          _        -> pprUnit p <> char ':' <> pprModuleName n
     | otherwise =
         pprModuleName n
-
+{-# SPECIALIZE pprModule :: Module -> SDoc #-}
+{-# SPECIALIZE pprModule :: Module -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 pprInstantiatedModule :: InstantiatedModule -> SDoc
 pprInstantiatedModule (Module uid m) =
@@ -344,10 +351,12 @@ stableUnitCmp p1 p2 = unitFS p1 `lexicalCompareFS` unitFS p2
 instance Outputable Unit where
    ppr pk = pprUnit pk
 
-pprUnit :: Unit -> SDoc
-pprUnit (RealUnit uid) = ppr uid
-pprUnit (VirtUnit uid) = ppr uid
+pprUnit :: IsLine doc => Unit -> doc
+pprUnit (RealUnit (Definite d)) = pprUnitId d
+pprUnit (VirtUnit uid) = pprInstantiatedUnit uid
 pprUnit HoleUnit       = ftext holeFS
+{-# SPECIALIZE pprUnit :: Unit -> SDoc #-}
+{-# SPECIALIZE pprUnit :: Unit -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 instance Show Unit where
     show = unitString
@@ -523,8 +532,14 @@ instance Uniquable UnitId where
     getUnique = getUnique . unitIdFS
 
 instance Outputable UnitId where
-    ppr (UnitId fs) = sdocOption sdocUnitIdForUser ($ fs) -- see Note [Pretty-printing UnitId]
-                                                          -- in "GHC.Unit"
+    ppr = pprUnitId
+
+pprUnitId :: IsLine doc => UnitId -> doc
+pprUnitId (UnitId fs) = dualLine (sdocOption sdocUnitIdForUser ($ fs)) (ftext fs)
+                        -- see Note [Pretty-printing UnitId] in GHC.Unit
+                        -- also see Note [dualLine and dualDoc] in GHC.Utils.Outputable
+{-# SPECIALIZE pprUnitId :: UnitId -> SDoc #-}
+{-# SPECIALIZE pprUnitId :: UnitId -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
 
 -- | A 'DefUnitId' is an 'UnitId' with the invariant that
 -- it only refers to a definite library; i.e., one we have generated
diff --git a/compiler/GHC/Utils/Asm.hs b/compiler/GHC/Utils/Asm.hs
index 2841ad3efa..237e482661 100644
--- a/compiler/GHC/Utils/Asm.hs
+++ b/compiler/GHC/Utils/Asm.hs
@@ -12,9 +12,10 @@ import GHC.Platform
 import GHC.Utils.Outputable
 
 -- | Generate a section type (e.g. @\@progbits@). See #13937.
-sectionType :: Platform -- ^ Target platform
+sectionType :: IsLine doc
+            => Platform -- ^ Target platform
             -> String   -- ^ section type
-            -> SDoc     -- ^ pretty assembler fragment
+            -> doc      -- ^ pretty assembler fragment
 sectionType platform ty =
     case platformArch platform of
       ArchARM{} -> char '%' <> text ty
diff --git a/compiler/GHC/Utils/BufHandle.hs b/compiler/GHC/Utils/BufHandle.hs
index aed15610cb..7fbca1932a 100644
--- a/compiler/GHC/Utils/BufHandle.hs
+++ b/compiler/GHC/Utils/BufHandle.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
 
 -----------------------------------------------------------------------------
 --
@@ -37,6 +38,10 @@ import Foreign
 import Foreign.C.String
 import System.IO
 
+-- for RULES
+import GHC.Exts (unpackCString#, unpackNBytes#, Int(..))
+import GHC.Ptr (Ptr(..))
+
 -- -----------------------------------------------------------------------------
 
 data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)
@@ -62,6 +67,22 @@ bPutChar b@(BufHandle buf r hdl) !c = do
         else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)
                 writeFastMutInt r (i+1)
 
+-- Equivalent of the text/str, text/unpackNBytes#, text/[] rules
+-- in GHC.Utils.Ppr.
+{-# RULES "hdoc/str"
+    forall a h. bPutStr h (unpackCString# a) = bPutPtrString h (mkPtrString# a)
+  #-}
+{-# RULES "hdoc/unpackNBytes#"
+    forall p n h. bPutStr h (unpackNBytes# p n) = bPutPtrString h (PtrString (Ptr p) (I# n))
+  #-}
+{-# RULES "hdoc/[]#"
+    forall h. bPutStr h [] = return ()
+  #-}
+
+{-# NOINLINE [0] bPutStr #-}  -- Give the RULE a chance to fire
+                              -- It must wait till after phase 1 when
+                              -- the unpackCString first is manifested
+
 bPutStr :: BufHandle -> String -> IO ()
 bPutStr (BufHandle buf r hdl) !str = do
   i <- readFastMutInt r
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index 1c6126d208..d23582897d 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -5,6 +5,8 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE FlexibleContexts #-}
 
 {-
 (c) The University of Glasgow 2006-2012
@@ -21,15 +23,17 @@ module GHC.Utils.Outputable (
         -- * Type classes
         Outputable(..), OutputableBndr(..), OutputableP(..),
 
+        IsOutput(..), IsLine(..), IsDoc(..),
+        HLine, HDoc,
+
         -- * Pretty printing combinators
         SDoc, runSDoc, PDoc(..),
         docToSDoc,
         interppSP, interpp'SP, interpp'SP',
         pprQuotedList, pprWithCommas, quotedListWithOr, quotedListWithNor,
         pprWithBars,
-        empty, isEmpty, nest,
-        char,
-        text, ftext, ptext, ztext,
+        isEmpty, nest,
+        ptext,
         int, intWithCommas, integer, word, float, double, rational, doublePrec,
         parens, cparen, brackets, braces, quotes, quote,
         doubleQuotes, angleBrackets,
@@ -38,10 +42,8 @@ module GHC.Utils.Outputable (
         lambda,
         lparen, rparen, lbrack, rbrack, lbrace, rbrace, underscore,
         blankLine, forAllLit, bullet,
-        (<>), (<+>), hcat, hsep,
-        ($$), ($+$), vcat,
-        sep, cat,
-        fsep, fcat,
+        ($+$),
+        cat, fcat,
         hang, hangNotEmpty, punctuate, ppWhen, ppUnless,
         ppWhenOption, ppUnlessOption,
         speakNth, speakN, speakNOf, plural, singular,
@@ -104,6 +106,8 @@ module GHC.Utils.Outputable (
 
         ifPprDebug, whenPprDebug, getPprDebug,
 
+        bPutHDoc
+
     ) where
 
 import Language.Haskell.Syntax.Module.Name ( ModuleName(..) )
@@ -113,7 +117,7 @@ import GHC.Prelude
 import {-# SOURCE #-}   GHC.Unit.Types ( Unit, Module, moduleName )
 import {-# SOURCE #-}   GHC.Types.Name.Occurrence( OccName )
 
-import GHC.Utils.BufHandle (BufHandle)
+import GHC.Utils.BufHandle (BufHandle, bPutChar, bPutStr, bPutFS, bPutFZS)
 import GHC.Data.FastString
 import qualified GHC.Utils.Ppr as Pretty
 import qualified GHC.Utils.Ppr.Colour as Col
@@ -561,17 +565,17 @@ userStyle (PprUser {}) = True
 userStyle _other       = False
 
 -- | Indicate if -dppr-debug mode is enabled
-getPprDebug :: (Bool -> SDoc) -> SDoc
+getPprDebug :: IsOutput doc => (Bool -> doc) -> doc
 {-# INLINE CONLIKE getPprDebug #-}
-getPprDebug d = sdocWithContext $ \ctx -> d (sdocPprDebug ctx)
+getPprDebug d = docWithContext $ \ctx -> d (sdocPprDebug ctx)
 
 -- | Says what to do with and without -dppr-debug
-ifPprDebug :: SDoc -> SDoc -> SDoc
+ifPprDebug :: IsOutput doc => doc -> doc -> doc
 {-# INLINE CONLIKE ifPprDebug #-}
 ifPprDebug yes no = getPprDebug $ \dbg -> if dbg then yes else no
 
 -- | Says what to do with -dppr-debug; without, return empty
-whenPprDebug :: SDoc -> SDoc        -- Empty for non-debug style
+whenPprDebug :: IsOutput doc => doc -> doc        -- Empty for non-debug style
 {-# INLINE CONLIKE whenPprDebug #-}
 whenPprDebug d = ifPprDebug d empty
 
@@ -638,43 +642,26 @@ isEmpty ctx sdoc = Pretty.isEmpty $ runSDoc sdoc (ctx {sdocPprDebug = True})
 docToSDoc :: Doc -> SDoc
 docToSDoc d = SDoc (\_ -> d)
 
-empty    :: SDoc
-char     :: Char       -> SDoc
-text     :: String     -> SDoc
-ftext    :: FastString -> SDoc
-ptext    :: PtrString  -> SDoc
-ztext    :: FastZString -> SDoc
-int      :: Int        -> SDoc
-integer  :: Integer    -> SDoc
-word     :: Integer    -> SDoc
-float    :: Float      -> SDoc
-double   :: Double     -> SDoc
-rational :: Rational   -> SDoc
-
-{-# INLINE CONLIKE empty #-}
-empty       = docToSDoc $ Pretty.empty
-{-# INLINE CONLIKE char #-}
-char c      = docToSDoc $ Pretty.char c
-
-{-# INLINE CONLIKE text #-}   -- Inline so that the RULE Pretty.text will fire
-text s      = docToSDoc $ Pretty.text s
-
-{-# INLINE CONLIKE ftext #-}
-ftext s     = docToSDoc $ Pretty.ftext s
+ptext    ::               PtrString  -> SDoc
+int      :: IsLine doc => Int        -> doc
+integer  :: IsLine doc => Integer    -> doc
+word     ::               Integer    -> SDoc
+float    :: IsLine doc => Float      -> doc
+double   :: IsLine doc => Double     -> doc
+rational ::               Rational   -> SDoc
+
 {-# INLINE CONLIKE ptext #-}
 ptext s     = docToSDoc $ Pretty.ptext s
-{-# INLINE CONLIKE ztext #-}
-ztext s     = docToSDoc $ Pretty.ztext s
 {-# INLINE CONLIKE int #-}
-int n       = docToSDoc $ Pretty.int n
+int n       = text $ show n
 {-# INLINE CONLIKE integer #-}
-integer n   = docToSDoc $ Pretty.integer n
+integer n   = text $ show n
 {-# INLINE CONLIKE float #-}
-float n     = docToSDoc $ Pretty.float n
+float n     = text $ show n
 {-# INLINE CONLIKE double #-}
-double n    = docToSDoc $ Pretty.double n
+double n    = text $ show n
 {-# INLINE CONLIKE rational #-}
-rational n  = docToSDoc $ Pretty.rational n
+rational n  = text $ show n
               -- See Note [Print Hexadecimal Literals] in GHC.Utils.Ppr
 {-# INLINE CONLIKE word #-}
 word n      = sdocOption sdocHexWordLiterals $ \case
@@ -686,19 +673,19 @@ word n      = sdocOption sdocHexWordLiterals $ \case
 doublePrec :: Int -> Double -> SDoc
 doublePrec p n = text (showFFloat (Just p) n "")
 
-parens, braces, brackets, quotes, quote,
-        doubleQuotes, angleBrackets :: SDoc -> SDoc
+quotes, quote :: SDoc -> SDoc
+parens, brackets, braces, doubleQuotes, angleBrackets :: IsLine doc => doc -> doc
 
 {-# INLINE CONLIKE parens #-}
-parens d        = SDoc $ Pretty.parens . runSDoc d
+parens d        = char '(' <> d <> char ')'
 {-# INLINE CONLIKE braces #-}
-braces d        = SDoc $ Pretty.braces . runSDoc d
+braces d        = char '{' <> d <> char '}'
 {-# INLINE CONLIKE brackets #-}
-brackets d      = SDoc $ Pretty.brackets . runSDoc d
+brackets d      = char '[' <> d <> char ']'
 {-# INLINE CONLIKE quote #-}
 quote d         = SDoc $ Pretty.quote . runSDoc d
 {-# INLINE CONLIKE doubleQuotes #-}
-doubleQuotes d  = SDoc $ Pretty.doubleQuotes . runSDoc d
+doubleQuotes d  = char '"' <> d <> char '"'
 {-# INLINE CONLIKE angleBrackets #-}
 angleBrackets d = char '<' <> d <> char '>'
 
@@ -720,35 +707,37 @@ quotes d = sdocOption sdocCanUseUnicode $ \case
          _ | Just '\'' <- lastMaybe str -> pp_d
            | otherwise        -> Pretty.quotes pp_d
 
-semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc
-arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt, larrowtt, lambda :: SDoc
-lparen, rparen, lbrack, rbrack, lbrace, rbrace, blankLine :: SDoc
+blankLine, dcolon, arrow, lollipop, larrow, darrow, arrowt, larrowt, arrowtt,
+  larrowtt, lambda :: SDoc
 
 blankLine  = docToSDoc Pretty.emptyText
-dcolon     = unicodeSyntax (char '∷') (docToSDoc $ Pretty.text "::")
-arrow      = unicodeSyntax (char '→') (docToSDoc $ Pretty.text "->")
-lollipop   = unicodeSyntax (char '⊸') (docToSDoc $ Pretty.text "%1 ->")
-larrow     = unicodeSyntax (char '←') (docToSDoc $ Pretty.text "<-")
-darrow     = unicodeSyntax (char '⇒') (docToSDoc $ Pretty.text "=>")
-arrowt     = unicodeSyntax (char '⤚') (docToSDoc $ Pretty.text ">-")
-larrowt    = unicodeSyntax (char '⤙') (docToSDoc $ Pretty.text "-<")
-arrowtt    = unicodeSyntax (char '⤜') (docToSDoc $ Pretty.text ">>-")
-larrowtt   = unicodeSyntax (char '⤛') (docToSDoc $ Pretty.text "-<<")
+dcolon     = unicodeSyntax (char '∷') (text "::")
+arrow      = unicodeSyntax (char '→') (text "->")
+lollipop   = unicodeSyntax (char '⊸') (text "%1 ->")
+larrow     = unicodeSyntax (char '←') (text "<-")
+darrow     = unicodeSyntax (char '⇒') (text "=>")
+arrowt     = unicodeSyntax (char '⤚') (text ">-")
+larrowt    = unicodeSyntax (char '⤙') (text "-<")
+arrowtt    = unicodeSyntax (char '⤜') (text ">>-")
+larrowtt   = unicodeSyntax (char '⤛') (text "-<<")
 lambda     = unicodeSyntax (char 'λ') (char '\\')
-semi       = docToSDoc $ Pretty.semi
-comma      = docToSDoc $ Pretty.comma
-colon      = docToSDoc $ Pretty.colon
-equals     = docToSDoc $ Pretty.equals
-space      = docToSDoc $ Pretty.space
+
+semi, comma, colon, equals, space, underscore, dot, vbar :: IsLine doc => doc
+lparen, rparen, lbrack, rbrack, lbrace, rbrace :: IsLine doc => doc
+semi       = char ';'
+comma      = char ','
+colon      = char ':'
+equals     = char '='
+space      = char ' '
 underscore = char '_'
 dot        = char '.'
 vbar       = char '|'
-lparen     = docToSDoc $ Pretty.lparen
-rparen     = docToSDoc $ Pretty.rparen
-lbrack     = docToSDoc $ Pretty.lbrack
-rbrack     = docToSDoc $ Pretty.rbrack
-lbrace     = docToSDoc $ Pretty.lbrace
-rbrace     = docToSDoc $ Pretty.rbrace
+lparen     = char '('
+rparen     = char ')'
+lbrack     = char '['
+rbrack     = char ']'
+lbrace     = char '{'
+rbrace     = char '}'
 
 forAllLit :: SDoc
 forAllLit = unicodeSyntax (char '∀') (text "forall")
@@ -771,38 +760,15 @@ unicode unicode plain = sdocOption sdocCanUseUnicode $ \case
 
 nest :: Int -> SDoc -> SDoc
 -- ^ Indent 'SDoc' some specified amount
-(<>) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together horizontally without a gap
-(<+>) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together horizontally with a gap between them
-($$) :: SDoc -> SDoc -> SDoc
--- ^ Join two 'SDoc' together vertically; if there is
--- no vertical overlap it "dovetails" the two onto one line
 ($+$) :: SDoc -> SDoc -> SDoc
 -- ^ Join two 'SDoc' together vertically
 
 {-# INLINE CONLIKE nest #-}
 nest n d    = SDoc $ Pretty.nest n . runSDoc d
-{-# INLINE CONLIKE (<>) #-}
-(<>) d1 d2  = SDoc $ \ctx -> (Pretty.<>)  (runSDoc d1 ctx) (runSDoc d2 ctx)
-{-# INLINE CONLIKE (<+>) #-}
-(<+>) d1 d2 = SDoc $ \ctx -> (Pretty.<+>) (runSDoc d1 ctx) (runSDoc d2 ctx)
-{-# INLINE CONLIKE ($$) #-}
-($$) d1 d2  = SDoc $ \ctx -> (Pretty.$$)  (runSDoc d1 ctx) (runSDoc d2 ctx)
 {-# INLINE CONLIKE ($+$) #-}
 ($+$) d1 d2 = SDoc $ \ctx -> (Pretty.$+$) (runSDoc d1 ctx) (runSDoc d2 ctx)
 
-hcat :: [SDoc] -> SDoc
--- ^ Concatenate 'SDoc' horizontally
-hsep :: [SDoc] -> SDoc
--- ^ Concatenate 'SDoc' horizontally with a space between each one
-vcat :: [SDoc] -> SDoc
--- ^ Concatenate 'SDoc' vertically with dovetailing
-sep :: [SDoc] -> SDoc
--- ^ Separate: is either like 'hsep' or like 'vcat', depending on what fits
 cat :: [SDoc] -> SDoc
--- ^ Concatenate: is either like 'hcat' or like 'vcat', depending on what fits
-fsep :: [SDoc] -> SDoc
 -- ^ A paragraph-fill combinator. It's much like sep, only it
 -- keeps fitting things on one line until it can't fit any more.
 fcat :: [SDoc] -> SDoc
@@ -812,18 +778,8 @@ fcat :: [SDoc] -> SDoc
 -- Inline all those wrappers to help ensure we create lists of Doc, not of SDoc
 -- later applied to the same SDocContext. It helps the worker/wrapper
 -- transformation extracting only the required fields from the SDocContext.
-{-# INLINE CONLIKE hcat #-}
-hcat ds = SDoc $ \ctx -> Pretty.hcat [runSDoc d ctx | d <- ds]
-{-# INLINE CONLIKE hsep #-}
-hsep ds = SDoc $ \ctx -> Pretty.hsep [runSDoc d ctx | d <- ds]
-{-# INLINE CONLIKE vcat #-}
-vcat ds = SDoc $ \ctx -> Pretty.vcat [runSDoc d ctx | d <- ds]
-{-# INLINE CONLIKE sep #-}
-sep ds  = SDoc $ \ctx -> Pretty.sep  [runSDoc d ctx | d <- ds]
 {-# INLINE CONLIKE cat #-}
 cat ds  = SDoc $ \ctx -> Pretty.cat  [runSDoc d ctx | d <- ds]
-{-# INLINE CONLIKE fsep #-}
-fsep ds = SDoc $ \ctx -> Pretty.fsep [runSDoc d ctx | d <- ds]
 {-# INLINE CONLIKE fcat #-}
 fcat ds = SDoc $ \ctx -> Pretty.fcat [runSDoc d ctx | d <- ds]
 
@@ -841,16 +797,17 @@ hangNotEmpty :: SDoc -> Int -> SDoc -> SDoc
 hangNotEmpty d1 n d2 =
     SDoc $ \ctx -> Pretty.hangNotEmpty (runSDoc d1 ctx) n (runSDoc d2 ctx)
 
-punctuate :: SDoc   -- ^ The punctuation
-          -> [SDoc] -- ^ The list that will have punctuation added between every adjacent pair of elements
-          -> [SDoc] -- ^ Punctuated list
+punctuate :: IsLine doc
+          => doc   -- ^ The punctuation
+          -> [doc] -- ^ The list that will have punctuation added between every adjacent pair of elements
+          -> [doc] -- ^ Punctuated list
 punctuate _ []     = []
 punctuate p (d:ds) = go d ds
                    where
                      go d [] = [d]
                      go d (e:es) = (d <> p) : go e es
 
-ppWhen, ppUnless :: Bool -> SDoc -> SDoc
+ppWhen, ppUnless :: IsOutput doc => Bool -> doc -> doc
 {-# INLINE CONLIKE ppWhen #-}
 ppWhen True  doc = doc
 ppWhen False _   = empty
@@ -866,10 +823,9 @@ ppWhenOption f doc = sdocOption f $ \case
    False -> empty
 
 {-# INLINE CONLIKE ppUnlessOption #-}
-ppUnlessOption :: (SDocContext -> Bool) -> SDoc -> SDoc
-ppUnlessOption f doc = sdocOption f $ \case
-   True  -> empty
-   False -> doc
+ppUnlessOption :: IsLine doc => (SDocContext -> Bool) -> doc -> doc
+ppUnlessOption f doc = docWithContext $
+                          \ctx -> if f ctx then empty else doc
 
 -- | Apply the given colour\/style for the argument.
 --
@@ -1041,12 +997,14 @@ instance Outputable Extension where
 instance Outputable ModuleName where
   ppr = pprModuleName
 
-pprModuleName :: ModuleName -> SDoc
+pprModuleName :: IsLine doc => ModuleName -> doc
 pprModuleName (ModuleName nm) =
-    getPprStyle $ \ sty ->
-    if codeStyle sty
+    docWithContext $ \ctx ->
+    if codeStyle (sdocStyle ctx)
         then ztext (zEncodeFS nm)
         else ftext nm
+{-# SPECIALIZE pprModuleName :: ModuleName -> SDoc #-}
+{-# SPECIALIZE pprModuleName :: ModuleName -> HLine #-} -- see Note [SPECIALIZE to HDoc]
 
 -----------------------------------------------------------------------
 -- The @OutputableP@ class
@@ -1314,12 +1272,14 @@ pprFastFilePath path = text $ normalise $ unpackFS path
 -- | Normalise, escape and render a string representing a path
 --
 -- e.g. "c:\\whatever"
-pprFilePathString :: FilePath -> SDoc
+pprFilePathString :: IsLine doc => FilePath -> doc
 pprFilePathString path = doubleQuotes $ text (escape (normalise path))
    where
       escape []        = []
       escape ('\\':xs) = '\\':'\\':escape xs
       escape (x:xs)    = x:escape xs
+{-# SPECIALIZE pprFilePathString :: FilePath -> SDoc #-}
+{-# SPECIALIZE pprFilePathString :: FilePath -> HLine #-} -- see Note [SPECIALIZE to HDoc]
 
 {-
 ************************************************************************
@@ -1498,3 +1458,352 @@ thisOrThese _   = text "These"
 hasOrHave :: [a] -> SDoc
 hasOrHave [_] = text "has"
 hasOrHave _   = text "have"
+
+{- Note [SDoc versus HDoc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+The SDoc type is used pervasively throughout the compiler to represent pretty-
+printable output. Almost all text written by GHC, from the Haskell types and
+expressions included in error messages to debug dumps, is assembled using SDoc.
+SDoc is nice because it handles multiline layout in a semi-automatic fashion,
+enabling printed expressions to wrap to fit a given line width while correctly
+indenting the following lines to preserve alignment.
+
+SDoc’s niceties necessarily have some performance cost, but this is normally
+okay, as printing output is rarely a performance bottleneck. However, one
+notable exception to this is code generation: GHC must sometimes write
+megabytes’ worth of generated assembly when compiling a single module, in which
+case the overhead of SDoc has a significant cost (see #21853 for some numbers).
+Moreover, generated assembly does not have the complex layout requirements of
+pretty-printed Haskell code, so using SDoc does not buy us much, anyway.
+
+Nevertheless, we do still want to be able to share some logic between writing
+assembly and pretty-printing. For example, the logic for printing basic block
+labels (GHC.Cmm.CLabel.pprCLabel) is nontrivial, so we want to have a single
+implementation that can be used both when generating code and when generating
+Cmm dumps. This is where HDoc comes in: HDoc provides a subset of the SDoc
+interface, but it is implemented in a far more efficient way, writing directly
+to a `Handle` (via a `BufHandle`) without building any intermediate structures.
+We can then use typeclasses to parameterize functions like `pprCLabel` over the
+printing implementation.
+
+One might imagine this would result in one IsDoc typeclass, and two instances,
+one for SDoc and one for HDoc. However, in fact, we need two *variants* of HDoc,
+as described in Note [HLine versus HDoc], and this gives rise to a small
+typeclass hierarchy consisting of IsOutput, IsLine, and IsDoc;
+see Note [The outputable class hierarchy] for details.
+
+Note [HLine versus HDoc]
+~~~~~~~~~~~~~~~~~~~~~~~~
+As described in Note [SDoc versus HDoc], HDoc does not support any of the layout
+niceties of SDoc for efficiency. However, this presents a small problem if we
+want to be compatible with the SDoc API, as expressions like
+
+    text "foo" <+> (text "bar" $$ text "baz")
+
+are expected to produce
+
+    foo bar
+        baz
+
+which requires tracking line widths to know how far to indent the second line.
+We can’t throw out vertical composition altogether, as we need to be able to
+construct multiline HDocs, but we *can* restrict vertical composition to
+concatenating whole lines at a time, as this is all that is necessary to
+generate assembly in the code generator.
+
+To implement this restriction, we provide two distinct types: HLine and HDoc.
+As their names suggests, an HLine represents a single line of output, while an
+HDoc represents a multiline document. Atoms formed from `char` and `text` begin
+their lives as HLines, which can be horizontally (but not vertically) composed:
+
+    char :: Char -> HLine
+    text :: String -> HLine
+    (<+>) :: HLine -> HLine -> HLine
+
+Once a line has been fully assembled, it can be “locked up” into a single-line
+HDoc via `line`, and HDocs can be vertically (but not horizontally) composed:
+
+    line :: HLine -> HDoc
+    ($$) :: HLine -> HLine -> HLine
+
+Note that, at runtime, HLine and HDoc use exactly the same representation. This
+distinction only exists in the type system to rule out the cases we don’t want
+to have to handle.
+
+Note [The outputable class hierarchy]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+As described in Note [SDoc versus HDoc], we want to be able to parameterize over
+the choice of printing implementation when implementing common bits of printing
+logic. However, as described in Note [HLine versus HDoc], we also want to
+distinguish code that does single-line printing from code that does multi-line
+printing. Therefore, code that is parameterized over the choice of printer must
+respect this single- versus multi-line distinction. This naturally leads to two
+typeclasses:
+
+    class IsLine doc where
+      char :: Char -> doc
+      text :: String -> doc
+      (<>) :: doc -> doc -> doc
+      ...
+
+    class IsLine (Line doc) => IsDoc doc where
+      type Line doc = r | r -> doc
+      line :: Line doc -> doc
+      ($$) :: doc -> doc -> doc
+      ...
+
+These classes support the following instances:
+
+    instance IsLine SDoc
+    instance IsLine SDoc where
+      type Line SDoc = SDoc
+
+    instance IsLine HLine
+    instance IsDoc HDoc where
+      type Line HDoc = HLine
+
+However, we run into a new problem: we provide many useful combinators on docs
+that don’t care at all about the single-/multi-line distinction. For example,
+ppWhen and ppUnless provide conditional logic, and docWithContext provides
+access to the ambient SDocContext. Given the above classes, we would need two
+variants of each of these combinators:
+
+    ppWhenL :: IsLine doc => Bool -> doc -> doc
+    ppWhenL c d = if c then d else emptyL
+
+    ppWhenD :: IsDoc  doc => Bool -> doc -> doc
+    ppWhenD c d = if c then d else emptyD
+
+This is a needlessly annoying distinction, so we introduce a common superclass,
+IsOutput, that allows these combinators to be generic over both variants:
+
+    class IsOutput doc => IsLine doc where
+      empty :: doc
+      docWithContext :: (SDocContext -> doc) -> doc
+
+    class IsOutput doc => IsLine doc
+    class (IsOutput doc, IsLine (Line doc)) => IsDoc doc
+
+In practice, IsOutput isn’t used explicitly very often, but it makes code that
+uses the combinators derived from it significantly less noisy.
+
+Note [SPECIALIZE to HDoc]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+The IsLine and IsDoc classes are useful to share printing logic between code
+that uses SDoc and code that uses HDoc, but we must take some care when doing
+so. Much HDoc’s efficiency comes from GHC’s ability to optimize code that uses
+it to eliminate unnecessary indirection, but the HDoc primitives must be inlined
+before these opportunities can be exposed. Therefore, we want to explicitly
+request that GHC generate HDoc (or HLine) specializations of any polymorphic
+printing functions used by the code generator.
+
+In code generators (CmmToAsm.{AArch64,PPC,X86}.Ppr) we add a specialize
+pragma just to the entry point pprNatCmmDecl, to avoid cluttering
+the entire module. Because specialization is transitive, this makes sure
+that other functions in that module are specialized too.
+
+Note [dualLine and dualDoc]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The IsLine and IsDoc classes provide the dualLine and dualDoc methods,
+respectively, which have the following types:
+
+    dualLine :: IsLine doc => SDoc -> HLine -> doc
+    dualDoc  :: IsDoc  doc => SDoc -> HDoc  -> doc
+
+These are effectively a form of type-`case`, selecting between each of their two
+arguments depending on the type they are instantiated at. They serve as a
+“nuclear option” for code that is, for some reason or another, unreasonably
+difficult to make completely equivalent under both printer implementations.
+
+These operations should generally be avoided, as they can result in surprising
+changes in behavior when the printer implementation is changed. However, in
+certain cases, the alternative is even worse. For example, we use dualLine in
+the implementation of pprUnitId, as the hack we use for printing unit ids
+(see Note [Pretty-printing UnitId] in GHC.Unit) is difficult to adapt to HLine
+and is not necessary for code paths that use it, anyway.
+
+Use these operations wisely. -}
+
+-- | Represents a single line of output that can be efficiently printed directly
+-- to a 'System.IO.Handle' (actually a 'BufHandle').
+-- See Note [SDoc versus HDoc] and Note [HLine versus HDoc] for more details.
+newtype HLine = HLine' { runHLine :: SDocContext -> BufHandle -> IO () }
+
+-- | Represents a (possibly empty) sequence of lines that can be efficiently
+-- printed directly to a 'System.IO.Handle' (actually a 'BufHandle').
+-- See Note [SDoc versus HDoc] and Note [HLine versus HDoc] for more details.
+newtype HDoc = HDoc' { runHDoc :: SDocContext -> BufHandle -> IO () }
+
+-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
+pattern HLine :: (SDocContext -> BufHandle -> IO ()) -> HLine
+pattern HLine f <- HLine' f
+  where HLine f = HLine' (oneShot (\ctx -> oneShot (\h -> f ctx h)))
+{-# COMPLETE HLine #-}
+
+-- See Note [The one-shot state monad trick] in GHC.Utils.Monad
+pattern HDoc :: (SDocContext -> BufHandle -> IO ()) -> HDoc
+pattern HDoc f <- HDoc' f
+  where HDoc f = HDoc' (oneShot (\ctx -> oneShot (\h -> f ctx h)))
+{-# COMPLETE HDoc #-}
+
+bPutHDoc :: BufHandle -> SDocContext -> HDoc -> IO ()
+bPutHDoc h ctx (HDoc f) = f ctx h
+
+-- | A superclass for 'IsLine' and 'IsDoc' that provides an identity, 'empty',
+-- as well as access to the shared 'SDocContext'.
+--
+-- See Note [The outputable class hierarchy] for more details.
+class IsOutput doc where
+  empty :: doc
+  docWithContext :: (SDocContext -> doc) -> doc
+
+-- | A class of types that represent a single logical line of text, with support
+-- for horizontal composition.
+--
+-- See Note [HLine versus HDoc] and Note [The outputable class hierarchy] for
+-- more details.
+class IsOutput doc => IsLine doc where
+  char :: Char -> doc
+  text :: String -> doc
+  ftext :: FastString -> doc
+  ztext :: FastZString -> doc
+
+  -- | Join two @doc@s together horizontally without a gap.
+  (<>) :: doc -> doc -> doc
+  -- | Join two @doc@s together horizontally with a gap between them.
+  (<+>) :: doc -> doc -> doc
+  -- | Separate: is either like 'hsep' or like 'vcat', depending on what fits.
+  sep :: [doc] -> doc
+  -- | A paragraph-fill combinator. It's much like 'sep', only it keeps fitting
+  -- things on one line until it can't fit any more.
+  fsep :: [doc] -> doc
+
+  -- | Concatenate @doc@s horizontally without gaps.
+  hcat :: [doc] -> doc
+  hcat docs = foldr (<>) empty docs
+  {-# INLINE CONLIKE hcat #-}
+
+  -- | Concatenate @doc@s horizontally with a space between each one.
+  hsep :: [doc] -> doc
+  hsep docs = foldr (<+>) empty docs
+  {-# INLINE CONLIKE hsep #-}
+
+  -- | Prints as either the given 'SDoc' or the given 'HLine', depending on
+  -- which type the result is instantiated to. This should generally be avoided;
+  -- see Note [dualLine and dualDoc] for details.
+  dualLine :: SDoc -> HLine -> doc
+
+
+-- | A class of types that represent a multiline document, with support for
+-- vertical composition.
+--
+-- See Note [HLine versus HDoc] and Note [The outputable class hierarchy] for
+-- more details.
+class (IsOutput doc, IsLine (Line doc)) => IsDoc doc where
+  type Line doc = r | r -> doc
+  line :: Line doc -> doc
+
+  -- | Join two @doc@s together vertically. If there is no vertical overlap it
+  -- "dovetails" the two onto one line.
+  ($$) :: doc -> doc -> doc
+
+  lines_ :: [Line doc] -> doc
+  lines_ = vcat . map line
+  {-# INLINE CONLIKE lines_ #-}
+
+  -- | Concatenate @doc@s vertically with dovetailing.
+  vcat :: [doc] -> doc
+  vcat ls = foldr ($$) empty ls
+  {-# INLINE CONLIKE vcat #-}
+
+  -- | Prints as either the given 'SDoc' or the given 'HDoc', depending on
+  -- which type the result is instantiated to. This should generally be avoided;
+  -- see Note [dualLine and dualDoc] for details.
+  dualDoc :: SDoc -> HDoc -> doc
+
+instance IsOutput SDoc where
+  empty       = docToSDoc $ Pretty.empty
+  {-# INLINE CONLIKE empty #-}
+  docWithContext = sdocWithContext
+  {-# INLINE docWithContext #-}
+
+instance IsLine SDoc where
+  char c = docToSDoc $ Pretty.char c
+  {-# INLINE CONLIKE char #-}
+  text s = docToSDoc $ Pretty.text s
+  {-# INLINE CONLIKE text #-}   -- Inline so that the RULE Pretty.text will fire
+  ftext s = docToSDoc $ Pretty.ftext s
+  {-# INLINE CONLIKE ftext #-}
+  ztext s = docToSDoc $ Pretty.ztext s
+  {-# INLINE CONLIKE ztext #-}
+  (<>) d1 d2 = SDoc $ \ctx -> (Pretty.<>)  (runSDoc d1 ctx) (runSDoc d2 ctx)
+  {-# INLINE CONLIKE (<>) #-}
+  (<+>) d1 d2 = SDoc $ \ctx -> (Pretty.<+>) (runSDoc d1 ctx) (runSDoc d2 ctx)
+  {-# INLINE CONLIKE (<+>) #-}
+  hcat ds = SDoc $ \ctx -> Pretty.hcat [runSDoc d ctx | d <- ds]
+  {-# INLINE CONLIKE hcat #-}
+  hsep ds = SDoc $ \ctx -> Pretty.hsep [runSDoc d ctx | d <- ds]
+  {-# INLINE CONLIKE hsep #-}
+  sep ds  = SDoc $ \ctx -> Pretty.sep  [runSDoc d ctx | d <- ds]
+  {-# INLINE CONLIKE sep #-}
+  fsep ds = SDoc $ \ctx -> Pretty.fsep [runSDoc d ctx | d <- ds]
+  {-# INLINE CONLIKE fsep #-}
+  dualLine s _ = s
+  {-# INLINE CONLIKE dualLine #-}
+
+instance IsDoc SDoc where
+  type Line SDoc = SDoc
+  line = id
+  {-# INLINE line #-}
+  lines_ = vcat
+  {-# INLINE lines_ #-}
+
+  ($$) d1 d2  = SDoc $ \ctx -> (Pretty.$$)  (runSDoc d1 ctx) (runSDoc d2 ctx)
+  {-# INLINE CONLIKE ($$) #-}
+  vcat ds = SDoc $ \ctx -> Pretty.vcat [runSDoc d ctx | d <- ds]
+  {-# INLINE CONLIKE vcat #-}
+  dualDoc s _ = s
+  {-# INLINE CONLIKE dualDoc #-}
+
+instance IsOutput HLine where
+  empty = HLine (\_ _ -> pure ())
+  {-# INLINE empty #-}
+  docWithContext f = HLine $ \ctx h -> runHLine (f ctx) ctx h
+  {-# INLINE CONLIKE docWithContext #-}
+
+instance IsOutput HDoc where
+  empty = HDoc (\_ _ -> pure ())
+  {-# INLINE empty #-}
+  docWithContext f = HDoc $ \ctx h -> runHDoc (f ctx) ctx h
+  {-# INLINE CONLIKE docWithContext #-}
+
+instance IsLine HLine where
+  char c = HLine (\_ h -> bPutChar h c)
+  {-# INLINE CONLIKE char #-}
+  text str = HLine (\_ h -> bPutStr h str)
+  {-# INLINE CONLIKE text #-}
+  ftext fstr = HLine (\_ h -> bPutFS h fstr)
+  {-# INLINE CONLIKE ftext #-}
+  ztext fstr = HLine (\_ h -> bPutFZS h fstr)
+  {-# INLINE CONLIKE ztext #-}
+
+  HLine f <> HLine g = HLine (\ctx h -> f ctx h *> g ctx h)
+  {-# INLINE CONLIKE (<>) #-}
+  f <+> g = f <> char ' ' <> g
+  {-# INLINE CONLIKE (<+>) #-}
+  sep = hsep
+  {-# INLINE sep #-}
+  fsep = hsep
+  {-# INLINE fsep #-}
+
+  dualLine _ h = h
+  {-# INLINE CONLIKE dualLine #-}
+
+instance IsDoc HDoc where
+  type Line HDoc = HLine
+  line (HLine f) = HDoc (\ctx h -> f ctx h *> bPutChar h '\n')
+  {-# INLINE CONLIKE line #-}
+  HDoc f $$ HDoc g = HDoc (\ctx h -> f ctx h *> g ctx h)
+  {-# INLINE CONLIKE ($$) #-}
+  dualDoc _ h = h
+  {-# INLINE CONLIKE dualDoc #-}
diff --git a/testsuite/tests/hiefile/should_run/TestUtils.hs b/testsuite/tests/hiefile/should_run/TestUtils.hs
index ec5d75e73f..5ba0a3dc58 100644
--- a/testsuite/tests/hiefile/should_run/TestUtils.hs
+++ b/testsuite/tests/hiefile/should_run/TestUtils.hs
@@ -2,6 +2,7 @@ module TestUtils
   ( readTestHie
   , render
   , text
+  , SDoc
   , DynFlags
   , module GHC.Iface.Ext.Types
   , module GHC.Iface.Ext.Utils
@@ -13,7 +14,8 @@ import GHC.Types.Name.Cache
 import GHC.Types.SrcLoc
 import GHC.Types.Unique.Supply
 import GHC.Types.Name
-import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
+import GHC.Utils.Outputable                 ( Outputable, renderWithContext, ppr, defaultUserStyle, SDoc )
+import qualified GHC.Utils.Outputable as O
 import GHC.Iface.Ext.Binary
 import GHC.Iface.Ext.Types
 import GHC.Iface.Ext.Utils
@@ -39,3 +41,6 @@ readTestHie fp = do
 
 render :: Outputable a => DynFlags -> a -> String
 render df = renderWithContext (initSDocContext df defaultUserStyle) . ppr
+
+text :: String -> SDoc
+text = O.text -- SDoc-only version