diff options
author | Sylvain Henry <sylvain@haskus.fr> | 2021-01-27 19:47:18 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-04-10 05:30:37 -0400 |
commit | 3f851bbd473f3a6b679a0b1baafdf489f4786c5e (patch) | |
tree | f2794f78b0bd40fd1d901608a7c77559313fad99 /compiler/GHC/Cmm | |
parent | 6b1d0b9cb5b984e7d4ada5626a675fe2d4e49a5d (diff) | |
download | haskell-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.hs | 31 |
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 -> |