Refactor CLabel pretty-printing

Pretty-printing CLabel relies on sdocWithDynFlags that we want to remove
(#10143, #17957). It uses it to query the backend and the platform.

This patch exposes Clabel ppr functions specialised for each backend so
that backend code can directly use them.

5 files changed, 190 insertions, 169 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 425b1b862d..602e3d38fc 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -108,7 +108,7 @@ module GHC.Cmm.CLabel (
         -- * Conversions
         toClosureLbl, toSlowEntryLbl, toEntryLbl, toInfoLbl, hasHaskellName,
 
-        pprCLabel,
+        pprCLabel, pprCLabel_LLVM, pprCLabel_NCG,
         isInfoTableLabel,
         isConInfoTableLabel,
         isIdLabel, isTickyLabel
@@ -242,7 +242,7 @@ data CLabel
 
   -- | These labels are generated and used inside the NCG only.
   --    They are special variants of a label used for dynamic linking
-  --    see module PositionIndependentCode for details.
+  --    see module "GHC.CmmToAsm.PIC" for details.
   | DynamicLinkerLabel DynamicLinkerLabelInfo CLabel
 
   -- | This label is generated and used inside the NCG only.
@@ -398,23 +398,24 @@ data ForeignLabelSource
 --      We can't make a Show instance for CLabel because lots of its components don't have instances.
 --      The regular Outputable instance only shows the label name, and not its other info.
 --
-pprDebugCLabel :: CLabel -> SDoc
-pprDebugCLabel lbl
+pprDebugCLabel :: Platform -> CLabel -> SDoc
+pprDebugCLabel platform lbl
  = case lbl of
-        IdLabel _ _ info-> ppr lbl <> (parens $ text "IdLabel"
-                                       <> whenPprDebug (text ":" <> text (show info)))
+        IdLabel _ _ info-> pprCLabel_other platform lbl
+                           <> (parens $ text "IdLabel"
+                           <> whenPprDebug (text ":" <> text (show info)))
         CmmLabel pkg _ext _name _info
-         -> ppr lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
+         -> pprCLabel_other platform lbl <> (parens $ text "CmmLabel" <+> ppr pkg)
 
-        RtsLabel{}      -> ppr lbl <> (parens $ text "RtsLabel")
+        RtsLabel{}      -> pprCLabel_other platform lbl <> (parens $ text "RtsLabel")
 
         ForeignLabel _name mSuffix src funOrData
-            -> ppr lbl <> (parens $ text "ForeignLabel"
-                                <+> ppr mSuffix
-                                <+> ppr src
-                                <+> ppr funOrData)
+            -> pprCLabel_other platform lbl <> (parens $ text "ForeignLabel"
+                                        <+> ppr mSuffix
+                                        <+> ppr src
+                                        <+> ppr funOrData)
 
-        _               -> ppr lbl <> (parens $ text "other CLabel")
+        _               -> pprCLabel_other platform lbl <> (parens $ text "other CLabel")
 
 
 data IdLabelInfo
@@ -753,34 +754,37 @@ mkAsmTempDieLabel l = mkAsmTempDerivedLabel l (fsLit "_die")
 -- -----------------------------------------------------------------------------
 -- Convert between different kinds of label
 
-toClosureLbl :: CLabel -> CLabel
-toClosureLbl (IdLabel n c _) = IdLabel n c Closure
-toClosureLbl (CmmLabel m ext str _) = CmmLabel m ext str CmmClosure
-toClosureLbl l = pprPanic "toClosureLbl" (ppr l)
-
-toSlowEntryLbl :: CLabel -> CLabel
-toSlowEntryLbl (IdLabel n _ BlockInfoTable)
-  = pprPanic "toSlowEntryLbl" (ppr n)
-toSlowEntryLbl (IdLabel n c _) = IdLabel n c Slow
-toSlowEntryLbl l = pprPanic "toSlowEntryLbl" (ppr l)
-
-toEntryLbl :: CLabel -> CLabel
-toEntryLbl (IdLabel n c LocalInfoTable)  = IdLabel n c LocalEntry
-toEntryLbl (IdLabel n c ConInfoTable)    = IdLabel n c ConEntry
-toEntryLbl (IdLabel n _ BlockInfoTable)  = mkLocalBlockLabel (nameUnique n)
-                              -- See Note [Proc-point local block entry-point].
-toEntryLbl (IdLabel n c _)               = IdLabel n c Entry
-toEntryLbl (CmmLabel m ext str CmmInfo)    = CmmLabel m ext str CmmEntry
-toEntryLbl (CmmLabel m ext str CmmRetInfo) = CmmLabel m ext str CmmRet
-toEntryLbl l = pprPanic "toEntryLbl" (ppr l)
-
-toInfoLbl :: CLabel -> CLabel
-toInfoLbl (IdLabel n c LocalEntry)     = IdLabel n c LocalInfoTable
-toInfoLbl (IdLabel n c ConEntry)       = IdLabel n c ConInfoTable
-toInfoLbl (IdLabel n c _)              = IdLabel n c InfoTable
-toInfoLbl (CmmLabel m ext str CmmEntry)= CmmLabel m ext str CmmInfo
-toInfoLbl (CmmLabel m ext str CmmRet)  = CmmLabel m ext str CmmRetInfo
-toInfoLbl l = pprPanic "CLabel.toInfoLbl" (ppr l)
+toClosureLbl :: Platform -> CLabel -> CLabel
+toClosureLbl platform lbl = case lbl of
+   IdLabel n c _        -> IdLabel n c Closure
+   CmmLabel m ext str _ -> CmmLabel m ext str CmmClosure
+   _                    -> pprPanic "toClosureLbl" (pprCLabel_other platform lbl)
+
+toSlowEntryLbl :: Platform -> CLabel -> CLabel
+toSlowEntryLbl platform lbl = case lbl of
+   IdLabel n _ BlockInfoTable -> pprPanic "toSlowEntryLbl" (ppr n)
+   IdLabel n c _              -> IdLabel n c Slow
+   _                          -> pprPanic "toSlowEntryLbl" (pprCLabel_other platform lbl)
+
+toEntryLbl :: Platform -> CLabel -> CLabel
+toEntryLbl platform lbl = case lbl of
+   IdLabel n c LocalInfoTable    -> IdLabel n c LocalEntry
+   IdLabel n c ConInfoTable      -> IdLabel n c ConEntry
+   IdLabel n _ BlockInfoTable    -> mkLocalBlockLabel (nameUnique n)
+                   -- See Note [Proc-point local block entry-point].
+   IdLabel n c _                 -> IdLabel n c Entry
+   CmmLabel m ext str CmmInfo    -> CmmLabel m ext str CmmEntry
+   CmmLabel m ext str CmmRetInfo -> CmmLabel m ext str CmmRet
+   _                             -> pprPanic "toEntryLbl" (pprCLabel_other platform lbl)
+
+toInfoLbl :: Platform -> CLabel -> CLabel
+toInfoLbl platform lbl = case lbl of
+   IdLabel n c LocalEntry      -> IdLabel n c LocalInfoTable
+   IdLabel n c ConEntry        -> IdLabel n c ConInfoTable
+   IdLabel n c _               -> IdLabel n c InfoTable
+   CmmLabel m ext str CmmEntry -> CmmLabel m ext str CmmInfo
+   CmmLabel m ext str CmmRet   -> CmmLabel m ext str CmmRetInfo
+   _                           -> pprPanic "CLabel.toInfoLbl" (pprCLabel_other platform lbl)
 
 hasHaskellName :: CLabel -> Maybe Name
 hasHaskellName (IdLabel n _ _) = Just n
@@ -1208,34 +1212,50 @@ and are not externally visible.
 -}
 
 instance Outputable CLabel where
-  ppr c = sdocWithDynFlags $ \dynFlags -> pprCLabel dynFlags c
+  ppr lbl = sdocWithDynFlags (\dflags -> pprCLabel (backend dflags) (targetPlatform dflags) lbl)
+
+pprCLabel :: Backend -> Platform -> CLabel -> SDoc
+pprCLabel bcknd platform lbl =
+   case bcknd of
+      NCG  -> pprCLabel_NCG   platform lbl
+      LLVM -> pprCLabel_LLVM  platform lbl
+      _    -> pprCLabel_other platform lbl
+
+pprCLabel_LLVM :: Platform -> CLabel -> SDoc
+pprCLabel_LLVM = pprCLabel_NCG
+
+pprCLabel_NCG :: Platform -> CLabel -> SDoc
+pprCLabel_NCG platform lbl = getPprStyle $ \sty ->
+  let
+    -- some platform (e.g. Darwin) require a leading "_" for exported asm
+    -- symbols
+    maybe_underscore :: SDoc -> SDoc
+    maybe_underscore doc =
+      if platformLeadingUnderscore platform
+      then pp_cSEP <> doc
+      else doc
 
-pprCLabel :: DynFlags -> CLabel -> SDoc
-pprCLabel dflags = \case
-   (LocalBlockLabel u) -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+  in case lbl of
+   LocalBlockLabel u
+      -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
-   (AsmTempLabel u)
-      | not (platformUnregisterised platform)
+   AsmTempLabel u
       -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
 
-   (AsmTempDerivedLabel l suf)
-      | useNCG
+   AsmTempDerivedLabel l suf
       -> ptext (asmTempLabelPrefix platform)
          <> case l of AsmTempLabel u    -> pprUniqueAlways u
                       LocalBlockLabel u -> pprUniqueAlways u
-                      _other            -> pprCLabel dflags l
+                      _other            -> pprCLabel_NCG platform l
          <> ftext suf
 
-   (DynamicLinkerLabel info lbl)
-      | useNCG
+   DynamicLinkerLabel info lbl
       -> pprDynamicLinkerAsmLabel platform info lbl
 
    PicBaseLabel
-      | useNCG
       -> text "1b"
 
-   (DeadStripPreventer lbl)
-      | useNCG
+   DeadStripPreventer lbl
       ->
       {-
          `lbl` can be temp one but we need to ensure that dsp label will stay
@@ -1243,36 +1263,36 @@ pprCLabel dflags = \case
          optional `_` (underscore) because this is how you mark non-temp symbols
          on some platforms (Darwin)
       -}
-      maybe_underscore $ text "dsp_" <> pprCLabel dflags lbl <> text "_dsp"
+      maybe_underscore $ text "dsp_" <> pprCLabel_NCG platform lbl <> text "_dsp"
 
-   (StringLitLabel u)
-      | useNCG
+   StringLitLabel u
       -> pprUniqueAlways u <> ptext (sLit "_str")
 
-   lbl -> getPprStyle $ \sty ->
-            if useNCG && asmStyle sty
-            then maybe_underscore $ pprAsmCLbl lbl
-            else pprCLbl platform lbl
+   ForeignLabel fs (Just sz) _ _
+      | asmStyle sty
+      , OSMinGW32 <- platformOS platform
+      -> -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
+         -- (The C compiler does this itself).
+         maybe_underscore $ ftext fs <> char '@' <> int sz
 
-  where
-    platform = targetPlatform dflags
-    useNCG   = backend dflags == NCG
+   _  | asmStyle sty -> maybe_underscore $ pprCLabel_common platform lbl
+      | otherwise    -> pprCLabel_common platform lbl
 
-    maybe_underscore :: SDoc -> SDoc
-    maybe_underscore doc =
-      if platformLeadingUnderscore platform
-      then pp_cSEP <> doc
-      else doc
+pprCLabel_other :: Platform -> CLabel -> SDoc
+pprCLabel_other platform lbl =
+   case lbl of
+      LocalBlockLabel u
+         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+
+      AsmTempLabel u
+         | not (platformUnregisterised platform)
+         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u
+
+      lbl -> pprCLabel_common platform lbl
 
-    pprAsmCLbl (ForeignLabel fs (Just sz) _ _)
-     | platformOS platform == OSMinGW32
-        -- In asm mode, we need to put the suffix on a stdcall ForeignLabel.
-        -- (The C compiler does this itself).
-        = ftext fs <> char '@' <> int sz
-    pprAsmCLbl lbl = pprCLbl platform lbl
 
-pprCLbl :: Platform -> CLabel -> SDoc
-pprCLbl platform = \case
+pprCLabel_common :: Platform -> CLabel -> SDoc
+pprCLabel_common platform = \case
    (StringLitLabel u)   -> pprUniqueAlways u <> text "_str"
    (SRTLabel u)         -> tempLabelPrefixOrUnderscore platform <> pprUniqueAlways u <> pp_cSEP <> text "srt"
    (LargeBitmapLabel u) -> tempLabelPrefixOrUnderscore platform
@@ -1335,11 +1355,11 @@ pprCLbl platform = \case
    (CCS_Label ccs)     -> ppr ccs
    (HpcTicksLabel mod) -> text "_hpc_tickboxes_"  <> ppr mod <> ptext (sLit "_hpc")
 
-   (AsmTempLabel {})        -> panic "pprCLbl AsmTempLabel"
-   (AsmTempDerivedLabel {}) -> panic "pprCLbl AsmTempDerivedLabel"
-   (DynamicLinkerLabel {})  -> panic "pprCLbl DynamicLinkerLabel"
-   (PicBaseLabel {})        -> panic "pprCLbl PicBaseLabel"
-   (DeadStripPreventer {})  -> panic "pprCLbl DeadStripPreventer"
+   (AsmTempLabel {})        -> panic "pprCLabel_common AsmTempLabel"
+   (AsmTempDerivedLabel {}) -> panic "pprCLabel_common AsmTempDerivedLabel"
+   (DynamicLinkerLabel {})  -> panic "pprCLabel_common DynamicLinkerLabel"
+   (PicBaseLabel {})        -> panic "pprCLabel_common PicBaseLabel"
+   (DeadStripPreventer {})  -> panic "pprCLabel_common DeadStripPreventer"
 
 ppIdFlavor :: IdLabelInfo -> SDoc
 ppIdFlavor x = pp_cSEP <> text
@@ -1402,60 +1422,60 @@ pprDynamicLinkerAsmLabel platform dllInfo lbl =
       OSDarwin
         | platformArch platform == ArchX86_64 ->
           case dllInfo of
-            CodeStub        -> char 'L' <> ppr lbl <> text "$stub"
-            SymbolPtr       -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
-            GotSymbolPtr    -> ppr lbl <> text "@GOTPCREL"
-            GotSymbolOffset -> ppr lbl
+            CodeStub        -> char 'L' <> ppLbl <> text "$stub"
+            SymbolPtr       -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
+            GotSymbolPtr    -> ppLbl <> text "@GOTPCREL"
+            GotSymbolOffset -> ppLbl
         | otherwise ->
           case dllInfo of
-            CodeStub  -> char 'L' <> ppr lbl <> text "$stub"
-            SymbolPtr -> char 'L' <> ppr lbl <> text "$non_lazy_ptr"
+            CodeStub  -> char 'L' <> ppLbl <> text "$stub"
+            SymbolPtr -> char 'L' <> ppLbl <> text "$non_lazy_ptr"
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       OSAIX ->
           case dllInfo of
-            SymbolPtr -> text "LC.." <> ppr lbl -- GCC's naming convention
+            SymbolPtr -> text "LC.." <> ppLbl -- GCC's naming convention
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       _ | osElfTarget (platformOS platform) -> elfLabel
 
       OSMinGW32 ->
           case dllInfo of
-            SymbolPtr -> text "__imp_" <> ppr lbl
+            SymbolPtr -> text "__imp_" <> ppLbl
             _         -> panic "pprDynamicLinkerAsmLabel"
 
       _ -> panic "pprDynamicLinkerAsmLabel"
   where
+    ppLbl = pprCLabel_NCG platform lbl
     elfLabel
       | platformArch platform == ArchPPC
       = case dllInfo of
           CodeStub  -> -- See Note [.LCTOC1 in PPC PIC code]
-                       ppr lbl <> text "+32768@plt"
-          SymbolPtr -> text ".LC_" <> ppr lbl
+                       ppLbl <> text "+32768@plt"
+          SymbolPtr -> text ".LC_" <> ppLbl
           _         -> panic "pprDynamicLinkerAsmLabel"
 
       | platformArch platform == ArchX86_64
       = case dllInfo of
-          CodeStub        -> ppr lbl <> text "@plt"
-          GotSymbolPtr    -> ppr lbl <> text "@gotpcrel"
-          GotSymbolOffset -> ppr lbl
-          SymbolPtr       -> text ".LC_" <> ppr lbl
+          CodeStub        -> ppLbl <> text "@plt"
+          GotSymbolPtr    -> ppLbl <> text "@gotpcrel"
+          GotSymbolOffset -> ppLbl
+          SymbolPtr       -> text ".LC_" <> ppLbl
 
       | platformArch platform == ArchPPC_64 ELF_V1
         || platformArch platform == ArchPPC_64 ELF_V2
       = case dllInfo of
-          GotSymbolPtr    -> text ".LC_"  <> ppr lbl
-                                  <> text "@toc"
-          GotSymbolOffset -> ppr lbl
-          SymbolPtr       -> text ".LC_" <> ppr lbl
+          GotSymbolPtr    -> text ".LC_"  <> ppLbl <> text "@toc"
+          GotSymbolOffset -> ppLbl
+          SymbolPtr       -> text ".LC_" <> ppLbl
           _               -> panic "pprDynamicLinkerAsmLabel"
 
       | otherwise
       = case dllInfo of
-          CodeStub        -> ppr lbl <> text "@plt"
-          SymbolPtr       -> text ".LC_" <> ppr lbl
-          GotSymbolPtr    -> ppr lbl <> text "@got"
-          GotSymbolOffset -> ppr lbl <> text "@gotoff"
+          CodeStub        -> ppLbl <> text "@plt"
+          SymbolPtr       -> text ".LC_" <> ppLbl
+          GotSymbolPtr    -> ppLbl <> text "@got"
+          GotSymbolOffset -> ppLbl <> text "@gotoff"
 
 -- Figure out whether `symbol` may serve as an alias
 -- to `target` within one compilation unit.
diff --git a/compiler/GHC/Cmm/Info.hs b/compiler/GHC/Cmm/Info.hs
index c650a66581..fa7602057f 100644
--- a/compiler/GHC/Cmm/Info.hs
+++ b/compiler/GHC/Cmm/Info.hs
@@ -253,7 +253,7 @@ mkInfoTableContents dflags
                            ++ [ liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
       where
-        slow_entry = CmmLabel (toSlowEntryLbl info_lbl)
+        slow_entry = CmmLabel (toSlowEntryLbl platform info_lbl)
         srt_lit = case srt_label of
                     []          -> mkIntCLit platform 0
                     (lit:_rest) -> ASSERT( null _rest ) lit
diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 54eb48efc6..8e91c2636e 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -459,8 +459,8 @@ newtype CAFLabel = CAFLabel CLabel
 type CAFSet = Set CAFLabel
 type CAFEnv = LabelMap CAFSet
 
-mkCAFLabel :: CLabel -> CAFLabel
-mkCAFLabel lbl = CAFLabel (toClosureLbl lbl)
+mkCAFLabel :: Platform -> CLabel -> CAFLabel
+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.
@@ -470,10 +470,10 @@ newtype SRTEntry = SRTEntry CLabel
 -- ---------------------------------------------------------------------
 -- CAF analysis
 
-addCafLabel :: CLabel -> CAFSet -> CAFSet
-addCafLabel l s
+addCafLabel :: Platform -> CLabel -> CAFSet -> CAFSet
+addCafLabel platform l s
   | Just _ <- hasHaskellName l
-  , let caf_label = mkCAFLabel l
+  , let caf_label = mkCAFLabel platform l
     -- For imported Ids hasCAF will have accurate CafInfo
     -- Locals are initialized as CAFFY. We turn labels with empty SRTs into
     -- non-CAFFYs in doSRTs
@@ -483,21 +483,20 @@ addCafLabel l s
   = s
 
 cafAnalData
-  :: CmmStatics
+  :: Platform
+  -> CmmStatics
   -> CAFSet
-
-cafAnalData (CmmStaticsRaw _lbl _data) =
-    Set.empty
-
-cafAnalData (CmmStatics _lbl _itbl _ccs payload) =
-    foldl' analyzeStatic Set.empty payload
-  where
-    analyzeStatic s lit =
-      case lit of
-        CmmLabel c -> addCafLabel c s
-        CmmLabelOff c _ -> addCafLabel c s
-        CmmLabelDiffOff c1 c2 _ _ -> addCafLabel c1 $! addCafLabel c2 s
-        _ -> s
+cafAnalData platform st = case st of
+   CmmStaticsRaw _lbl _data           -> Set.empty
+   CmmStatics _lbl _itbl _ccs payload ->
+       foldl' analyzeStatic Set.empty payload
+     where
+       analyzeStatic s lit =
+         case lit of
+           CmmLabel c -> addCafLabel platform c s
+           CmmLabelOff c _ -> addCafLabel platform c s
+           CmmLabelDiffOff c1 c2 _ _ -> addCafLabel platform c1 $! addCafLabel platform c2 s
+           _ -> s
 
 -- |
 -- For each code block:
@@ -507,16 +506,17 @@ cafAnalData (CmmStatics _lbl _itbl _ccs payload) =
 -- This gives us a `CAFEnv`: a mapping from code block to sets of labels
 --
 cafAnal
-  :: LabelSet   -- The blocks representing continuations, ie. those
+  :: Platform
+  -> LabelSet   -- The blocks representing continuations, ie. those
                 -- that will get RET info tables.  These labels will
                 -- get their own SRTs, so we don't aggregate CAFs from
                 -- references to these labels, we just use the label.
   -> CLabel     -- The top label of the proc
   -> CmmGraph
   -> CAFEnv
-cafAnal contLbls topLbl cmmGraph =
+cafAnal platform contLbls topLbl cmmGraph =
   analyzeCmmBwd cafLattice
-    (cafTransfers contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
+    (cafTransfers platform contLbls (g_entry cmmGraph) topLbl) cmmGraph mapEmpty
 
 
 cafLattice :: DataflowLattice CAFSet
@@ -527,8 +527,8 @@ cafLattice = DataflowLattice Set.empty add
         in changedIf (Set.size new' > Set.size old) new'
 
 
-cafTransfers :: LabelSet -> Label -> CLabel -> TransferFun CAFSet
-cafTransfers contLbls entry topLbl
+cafTransfers :: Platform -> LabelSet -> Label -> CLabel -> TransferFun CAFSet
+cafTransfers platform contLbls entry topLbl
   block@(BlockCC eNode middle xNode) fBase =
     let joined :: CAFSet
         joined = cafsInNode xNode $! live'
@@ -546,11 +546,11 @@ cafTransfers contLbls entry topLbl
         successorFact s
           -- If this is a loop back to the entry, we can refer to the
           -- entry label.
-          | s == entry = Just (addCafLabel topLbl Set.empty)
+          | s == entry = Just (addCafLabel platform topLbl Set.empty)
           -- If this is a continuation, we want to refer to the
           -- SRT for the continuation's info table
           | s `setMember` contLbls
-          = Just (Set.singleton (mkCAFLabel (infoTblLbl s)))
+          = Just (Set.singleton (mkCAFLabel platform (infoTblLbl s)))
           -- Otherwise, takes the CAF references from the destination
           | otherwise
           = lookupFact s fBase
@@ -562,11 +562,11 @@ cafTransfers contLbls entry topLbl
         addCafExpr expr !set =
           case expr of
             CmmLit (CmmLabel c) ->
-              addCafLabel c set
+              addCafLabel platform c set
             CmmLit (CmmLabelOff c _) ->
-              addCafLabel c set
+              addCafLabel platform c set
             CmmLit (CmmLabelDiffOff c1 c2 _ _) ->
-              addCafLabel c1 $! addCafLabel c2 set
+              addCafLabel platform c1 $! addCafLabel platform c2 set
             _ ->
               set
     in
@@ -649,35 +649,34 @@ getBlockLabels = mapMaybe getBlockLabel
 --   where the label is
 --   - the info label for a continuation or dynamic closure
 --   - the closure label for a top-level function (not a CAF)
-getLabelledBlocks :: CmmDecl -> [(SomeLabel, CAFLabel)]
-getLabelledBlocks (CmmData _ (CmmStaticsRaw _ _)) =
-  []
-getLabelledBlocks (CmmData _ (CmmStatics lbl _ _ _)) =
-  [ (DeclLabel lbl, mkCAFLabel lbl) ]
-getLabelledBlocks (CmmProc top_info _ _ _) =
-  [ (BlockLabel blockId, caf_lbl)
-  | (blockId, info) <- mapToList (info_tbls top_info)
-  , let rep = cit_rep info
-  , not (isStaticRep rep) || not (isThunkRep rep)
-  , let !caf_lbl = mkCAFLabel (cit_lbl info)
-  ]
+getLabelledBlocks :: Platform -> CmmDecl -> [(SomeLabel, CAFLabel)]
+getLabelledBlocks platform decl = case decl of
+   CmmData _ (CmmStaticsRaw _ _)    -> []
+   CmmData _ (CmmStatics lbl _ _ _) -> [ (DeclLabel lbl, mkCAFLabel platform lbl) ]
+   CmmProc top_info _ _ _           -> [ (BlockLabel blockId, caf_lbl)
+                                       | (blockId, info) <- mapToList (info_tbls top_info)
+                                       , let rep = cit_rep info
+                                       , not (isStaticRep rep) || not (isThunkRep rep)
+                                       , let !caf_lbl = mkCAFLabel platform (cit_lbl info)
+                                       ]
 
 -- | Put the labelled blocks that we will be annotating with SRTs into
 -- dependency order.  This is so that we can process them one at a
 -- time, resolving references to earlier blocks to point to their
 -- SRTs. CAFs themselves are not included here; see getCAFs below.
 depAnalSRTs
-  :: CAFEnv
+  :: Platform
+  -> CAFEnv
   -> Map CLabel CAFSet -- CAFEnv for statics
   -> [CmmDecl]
   -> [SCC (SomeLabel, CAFLabel, Set CAFLabel)]
-depAnalSRTs cafEnv cafEnv_static decls =
+depAnalSRTs platform cafEnv cafEnv_static decls =
   srtTrace "depAnalSRTs" (text "decls:" <+> ppr decls $$
                            text "nodes:" <+> ppr (map node_payload nodes) $$
                            text "graph:" <+> ppr graph) graph
  where
   labelledBlocks :: [(SomeLabel, CAFLabel)]
-  labelledBlocks = concatMap getLabelledBlocks decls
+  labelledBlocks = concatMap (getLabelledBlocks platform) decls
   labelToBlock :: Map CAFLabel SomeLabel
   labelToBlock = foldl' (\m (v,k) -> Map.insert k v m) Map.empty labelledBlocks
 
@@ -701,9 +700,9 @@ depAnalSRTs cafEnv cafEnv_static decls =
 --    SRT, since the point of SRTs is to keep CAFs alive.
 --  - CAFs therefore don't take part in the dependency analysis in depAnalSRTs.
 --    instead we generate their SRTs after everything else.
-getCAFs :: CAFEnv -> [CmmDecl] -> [(Label, CAFLabel, Set CAFLabel)]
-getCAFs cafEnv decls =
-  [ (g_entry g, mkCAFLabel topLbl, cafs)
+getCAFs :: Platform -> CAFEnv -> [CmmDecl] -> [(Label, CAFLabel, Set CAFLabel)]
+getCAFs platform cafEnv decls =
+  [ (g_entry g, mkCAFLabel platform topLbl, cafs)
   | CmmProc top_info topLbl _ g <- decls
   , Just info <- [mapLookup (g_entry g) (info_tbls top_info)]
   , let rep = cit_rep info
@@ -747,11 +746,11 @@ srtMapNonCAFs srtMap =
     get_name (_l, Just _srt_entry) = Nothing
 
 -- | resolve a CAFLabel to its SRTEntry using the SRTMap
-resolveCAF :: SRTMap -> CAFLabel -> Maybe SRTEntry
-resolveCAF srtMap lbl@(CAFLabel l) =
+resolveCAF :: Platform -> SRTMap -> CAFLabel -> Maybe SRTEntry
+resolveCAF platform srtMap lbl@(CAFLabel l) =
     srtTrace "resolveCAF" ("l:" <+> ppr l <+> "resolved:" <+> ppr ret) ret
   where
-    ret = Map.findWithDefault (Just (SRTEntry (toClosureLbl l))) lbl srtMap
+    ret = Map.findWithDefault (Just (SRTEntry (toClosureLbl platform l))) lbl srtMap
 
 -- | Attach SRTs to all info tables in the CmmDecls, and add SRT
 -- declarations to the ModuleSRTInfo.
@@ -791,6 +790,8 @@ doSRTs dflags moduleSRTInfo procs data_ = do
       decls = map snd data_ ++ concat procss
       staticFuns = mapFromList (getStaticFuns decls)
 
+      platform = targetPlatform dflags
+
   -- Put the decls in dependency order. Why? So that we can implement
   -- [Inline] and [Filter].  If we need to refer to an SRT that has
   -- a single entry, we use the entry itself, which means that we
@@ -799,10 +800,10 @@ doSRTs dflags moduleSRTInfo procs data_ = do
   -- them.
   let
     sccs :: [SCC (SomeLabel, CAFLabel, Set CAFLabel)]
-    sccs = {-# SCC depAnalSRTs #-} depAnalSRTs cafEnv static_data_env decls
+    sccs = {-# SCC depAnalSRTs #-} depAnalSRTs platform cafEnv static_data_env decls
 
     cafsWithSRTs :: [(Label, CAFLabel, Set CAFLabel)]
-    cafsWithSRTs = getCAFs cafEnv decls
+    cafsWithSRTs = getCAFs platform cafEnv decls
 
   srtTraceM "doSRTs" (text "data:" <+> ppr data_ $$
                       text "procs:" <+> ppr procs $$
@@ -853,7 +854,7 @@ doSRTs dflags moduleSRTInfo procs data_ = do
                           -- be CAFFY.
                           -- See Note [Ticky labels in SRT analysis] above for
                           -- why we exclude ticky labels here.
-                          Map.insert (mkCAFLabel lbl) Nothing srtMap
+                          Map.insert (mkCAFLabel platform lbl) Nothing srtMap
                       | otherwise ->
                           -- Not an IdLabel, ignore
                           srtMap
@@ -933,6 +934,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
   let
     config = initConfig dflags
     profile = targetProfile dflags
+    platform = profilePlatform profile
     srtMap = moduleSRTMap topSRT
 
     blockids = getBlockLabels lbls
@@ -951,7 +953,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
 
     -- Resolve references to their SRT entries
     resolved :: [SRTEntry]
-    resolved = mapMaybe (resolveCAF srtMap) (Set.toList nonRec)
+    resolved = mapMaybe (resolveCAF platform srtMap) (Set.toList nonRec)
 
     -- The set of all SRTEntries in SRTs that we refer to from here.
     allBelow =
@@ -1016,7 +1018,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
     -- We're going to build an SRT for this group, which should include function
     -- references in the group. See Note [recursive SRTs].
     let allBelow_funs =
-          Set.fromList (map (SRTEntry . toClosureLbl) otherFunLabels)
+          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)
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index 876de8a41e..ccf3d36a82 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -46,7 +46,7 @@ cmmPipeline
 cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline") forceRes $
   do let dflags = hsc_dflags hsc_env
 
-     tops <- {-# SCC "tops" #-} mapM (cpsTop hsc_env) prog
+     tops <- {-# SCC "tops" #-} mapM (cpsTop dflags) prog
 
      let (procs, data_) = partitionEithers tops
      (srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs dflags srtInfo procs data_
@@ -59,9 +59,9 @@ cmmPipeline hsc_env srtInfo prog = withTimingSilent dflags (text "Cmm pipeline")
 
         dflags = hsc_dflags hsc_env
 
-cpsTop :: HscEnv -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl))
-cpsTop _ p@(CmmData _ statics) = return (Right (cafAnalData statics, p))
-cpsTop hsc_env proc =
+cpsTop :: DynFlags -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl))
+cpsTop dflags p@(CmmData _ statics) = return (Right (cafAnalData (targetPlatform dflags) statics, p))
+cpsTop dflags proc =
     do
        ----------- Control-flow optimisations ----------------------------------
 
@@ -118,7 +118,7 @@ cpsTop hsc_env proc =
                      Opt_D_dump_cmm_sink "Sink assignments"
 
        ------------- CAF analysis ----------------------------------------------
-       let cafEnv = {-# SCC "cafAnal" #-} cafAnal call_pps l g
+       let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
        dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (ppr cafEnv)
 
        g <- if splitting_proc_points
@@ -153,8 +153,7 @@ cpsTop hsc_env proc =
 
        return (Left (cafEnv, g))
 
-  where dflags = hsc_dflags hsc_env
-        platform = targetPlatform dflags
+  where platform = targetPlatform dflags
         dump = dumpGraph dflags
 
         dumps flag name
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 1a42dad51d..cca69310b7 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -319,7 +319,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
                   tablesNextToCode = platformTablesNextToCode platform
                   jump_label (Just info_lbl) _
                              | tablesNextToCode = info_lbl
-                             | otherwise        = toEntryLbl info_lbl
+                             | otherwise        = toEntryLbl platform info_lbl
                   jump_label Nothing  block_lbl = block_lbl
 
                   add_if_pp id rst = case mapLookup id procLabels of