From 3f851bbd473f3a6b679a0b1baafdf489f4786c5e Mon Sep 17 00:00:00 2001
From: Sylvain Henry <sylvain@haskus.fr>
Date: Wed, 27 Jan 2021 19:47:18 +0100
Subject: 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
---
 compiler/GHC/Cmm/CLabel.hs | 31 ++++++++++++++++++++-----------
 1 file changed, 20 insertions(+), 11 deletions(-)

(limited to 'compiler/GHC/Cmm')

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 ->
-- 
cgit v1.2.1