Remove label style from printing context

Previously, the SDocContext used for code generation contained
information whether the labels should use Asm or C style.
However, at every individual call site, this is known statically.
This removes the parameter to 'PprCode' and replaces every 'pdoc'
used to print a label in code style with 'pprCLabel' or 'pprAsmLabel'.
The OutputableP instance is now used only for dumps.

The output of T15155 changes, it now uses the Asm style
(which is faithful to what actually happens).

5 files changed, 20 insertions, 16 deletions

diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index c12ecff5eb..5a969d30f5 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -128,6 +128,7 @@ module GHC.Cmm.CLabel (
         LabelStyle (..),
         pprDebugCLabel,
         pprCLabel,
+        pprAsmLabel,
         ppInternalProcLabel,
 
         -- * Others
@@ -1389,13 +1390,15 @@ allocation.  Take care if you want to remove them!
 
 -}
 
+pprAsmLabel :: Platform -> CLabel -> SDoc
+pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl
+
 instance OutputableP Platform CLabel where
   {-# INLINE pdoc #-} -- see Note [Bangs in CLabel]
   pdoc !platform lbl = getPprStyle $ \pp_sty ->
-                        let !sty = case pp_sty of
-                                    PprCode sty -> sty
-                                    _           -> CStyle
-                        in pprCLabel platform sty lbl
+                        case pp_sty of
+                          PprDump{} -> pprCLabel platform CStyle lbl
+                          _         -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl)
 
 pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
 pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
@@ -1522,7 +1525,7 @@ pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel]
 
    CC_Label cc   -> maybe_underscore $ ppr cc
    CCS_Label ccs -> maybe_underscore $ ppr ccs
-   IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCode CStyle (pdoc platform l) <> text "_" <> ppr m <> text "_ipe")
+   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
 
    CmmLabel _ _ fs CmmCode     -> maybe_underscore $ ftext fs
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index 977ab271f7..6eca29e722 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -77,7 +77,7 @@ data DebugBlock =
   , dblBlocks     :: ![DebugBlock] -- ^ Nested blocks
   }
 
-instance OutputableP env CLabel => OutputableP env DebugBlock where
+instance OutputableP Platform DebugBlock where
   pdoc env blk =
             (if | dblProcedure blk == dblLabel blk
                 -> text "proc"
@@ -85,7 +85,7 @@ instance OutputableP env CLabel => OutputableP env DebugBlock where
                 -> text "pp-blk"
                 | otherwise
                 -> text "blk") <+>
-            ppr (dblLabel blk) <+> parens (pdoc env (dblCLabel blk)) <+>
+            ppr (dblLabel blk) <+> parens (pprAsmLabel env (dblCLabel blk)) <+>
             (maybe empty ppr (dblSourceTick blk)) <+>
             (maybe (text "removed") ((text "pos " <>) . ppr)
                    (dblPosition blk)) <+>
@@ -495,9 +495,9 @@ LOC this information will end up in is Y.
 -- | A label associated with an 'UnwindTable'
 data UnwindPoint = UnwindPoint !CLabel !UnwindTable
 
-instance OutputableP env CLabel => OutputableP env UnwindPoint where
+instance OutputableP Platform UnwindPoint where
   pdoc env (UnwindPoint lbl uws) =
-      braces $ pdoc env lbl <> colon
+      braces $ pprAsmLabel env lbl <> colon
       <+> hsep (punctuate comma $ map pprUw $ Map.toList uws)
     where
       pprUw (g, expr) = ppr g <> char '=' <> pdoc env expr
@@ -519,16 +519,16 @@ data UnwindExpr = UwConst !Int                  -- ^ literal value
                 | UwTimes UnwindExpr UnwindExpr
                 deriving (Eq)
 
-instance OutputableP env CLabel => OutputableP env UnwindExpr where
+instance OutputableP Platform UnwindExpr where
   pdoc = pprUnwindExpr 0
 
-pprUnwindExpr :: OutputableP env CLabel => Rational -> env -> UnwindExpr -> SDoc
+pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc
 pprUnwindExpr p env = \case
   UwConst i     -> ppr i
   UwReg g 0     -> ppr g
   UwReg g x     -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x))
   UwDeref e     -> char '*' <> pprUnwindExpr 3 env e
-  UwLabel l     -> pdoc env l
+  UwLabel l     -> pprAsmLabel env l
   UwPlus e0 e1
    | p <= 0     -> pprUnwindExpr 0 env e0 <> char '+' <> pprUnwindExpr 0 env e1
   UwMinus e0 e1
diff --git a/compiler/GHC/Cmm/Lint.hs b/compiler/GHC/Cmm/Lint.hs
index ec81099223..03d667b4d4 100644
--- a/compiler/GHC/Cmm/Lint.hs
+++ b/compiler/GHC/Cmm/Lint.hs
@@ -23,6 +23,7 @@ import GHC.Cmm.Dataflow.Label
 import GHC.Cmm
 import GHC.Cmm.Liveness
 import GHC.Cmm.Switch (switchTargetsToList)
+import GHC.Cmm.CLabel (pprDebugCLabel)
 import GHC.Utils.Outputable
 
 import Control.Monad (ap, unless)
@@ -55,7 +56,7 @@ lintCmmDecl :: GenCmmDecl h i CmmGraph -> CmmLint ()
 lintCmmDecl (CmmProc _ lbl _ g)
   = do
     platform <- getPlatform
-    addLintInfo (text "in proc " <> pdoc platform lbl) $ lintCmmGraph g
+    addLintInfo (text "in proc " <> pprDebugCLabel platform lbl) $ lintCmmGraph g
 lintCmmDecl (CmmData {})
   = return ()
 
diff --git a/compiler/GHC/Cmm/Node.hs b/compiler/GHC/Cmm/Node.hs
index 117ed9747a..24983360c2 100644
--- a/compiler/GHC/Cmm/Node.hs
+++ b/compiler/GHC/Cmm/Node.hs
@@ -508,9 +508,9 @@ pprForeignTarget platform (PrimTarget op)
  -- HACK: We're just using a ForeignLabel to get this printed, the label
  --       might not really be foreign.
  = pdoc platform
-               (CmmLabel (mkForeignLabel
+               (mkForeignLabel
                           (mkFastString (show op))
-                          Nothing ForeignLabelInThisPackage IsFunction))
+                          Nothing ForeignLabelInThisPackage IsFunction)
 
 instance Outputable Convention where
   ppr = pprConvention
diff --git a/compiler/GHC/Cmm/Parser.y b/compiler/GHC/Cmm/Parser.y
index 92ff930bf1..312dc2e4f7 100644
--- a/compiler/GHC/Cmm/Parser.y
+++ b/compiler/GHC/Cmm/Parser.y
@@ -449,7 +449,7 @@ cmmproc :: { CmmParse () }
                          platform <- getPlatform;
                          ctx      <- getContext;
                          formals <- sequence (fromMaybe [] $3);
-                         withName (renderWithContext ctx (pdoc platform entry_ret_label))
+                         withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label))
                            $4;
                          return (entry_ret_label, info, stk_formals, formals) }
                      let do_layout = isJust $3