summaryrefslogtreecommitdiff
path: root/compiler/GHC/Cmm/CLabel.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Cmm/CLabel.hs')
-rw-r--r--compiler/GHC/Cmm/CLabel.hs69
1 files changed, 40 insertions, 29 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index 83555e9227..96f78b6789 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -307,12 +307,14 @@ data ModuleLabelKind
| MLK_IPEBuffer
deriving (Eq, Ord)
-instance Outputable ModuleLabelKind where
- ppr MLK_InitializerArray = text "init_arr"
- ppr (MLK_Initializer (LexicalFastString s)) = text "init__" <> ftext s
- ppr MLK_FinalizerArray = text "fini_arr"
- ppr (MLK_Finalizer (LexicalFastString s)) = text "fini__" <> ftext s
- ppr MLK_IPEBuffer = text "ipe_buf"
+pprModuleLabelKind :: IsLine doc => ModuleLabelKind -> doc
+pprModuleLabelKind MLK_InitializerArray = text "init_arr"
+pprModuleLabelKind (MLK_Initializer (LexicalFastString s)) = text "init__" <> ftext s
+pprModuleLabelKind MLK_FinalizerArray = text "fini_arr"
+pprModuleLabelKind (MLK_Finalizer (LexicalFastString s)) = text "fini__" <> ftext s
+pprModuleLabelKind MLK_IPEBuffer = text "ipe_buf"
+{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> SDoc #-}
+{-# SPECIALIZE pprModuleLabelKind :: ModuleLabelKind -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = True
@@ -1431,11 +1433,15 @@ data LabelStyle
= CStyle -- ^ C label style (used by C and LLVM backends)
| AsmStyle -- ^ Asm label style (used by NCG backend)
-pprAsmLabel :: Platform -> CLabel -> SDoc
+pprAsmLabel :: IsLine doc => Platform -> CLabel -> doc
pprAsmLabel platform lbl = pprCLabelStyle platform AsmStyle lbl
+{-# SPECIALIZE pprAsmLabel :: Platform -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprAsmLabel :: Platform -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-pprCLabel :: Platform -> CLabel -> SDoc
+pprCLabel :: IsLine doc => Platform -> CLabel -> doc
pprCLabel platform lbl = pprCLabelStyle platform CStyle lbl
+{-# SPECIALIZE pprCLabel :: Platform -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprCLabel :: Platform -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
instance OutputableP Platform CLabel where
{-# INLINE pdoc #-} -- see Note [Bangs in CLabel]
@@ -1444,19 +1450,19 @@ instance OutputableP Platform CLabel where
PprDump{} -> pprCLabel platform lbl
_ -> pprPanic "Labels in code should be printed with pprCLabel or pprAsmLabel" (pprCLabel platform lbl)
-pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> SDoc
+pprCLabelStyle :: forall doc. IsLine doc => Platform -> LabelStyle -> CLabel -> doc
pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
let
!use_leading_underscores = platformLeadingUnderscore platform
-- some platform (e.g. Darwin) require a leading "_" for exported asm
-- symbols
- maybe_underscore :: SDoc -> SDoc
+ maybe_underscore :: doc -> doc
maybe_underscore doc = case sty of
AsmStyle | use_leading_underscores -> pp_cSEP <> doc
_ -> doc
- tempLabelPrefixOrUnderscore :: SDoc
+ tempLabelPrefixOrUnderscore :: doc
tempLabelPrefixOrUnderscore = case sty of
AsmStyle -> asmTempLabelPrefix platform
CStyle -> char '_'
@@ -1508,14 +1514,14 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
IdLabel name _cafs flavor -> case sty of
- AsmStyle -> maybe_underscore $ internalNamePrefix <> ppr name <> ppIdFlavor flavor
+ AsmStyle -> maybe_underscore $ internalNamePrefix <> pprName name <> ppIdFlavor flavor
where
isRandomGenerated = not (isExternalName name)
internalNamePrefix =
if isRandomGenerated
then asmTempLabelPrefix platform
else empty
- CStyle -> ppr name <> ppIdFlavor flavor
+ CStyle -> pprName name <> ppIdFlavor flavor
SRTLabel u
-> maybe_underscore $ tempLabelPrefixOrUnderscore <> pprUniqueAlways u <> pp_cSEP <> text "srt"
@@ -1552,7 +1558,7 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
]
RtsLabel (RtsPrimOp primop)
- -> maybe_underscore $ text "stg_" <> ppr primop
+ -> maybe_underscore $ text "stg_" <> pprPrimOp primop
RtsLabel (RtsSlowFastTickyCtr pat)
-> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr"
@@ -1570,12 +1576,12 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
-- with a letter so the label will be legal assembly code.
HpcTicksLabel mod
- -> maybe_underscore $ text "_hpc_tickboxes_" <> ppr mod <> text "_hpc"
+ -> maybe_underscore $ text "_hpc_tickboxes_" <> pprModule mod <> text "_hpc"
- CC_Label cc -> maybe_underscore $ ppr cc
- CCS_Label ccs -> maybe_underscore $ ppr ccs
- IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform l <> text "_" <> ppr m <> text "_ipe")
- ModuleLabel mod kind -> maybe_underscore $ ppr mod <> text "_" <> ppr kind
+ CC_Label cc -> maybe_underscore $ pprCostCentre cc
+ CCS_Label ccs -> maybe_underscore $ pprCostCentreStack ccs
+ IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform l <> text "_" <> pprModule m <> text "_ipe")
+ ModuleLabel mod kind -> maybe_underscore $ pprModule mod <> text "_" <> pprModuleLabelKind kind
CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs
CmmLabel _ _ fs CmmData -> maybe_underscore $ ftext fs
@@ -1585,6 +1591,8 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
CmmLabel _ _ fs CmmRetInfo -> maybe_underscore $ ftext fs <> text "_info"
CmmLabel _ _ fs CmmRet -> maybe_underscore $ ftext fs <> text "_ret"
CmmLabel _ _ fs CmmClosure -> maybe_underscore $ ftext fs <> text "_closure"
+{-# SPECIALIZE pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> SDoc #-}
+{-# SPECIALIZE pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-- Note [Internal proc labels]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1605,21 +1613,24 @@ pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel]
-- | Generate a label for a procedure internal to a module (if
-- 'Opt_ExposeAllSymbols' is enabled).
-- See Note [Internal proc labels].
-ppInternalProcLabel :: Module -- ^ the current module
+ppInternalProcLabel :: IsLine doc
+ => Module -- ^ the current module
-> CLabel
- -> Maybe SDoc -- ^ the internal proc label
+ -> Maybe doc -- ^ the internal proc label
ppInternalProcLabel this_mod (IdLabel nm _ flavour)
| isInternalName nm
= Just
- $ text "_" <> ppr this_mod
+ $ text "_" <> pprModule this_mod
<> char '_'
<> ztext (zEncodeFS (occNameFS (occName nm)))
<> char '_'
<> pprUniqueAlways (getUnique nm)
<> ppIdFlavor flavour
ppInternalProcLabel _ _ = Nothing
+{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe SDoc #-}
+{-# SPECIALIZE ppInternalProcLabel :: Module -> CLabel -> Maybe HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-ppIdFlavor :: IdLabelInfo -> SDoc
+ppIdFlavor :: IsLine doc => IdLabelInfo -> doc
ppIdFlavor x = pp_cSEP <> case x of
Closure -> text "closure"
InfoTable -> text "info"
@@ -1630,22 +1641,22 @@ ppIdFlavor x = pp_cSEP <> case x of
IdTickyInfo TickyRednCounts
-> text "ct"
IdTickyInfo (TickyInferedTag unique)
- -> text "ct_inf_tag" <> char '_' <> ppr unique
+ -> text "ct_inf_tag" <> char '_' <> pprUniqueAlways unique
ConEntry loc ->
case loc of
DefinitionSite -> text "con_entry"
UsageSite m n ->
- ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_entry"
+ pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_entry"
ConInfoTable k ->
case k of
DefinitionSite -> text "con_info"
UsageSite m n ->
- ppr m <> pp_cSEP <> ppr n <> pp_cSEP <> text "con_info"
+ pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_info"
ClosureTable -> text "closure_tbl"
Bytes -> text "bytes"
BlockInfoTable -> text "info"
-pp_cSEP :: SDoc
+pp_cSEP :: IsLine doc => doc
pp_cSEP = char '_'
@@ -1659,13 +1670,13 @@ instance Outputable ForeignLabelSource where
-- -----------------------------------------------------------------------------
-- Machine-dependent knowledge about labels.
-asmTempLabelPrefix :: Platform -> SDoc -- for formatting labels
+asmTempLabelPrefix :: IsLine doc => Platform -> doc -- for formatting labels
asmTempLabelPrefix !platform = case platformOS platform of
OSDarwin -> text "L"
OSAIX -> text "__L" -- follow IBM XL C's convention
_ -> text ".L"
-pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
+pprDynamicLinkerAsmLabel :: IsLine doc => Platform -> DynamicLinkerLabelInfo -> doc -> doc
pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
case platformOS platform of
OSDarwin
View Lorry Controller Status