summaryrefslogtreecommitdiff
path: root/compiler/GHC/Cmm
diff options
context:
space:
mode:
authorSylvain Henry <sylvain@haskus.fr>2021-01-27 19:47:18 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-04-10 05:30:37 -0400
commit3f851bbd473f3a6b679a0b1baafdf489f4786c5e (patch)
treef2794f78b0bd40fd1d901608a7c77559313fad99 /compiler/GHC/Cmm
parent6b1d0b9cb5b984e7d4ada5626a675fe2d4e49a5d (diff)
downloadhaskell-3f851bbd473f3a6b679a0b1baafdf489f4786c5e.tar.gz
Enhance pretty-printing perf
A few refactorings made after looking at Core/STG * Use Doc instead of SDoc in pprASCII to avoid passing the SDocContext that is never used. * Inline every SDoc wrappers in GHC.Utils.Outputable to expose Doc constructs * Add text/[] rule for empty strings (i.e., text "") * Use a single occurrence of pprGNUSectionHeader * Use bangs on Platform parameters and some others Metric Decrease: ManyAlternatives ManyConstructors T12707 T13035 T13379 T18698a T18698b T1969 T3294 T4801 T5321FD T783
Diffstat (limited to 'compiler/GHC/Cmm')
-rw-r--r--compiler/GHC/Cmm/CLabel.hs31
1 files changed, 20 insertions, 11 deletions
diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs
index e2f7ce82bc..4d6c66066c 100644
--- a/compiler/GHC/Cmm/CLabel.hs
+++ b/compiler/GHC/Cmm/CLabel.hs
@@ -8,7 +8,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
@@ -1304,24 +1303,34 @@ the fact that it was derived from a block ID in `IdLabelInfo` as
The info table label and the local block label are both local labels
and are not externally visible.
+
+Note [Bangs in CLabel]
+~~~~~~~~~~~~~~~~~~~~~~
+There are some carefully placed strictness annotations in this module,
+which were discovered in !5226 to significantly reduce compile-time
+allocation. Take care if you want to remove them!
+
-}
instance OutputableP Platform CLabel where
- pdoc platform lbl = getPprStyle $ \case
- PprCode CStyle -> pprCLabel platform CStyle lbl
- PprCode AsmStyle -> pprCLabel platform AsmStyle lbl
- _ -> pprCLabel platform CStyle lbl
- -- default to CStyle
+ {-# 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
pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc
-pprCLabel platform sty lbl =
+pprCLabel !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 = case sty of
- AsmStyle | platformLeadingUnderscore platform -> pp_cSEP <> doc
- _ -> doc
+ AsmStyle | use_leading_underscores -> pp_cSEP <> doc
+ _ -> doc
tempLabelPrefixOrUnderscore :: Platform -> SDoc
tempLabelPrefixOrUnderscore platform = case sty of
@@ -1520,13 +1529,13 @@ instance Outputable ForeignLabelSource where
-- Machine-dependent knowledge about labels.
asmTempLabelPrefix :: Platform -> PtrString -- for formatting labels
-asmTempLabelPrefix platform = case platformOS platform of
+asmTempLabelPrefix !platform = case platformOS platform of
OSDarwin -> sLit "L"
OSAIX -> sLit "__L" -- follow IBM XL C's convention
_ -> sLit ".L"
pprDynamicLinkerAsmLabel :: Platform -> DynamicLinkerLabelInfo -> SDoc -> SDoc
-pprDynamicLinkerAsmLabel platform dllInfo ppLbl =
+pprDynamicLinkerAsmLabel !platform dllInfo ppLbl =
case platformOS platform of
OSDarwin
| platformArch platform == ArchX86_64 ->