Don't rely on CLabel's Outputable instance in CmmToC

This is in preparation of the removal of sdocWithDynFlags (#10143),
hence of the refactoring of CLabel's Outputable instance.

2 files changed, 21 insertions, 20 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 2782da2ea4..c8f39b80ef 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_LLVM, pprCLabel_NCG,
+        pprCLabel, pprCLabel_LLVM, pprCLabel_NCG, pprCLabel_ViaC,
         isInfoTableLabel,
         isConInfoTableLabel,
         isIdLabel, isTickyLabel
@@ -1218,11 +1218,15 @@ pprCLabel bcknd platform lbl =
    case bcknd of
       NCG  -> pprCLabel_NCG   platform lbl
       LLVM -> pprCLabel_LLVM  platform lbl
+      ViaC -> pprCLabel_ViaC  platform lbl
       _    -> pprCLabel_other platform lbl
 
 pprCLabel_LLVM :: Platform -> CLabel -> SDoc
 pprCLabel_LLVM = pprCLabel_NCG
 
+pprCLabel_ViaC :: Platform -> CLabel -> SDoc
+pprCLabel_ViaC = pprCLabel_other
+
 pprCLabel_NCG :: Platform -> CLabel -> SDoc
 pprCLabel_NCG platform lbl = getPprStyle $ \sty ->
   let
@@ -1348,7 +1352,13 @@ pprCLabel_common platform = \case
 
    (ForeignLabel str _ _ _) -> ftext str
 
-   (IdLabel name _cafs flavor) -> internalNamePrefix platform name <> ppr name <> ppIdFlavor flavor
+   (IdLabel name _cafs flavor) -> internalNamePrefix <> ppr name <> ppIdFlavor flavor
+                                    where
+                                       isRandomGenerated = not (isExternalName name)
+                                       internalNamePrefix = getPprStyle $ \ sty ->
+                                          if asmStyle sty && isRandomGenerated
+                                             then ptext (asmTempLabelPrefix platform)
+                                             else empty
 
    (CC_Label cc)       -> ppr cc
    (CCS_Label ccs)     -> ppr ccs
@@ -1389,15 +1399,6 @@ instance Outputable ForeignLabelSource where
         ForeignLabelInThisPackage       -> parens $ text "this package"
         ForeignLabelInExternalPackage   -> parens $ text "external package"
 
-internalNamePrefix :: Platform -> Name -> SDoc
-internalNamePrefix platform name = getPprStyle $ \ sty ->
-  if asmStyle sty && isRandomGenerated then
-      ptext (asmTempLabelPrefix platform)
-  else
-    empty
-  where
-    isRandomGenerated = not $ isExternalName name
-
 tempLabelPrefixOrUnderscore :: Platform -> SDoc
 tempLabelPrefixOrUnderscore platform =
   getPprStyle $ \ sty ->
diff --git a/compiler/GHC/CmmToC.hs b/compiler/GHC/CmmToC.hs
index daf98f71a5..dc7a383d2f 100644
--- a/compiler/GHC/CmmToC.hs
+++ b/compiler/GHC/CmmToC.hs
@@ -91,7 +91,7 @@ pprTop platform = \case
            blankLine,
            extern_decls,
            (if (externallyVisibleCLabel clbl)
-                    then mkFN_ else mkIF_) (ppr clbl) <+> lbrace,
+                    then mkFN_ else mkIF_) (pprCLabel_ViaC platform clbl) <+> lbrace,
            nest 8 temp_decls,
            vcat (map (pprBBlock platform) blocks),
            rbrace ]
@@ -110,14 +110,14 @@ pprTop platform = \case
   (CmmData section (CmmStaticsRaw lbl [CmmString str])) ->
     pprExternDecl platform lbl $$
     hcat [
-      pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
+      pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl,
       text "[] = ", pprStringInCStyle str, semi
     ]
 
   (CmmData section (CmmStaticsRaw lbl [CmmUninitialised size])) ->
     pprExternDecl platform lbl $$
     hcat [
-      pprLocalness lbl, pprConstness (isSecConstant section), text "char ", ppr lbl,
+      pprLocalness lbl, pprConstness (isSecConstant section), text "char ", pprCLabel_ViaC platform lbl,
       brackets (int size), semi
     ]
 
@@ -153,7 +153,7 @@ pprWordArray platform is_ro lbl ds
   = -- TODO: align closures only
     pprExternDecl platform lbl $$
     hcat [ pprLocalness lbl, pprConstness is_ro, text "StgWord"
-         , space, ppr lbl, text "[]"
+         , space, pprCLabel_ViaC platform lbl, text "[]"
          -- See Note [StgWord alignment]
          , pprAlignment (wordWidth platform)
          , text "= {" ]
@@ -238,7 +238,7 @@ pprStmt platform stmt =
             case fn of
               CmmLit (CmmLabel lbl)
                 | StdCallConv <- cconv ->
-                    pprCall platform (ppr lbl) cconv hresults hargs
+                    pprCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs
                         -- stdcall functions must be declared with
                         -- a function type, otherwise the C compiler
                         -- doesn't add the @n suffix to the label.  We
@@ -247,7 +247,7 @@ pprStmt platform stmt =
                 | CmmNeverReturns <- ret ->
                     pprCall platform cast_fn cconv hresults hargs <> semi
                 | not (isMathFun lbl) ->
-                    pprForeignCall platform (ppr lbl) cconv hresults hargs
+                    pprForeignCall platform (pprCLabel_ViaC platform lbl) cconv hresults hargs
               _ ->
                     pprCall platform cast_fn cconv hresults hargs <> semi
                         -- for a dynamic call, no declaration is necessary.
@@ -487,7 +487,7 @@ pprLit platform lit = case lit of
         -> mkW_ <> pprCLabelAddr clbl1 <> char '+' <> int i
 
     where
-        pprCLabelAddr lbl = char '&' <> ppr lbl
+        pprCLabelAddr lbl = char '&' <> pprCLabel_ViaC platform lbl
 
 pprLit1 :: Platform -> CmmLit -> SDoc
 pprLit1 platform lit = case lit of
@@ -1047,7 +1047,7 @@ pprExternDecl platform lbl
   | not (needsCDecl lbl) = empty
   | Just sz <- foreignLabelStdcallInfo lbl = stdcall_decl sz
   | otherwise =
-        hcat [ visibility, label_type lbl , lparen, ppr lbl, text ");"
+        hcat [ visibility, label_type lbl , lparen, pprCLabel_ViaC platform lbl, text ");"
              -- occasionally useful to see label type
              -- , text "/* ", pprDebugCLabel lbl, text " */"
              ]
@@ -1070,7 +1070,7 @@ pprExternDecl platform lbl
   -- we must generate an appropriate prototype for it, so that the C compiler will
   -- add the @n suffix to the label (#2276)
   stdcall_decl sz =
-        text "extern __attribute__((stdcall)) void " <> ppr lbl
+        text "extern __attribute__((stdcall)) void " <> pprCLabel_ViaC platform lbl
         <> parens (commafy (replicate (sz `quot` platformWordSizeInBytes platform) (machRep_U_CType platform (wordWidth platform))))
         <> semi