summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-08-25 16:51:21 +0200
committerKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2022-08-26 14:07:29 +0200
commit9721800921351ec5eaa2e116e5fe9b7cb8b5f8eb (patch)
tree3a86fe92f5dbbc0c865a7cc76eff43934d72fa5d
parent28402eed1bd0ec27d1dd5b663304a741de0ce2c3 (diff)
downloadhaskell-wip/styled-labels-final.tar.gz
Remove label style from printing contextwip/styled-labels-final
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).
-rw-r--r--compiler/GHC/Cmm/CLabel.hs13
-rw-r--r--compiler/GHC/Cmm/DebugBlock.hs14
-rw-r--r--compiler/GHC/Cmm/Lint.hs3
-rw-r--r--compiler/GHC/Cmm/Node.hs4
-rw-r--r--compiler/GHC/Cmm/Parser.y2
-rw-r--r--compiler/GHC/CmmToAsm.hs6
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/CodeGen.hs6
-rw-r--r--compiler/GHC/CmmToAsm/AArch64/Ppr.hs98
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf.hs10
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf/Types.hs54
-rw-r--r--compiler/GHC/CmmToAsm/PIC.hs2
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs52
-rw-r--r--compiler/GHC/CmmToAsm/Ppr.hs2
-rw-r--r--compiler/GHC/CmmToAsm/X86/Ppr.hs30
-rw-r--r--compiler/GHC/CmmToLlvm/CodeGen.hs9
-rw-r--r--compiler/GHC/Driver/CodeOutput.hs15
-rw-r--r--compiler/GHC/Driver/Config/CmmToAsm.hs2
-rw-r--r--compiler/GHC/Driver/Config/CmmToLlvm.hs2
-rw-r--r--compiler/GHC/Driver/Pipeline.hs2
-rw-r--r--compiler/GHC/HsToCore/Foreign/C.hs2
-rw-r--r--compiler/GHC/Iface/Tidy/StaticPtrTable.hs4
-rw-r--r--compiler/GHC/StgToCmm/Layout.hs2
-rw-r--r--compiler/GHC/StgToCmm/Ticky.hs2
-rw-r--r--compiler/GHC/Utils/Logger.hs2
-rw-r--r--compiler/GHC/Utils/Outputable.hs16
-rw-r--r--testsuite/tests/codeGen/should_compile/Makefile4
-rw-r--r--testsuite/tests/codeGen/should_compile/T15155.stdout-darwin1
27 files changed, 179 insertions, 180 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
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 21b68a8f01..a8cfd23f08 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -396,7 +396,7 @@ cmmNativeGens logger config modLoc ncgImpl h dbgMap = go
-- force evaluation all this stuff to avoid space leaks
let platform = ncgPlatform config
- {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pdoc platform) imports) ()
+ {-# SCC "seqString" #-} evaluate $ seqList (showSDocUnsafe $ vcat $ map (pprAsmLabel platform) imports) ()
let !labels' = if ncgDwarfEnabled config
then cmmDebugLabels isMetaInstr native else []
@@ -455,7 +455,7 @@ cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count
let weights = ncgCfgWeights config
let proc_name = case cmm of
- (CmmProc _ entry_label _ _) -> pdoc platform entry_label
+ (CmmProc _ entry_label _ _) -> pprAsmLabel platform entry_label
_ -> text "DataChunk"
-- rewrite assignments to global regs
@@ -789,7 +789,7 @@ makeImportsDoc config imports
doPpr lbl = (lbl, renderWithContext
(ncgAsmContext config)
- (pprCLabel platform AsmStyle lbl))
+ (pprAsmLabel platform lbl))
-- -----------------------------------------------------------------------------
-- Generate jump tables
diff --git a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
index 0071f291a1..c017f376bb 100644
--- a/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
@@ -60,6 +60,7 @@ import GHC.Types.ForeignCall
import GHC.Data.FastString
import GHC.Utils.Misc
import GHC.Utils.Panic
+import GHC.Utils.Constants (debugIsOn)
-- Note [General layout of an NCG]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -135,10 +136,11 @@ basicBlockCodeGen block = do
id = entryLabel block
stmts = blockToList nodes
- header_comment_instr = unitOL $ MULTILINE_COMMENT (
+ header_comment_instr | debugIsOn = unitOL $ MULTILINE_COMMENT (
text "-- --------------------------- basicBlockCodeGen --------------------------- --\n"
- $+$ pdoc (ncgPlatform config) block
+ $+$ withPprStyle defaultDumpStyle (pdoc (ncgPlatform config) block)
)
+ | otherwise = nilOL
-- Generate location directive
dbg <- getDebugBlock (entryLabel block)
loc_instrs <- case dblSourceTick =<< dbg of
diff --git a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
index 9c50f7676c..16665b9c57 100644
--- a/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/AArch64/Ppr.hs
@@ -50,14 +50,14 @@ 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 pdoc platform (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
+ then 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 pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
+ then 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
@@ -65,9 +65,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
(if platformHasSubsectionsViaSymbols platform
then -- See Note [Subsections Via Symbols]
text "\t.long "
- <+> pdoc platform info_lbl
+ <+> pprAsmLabel platform info_lbl
<+> char '-'
- <+> pdoc platform (mkDeadStripPreventer info_lbl)
+ <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
else empty) $$
pprSizeDecl platform info_lbl
@@ -75,7 +75,7 @@ pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl =
pprGloblDecl platform lbl
$$ pprTypeDecl platform lbl
- $$ (pdoc platform lbl <> char ':')
+ $$ (pprAsmLabel platform lbl <> char ':')
pprAlign :: Platform -> Alignment -> SDoc
pprAlign _platform alignment
@@ -105,7 +105,7 @@ pprSectionAlign config sec@(Section seg _) =
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
= if osElfTarget (platformOS platform)
- then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl
+ then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl
else empty
pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
@@ -115,7 +115,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprLabel platform asmLbl $$
vcat (map (pprInstr platform) (id {-detectTrivialDeadlock-} optInstrs)) $$
(if ncgDwarfEnabled config
- then pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':'
+ then pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':'
else empty
)
where
@@ -135,7 +135,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprLabel platform info_lbl $$
c $$
(if ncgDwarfEnabled config
- then pdoc platform (mkAsmTempEndLabel info_lbl) <> char ':'
+ then 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]
@@ -153,7 +153,7 @@ pprDatas config (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit
, Just ind' <- labelInd ind
, alias `mayRedirectTo` ind'
= pprGloblDecl (ncgPlatform config) alias
- $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind')
+ $$ text ".equiv" <+> pprAsmLabel (ncgPlatform config) alias <> comma <> pprAsmLabel (ncgPlatform config) ind'
pprDatas config (CmmStaticsRaw lbl dats)
= vcat (pprLabel platform lbl : map (pprData config) dats)
@@ -175,7 +175,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl platform lbl
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = text "\t.globl " <> pdoc platform lbl
+ | otherwise = text "\t.globl " <> pprAsmLabel platform lbl
-- Note [Always use objects for info tables]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -201,7 +201,7 @@ pprLabelType' platform lbl =
pprTypeDecl :: Platform -> CLabel -> SDoc
pprTypeDecl platform lbl
= if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
- then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
+ then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl
else empty
pprDataItem :: NCGConfig -> CmmLit -> SDoc
@@ -230,8 +230,8 @@ pprDataItem config lit
pprImm :: Platform -> Imm -> SDoc
pprImm _ (ImmInt i) = int i
pprImm _ (ImmInteger i) = integer i
-pprImm p (ImmCLbl l) = pdoc p l
-pprImm p (ImmIndex l i) = pdoc p l <> char '+' <> int i
+pprImm p (ImmCLbl l) = pprAsmLabel p l
+pprImm p (ImmIndex l i) = pprAsmLabel p l <> char '+' <> int i
pprImm _ (ImmLit s) = text s
-- TODO: See pprIm below for why this is a bad idea!
@@ -279,8 +279,8 @@ pprIm platform im = case im of
ImmDouble d | d == 0 -> text "xzr"
ImmDouble d -> char '#' <> double (fromRational d)
-- =<lbl> pseudo instruction!
- ImmCLbl l -> char '=' <> pdoc platform l
- ImmIndex l o -> text "[=" <> pdoc platform l <> comma <+> char '#' <> int o <> char ']'
+ ImmCLbl l -> char '=' <> pprAsmLabel platform l
+ ImmIndex l o -> text "[=" <> pprAsmLabel platform l <> comma <+> char '#' <> int o <> char ']'
_ -> panic "AArch64.pprIm"
pprExt :: ExtMode -> SDoc
@@ -430,28 +430,28 @@ pprInstr platform instr = case instr of
-- 4. Branch Instructions ----------------------------------------------------
J t -> pprInstr platform (B t)
- B (TBlock bid) -> text "\tb" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
- B (TLabel lbl) -> text "\tb" <+> pdoc platform lbl
+ 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
- BL (TBlock bid) _ _ -> text "\tbl" <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
- BL (TLabel lbl) _ _ -> text "\tbl" <+> pdoc platform lbl
+ 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
- BCOND c (TBlock bid) -> text "\t" <> pprBcond c <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
- BCOND c (TLabel lbl) -> text "\t" <> pprBcond c <+> pdoc platform lbl
+ 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 _ (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
- CBZ o (TBlock bid) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
- CBZ o (TLabel lbl) -> text "\tcbz" <+> pprOp platform o <> comma <+> pdoc platform lbl
+ 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 _ (TReg _) -> panic "AArch64.ppr: No conditional (cbz) branching to registers!"
- CBNZ o (TBlock bid) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform (mkLocalBlockLabel (getUnique bid))
- CBNZ o (TLabel lbl) -> text "\tcbnz" <+> pprOp platform o <> comma <+> pdoc platform lbl
+ 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 _ (TReg _) -> panic "AArch64.ppr: No conditional (cbnz) branching to registers!"
-- 7. Load and Store Instructions --------------------------------------------
@@ -466,58 +466,58 @@ pprInstr platform instr = case instr of
#if defined(darwin_HOST_OS)
LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]" $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmIndex lbl off)) ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff" $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$
+ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"
LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpage" $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@gotpageoff" <> text "]"
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"
LDR _f o1 (OpImm (ImmCLbl lbl)) ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@page" $$
- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pdoc platform lbl <> text "@pageoff"
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$
+ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff"
#else
LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]" $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmIndex lbl off)) ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl $$
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$
+ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$
text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.
LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"
LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pdoc platform lbl $$
- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pdoc platform lbl <> text "]"
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$
+ text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"
LDR _f o1 (OpImm (ImmCLbl lbl)) ->
- text "\tadrp" <+> pprOp platform o1 <> comma <+> pdoc platform lbl $$
- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pdoc platform lbl
+ text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$
+ text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl
#endif
LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->
diff --git a/compiler/GHC/CmmToAsm/Dwarf.hs b/compiler/GHC/CmmToAsm/Dwarf.hs
index 503aca0b3e..407050d045 100644
--- a/compiler/GHC/CmmToAsm/Dwarf.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf.hs
@@ -51,8 +51,8 @@ dwarfGen config modLoc us blocks = do
, dwName = fromMaybe "" (ml_hs_file modLoc)
, dwCompDir = addTrailingPathSeparator compPath
, dwProducer = cProjectName ++ " " ++ cProjectVersion
- , dwLowLabel = pdoc platform lowLabel
- , dwHighLabel = pdoc platform highLabel
+ , dwLowLabel = pprAsmLabel platform lowLabel
+ , dwHighLabel = pprAsmLabel platform highLabel
, dwLineLabel = dwarfLineLabel
}
@@ -109,9 +109,9 @@ mkDwarfARange proc = DwarfARange lbl end
compileUnitHeader :: Platform -> Unique -> SDoc
compileUnitHeader platform unitU =
let cuLabel = mkAsmTempLabel unitU -- sits right before initialLength field
- length = pdoc platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pdoc platform cuLabel
+ length = pprAsmLabel platform (mkAsmTempEndLabel cuLabel) <> char '-' <> pprAsmLabel platform cuLabel
<> text "-4" -- length of initialLength field
- in vcat [ pdoc platform cuLabel <> colon
+ in vcat [ pprAsmLabel platform cuLabel <> colon
, text "\t.long " <> length -- compilation unit size
, pprHalf 3 -- DWARF version
, sectionOffset platform dwarfAbbrevLabel dwarfAbbrevLabel
@@ -123,7 +123,7 @@ compileUnitHeader platform unitU =
compileUnitFooter :: Platform -> Unique -> SDoc
compileUnitFooter platform unitU =
let cuEndLabel = mkAsmTempEndLabel $ mkAsmTempLabel unitU
- in pdoc platform cuEndLabel <> colon
+ in 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/Types.hs b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
index caa829db21..236ddb5ffc 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Types.hs
+++ b/compiler/GHC/CmmToAsm/Dwarf/Types.hs
@@ -184,14 +184,14 @@ pprDwarfInfoOpen platform haveSrc (DwarfCompileUnit _ name producer compDir lowL
then sectionOffset platform lineLbl dwarfLineLabel
else empty
pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
- pdoc platform (mkAsmTempDieLabel label) <> colon
+ pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
$$ pprAbbrev abbrev
$$ pprString name
$$ pprLabelString platform label
$$ pprFlag (externallyVisibleCLabel label)
-- Offset due to Note [Info Offset]
- $$ pprWord platform (pdoc platform label <> text "-1")
- $$ pprWord platform (pdoc platform $ mkAsmTempProcEndLabel label)
+ $$ pprWord platform (pprAsmLabel platform label <> text "-1")
+ $$ pprWord platform (pprAsmLabel platform $ mkAsmTempProcEndLabel label)
$$ pprByte 1
$$ pprByte dW_OP_call_frame_cfa
$$ parentValue
@@ -199,17 +199,17 @@ pprDwarfInfoOpen platform _ (DwarfSubprogram _ name label parent) =
abbrev = case parent of Nothing -> DwAbbrSubprogram
Just _ -> DwAbbrSubprogramWithParent
parentValue = maybe empty pprParentDie parent
- pprParentDie sym = sectionOffset platform (pdoc platform sym) dwarfInfoLabel
+ pprParentDie sym = sectionOffset platform (pprAsmLabel platform sym) dwarfInfoLabel
pprDwarfInfoOpen platform _ (DwarfBlock _ label Nothing) =
- pdoc platform (mkAsmTempDieLabel label) <> colon
+ pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
$$ pprAbbrev DwAbbrBlockWithoutCode
$$ pprLabelString platform label
pprDwarfInfoOpen platform _ (DwarfBlock _ label (Just marker)) =
- pdoc platform (mkAsmTempDieLabel label) <> colon
+ pprAsmLabel platform (mkAsmTempDieLabel label) <> colon
$$ pprAbbrev DwAbbrBlock
$$ pprLabelString platform label
- $$ pprWord platform (pdoc platform marker)
- $$ pprWord platform (pdoc platform $ mkAsmTempEndLabel marker)
+ $$ pprWord platform (pprAsmLabel platform marker)
+ $$ pprWord platform (pprAsmLabel platform $ mkAsmTempEndLabel marker)
pprDwarfInfoOpen _ _ (DwarfSrcNote ss) =
pprAbbrev DwAbbrGhcSrcNote
$$ pprString' (ftext $ srcSpanFile ss)
@@ -245,7 +245,7 @@ pprDwarfARanges platform arngs unitU =
initialLength = 8 + paddingSize + (1 + length arngs) * 2 * wordSize
in pprDwWord (ppr initialLength)
$$ pprHalf 2
- $$ sectionOffset platform (pdoc platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel
+ $$ sectionOffset platform (pprAsmLabel platform $ mkAsmTempLabel $ unitU) dwarfInfoLabel
$$ pprByte (fromIntegral wordSize)
$$ pprByte 0
$$ pad paddingSize
@@ -258,11 +258,11 @@ pprDwarfARanges platform arngs unitU =
pprDwarfARange :: Platform -> DwarfARange -> SDoc
pprDwarfARange platform arng =
-- Offset due to Note [Info Offset].
- pprWord platform (pdoc platform (dwArngStartLabel arng) <> text "-1")
+ pprWord platform (pprAsmLabel platform (dwArngStartLabel arng) <> text "-1")
$$ pprWord platform length
where
- length = pdoc platform (dwArngEndLabel arng)
- <> char '-' <> pdoc platform (dwArngStartLabel arng)
+ length = pprAsmLabel platform (dwArngEndLabel arng)
+ <> char '-' <> pprAsmLabel platform (dwArngStartLabel arng)
-- | Information about unwind instructions for a procedure. This
-- corresponds to a "Common Information Entry" (CIE) in DWARF.
@@ -293,7 +293,7 @@ data DwarfFrameBlock
-- in the block
}
-instance OutputableP env CLabel => OutputableP env DwarfFrameBlock where
+instance OutputableP Platform DwarfFrameBlock where
pdoc env (DwarfFrameBlock hasInfo unwinds) = braces $ ppr hasInfo <+> pdoc env unwinds
-- | Header for the @.debug_frame@ section. Here we emit the "Common
@@ -303,7 +303,7 @@ pprDwarfFrame :: Platform -> DwarfFrame -> SDoc
pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCieProcs=procs}
= let cieStartLabel= mkAsmTempDerivedLabel cieLabel (fsLit "_start")
cieEndLabel = mkAsmTempEndLabel cieLabel
- length = pdoc platform cieEndLabel <> char '-' <> pdoc platform cieStartLabel
+ length = pprAsmLabel platform cieEndLabel <> char '-' <> pprAsmLabel platform cieStartLabel
spReg = dwarfGlobalRegNo platform Sp
retReg = dwarfReturnRegNo platform
wordSize = platformWordSizeInBytes platform
@@ -316,9 +316,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 [ pdoc platform cieLabel <> colon
+ in vcat [ pprAsmLabel platform cieLabel <> colon
, pprData4' length -- Length of CIE
- , pdoc platform cieStartLabel <> colon
+ , pprAsmLabel platform cieStartLabel <> colon
, pprData4' (text "-1")
-- Common Information Entry marker (-1 = 0xf..f)
, pprByte 3 -- CIE version (we require DWARF 3)
@@ -346,7 +346,7 @@ pprDwarfFrame platform DwarfFrame{dwCieLabel=cieLabel,dwCieInit=cieInit,dwCiePro
, pprLEBWord 0
] $$
wordAlign platform $$
- pdoc platform cieEndLabel <> colon $$
+ pprAsmLabel platform cieEndLabel <> colon $$
-- Procedure unwind tables
vcat (map (pprFrameProc platform cieLabel cieInit) procs)
@@ -360,17 +360,17 @@ pprFrameProc platform frameLbl initUw (DwarfFrameProc procLbl hasInfo blocks)
procEnd = mkAsmTempProcEndLabel procLbl
ifInfo str = if hasInfo then text str else empty
-- see Note [Info Offset]
- in vcat [ whenPprDebug $ text "# Unwinding for" <+> pdoc platform procLbl <> colon
- , pprData4' (pdoc platform fdeEndLabel <> char '-' <> pdoc platform fdeLabel)
- , pdoc platform fdeLabel <> colon
- , pprData4' (pdoc platform frameLbl <> char '-' <> dwarfFrameLabel) -- Reference to CIE
- , pprWord platform (pdoc platform procLbl <> ifInfo "-1") -- Code pointer
- , pprWord platform (pdoc platform procEnd <> char '-' <>
- pdoc platform procLbl <> ifInfo "+1") -- Block byte length
+ in vcat [ whenPprDebug $ text "# Unwinding for" <+> pprAsmLabel platform procLbl <> colon
+ , pprData4' (pprAsmLabel platform fdeEndLabel <> char '-' <> pprAsmLabel platform fdeLabel)
+ , 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 '-' <>
+ pprAsmLabel platform procLbl <> ifInfo "+1") -- Block byte length
] $$
vcat (S.evalState (mapM (pprFrameBlock platform) blocks) initUw) $$
wordAlign platform $$
- pdoc platform fdeEndLabel <> colon
+ pprAsmLabel platform fdeEndLabel <> colon
-- | Generates unwind information for a block. We only generate
-- instructions where unwind information actually changes. This small
@@ -402,7 +402,7 @@ pprFrameBlock platform (DwarfFrameBlock hasInfo uws0) =
then (empty, oldUws)
else let -- see Note [Info Offset]
needsOffset = firstDecl && hasInfo
- lblDoc = pdoc platform lbl <>
+ lblDoc = pprAsmLabel platform lbl <>
if needsOffset then text "-1" else empty
doc = pprByte dW_CFA_set_loc $$ pprWord platform lblDoc $$
vcat (map (uncurry $ pprSetUnwind platform) changed)
@@ -513,7 +513,7 @@ pprUnwindExpr platform spIsCFA expr
pprE (UwReg g i) = pprByte (dW_OP_breg0+dwarfGlobalRegNo platform g) $$
pprLEBInt i
pprE (UwDeref u) = pprE u $$ pprByte dW_OP_deref
- pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pdoc platform l)
+ pprE (UwLabel l) = pprByte dW_OP_addr $$ pprWord platform (pprAsmLabel platform l)
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
diff --git a/compiler/GHC/CmmToAsm/PIC.hs b/compiler/GHC/CmmToAsm/PIC.hs
index 2bf8a58fd6..0b92afbfe6 100644
--- a/compiler/GHC/CmmToAsm/PIC.hs
+++ b/compiler/GHC/CmmToAsm/PIC.hs
@@ -729,7 +729,7 @@ pprImportedSymbol config importedLbl = case (arch,os) of
_ -> panic "PIC.pprImportedSymbol: no match"
where
platform = ncgPlatform config
- ppr_lbl = pprCLabel platform AsmStyle
+ ppr_lbl = pprAsmLabel platform
arch = platformArch platform
os = platformOS platform
pic = ncgPIC config
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index c09d02bafc..19de3cd1e2 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
@@ -63,7 +63,7 @@ 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) (pdoc platform (mkAsmTempEndLabel lbl)
+ ppWhen (ncgDwarfEnabled config) (pprAsmLabel platform (mkAsmTempEndLabel lbl)
<> char ':' $$
pprProcEndLabel platform lbl) $$
pprSizeDecl platform lbl
@@ -71,7 +71,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
(if platformHasSubsectionsViaSymbols platform
- then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
+ then 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
@@ -80,9 +80,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
then
-- See Note [Subsections Via Symbols] in X86/Ppr.hs
text "\t.long "
- <+> pdoc platform info_lbl
+ <+> pprAsmLabel platform info_lbl
<+> char '-'
- <+> pdoc platform (mkDeadStripPreventer info_lbl)
+ <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
else empty) $$
pprSizeDecl platform info_lbl
@@ -93,7 +93,7 @@ pprSizeDecl platform lbl
then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl
else empty
where
- prettyLbl = pdoc platform lbl
+ prettyLbl = pprAsmLabel platform lbl
codeLbl
| platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl
| otherwise = prettyLbl
@@ -102,33 +102,33 @@ pprFunctionDescriptor :: Platform -> CLabel -> SDoc
pprFunctionDescriptor platform lab = pprGloblDecl platform lab
$$ text "\t.section \".opd\", \"aw\""
$$ text "\t.align 3"
- $$ pdoc platform lab <> char ':'
+ $$ pprAsmLabel platform lab <> char ':'
$$ text "\t.quad ."
- <> pdoc platform lab
+ <> pprAsmLabel platform lab
<> text ",.TOC.@tocbase,0"
$$ text "\t.previous"
$$ text "\t.type"
- <+> pdoc platform lab
+ <+> pprAsmLabel platform lab
<> text ", @function"
- $$ char '.' <> pdoc platform lab <> char ':'
+ $$ char '.' <> pprAsmLabel platform lab <> char ':'
pprFunctionPrologue :: Platform -> CLabel ->SDoc
pprFunctionPrologue platform lab = pprGloblDecl platform lab
$$ text ".type "
- <> pdoc platform lab
+ <> pprAsmLabel platform lab
<> text ", @function"
- $$ pdoc platform lab <> char ':'
+ $$ 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" <> pdoc platform lab
- <> text ",.-" <> pdoc platform lab
+ $$ text "\t.localentry\t" <> pprAsmLabel platform lab
+ <> text ",.-" <> pprAsmLabel platform lab
pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
-> SDoc
pprProcEndLabel platform lbl =
- pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':'
+ pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> char ':'
pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
-> SDoc
@@ -137,7 +137,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
pprLabel platform asmLbl $$
vcat (map (pprInstr platform) instrs) $$
ppWhen (ncgDwarfEnabled config) (
- pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':'
+ pprAsmLabel platform (mkAsmTempEndLabel asmLbl) <> char ':'
<> pprProcEndLabel platform asmLbl
)
where
@@ -162,7 +162,7 @@ pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLi
, Just ind' <- labelInd ind
, alias `mayRedirectTo` ind'
= pprGloblDecl platform alias
- $$ text ".equiv" <+> pdoc platform alias <> comma <> pdoc platform (CmmLabel ind')
+ $$ 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
@@ -175,20 +175,20 @@ pprData platform d = case d of
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl platform lbl
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = text ".globl " <> pdoc platform lbl
+ | otherwise = text ".globl " <> pprAsmLabel platform lbl
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl platform lbl
= if platformOS platform == OSLinux && externallyVisibleCLabel lbl
then text ".type " <>
- pdoc platform lbl <> text ", @object"
+ pprAsmLabel platform lbl <> text ", @object"
else empty
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl =
pprGloblDecl platform lbl
$$ pprTypeAndSizeDecl platform lbl
- $$ (pdoc platform lbl <> char ':')
+ $$ (pprAsmLabel platform lbl <> char ':')
-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'
@@ -238,8 +238,8 @@ pprImm :: Platform -> Imm -> SDoc
pprImm platform = \case
ImmInt i -> int i
ImmInteger i -> integer i
- ImmCLbl l -> pdoc platform l
- ImmIndex l i -> pdoc platform l <> char '+' <> int i
+ ImmCLbl l -> pprAsmLabel platform l
+ ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i
ImmLit s -> text s
ImmFloat f -> float $ fromRational f
ImmDouble d -> double $ fromRational d
@@ -559,7 +559,7 @@ pprInstr platform instr = case instr of
pprCond cond,
pprPrediction prediction,
char '\t',
- pdoc platform lbl
+ pprAsmLabel platform lbl
]
where lbl = mkLocalBlockLabel (getUnique blockid)
pprPrediction p = case p of
@@ -577,7 +577,7 @@ pprInstr platform instr = case instr of
],
hcat [
text "\tb\t",
- pdoc platform lbl
+ pprAsmLabel platform lbl
]
]
where lbl = mkLocalBlockLabel (getUnique blockid)
@@ -594,7 +594,7 @@ pprInstr platform instr = case instr of
char '\t',
text "b",
char '\t',
- pdoc platform lbl
+ pprAsmLabel platform lbl
]
MTCTR reg
@@ -625,12 +625,12 @@ pprInstr platform instr = case instr of
-- they'd technically be more like 'ForeignLabel's.
hcat [
text "\tbl\t.",
- pdoc platform lbl
+ pprAsmLabel platform lbl
]
_ ->
hcat [
text "\tbl\t",
- pdoc platform lbl
+ pprAsmLabel platform lbl
]
BCTRL _
diff --git a/compiler/GHC/CmmToAsm/Ppr.hs b/compiler/GHC/CmmToAsm/Ppr.hs
index 5bda8d7a01..c54ce8f906 100644
--- a/compiler/GHC/CmmToAsm/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/Ppr.hs
@@ -210,7 +210,7 @@ pprGNUSectionHeader config t suffix =
platform = ncgPlatform config
splitSections = ncgSplitSections config
subsection
- | splitSections = sep <> pdoc platform suffix
+ | splitSections = sep <> pprAsmLabel platform suffix
| otherwise = empty
header = case t of
Text -> text ".text"
diff --git a/compiler/GHC/CmmToAsm/X86/Ppr.hs b/compiler/GHC/CmmToAsm/X86/Ppr.hs
index 8eb69f5179..cad3ab7163 100644
--- a/compiler/GHC/CmmToAsm/X86/Ppr.hs
+++ b/compiler/GHC/CmmToAsm/X86/Ppr.hs
@@ -93,7 +93,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
pprProcAlignment config $$
pprProcLabel config lbl $$
(if platformHasSubsectionsViaSymbols platform
- then pdoc platform (mkDeadStripPreventer info_lbl) <> colon
+ then pprAsmLabel platform (mkDeadStripPreventer info_lbl) <> colon
else empty) $$
vcat (map (pprBasicBlock config top_info) blocks) $$
ppWhen (ncgDwarfEnabled config) (pprProcEndLabel platform info_lbl) $$
@@ -102,9 +102,9 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
(if platformHasSubsectionsViaSymbols platform
then -- See Note [Subsections Via Symbols]
text "\t.long "
- <+> pdoc platform info_lbl
+ <+> pprAsmLabel platform info_lbl
<+> char '-'
- <+> pdoc platform (mkDeadStripPreventer info_lbl)
+ <+> pprAsmLabel platform (mkDeadStripPreventer info_lbl)
else empty) $$
pprSizeDecl platform info_lbl
@@ -120,18 +120,18 @@ pprProcLabel config lbl
pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
-> SDoc
pprProcEndLabel platform lbl =
- pdoc platform (mkAsmTempProcEndLabel lbl) <> colon
+ pprAsmLabel platform (mkAsmTempProcEndLabel lbl) <> colon
pprBlockEndLabel :: Platform -> CLabel -- ^ Block name
-> SDoc
pprBlockEndLabel platform lbl =
- pdoc platform (mkAsmTempEndLabel lbl) <> colon
+ pprAsmLabel platform (mkAsmTempEndLabel lbl) <> colon
-- | Output the ELF .size directive.
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
= if osElfTarget (platformOS platform)
- then text "\t.size" <+> pdoc platform lbl <> text ", .-" <> pdoc platform lbl
+ then text "\t.size" <+> pprAsmLabel platform lbl <> text ", .-" <> pprAsmLabel platform lbl
else empty
pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
@@ -156,7 +156,7 @@ pprBasicBlock config info_env (BasicBlock blockid instrs)
vcat (map (pprData config) info) $$
pprLabel platform infoLbl $$
c $$
- ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel infoLbl) <> colon)
+ ppWhen (ncgDwarfEnabled config) (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]
@@ -175,7 +175,7 @@ pprDatas config (_, CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticL
, Just ind' <- labelInd ind
, alias `mayRedirectTo` ind'
= pprGloblDecl (ncgPlatform config) alias
- $$ text ".equiv" <+> pdoc (ncgPlatform config) alias <> comma <> pdoc (ncgPlatform config) (CmmLabel ind')
+ $$ 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)
@@ -197,7 +197,7 @@ pprData config (CmmStaticLit lit) = pprDataItem config lit
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl platform lbl
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = text ".globl " <> pdoc platform lbl
+ | otherwise = text ".globl " <> pprAsmLabel platform lbl
pprLabelType' :: Platform -> CLabel -> SDoc
pprLabelType' platform lbl =
@@ -260,14 +260,14 @@ pprLabelType' platform lbl =
pprTypeDecl :: Platform -> CLabel -> SDoc
pprTypeDecl platform lbl
= if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
- then text ".type " <> pdoc platform lbl <> text ", " <> pprLabelType' platform lbl
+ then text ".type " <> pprAsmLabel platform lbl <> text ", " <> pprLabelType' platform lbl
else empty
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl =
pprGloblDecl platform lbl
$$ pprTypeDecl platform lbl
- $$ (pdoc platform lbl <> colon)
+ $$ (pprAsmLabel platform lbl <> colon)
pprAlign :: Platform -> Alignment -> SDoc
pprAlign platform alignment
@@ -430,8 +430,8 @@ pprImm :: Platform -> Imm -> SDoc
pprImm platform = \case
ImmInt i -> int i
ImmInteger i -> integer i
- ImmCLbl l -> pdoc platform l
- ImmIndex l i -> pdoc platform l <> char '+' <> int i
+ ImmCLbl l -> pprAsmLabel platform l
+ ImmIndex l i -> pprAsmLabel platform l <> char '+' <> int i
ImmLit s -> text s
ImmFloat f -> float $ fromRational f
ImmDouble d -> double $ fromRational d
@@ -576,7 +576,7 @@ pprInstr platform i = case i of
UNWIND lbl d
-> asmComment (text "\tunwind = " <> pdoc platform d)
- $$ pdoc platform lbl <> colon
+ $$ pprAsmLabel platform lbl <> colon
LDATA _ _
-> panic "pprInstr: LDATA"
@@ -818,7 +818,7 @@ pprInstr platform i = case i of
-> pprFormatOpReg (text "xchg") format src val
JXX cond blockid
- -> pprCondInstr (text "j") cond (pdoc platform lab)
+ -> pprCondInstr (text "j") cond (pprAsmLabel platform lab)
where lab = blockLbl blockid
JXX_GBL cond imm
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index 55c6e18883..cd110a0900 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -1705,7 +1705,6 @@ genMachOp_slow opt op [x, y] = case op of
where
binLlvmOp ty binOp allow_y_cast = do
- cfg <- getConfig
platform <- getPlatform
runExprData $ do
vx <- exprToVarW x
@@ -1721,13 +1720,7 @@ genMachOp_slow opt op [x, y] = case op of
doExprW (ty vx) $ binOp vx vy'
| otherwise
- -> do
- -- Error. Continue anyway so we can debug the generated ll file.
- let render = renderWithContext (llvmCgContext cfg)
- cmmToStr = (lines . render . pdoc platform)
- statement $ Comment $ map fsLit $ cmmToStr x
- statement $ Comment $ map fsLit $ cmmToStr y
- doExprW (ty vx) $ binOp vx vy
+ -> pprPanic "binLlvmOp types" (pdoc platform x $$ pdoc platform y)
binCastLlvmOp ty binOp = runExprData $ do
vx <- exprToVarW x
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index ce5a7e156d..e07c0af91f 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -173,7 +173,7 @@ outputC logger dflags filenm cmm_stream unit_deps =
"C backend output"
FormatC
doc
- let ctx = initSDocContext dflags (PprCode CStyle)
+ let ctx = initSDocContext dflags PprCode
printSDocLn ctx LeftMode h doc
Stream.consume cmm_stream id writeC
@@ -253,11 +253,11 @@ outputForeignStubs logger tmpfs dflags unit_state mod location stubs
ForeignStubs (CHeader h_code) (CStub c_code _ _) -> do
let
- stub_c_output_d = pprCode CStyle c_code
+ stub_c_output_d = pprCode c_code
stub_c_output_w = showSDoc dflags stub_c_output_d
-- Header file protos for "foreign export"ed functions.
- stub_h_output_d = pprCode CStyle h_code
+ stub_h_output_d = pprCode h_code
stub_h_output_w = showSDoc dflags stub_h_output_d
createDirectoryIfMissing True (takeDirectory stub_h)
@@ -330,6 +330,7 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs)
= {-# SCC profilingInitCode #-}
initializerCStub platform fn_name decls body
where
+ pdocC = pprCLabel platform CStyle
fn_name = mkInitializerStubLabel this_mod "prof_init"
decls = vcat
$ map emit_cc_decl local_CCs
@@ -342,22 +343,22 @@ profilingInitCode platform this_mod (local_CCs, singleton_CCSs)
]
emit_cc_decl cc =
text "extern CostCentre" <+> cc_lbl <> text "[];"
- where cc_lbl = pdoc platform (mkCCLabel cc)
+ where cc_lbl = pdocC (mkCCLabel cc)
local_cc_list_label = text "local_cc_" <> ppr this_mod
emit_cc_list ccs =
text "static CostCentre *" <> local_cc_list_label <> text "[] ="
- <+> braces (vcat $ [ pdoc platform (mkCCLabel cc) <> comma
+ <+> braces (vcat $ [ pdocC (mkCCLabel cc) <> comma
| cc <- ccs
] ++ [text "NULL"])
<> semi
emit_ccs_decl ccs =
text "extern CostCentreStack" <+> ccs_lbl <> text "[];"
- where ccs_lbl = pdoc platform (mkCCSLabel ccs)
+ where ccs_lbl = pdocC (mkCCSLabel ccs)
singleton_cc_list_label = text "singleton_cc_" <> ppr this_mod
emit_ccs_list ccs =
text "static CostCentreStack *" <> singleton_cc_list_label <> text "[] ="
- <+> braces (vcat $ [ pdoc platform (mkCCSLabel cc) <> comma
+ <+> braces (vcat $ [ pdocC (mkCCSLabel cc) <> comma
| cc <- ccs
] ++ [text "NULL"])
<> semi
diff --git a/compiler/GHC/Driver/Config/CmmToAsm.hs b/compiler/GHC/Driver/Config/CmmToAsm.hs
index edf82a37cc..877035d7ec 100644
--- a/compiler/GHC/Driver/Config/CmmToAsm.hs
+++ b/compiler/GHC/Driver/Config/CmmToAsm.hs
@@ -18,7 +18,7 @@ initNCGConfig :: DynFlags -> Module -> NCGConfig
initNCGConfig dflags this_mod = NCGConfig
{ ncgPlatform = targetPlatform dflags
, ncgThisModule = this_mod
- , ncgAsmContext = initSDocContext dflags (PprCode AsmStyle)
+ , ncgAsmContext = initSDocContext dflags PprCode
, ncgProcAlignment = cmmProcAlignment dflags
, ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
, ncgPIC = positionIndependent dflags
diff --git a/compiler/GHC/Driver/Config/CmmToLlvm.hs b/compiler/GHC/Driver/Config/CmmToLlvm.hs
index 61ffb8bcf4..8097bbec7e 100644
--- a/compiler/GHC/Driver/Config/CmmToLlvm.hs
+++ b/compiler/GHC/Driver/Config/CmmToLlvm.hs
@@ -20,7 +20,7 @@ initLlvmCgConfig logger config_cache dflags = do
llvm_config <- readLlvmConfigCache config_cache
pure $! LlvmCgConfig {
llvmCgPlatform = targetPlatform dflags
- , llvmCgContext = initSDocContext dflags (PprCode CStyle)
+ , llvmCgContext = initSDocContext dflags PprCode
, llvmCgFillUndefWithGarbage = gopt Opt_LlvmFillUndefWithGarbage dflags
, llvmCgSplitSection = gopt Opt_SplitSections dflags
, llvmCgBmiVersion = case platformArch (targetPlatform dflags) of
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index b060b4f457..cd2c3e93be 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -606,7 +606,7 @@ compileEmptyStub dflags hsc_env basename location mod_name = do
empty_stub <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c"
let home_unit = hsc_home_unit hsc_env
src = text "int" <+> ppr (mkHomeModule home_unit mod_name) <+> text "= 0;"
- writeFile empty_stub (showSDoc dflags (pprCode CStyle src))
+ writeFile empty_stub (showSDoc dflags (pprCode src))
let pipe_env = (mkPipeEnv NoStop empty_stub Nothing Persistent) { src_basename = basename}
pipeline = viaCPipeline HCc pipe_env hsc_env (Just location) empty_stub
_ <- runPipeline (hsc_hooks hsc_env) pipeline
diff --git a/compiler/GHC/HsToCore/Foreign/C.hs b/compiler/GHC/HsToCore/Foreign/C.hs
index 69ae4962d8..63350bf258 100644
--- a/compiler/GHC/HsToCore/Foreign/C.hs
+++ b/compiler/GHC/HsToCore/Foreign/C.hs
@@ -333,7 +333,7 @@ dsFCall fn_id co fcall mDeclHeader = do
toCName :: Id -> String
-toCName i = renderWithContext defaultSDocContext (pprCode CStyle (ppr (idName i)))
+toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i)))
toCType :: Type -> (Maybe Header, SDoc)
toCType = f False
diff --git a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
index 3107a593b1..63297f4ad2 100644
--- a/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
+++ b/compiler/GHC/Iface/Tidy/StaticPtrTable.hs
@@ -249,11 +249,11 @@ sptModuleInitCode platform this_mod entries =
[ text "static StgWord64 k" <> int i <> text "[2] = "
<> pprFingerprint fp <> semi
$$ text "extern StgPtr "
- <> (pdoc platform $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
+ <> (pprCLabel platform CStyle $ mkClosureLabel (idName n) (idCafInfo n)) <> semi
$$ text "hs_spt_insert" <> parens
(hcat $ punctuate comma
[ char 'k' <> int i
- , char '&' <> pdoc platform (mkClosureLabel (idName n) (idCafInfo n))
+ , char '&' <> pprCLabel platform CStyle (mkClosureLabel (idName n) (idCafInfo n))
]
)
<> semi
diff --git a/compiler/GHC/StgToCmm/Layout.hs b/compiler/GHC/StgToCmm/Layout.hs
index 0857cf5db2..26ebb8a7f1 100644
--- a/compiler/GHC/StgToCmm/Layout.hs
+++ b/compiler/GHC/StgToCmm/Layout.hs
@@ -297,7 +297,7 @@ direct_call caller call_conv lbl arity args
platform <- getPlatform
pprPanic "direct_call" $
text caller <+> ppr arity <+>
- pdoc platform lbl <+> ppr (length args) <+>
+ pprDebugCLabel platform lbl <+> ppr (length args) <+>
pdoc platform (map snd args) <+> ppr (map fst args)
| null rest_args -- Precisely the right number of arguments
diff --git a/compiler/GHC/StgToCmm/Ticky.hs b/compiler/GHC/StgToCmm/Ticky.hs
index 9f9aa451e2..6e9b84d53c 100644
--- a/compiler/GHC/StgToCmm/Ticky.hs
+++ b/compiler/GHC/StgToCmm/Ticky.hs
@@ -363,7 +363,7 @@ emitTickyCounter cloType tickee
Just (CgIdInfo { cg_lf = cg_lf })
| isLFThunk cg_lf
-> return $! CmmLabel $ mkClosureInfoTableLabel (profilePlatform profile) tickee cg_lf
- _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pdoc (profilePlatform profile) (mkInfoTableLabel name NoCafRefs))
+ _ -> pprTraceDebug "tickyThunkUnknown" (text t <> colon <> ppr name <+> pprDebugCLabel (profilePlatform profile) (mkInfoTableLabel name NoCafRefs))
return $! zeroCLit platform
TickyLNE {} -> return $! zeroCLit platform
diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs
index 83b2600439..43a290189c 100644
--- a/compiler/GHC/Utils/Logger.hs
+++ b/compiler/GHC/Utils/Logger.hs
@@ -332,7 +332,7 @@ jsonLogAction _ (MCDiagnostic SevIgnore _) _ _ = return () -- suppress the messa
jsonLogAction logflags msg_class srcSpan msg
=
defaultLogActionHPutStrDoc logflags True stdout
- (withPprStyle (PprCode CStyle) (doc $$ text ""))
+ (withPprStyle PprCode (doc $$ text ""))
where
str = renderWithContext (log_default_user_context logflags) msg
doc = renderJSON $
diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs
index c820c8b51d..e1c9ceb054 100644
--- a/compiler/GHC/Utils/Outputable.hs
+++ b/compiler/GHC/Utils/Outputable.hs
@@ -96,7 +96,7 @@ module GHC.Utils.Outputable (
defaultSDocContext, traceSDocContext,
getPprStyle, withPprStyle, setStyleColoured,
pprDeeper, pprDeeperList, pprSetDepth,
- codeStyle, userStyle, dumpStyle, asmStyle,
+ codeStyle, userStyle, dumpStyle,
qualName, qualModule, qualPackage,
mkErrStyle, defaultErrStyle, defaultDumpStyle, mkDumpStyle, defaultUserStyle,
mkUserStyle, cmdlineParserStyle, Depth(..),
@@ -170,7 +170,7 @@ data PprStyle
-- Does not assume tidied code: non-external names
-- are printed with uniques.
- | PprCode !LabelStyle -- ^ Print code; either C or assembler
+ | PprCode -- ^ Print code; either C or assembler
-- | Style of label pretty-printing.
--
@@ -550,12 +550,8 @@ queryQual s = QueryQualify (qualName s)
(qualPackage s)
codeStyle :: PprStyle -> Bool
-codeStyle (PprCode _) = True
-codeStyle _ = False
-
-asmStyle :: PprStyle -> Bool
-asmStyle (PprCode AsmStyle) = True
-asmStyle _other = False
+codeStyle PprCode = True
+codeStyle _ = False
dumpStyle :: PprStyle -> Bool
dumpStyle (PprDump {}) = True
@@ -603,9 +599,9 @@ bufLeftRenderSDoc :: SDocContext -> BufHandle -> SDoc -> IO ()
bufLeftRenderSDoc ctx bufHandle doc =
Pretty.bufLeftRender bufHandle (runSDoc doc ctx)
-pprCode :: LabelStyle -> SDoc -> SDoc
+pprCode :: SDoc -> SDoc
{-# INLINE CONLIKE pprCode #-}
-pprCode cs d = withPprStyle (PprCode cs) d
+pprCode d = withPprStyle PprCode d
renderWithContext :: SDocContext -> SDoc -> String
renderWithContext ctx sdoc
diff --git a/testsuite/tests/codeGen/should_compile/Makefile b/testsuite/tests/codeGen/should_compile/Makefile
index 90cf78fb4b..35242a5830 100644
--- a/testsuite/tests/codeGen/should_compile/Makefile
+++ b/testsuite/tests/codeGen/should_compile/Makefile
@@ -48,9 +48,11 @@ T15723:
'$(TEST_HC)' $(TEST_HC_OPTS) -dynamic -shared T15723B.o -o T15723B.so
# Check that the static indirection b is compiled to an equiv directive
+# This will be .equiv T15155_b_closure,T15155_a_closure
+# or .equiv _T15155_b_closure,_T15155_a_closure on Darwin
T15155:
'$(TEST_HC)' $(TEST_HC_OPTS) -c -O0 -ddump-asm T15155l.hs | \
- grep -F ".equiv T15155.b_closure,T15155.a_closure"
+ grep -F ".equiv"
# Same as above, but in LLVM. Check that the static indirection b is compiled to
# an alias.
diff --git a/testsuite/tests/codeGen/should_compile/T15155.stdout-darwin b/testsuite/tests/codeGen/should_compile/T15155.stdout-darwin
new file mode 100644
index 0000000000..535026aed4
--- /dev/null
+++ b/testsuite/tests/codeGen/should_compile/T15155.stdout-darwin
@@ -0,0 +1 @@
+.equiv _T15155.b_closure,_T15155.a_closure