Introduce OutputableP

Some types need a Platform value to be pretty-printed: CLabel, Cmm
types, instructions, etc.

Before this patch they had an Outputable instance and the Platform value
was obtained via sdocWithDynFlags. It meant that the *renderer* of the
SDoc was responsible of passing the appropriate Platform value (e.g. via
the DynFlags given to showSDoc).  It put the burden of passing the
Platform value on the renderer while the generator of the SDoc knows the
Platform it is generating the SDoc for and there is no point passing a
different Platform at rendering time.

With this patch, we introduce a new OutputableP class:

   class OutputableP a where
      pdoc :: Platform -> a -> SDoc

With this class we still have some polymorphism as we have with `ppr`
(i.e. we can use `pdoc` on a variety of types instead of having a
dedicated `pprXXX` function for each XXX type).

One step closer removing `sdocWithDynFlags` (#10143) and supporting
several platforms (#14335).

12 files changed, 232 insertions, 222 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index c8f39b80ef..924991794f 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -1210,8 +1210,8 @@ The info table label and the local block label are both local labels
 and are not externally visible.
 -}
 
-instance Outputable CLabel where
-  ppr lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) (targetPlatform dflags) lbl)
+instance OutputableP CLabel where
+  pdoc platform lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) platform lbl)
 
 pprCLabel :: Backend -> Platform -> CLabel -> SDoc
 pprCLabel bcknd platform lbl =
diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs
index a63cc63ed8..e01f301627 100644
--- a/compiler/GHC/Cmm/Dataflow/Label.hs
+++ b/compiler/GHC/Cmm/Dataflow/Label.hs
@@ -43,6 +43,9 @@ instance Uniquable Label where
 instance Outputable Label where
   ppr label = ppr (getUnique label)
 
+instance OutputableP Label where
+  pdoc _ l = ppr l
+
 -----------------------------------------------------------------------------
 -- LabelSet
 
@@ -128,6 +131,9 @@ instance Outputable LabelSet where
 instance Outputable a => Outputable (LabelMap a) where
   ppr = ppr . mapToList
 
+instance OutputableP a => OutputableP (LabelMap a) where
+  pdoc platform = pdoc platform . mapToList
+
 instance TrieMap LabelMap where
   type Key LabelMap = Label
   emptyTM = mapEmpty
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 2d8ec5f2b3..927003b16f 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -72,19 +72,20 @@ data DebugBlock =
   , dblBlocks     :: ![DebugBlock] -- ^ Nested blocks
   }
 
-instance Outputable DebugBlock where
-  ppr blk = (if | dblProcedure blk == dblLabel blk
+instance OutputableP DebugBlock where
+  pdoc platform blk =
+            (if | dblProcedure blk == dblLabel blk
                 -> text "proc"
                 | dblHasInfoTbl blk
                 -> text "pp-blk"
                 | otherwise
                 -> text "blk") <+>
-            ppr (dblLabel blk) <+> parens (ppr (dblCLabel blk)) <+>
+            ppr (dblLabel blk) <+> parens (pdoc platform (dblCLabel blk)) <+>
             (maybe empty ppr (dblSourceTick blk)) <+>
             (maybe (text "removed") ((text "pos " <>) . ppr)
                    (dblPosition blk)) <+>
-            (ppr (dblUnwind blk)) $+$
-            (if null (dblBlocks blk) then empty else nest 4 (ppr (dblBlocks blk)))
+            (pdoc platform (dblUnwind blk)) $+$
+            (if null (dblBlocks blk) then empty else nest 4 (pdoc platform (dblBlocks blk)))
 
 -- | Intermediate data structure holding debug-relevant context information
 -- about a block.
@@ -489,12 +490,12 @@ LOC this information will end up in is Y.
 -- | A label associated with an 'UnwindTable'
 data UnwindPoint = UnwindPoint !CLabel !UnwindTable
 
-instance Outputable UnwindPoint where
-  ppr (UnwindPoint lbl uws) =
-      braces $ ppr lbl<>colon
+instance OutputableP UnwindPoint where
+  pdoc platform (UnwindPoint lbl uws) =
+      braces $ pdoc platform lbl <> colon
       <+> hsep (punctuate comma $ map pprUw $ Map.toList uws)
     where
-      pprUw (g, expr) = ppr g <> char '=' <> ppr expr
+      pprUw (g, expr) = ppr g <> char '=' <> pdoc platform expr
 
 -- | Maps registers to expressions that yield their "old" values
 -- further up the stack. Most interesting for the stack pointer @Sp@,
@@ -513,19 +514,19 @@ data UnwindExpr = UwConst !Int                  -- ^ literal value
                 | UwTimes UnwindExpr UnwindExpr
                 deriving (Eq)
 
-instance Outputable UnwindExpr where
-  pprPrec _ (UwConst i)     = ppr i
-  pprPrec _ (UwReg g 0)     = ppr g
-  pprPrec p (UwReg g x)     = pprPrec p (UwPlus (UwReg g 0) (UwConst x))
-  pprPrec _ (UwDeref e)     = char '*' <> pprPrec 3 e
-  pprPrec _ (UwLabel l)     = pprPrec 3 l
-  pprPrec p (UwPlus e0 e1)  | p <= 0
-                            = pprPrec 0 e0 <> char '+' <> pprPrec 0 e1
-  pprPrec p (UwMinus e0 e1) | p <= 0
-                            = pprPrec 1 e0 <> char '-' <> pprPrec 1 e1
-  pprPrec p (UwTimes e0 e1) | p <= 1
-                            = pprPrec 2 e0 <> char '*' <> pprPrec 2 e1
-  pprPrec _ other           = parens (pprPrec 0 other)
+instance OutputableP UnwindExpr where
+  pdocPrec _ _        (UwConst i)     = ppr i
+  pdocPrec _ _        (UwReg g 0)     = ppr g
+  pdocPrec p platform (UwReg g x)     = pdocPrec p platform (UwPlus (UwReg g 0) (UwConst x))
+  pdocPrec _ platform (UwDeref e)     = char '*' <> pdocPrec 3 platform e
+  pdocPrec _ platform (UwLabel l)     = pdocPrec 3 platform l
+  pdocPrec p platform (UwPlus e0 e1)  | p <= 0
+                                      = pdocPrec 0 platform e0 <> char '+' <> pdocPrec 0 platform e1
+  pdocPrec p platform (UwMinus e0 e1) | p <= 0
+                                      = pdocPrec 1 platform e0 <> char '-' <> pdocPrec 1 platform e1
+  pdocPrec p platform (UwTimes e0 e1) | p <= 1
+                                      = pdocPrec 2 platform e0 <> char '*' <> pdocPrec 2 platform e1
+  pdocPrec _ platform other           = parens (pdocPrec 0 platform other)
 
 -- | Conversion of Cmm expressions to unwind expressions. We check for
 -- unsupported operator usages and simplify the expression as far as
@@ -549,5 +550,5 @@ toUnwindExpr platform e@(CmmMachOp op [e1, e2])   =
     (MO_Mul{}, u1,        u2       ) -> UwTimes u1 u2
     _otherwise -> pprPanic "Unsupported operator in unwind expression!"
                            (pprExpr platform e)
-toUnwindExpr _ e
-  = pprPanic "Unsupported unwind expression!" (ppr e)
+toUnwindExpr platform e
+  = pprPanic "Unsupported unwind expression!" (pdoc platform e)
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index efb5f80802..0497f18937 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE GADTs, BangPatterns, RecordWildCards,
     GeneralizedNewtypeDeriving, NondecreasingIndentation, TupleSections,
-    ScopedTypeVariables, OverloadedStrings #-}
+    ScopedTypeVariables, OverloadedStrings, LambdaCase #-}
 
 module GHC.Cmm.Info.Build
   ( CAFSet, CAFEnv, cafAnal, cafAnalData
@@ -455,7 +455,7 @@ non-CAFFY.
 -- map them to SRTEntry later, which ranges over labels that do exist.
 --
 newtype CAFLabel = CAFLabel CLabel
-  deriving (Eq,Ord,Outputable)
+  deriving (Eq,Ord,OutputableP)
 
 type CAFSet = Set CAFLabel
 type CAFEnv = LabelMap CAFSet
@@ -466,7 +466,7 @@ mkCAFLabel platform lbl = CAFLabel (toClosureLbl platform lbl)
 -- This is a label that we can put in an SRT.  It *must* be a closure label,
 -- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
 newtype SRTEntry = SRTEntry CLabel
-  deriving (Eq, Ord, Outputable)
+  deriving (Eq, Ord, OutputableP)
 
 -- ---------------------------------------------------------------------
 -- CAF analysis
@@ -571,12 +571,12 @@ cafTransfers platform contLbls entry topLbl
             _ ->
               set
     in
-      srtTrace "cafTransfers" (text "block:" <+> ppr block $$
-                                text "contLbls:" <+> ppr contLbls $$
-                                text "entry:" <+> ppr entry $$
-                                text "topLbl:" <+> ppr topLbl $$
-                                text "cafs in exit:" <+> ppr joined $$
-                                text "result:" <+> ppr result) $
+      srtTrace "cafTransfers" (text "block:"         <+> pdoc platform block $$
+                                text "contLbls:"     <+> ppr contLbls $$
+                                text "entry:"        <+> ppr entry $$
+                                text "topLbl:"       <+> pdoc platform topLbl $$
+                                text "cafs in exit:" <+> pdoc platform joined $$
+                                text "result:"       <+> pdoc platform result) $
         mapSingleton (entryLabel eNode) result
 
 
@@ -597,12 +597,12 @@ data ModuleSRTInfo = ModuleSRTInfo
   , moduleSRTMap :: SRTMap
   }
 
-instance Outputable ModuleSRTInfo where
-  ppr ModuleSRTInfo{..} =
+instance OutputableP ModuleSRTInfo where
+  pdoc platform ModuleSRTInfo{..} =
     text "ModuleSRTInfo {" $$
-      (nest 4 $ text "dedupSRTs =" <+> ppr dedupSRTs $$
-                text "flatSRTs =" <+> ppr flatSRTs $$
-                text "moduleSRTMap =" <+> ppr moduleSRTMap) $$ char '}'
+      (nest 4 $ text "dedupSRTs ="    <+> pdoc platform dedupSRTs $$
+                text "flatSRTs ="     <+> pdoc platform flatSRTs $$
+                text "moduleSRTMap =" <+> pdoc platform moduleSRTMap) $$ char '}'
 
 emptySRT :: Module -> ModuleSRTInfo
 emptySRT mod =
@@ -635,9 +635,10 @@ data SomeLabel
   | DeclLabel CLabel
   deriving (Eq, Ord)
 
-instance Outputable SomeLabel where
-  ppr (BlockLabel l) = text "b:" <+> ppr l
-  ppr (DeclLabel l) = text "s:" <+> ppr l
+instance OutputableP SomeLabel where
+   pdoc platform = \case
+      BlockLabel l -> text "b:" <+> pdoc platform l
+      DeclLabel l  -> text "s:" <+> pdoc platform l
 
 getBlockLabel :: SomeLabel -> Maybe Label
 getBlockLabel (BlockLabel l) = Just l
@@ -672,9 +673,9 @@ depAnalSRTs
   -> [CmmDecl]
   -> [SCC (SomeLabel, CAFLabel, Set CAFLabel)]
 depAnalSRTs platform cafEnv cafEnv_static decls =
-  srtTrace "depAnalSRTs" (text "decls:" <+> ppr decls $$
-                           text "nodes:" <+> ppr (map node_payload nodes) $$
-                           text "graph:" <+> ppr graph) graph
+  srtTrace "depAnalSRTs" (text "decls:"  <+> pdoc platform decls $$
+                           text "nodes:" <+> pdoc platform (map node_payload nodes) $$
+                           text "graph:" <+> pdoc platform graph) graph
  where
   labelledBlocks :: [(SomeLabel, CAFLabel)]
   labelledBlocks = concatMap (getLabelledBlocks platform) decls
@@ -749,7 +750,7 @@ srtMapNonCAFs srtMap =
 -- | resolve a CAFLabel to its SRTEntry using the SRTMap
 resolveCAF :: Platform -> SRTMap -> CAFLabel -> Maybe SRTEntry
 resolveCAF platform srtMap lbl@(CAFLabel l) =
-    srtTrace "resolveCAF" ("l:" <+> ppr l <+> "resolved:" <+> ppr ret) ret
+    srtTrace "resolveCAF" ("l:" <+> pdoc platform l <+> "resolved:" <+> pdoc platform ret) ret
   where
     ret = Map.findWithDefault (Just (SRTEntry (toClosureLbl platform l))) lbl srtMap
 
@@ -777,7 +778,7 @@ doSRTs dflags moduleSRTInfo procs data_ = do
         \(set, decl) ->
           case decl of
             CmmProc{} ->
-              pprPanic "doSRTs" (text "Proc in static data list:" <+> ppr decl)
+              pprPanic "doSRTs" (text "Proc in static data list:" <+> pdoc platform decl)
             CmmData _ static ->
               case static of
                 CmmStatics lbl _ _ _ -> (lbl, set)
@@ -806,11 +807,11 @@ doSRTs dflags moduleSRTInfo procs data_ = do
     cafsWithSRTs :: [(Label, CAFLabel, Set CAFLabel)]
     cafsWithSRTs = getCAFs platform cafEnv decls
 
-  srtTraceM "doSRTs" (text "data:" <+> ppr data_ $$
-                      text "procs:" <+> ppr procs $$
-                      text "static_data_env:" <+> ppr static_data_env $$
-                      text "sccs:" <+> ppr sccs $$
-                      text "cafsWithSRTs:" <+> ppr cafsWithSRTs)
+  srtTraceM "doSRTs" (text "data:"            <+> pdoc platform data_ $$
+                      text "procs:"           <+> pdoc platform procs $$
+                      text "static_data_env:" <+> pdoc platform static_data_env $$
+                      text "sccs:"            <+> pdoc platform sccs $$
+                      text "cafsWithSRTs:"    <+> pdoc platform cafsWithSRTs)
 
   -- On each strongly-connected group of decls, construct the SRT
   -- closures and the SRT fields for info tables.
@@ -860,7 +861,7 @@ doSRTs dflags moduleSRTInfo procs data_ = do
                           -- Not an IdLabel, ignore
                           srtMap
                     CmmProc{} ->
-                      pprPanic "doSRTs" (text "Found Proc in static data list:" <+> ppr decl))
+                      pprPanic "doSRTs" (text "Found Proc in static data list:" <+> pdoc platform decl))
                (moduleSRTMap moduleSRTInfo') data_
 
   return (moduleSRTInfo'{ moduleSRTMap = srtMap_w_raws }, srt_decls ++ decls')
@@ -966,18 +967,18 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
     filtered0 = Set.fromList resolved `Set.difference` allBelow
 
   srtTraceM "oneSRT:"
-     (text "srtMap:" <+> ppr srtMap $$
-      text "nonRec:" <+> ppr nonRec $$
-      text "lbls:" <+> ppr lbls $$
-      text "caf_lbls:" <+> ppr caf_lbls $$
-      text "static_data:" <+> ppr static_data $$
-      text "cafs:" <+> ppr cafs $$
-      text "blockids:" <+> ppr blockids $$
-      text "maybeFunClosure:" <+> ppr maybeFunClosure $$
-      text "otherFunLabels:" <+> ppr otherFunLabels $$
-      text "resolved:" <+> ppr resolved $$
-      text "allBelow:" <+> ppr allBelow $$
-      text "filtered0:" <+> ppr filtered0)
+     (text "srtMap:"          <+> pdoc platform srtMap $$
+      text "nonRec:"          <+> pdoc platform nonRec $$
+      text "lbls:"            <+> pdoc platform lbls $$
+      text "caf_lbls:"        <+> pdoc platform caf_lbls $$
+      text "static_data:"     <+> pdoc platform static_data $$
+      text "cafs:"            <+> pdoc platform cafs $$
+      text "blockids:"        <+> ppr blockids $$
+      text "maybeFunClosure:" <+> pdoc platform maybeFunClosure $$
+      text "otherFunLabels:"  <+> pdoc platform otherFunLabels $$
+      text "resolved:"        <+> pdoc platform resolved $$
+      text "allBelow:"        <+> pdoc platform allBelow $$
+      text "filtered0:"       <+> pdoc platform filtered0)
 
   let
     isStaticFun = isJust maybeFunClosure
@@ -989,7 +990,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
     updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
     updateSRTMap srtEntry =
       srtTrace "updateSRTMap"
-        (ppr srtEntry <+> "isCAF:" <+> ppr isCAF <+>
+        (pdoc platform srtEntry <+> "isCAF:" <+> ppr isCAF <+>
          "isStaticFun:" <+> ppr isStaticFun) $
       when (not isCAF && (not isStaticFun || isNothing srtEntry)) $
         modify' $ \state ->
@@ -1012,7 +1013,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
       all (\(CAFLabel clbl) -> Set.member clbl static_data) caf_lbls
 
   if Set.null filtered0 then do
-    srtTraceM "oneSRT: empty" (ppr caf_lbls)
+    srtTraceM "oneSRT: empty" (pdoc platform caf_lbls)
     updateSRTMap Nothing
     return ([], [], [], False)
   else do
@@ -1021,8 +1022,8 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
     let allBelow_funs =
           Set.fromList (map (SRTEntry . toClosureLbl platform) otherFunLabels)
     let filtered = filtered0 `Set.union` allBelow_funs
-    srtTraceM "oneSRT" (text "filtered:" <+> ppr filtered $$
-                        text "allBelow_funs:" <+> ppr allBelow_funs)
+    srtTraceM "oneSRT" (text "filtered:"      <+> pdoc platform filtered $$
+                        text "allBelow_funs:" <+> pdoc platform allBelow_funs)
     case Set.toList filtered of
       [] -> pprPanic "oneSRT" empty -- unreachable
 
@@ -1054,8 +1055,8 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
                   [ (b, if b == staticFunBlock then lbl else staticFunLbl)
                   | b <- blockids ]
             Nothing -> do
-              srtTraceM "oneSRT: one" (text "caf_lbls:" <+> ppr caf_lbls $$
-                                       text "one:" <+> ppr one)
+              srtTraceM "oneSRT: one" (text "caf_lbls:" <+> pdoc platform caf_lbls $$
+                                       text "one:"      <+> pdoc platform one)
               updateSRTMap (Just one)
               return ([], map (,lbl) blockids, [], True)
 
@@ -1067,7 +1068,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
         -- Implements the [Common] optimisation.
         case Map.lookup filtered (dedupSRTs topSRT) of
           Just srtEntry@(SRTEntry srtLbl)  -> do
-            srtTraceM "oneSRT [Common]" (ppr caf_lbls <+> ppr srtLbl)
+            srtTraceM "oneSRT [Common]" (pdoc platform caf_lbls <+> pdoc platform srtLbl)
             updateSRTMap (Just srtEntry)
             return ([], map (,srtLbl) blockids, [], True)
           Nothing -> do
@@ -1087,11 +1088,11 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
                 newDedupSRTs = Map.insert filtered srtEntry (dedupSRTs topSRT)
             modify' (\state -> state{ dedupSRTs = newDedupSRTs,
                                       flatSRTs = newFlatSRTs })
-            srtTraceM "oneSRT: new" (text "caf_lbls:" <+> ppr caf_lbls $$
-                                      text "filtered:" <+> ppr filtered $$
-                                      text "srtEntry:" <+> ppr srtEntry $$
-                                      text "newDedupSRTs:" <+> ppr newDedupSRTs $$
-                                      text "newFlatSRTs:" <+> ppr newFlatSRTs)
+            srtTraceM "oneSRT: new" (text "caf_lbls:"      <+> pdoc platform caf_lbls $$
+                                      text "filtered:"     <+> pdoc platform filtered $$
+                                      text "srtEntry:"     <+> pdoc platform srtEntry $$
+                                      text "newDedupSRTs:" <+> pdoc platform newDedupSRTs $$
+                                      text "newFlatSRTs:"  <+> pdoc platform newFlatSRTs)
             let SRTEntry lbl = srtEntry
             return (decls, map (,lbl) blockids, funSRTs, True)
 
@@ -1179,7 +1180,7 @@ updInfoSRTs profile srt_env funSRTEnv caffy (CmmProc top_info top_l live g)
               -- if we don't add SRT entries to this closure, then we
               -- want to set the srt field in its info table as usual
               (info_tbl { cit_srt = mapLookup (g_entry g) srt_env }, [])
-            Just srtEntries -> srtTrace "maybeStaticFun" (ppr res)
+            Just srtEntries -> srtTrace "maybeStaticFun" (pdoc (profilePlatform profile) res)
               (info_tbl { cit_rep = new_rep }, res)
               where res = [ CmmLabel lbl | SRTEntry lbl <- srtEntries ]
           fields = mkStaticClosureFields profile info_tbl ccs caf_info srtEntries
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index 19358d350d..5b393de902 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -1023,7 +1023,7 @@ setInfoTableStackMap platform stackmaps (CmmProc top_info@TopInfo{..} l v g)
     get_liveness :: BlockId -> Liveness
     get_liveness lbl
       = case mapLookup lbl stackmaps of
-          Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl <+> ppr info_tbls)
+          Nothing -> pprPanic "setInfoTableStackMap" (ppr lbl <+> pdoc platform info_tbls)
           Just sm -> stackMapToLiveness platform sm
 
 setInfoTableStackMap _ _ d = d
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs
index 2eccf50d0e..da9ff30d85 100644
--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -37,25 +37,27 @@ import Control.Monad (ap, unless)
 -- -----------------------------------------------------------------------------
 -- Exported entry points:
 
-cmmLint :: (Outputable d, Outputable h)
+cmmLint :: (OutputableP d, OutputableP h)
         => Platform -> GenCmmGroup d h CmmGraph -> Maybe SDoc
 cmmLint platform tops = runCmmLint platform (mapM_ lintCmmDecl) tops
 
 cmmLintGraph :: Platform -> CmmGraph -> Maybe SDoc
 cmmLintGraph platform g = runCmmLint platform lintCmmGraph g
 
-runCmmLint :: Outputable a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
+runCmmLint :: OutputableP a => Platform -> (a -> CmmLint b) -> a -> Maybe SDoc
 runCmmLint platform l p =
    case unCL (l p) platform of
      Left err -> Just (vcat [text "Cmm lint error:",
                              nest 2 err,
                              text "Program was:",
-                             nest 2 (ppr p)])
+                             nest 2 (pdoc platform p)])
      Right _  -> Nothing
 
 lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint ()
 lintCmmDecl (CmmProc _ lbl _ g)
-  = addLintInfo (text "in proc " <> ppr lbl) $ lintCmmGraph g
+  = do
+    platform <- getPlatform
+    addLintInfo (text "in proc " <> pdoc platform lbl) $ lintCmmGraph g
 lintCmmDecl (CmmData {})
   = return ()
 
@@ -188,7 +190,7 @@ lintCmmLast labels node = case node of
             if (erep `cmmEqType_ignoring_ptrhood` bWord platform)
               then return ()
               else cmmLintErr (text "switch scrutinee is not a word: " <>
-                               ppr e <> text " :: " <> ppr erep)
+                               pdoc platform e <> text " :: " <> ppr erep)
 
   CmmCall { cml_target = target, cml_cont = cont } -> do
           _ <- lintCmmExpr target
@@ -222,21 +224,21 @@ lintTarget (PrimTarget {})     = return ()
 -- | As noted in Note [Register parameter passing], the arguments and
 -- 'ForeignTarget' of a foreign call mustn't mention
 -- caller-saved registers.
-mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, Outputable a)
+mayNotMentionCallerSavedRegs :: (UserOfRegs GlobalReg a, OutputableP a)
                              => SDoc -> a -> CmmLint ()
 mayNotMentionCallerSavedRegs what thing = do
     platform <- getPlatform
     let badRegs = filter (callerSaves platform)
                   $ foldRegsUsed platform (flip (:)) [] thing
     unless (null badRegs)
-      $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ ppr thing)
+      $ cmmLintErr (what <+> text "mentions caller-saved registers: " <> ppr badRegs $$ pdoc platform thing)
 
 checkCond :: Platform -> CmmExpr -> CmmLint ()
 checkCond _ (CmmMachOp mop _) | isComparisonMachOp mop = return ()
 checkCond platform (CmmLit (CmmInt x t)) | x == 0 || x == 1, t == wordWidth platform = return () -- constant values
-checkCond _ expr
+checkCond platform expr
     = cmmLintErr (hang (text "expression is not a conditional:") 2
-                         (ppr expr))
+                         (pdoc platform expr))
 
 -- -----------------------------------------------------------------------------
 -- CmmLint monad
@@ -270,15 +272,19 @@ addLintInfo info thing = CmmLint $ \platform ->
 
 cmmLintMachOpErr :: CmmExpr -> [CmmType] -> [Width] -> CmmLint a
 cmmLintMachOpErr expr argsRep opExpectsRep
-     = cmmLintErr (text "in MachOp application: " $$
-                   nest 2 (ppr  expr) $$
+     = do
+       platform <- getPlatform
+       cmmLintErr (text "in MachOp application: " $$
+                   nest 2 (pdoc platform expr) $$
                       (text "op is expecting: " <+> ppr opExpectsRep) $$
                       (text "arguments provide: " <+> ppr argsRep))
 
 cmmLintAssignErr :: CmmNode e x -> CmmType -> CmmType -> CmmLint a
 cmmLintAssignErr stmt e_ty r_ty
-  = cmmLintErr (text "in assignment: " $$
-                nest 2 (vcat [ppr stmt,
+  = do
+    platform <- getPlatform
+    cmmLintErr (text "in assignment: " $$
+                nest 2 (vcat [pdoc platform stmt,
                               text "Reg ty:" <+> ppr r_ty,
                               text "Rhs ty:" <+> ppr e_ty]))
 
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index b2c107d429..3771a0e82c 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -442,8 +442,9 @@ cmmproc :: { CmmParse () }
                        getCodeScoped $ loopDecls $ do {
                          (entry_ret_label, info, stk_formals) <- $1;
                          dflags <- getDynFlags;
+                         platform <- getPlatform;
                          formals <- sequence (fromMaybe [] $3);
-                         withName (showSDoc dflags (ppr entry_ret_label))
+                         withName (showSDoc dflags (pdoc platform entry_ret_label))
                            $4;
                          return (entry_ret_label, info, stk_formals, formals) }
                      let do_layout = isJust $3
@@ -996,8 +997,8 @@ machOps = listToUFM $
         ( "i2f64",    flip MO_SF_Conv W64 )
         ]
 
-callishMachOps :: UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
-callishMachOps = listToUFM $
+callishMachOps :: Platform -> UniqFM FastString ([CmmExpr] -> (CallishMachOp, [CmmExpr]))
+callishMachOps platform = listToUFM $
         map (\(x, y) -> (mkFastString x, y)) [
         ( "read_barrier", (MO_ReadBarrier,)),
         ( "write_barrier", (MO_WriteBarrier,)),
@@ -1049,7 +1050,7 @@ callishMachOps = listToUFM $
         args' = init args
         align = case last args of
           CmmLit (CmmInt alignInteger _) -> fromInteger alignInteger
-          e -> pgmErrorDoc "Non-constant alignment in memcpy-like function:" (ppr e)
+          e -> pgmErrorDoc "Non-constant alignment in memcpy-like function:" (pdoc platform e)
         -- The alignment of memcpy-ish operations must be a
         -- compile-time constant. We verify this here, passing it around
         -- in the MO_* constructor. In order to do this, however, we
@@ -1166,7 +1167,7 @@ reserveStackFrame psize preg body = do
   let size = case constantFoldExpr platform esize of
                CmmLit (CmmInt n _) -> n
                _other -> pprPanic "CmmParse: not a compile-time integer: "
-                            (ppr esize)
+                            (pdoc platform esize)
   let frame = old_updfr_off + platformWordSizeInBytes platform * fromIntegral size
   emitAssign reg (CmmStackSlot Old frame)
   withUpdFrameOff frame body
@@ -1269,7 +1270,9 @@ primCall
         -> [CmmParse CmmExpr]
         -> PD (CmmParse ())
 primCall results_code name args_code
-  = case lookupUFM callishMachOps name of
+  = do
+    platform <- PD.getPlatform
+    case lookupUFM (callishMachOps platform) name of
         Nothing -> failMsgPD ("unknown primitive " ++ unpackFS name)
         Just f  -> return $ do
                 results <- sequence results_code
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index f213a28cfe..b3f9606512 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -45,12 +45,13 @@ cmmPipeline
 
 cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline") forceRes $
   do let dflags = hsc_dflags hsc_env
+         platform = targetPlatform dflags
 
      tops <- {-# SCC "tops" #-} mapM (cpsTop dflags) prog
 
      let (procs, data_) = partitionEithers tops
      (srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags srtInfo procs data_
-     dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (ppr cmms)
+     dumpWith dflags Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (pdoc platform cmms)
 
      return (srtInfo, cmms)
 
@@ -99,7 +100,7 @@ cpsTop dflags proc =
                pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
                   minimalProcPointSet platform call_pps g
                dumpWith dflags Opt_D_dump_cmm_proc "Proc points"
-                     FormatCMM (ppr l $$ ppr pp $$ ppr g)
+                     FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g)
                return pp
              else
                return call_pps
@@ -119,7 +120,7 @@ cpsTop dflags proc =
 
        ------------- CAF analysis ----------------------------------------------
        let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
-       dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (ppr cafEnv)
+       dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv)
 
        g <- if splitting_proc_points
             then do
@@ -157,7 +158,7 @@ cpsTop dflags proc =
         dump = dumpGraph dflags
 
         dumps flag name
-           = mapM_ (dumpWith dflags flag name FormatCMM . ppr)
+           = mapM_ (dumpWith dflags flag name FormatCMM . pdoc platform)
 
         condPass flag pass g dumpflag dumpname =
             if gopt flag dflags
@@ -353,9 +354,10 @@ runUniqSM m = do
 dumpGraph :: DynFlags -> DumpFlag -> String -> CmmGraph -> IO ()
 dumpGraph dflags flag name g = do
   when (gopt Opt_DoCmmLinting dflags) $ do_lint g
-  dumpWith dflags flag name FormatCMM (ppr g)
+  dumpWith dflags flag name FormatCMM (pdoc platform g)
  where
-  do_lint g = case cmmLintGraph (targetPlatform dflags) g of
+  platform = targetPlatform dflags
+  do_lint g = case cmmLintGraph platform g of
                  Just err -> do { fatalErrorMsg dflags err
                                 ; ghcExit dflags 1
                                 }
diff --git a/compiler/GHC/Cmm/Ppr.hs b/compiler/GHC/Cmm/Ppr.hs
index f451550ed1..b791b78d70 100644
--- a/compiler/GHC/Cmm/Ppr.hs
+++ b/compiler/GHC/Cmm/Ppr.hs
@@ -43,7 +43,6 @@ where
 import GHC.Prelude hiding (succ)
 
 import GHC.Platform
-import GHC.Driver.Session (targetPlatform)
 import GHC.Cmm.CLabel
 import GHC.Cmm
 import GHC.Cmm.Utils
@@ -64,13 +63,12 @@ import GHC.Cmm.Dataflow.Graph
 instance Outputable CmmStackInfo where
     ppr = pprStackInfo
 
-instance Outputable CmmTopInfo where
-    ppr = pprTopInfo
+instance OutputableP CmmTopInfo where
+    pdoc = pprTopInfo
 
 
-instance Outputable (CmmNode e x) where
-    ppr e = sdocWithDynFlags $ \dflags ->
-            pprNode (targetPlatform dflags) e
+instance OutputableP (CmmNode e x) where
+    pdoc = pprNode
 
 instance Outputable Convention where
     ppr = pprConvention
@@ -78,26 +76,26 @@ instance Outputable Convention where
 instance Outputable ForeignConvention where
     ppr = pprForeignConvention
 
-instance Outputable ForeignTarget where
-    ppr = pprForeignTarget
+instance OutputableP ForeignTarget where
+    pdoc = pprForeignTarget
 
 instance Outputable CmmReturnInfo where
     ppr = pprReturnInfo
 
-instance Outputable (Block CmmNode C C) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode C O) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode O C) where
-    ppr = pprBlock
-instance Outputable (Block CmmNode O O) where
-    ppr = pprBlock
+instance OutputableP (Block CmmNode C C) where
+    pdoc = pprBlock
+instance OutputableP (Block CmmNode C O) where
+    pdoc = pprBlock
+instance OutputableP (Block CmmNode O C) where
+    pdoc = pprBlock
+instance OutputableP (Block CmmNode O O) where
+    pdoc = pprBlock
 
-instance Outputable (Graph CmmNode e x) where
-    ppr = pprGraph
+instance OutputableP (Graph CmmNode e x) where
+    pdoc = pprGraph
 
-instance Outputable CmmGraph where
-    ppr = pprCmmGraph
+instance OutputableP CmmGraph where
+    pdoc = pprCmmGraph
 
 ----------------------------------------------------------
 -- Outputting types Cmm contains
@@ -106,40 +104,41 @@ pprStackInfo :: CmmStackInfo -> SDoc
 pprStackInfo (StackInfo {arg_space=arg_space}) =
   text "arg_space: " <> ppr arg_space
 
-pprTopInfo :: CmmTopInfo -> SDoc
-pprTopInfo (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
-  vcat [text "info_tbls: " <> ppr info_tbl,
+pprTopInfo :: Platform -> CmmTopInfo -> SDoc
+pprTopInfo platform (TopInfo {info_tbls=info_tbl, stack_info=stack_info}) =
+  vcat [text "info_tbls: " <> pdoc platform info_tbl,
         text "stack_info: " <> ppr stack_info]
 
 ----------------------------------------------------------
 -- Outputting blocks and graphs
 
 pprBlock :: IndexedCO x SDoc SDoc ~ SDoc
-         => Block CmmNode e x -> IndexedCO e SDoc SDoc
-pprBlock block
-    = foldBlockNodesB3 ( ($$) . ppr
-                       , ($$) . (nest 4) . ppr
-                       , ($$) . (nest 4) . ppr
+         => Platform -> Block CmmNode e x -> IndexedCO e SDoc SDoc
+pprBlock platform block
+    = foldBlockNodesB3 ( ($$) . pdoc platform
+                       , ($$) . (nest 4) . pdoc platform
+                       , ($$) . (nest 4) . pdoc platform
                        )
                        block
                        empty
 
-pprGraph :: Graph CmmNode e x -> SDoc
-pprGraph GNil = empty
-pprGraph (GUnit block) = ppr block
-pprGraph (GMany entry body exit)
-   = text "{"
-  $$ nest 2 (pprMaybeO entry $$ (vcat $ map ppr $ bodyToBlockList body) $$ pprMaybeO exit)
-  $$ text "}"
-  where pprMaybeO :: Outputable (Block CmmNode e x)
-                  => MaybeO ex (Block CmmNode e x) -> SDoc
-        pprMaybeO NothingO = empty
-        pprMaybeO (JustO block) = ppr block
-
-pprCmmGraph :: CmmGraph -> SDoc
-pprCmmGraph g
+pprGraph :: Platform -> Graph CmmNode e x -> SDoc
+pprGraph platform = \case
+   GNil                  -> empty
+   GUnit block           -> pdoc platform block
+   GMany entry body exit ->
+         text "{"
+      $$ nest 2 (pprMaybeO entry $$ (vcat $ map (pdoc platform) $ bodyToBlockList body) $$ pprMaybeO exit)
+      $$ text "}"
+      where pprMaybeO :: OutputableP (Block CmmNode e x)
+                      => MaybeO ex (Block CmmNode e x) -> SDoc
+            pprMaybeO NothingO = empty
+            pprMaybeO (JustO block) = pdoc platform block
+
+pprCmmGraph :: Platform -> CmmGraph -> SDoc
+pprCmmGraph platform g
    = text "{" <> text "offset"
-  $$ nest 2 (vcat $ map ppr blocks)
+  $$ nest 2 (vcat $ map (pdoc platform) blocks)
   $$ text "}"
   where blocks = revPostorder g
     -- revPostorder has the side-effect of discarding unreachable code,
@@ -164,17 +163,17 @@ pprReturnInfo :: CmmReturnInfo -> SDoc
 pprReturnInfo CmmMayReturn = empty
 pprReturnInfo CmmNeverReturns = text "never returns"
 
-pprForeignTarget :: ForeignTarget -> SDoc
-pprForeignTarget (ForeignTarget fn c) = ppr c <+> ppr_target fn
+pprForeignTarget :: Platform -> ForeignTarget -> SDoc
+pprForeignTarget platform (ForeignTarget fn c) = ppr c <+> ppr_target fn
   where
         ppr_target :: CmmExpr -> SDoc
-        ppr_target t@(CmmLit _) = ppr t
-        ppr_target fn'          = parens (ppr fn')
+        ppr_target t@(CmmLit _) = pdoc platform t
+        ppr_target fn'          = parens (pdoc platform fn')
 
-pprForeignTarget (PrimTarget op)
+pprForeignTarget platform (PrimTarget op)
  -- HACK: We're just using a ForeignLabel to get this printed, the label
  --       might not really be foreign.
- = ppr
+ = pdoc platform
                (CmmLabel (mkForeignLabel
                          (mkFastString (show op))
                          Nothing ForeignLabelInThisPackage IsFunction))
@@ -203,13 +202,13 @@ pprNode platform node = pp_node <+> pp_debug
       -- unwind reg = expr;
       CmmUnwind regs ->
           text "unwind "
-          <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> ppr e) regs) <> semi
+          <> commafy (map (\(r,e) -> ppr r <+> char '=' <+> pdoc platform e) regs) <> semi
 
       -- reg = expr;
-      CmmAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
+      CmmAssign reg expr -> ppr reg <+> equals <+> pdoc platform expr <> semi
 
       -- rep[lv] = expr;
-      CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
+      CmmStore lv expr -> rep <> brackets (pdoc platform lv) <+> equals <+> pdoc platform expr <> semi
           where
             rep = ppr ( cmmExprType platform expr )
 
@@ -219,7 +218,7 @@ pprNode platform node = pp_node <+> pp_debug
           hsep [ ppUnless (null results) $
                     parens (commafy $ map ppr results) <+> equals,
                  text "call",
-                 ppr target <> parens (commafy $ map ppr args) <> semi]
+                 pdoc platform target <> parens (commafy $ map (pdoc platform) args) <> semi]
 
       -- goto label;
       CmmBranch ident -> text "goto" <+> ppr ident <> semi
@@ -227,7 +226,7 @@ pprNode platform node = pp_node <+> pp_debug
       -- if (expr) goto t; else goto f;
       CmmCondBranch expr t f l ->
           hsep [ text "if"
-               , parens(ppr expr)
+               , parens (pdoc platform expr)
                , case l of
                    Nothing -> empty
                    Just b -> parens (text "likely:" <+> ppr b)
@@ -241,8 +240,8 @@ pprNode platform node = pp_node <+> pp_debug
           hang (hsep [ text "switch"
                      , range
                      , if isTrivialCmmExpr expr
-                       then ppr expr
-                       else parens (ppr expr)
+                       then pdoc platform expr
+                       else parens (pdoc platform expr)
                      , text "{"
                      ])
              4 (vcat (map ppCase cases) $$ def) $$ rbrace
@@ -271,8 +270,8 @@ pprNode platform node = pp_node <+> pp_debug
                  text "res: " <> ppr res <> comma <+>
                  text "upd: " <> ppr updfr_off
                , semi ]
-          where pprFun f@(CmmLit _) = ppr f
-                pprFun f = parens (ppr f)
+          where pprFun f@(CmmLit _) = pdoc platform f
+                pprFun f = parens (pdoc platform f)
 
                 returns
                   | Just r <- k = text "returns to" <+> ppr r <> comma
@@ -281,9 +280,9 @@ pprNode platform node = pp_node <+> pp_debug
       CmmForeignCall {tgt=t, res=rs, args=as, succ=s, ret_args=a, ret_off=u, intrbl=i} ->
           hcat $ if i then [text "interruptible", space] else [] ++
                [ text "foreign call", space
-               , ppr t, text "(...)", space
+               , pdoc platform t, text "(...)", space
                , text "returns to" <+> ppr s
-                    <+> text "args:" <+> parens (ppr as)
+                    <+> text "args:" <+> parens (pdoc platform as)
                     <+> text "ress:" <+> parens (ppr rs)
                , text "ret_args:" <+> ppr a
                , text "ret_off:" <+> ppr u
diff --git a/compiler/GHC/Cmm/Ppr/Decl.hs b/compiler/GHC/Cmm/Ppr/Decl.hs
index 94216a537b..b65cb9bd0b 100644
--- a/compiler/GHC/Cmm/Ppr/Decl.hs
+++ b/compiler/GHC/Cmm/Ppr/Decl.hs
@@ -36,7 +36,7 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module GHC.Cmm.Ppr.Decl
-    ( writeCmms, pprCmms, pprCmmGroup, pprSection, pprStatic
+    ( pprCmms, pprCmmGroup, pprSection, pprStatic
     )
 where
 
@@ -46,62 +46,54 @@ import GHC.Platform
 import GHC.Cmm.Ppr.Expr
 import GHC.Cmm
 
-import GHC.Driver.Ppr
-import GHC.Driver.Session
 import GHC.Utils.Outputable
 import GHC.Data.FastString
 
 import Data.List
-import System.IO
 
 import qualified Data.ByteString as BS
 
 
-pprCmms :: (Outputable info, Outputable g)
-        => [GenCmmGroup RawCmmStatics info g] -> SDoc
-pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms))
+pprCmms :: (OutputableP info, OutputableP g)
+        => Platform -> [GenCmmGroup RawCmmStatics info g] -> SDoc
+pprCmms platform cmms = pprCode CStyle (vcat (intersperse separator $ map (pdoc platform) cmms))
         where
           separator = space $$ text "-------------------" $$ space
 
-writeCmms :: (Outputable info, Outputable g)
-          => DynFlags -> Handle -> [GenCmmGroup RawCmmStatics info g] -> IO ()
-writeCmms dflags handle cmms = printForC dflags handle (pprCmms cmms)
-
 -----------------------------------------------------------------------------
 
-instance (Outputable d, Outputable info, Outputable i)
-      => Outputable (GenCmmDecl d info i) where
-    ppr t = pprTop t
+instance (OutputableP d, OutputableP info, OutputableP i)
+      => OutputableP (GenCmmDecl d info i) where
+    pdoc = pprTop
 
-instance Outputable (GenCmmStatics a) where
-    ppr = pprStatics
+instance OutputableP (GenCmmStatics a) where
+    pdoc = pprStatics
 
-instance Outputable CmmStatic where
-    ppr e = sdocWithDynFlags $ \dflags ->
-            pprStatic (targetPlatform dflags) e
+instance OutputableP CmmStatic where
+    pdoc = pprStatic
 
-instance Outputable CmmInfoTable where
-    ppr = pprInfoTable
+instance OutputableP CmmInfoTable where
+    pdoc = pprInfoTable
 
 
 -----------------------------------------------------------------------------
 
-pprCmmGroup :: (Outputable d, Outputable info, Outputable g)
-            => GenCmmGroup d info g -> SDoc
-pprCmmGroup tops
-    = vcat $ intersperse blankLine $ map pprTop tops
+pprCmmGroup :: (OutputableP d, OutputableP info, OutputableP g)
+            => Platform -> GenCmmGroup d info g -> SDoc
+pprCmmGroup platform tops
+    = vcat $ intersperse blankLine $ map (pprTop platform) tops
 
 -- --------------------------------------------------------------------------
 -- Top level `procedure' blocks.
 --
-pprTop :: (Outputable d, Outputable info, Outputable i)
-       => GenCmmDecl d info i -> SDoc
+pprTop :: (OutputableP d, OutputableP info, OutputableP i)
+       => Platform -> GenCmmDecl d info i -> SDoc
 
-pprTop (CmmProc info lbl live graph)
+pprTop platform (CmmProc info lbl live graph)
 
-  = vcat [ ppr lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live
-         , nest 8 $ lbrace <+> ppr info $$ rbrace
-         , nest 4 $ ppr graph
+  = vcat [ pdoc platform lbl <> lparen <> rparen <+> lbrace <+> text "// " <+> ppr live
+         , nest 8 $ lbrace <+> pdoc platform info $$ rbrace
+         , nest 4 $ pdoc platform graph
          , rbrace ]
 
 -- --------------------------------------------------------------------------
@@ -109,25 +101,25 @@ pprTop (CmmProc info lbl live graph)
 --
 --      section "data" { ... }
 --
-pprTop (CmmData section ds) =
-    (hang (pprSection section <+> lbrace) 4 (ppr ds))
+pprTop platform (CmmData section ds) =
+    (hang (pprSection platform section <+> lbrace) 4 (pdoc platform ds))
     $$ rbrace
 
 -- --------------------------------------------------------------------------
 -- Info tables.
 
-pprInfoTable :: CmmInfoTable -> SDoc
-pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
+pprInfoTable :: Platform -> CmmInfoTable -> SDoc
+pprInfoTable platform (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
                            , cit_prof = prof_info
                            , cit_srt = srt })
-  = vcat [ text "label: " <> ppr lbl
+  = vcat [ text "label: " <> pdoc platform lbl
          , text "rep: " <> ppr rep
          , case prof_info of
              NoProfilingInfo -> empty
              ProfilingInfo ct cd ->
                vcat [ text "type: " <> text (show (BS.unpack ct))
                     , text "desc: " <> text (show (BS.unpack cd)) ]
-         , text "srt: " <> ppr srt ]
+         , text "srt: " <> pdoc platform srt ]
 
 instance Outputable ForeignHint where
   ppr NoHint     = empty
@@ -142,10 +134,10 @@ instance Outputable ForeignHint where
 --      following C--
 --
 
-pprStatics :: GenCmmStatics a -> SDoc
-pprStatics (CmmStatics lbl itbl ccs payload) =
-  ppr lbl <> colon <+> ppr itbl <+> ppr ccs <+> ppr payload
-pprStatics (CmmStaticsRaw lbl ds) = vcat ((ppr lbl <> colon) : map ppr ds)
+pprStatics :: Platform -> GenCmmStatics a -> SDoc
+pprStatics platform (CmmStatics lbl itbl ccs payload) =
+  pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload
+pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds)
 
 pprStatic :: Platform -> CmmStatic -> SDoc
 pprStatic platform s = case s of
@@ -157,9 +149,9 @@ pprStatic platform s = case s of
 -- --------------------------------------------------------------------------
 -- data sections
 --
-pprSection :: Section -> SDoc
-pprSection (Section t suffix) =
-  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> ppr suffix)
+pprSection :: Platform -> Section -> SDoc
+pprSection platform (Section t suffix) =
+  section <+> doubleQuotes (pprSectionType t <+> char '.' <+> pdoc platform suffix)
   where
     section = text "section"
 
diff --git a/compiler/GHC/Cmm/Ppr/Expr.hs b/compiler/GHC/Cmm/Ppr/Expr.hs
index 4bb8021541..5b1d01b00a 100644
--- a/compiler/GHC/Cmm/Ppr/Expr.hs
+++ b/compiler/GHC/Cmm/Ppr/Expr.hs
@@ -41,7 +41,6 @@ where
 
 import GHC.Prelude
 
-import GHC.Driver.Session (targetPlatform)
 import GHC.Driver.Ppr
 
 import GHC.Platform
@@ -54,16 +53,14 @@ import Numeric ( fromRat )
 
 -----------------------------------------------------------------------------
 
-instance Outputable CmmExpr where
-    ppr e = sdocWithDynFlags $ \dflags ->
-            pprExpr (targetPlatform dflags) e
+instance OutputableP CmmExpr where
+    pdoc = pprExpr
 
 instance Outputable CmmReg where
     ppr e = pprReg e
 
-instance Outputable CmmLit where
-    ppr l = sdocWithDynFlags $ \dflags ->
-            pprLit (targetPlatform dflags) l
+instance OutputableP CmmLit where
+    pdoc = pprLit
 
 instance Outputable LocalReg where
     ppr e = pprLocalReg e
@@ -74,6 +71,9 @@ instance Outputable Area where
 instance Outputable GlobalReg where
     ppr e = pprGlobalReg e
 
+instance OutputableP GlobalReg where
+    pdoc _ = ppr
+
 -- --------------------------------------------------------------------------
 -- Expressions
 --
@@ -147,7 +147,7 @@ pprExpr9 :: Platform -> CmmExpr -> SDoc
 pprExpr9 platform e =
    case e of
         CmmLit    lit       -> pprLit1 platform lit
-        CmmLoad   expr rep  -> ppr rep <> brackets (ppr expr)
+        CmmLoad   expr rep  -> ppr rep <> brackets (pdoc platform expr)
         CmmReg    reg       -> ppr reg
         CmmRegOff  reg off  -> parens (ppr reg <+> char '+' <+> int off)
         CmmStackSlot a off  -> parens (ppr a   <+> char '+' <+> int off)
@@ -204,10 +204,10 @@ pprLit platform lit = case lit of
 
     CmmFloat f rep     -> hsep [ double (fromRat f), dcolon, ppr rep ]
     CmmVec lits        -> char '<' <> commafy (map (pprLit platform) lits) <> char '>'
-    CmmLabel clbl      -> ppr clbl
-    CmmLabelOff clbl i -> ppr clbl <> ppr_offset i
-    CmmLabelDiffOff clbl1 clbl2 i _ -> ppr clbl1 <> char '-'
-                                  <> ppr clbl2 <> ppr_offset i
+    CmmLabel clbl      -> pdoc platform clbl
+    CmmLabelOff clbl i -> pdoc platform clbl <> ppr_offset i
+    CmmLabelDiffOff clbl1 clbl2 i _ -> pdoc platform clbl1 <> char '-'
+                                       <> pdoc platform clbl2 <> ppr_offset i
     CmmBlock id        -> ppr id
     CmmHighStackMark -> text "<highSp>"
 
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 1a0c4708da..23dbc282d9 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -206,7 +206,7 @@ extendPPSet platform g blocks procPoints =
         newPoint  = listToMaybe newPoints
         ppSuccessor b =
             let nreached id = case mapLookup id env `orElse`
-                                    pprPanic "no ppt" (ppr id <+> ppr b) of
+                                    pprPanic "no ppt" (ppr id <+> pdoc platform b) of
                                 ProcPoint -> 1
                                 ReachedBy ps -> setSize ps
                 block_procpoints = nreached (entryLabel b)