[Git][ghc/ghc][wip/romes/9557] 2 commits: Improve performance of deriving Show

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Sat Oct 26 08:58:06 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/9557 at Glasgow Haskell Compiler / GHC


Commits:
45a72fb9 by Rodrigo Mesquita at 2024-10-26T09:57:33+01:00
Improve performance of deriving Show

Significantly improves performance of deriving Show instances by
avoiding using the very polymorphic `.` operator in favour of inlining
its definition. We were generating tons of applications of it, each
which had 3 type arguments!

With the example module linked in #9557, this change makes deriving Show,
on my machine, go from taking:

* 5.5s to 3.5s with -O1
* 2.9s to 2.0s with -O0

Improves on #9557

- - - - -
d7bbd3c2 by Rodrigo Mesquita at 2024-10-26T09:57:38+01:00
deriving Ord compare and <= only

Since the implementation of CLC proposal #24, the default
implementations of Ord's `<`, `>`, and `>=` are given in terms of `<=`.

This means we no longer need to generate implementations for these
methods when stock deriving `Ord`. Rather, just derive the
implementation of `compare` and `<=`, and rely on the default
implementations for the others.

Progress towards #9557

Using the same sample module from #9557, this commit takes compilation
on my machine from being:
* 4.3s to 3.3s with -O0
* 6.9s to 5.2s with -O1

- - - - -


2 changed files:

- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Tc/Deriv/Generate.hs


Changes:

=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -56,7 +56,7 @@ module GHC.Hs.Utils(
   nlHsTyApp, nlHsTyApps, nlHsVar, nlHsDataCon,
   nlHsLit, nlHsApp, nlHsApps, nlHsSyntaxApps,
   nlHsIntLit, nlHsVarApps,
-  nlHsDo, nlHsOpApp, nlHsPar, nlHsIf, nlHsCase, nlList,
+  nlHsDo, nlHsOpApp, nlHsLam, nlHsPar, nlHsIf, nlHsCase, nlList,
   mkLHsTupleExpr, mkLHsVarTuple, missingTupArg,
   mkLocatedList, nlAscribe,
 
@@ -598,11 +598,15 @@ nlHsDo ctxt stmts = noLocA (mkHsDo ctxt (noLocA stmts))
 nlHsOpApp :: LHsExpr GhcPs -> IdP GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs
 nlHsOpApp e1 op e2 = noLocA (mkHsOpApp e1 op e2)
 
+nlHsLam  :: LMatch GhcPs (LHsExpr GhcPs) -> LHsExpr GhcPs
 nlHsPar  :: IsPass p => LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
 nlHsCase :: LHsExpr GhcPs -> [LMatch GhcPs (LHsExpr GhcPs)]
          -> LHsExpr GhcPs
 nlList   :: [LHsExpr GhcPs] -> LHsExpr GhcPs
 
+nlHsLam match = noLocA $ HsLam noAnn LamSingle
+                  $ mkMatchGroup (Generated OtherExpansion SkipPmc) (noLocA [match])
+
 nlHsPar e     = noLocA (gHsPar e)
 
 -- nlHsIf should generate if-expressions which are NOT subject to


=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -339,7 +339,7 @@ Several special cases:
   See function unliftedOrdOp
 
 Note [Game plan for deriving Ord]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 It's a bad idea to define only 'compare', and build the other binary
 comparisons on top of it; see #2130, #4019.  Reason: we don't
 want to laboriously make a three-way comparison, only to extract a
@@ -350,16 +350,22 @@ binary result, something like this:
                                        True  -> False
                                        False -> True
 
-This being said, we can get away with generating full code only for
-'compare' and '<' thus saving us generation of other three operators.
-Other operators can be cheaply expressed through '<':
-a <= b = not $ b < a
-a > b = b < a
-a >= b = not $ a < b
-
 So for sufficiently small types (few constructors, or all nullary)
 we generate all methods; for large ones we just use 'compare'.
 
+This being said, we can get away with generating full code only for
+'compare' and '<=' thus saving us generation of other three operators.
+Other operators can be cheaply expressed through '<=' -- indeed, that's what
+the default implementations of >, <, and >= do.
+
+Historically, derived instances defined '<' and the remaining operators as
+cheap expressions in function of it:
+  a <= b = not $ b < a
+  a > b = b < a
+  a >= b = not $ a < b
+but since the CLC proposal #24 (see 8f174e06185143674d6cbfee75c30e68805d85b8),
+it suffices to derive '<=' and rely on the
+default implementation for the others.
 -}
 
 data OrdOp = OrdCompare | OrdLT | OrdLE | OrdGE | OrdGT
@@ -417,19 +423,10 @@ gen_Ord_binds loc dit@(DerivInstTys{ dit_rep_tc = tycon
     other_ops
       | (last_tag - first_tag) <= 2     -- 1-3 constructors
         || null non_nullary_cons        -- Or it's an enumeration
-      = [mkOrdOp OrdLT, lE, gT, gE]
+      = [mkOrdOp OrdGE]
       | otherwise
       = []
 
-    negate_expr = nlHsApp (nlHsVar not_RDR)
-    pats = noLocA [a_Pat, b_Pat]
-    lE = mkSimpleGeneratedFunBind loc le_RDR pats $
-        negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr)
-    gT = mkSimpleGeneratedFunBind loc gt_RDR pats $
-        nlHsApp (nlHsApp (nlHsVar lt_RDR) b_Expr) a_Expr
-    gE = mkSimpleGeneratedFunBind loc ge_RDR pats $
-        negate_expr (nlHsApp (nlHsApp (nlHsVar lt_RDR) a_Expr) b_Expr)
-
     get_tag con = dataConTag con - fIRST_TAG
         -- We want *zero-based* tags, because that's what
         -- con2Tag returns (generated by untag_Expr)!
@@ -2528,11 +2525,14 @@ showParen_Expr
 showParen_Expr e1 e2 = nlHsApp (nlHsApp (nlHsVar showParen_RDR) e1) e2
 
 nested_compose_Expr :: [LHsExpr GhcPs] -> LHsExpr GhcPs
-
-nested_compose_Expr []  = panic "nested_compose_expr"   -- Arg is always non-empty
-nested_compose_Expr [e] = parenify e
-nested_compose_Expr (e:es)
-  = nlHsApp (nlHsApp (nlHsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
+nested_compose_Expr =
+  nlHsLam . mkSimpleMatch (LamAlt LamSingle) (noLocA [z_Pat]) . go
+  where
+    -- Inlined nested applications of (`.`) to speed up deriving!
+    go []  = panic "nested_compose_expr"   -- Arg is always non-empty
+    go [e] = nlHsApp (parenify e) z_Expr
+    go (e:es)
+      = nlHsApp (parenify e) (go es)
 
 -- impossible_Expr is used in case RHSs that should never happen.
 -- We generate these to keep the desugarer from complaining that they *might* happen!



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46e2a9b2eaf2f047db7769ef3759b38f2158ec10...d7bbd3c233af14eb69c9c931916bf6d4098b4f45

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/46e2a9b2eaf2f047db7769ef3759b38f2158ec10...d7bbd3c233af14eb69c9c931916bf6d4098b4f45
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241026/6257e43c/attachment-0001.html>


More information about the ghc-commits mailing list