[Git][ghc/ghc][wip/romes/9557] 8 commits: Improve performance of deriving Show
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Oct 28 17:25:31 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/9557 at Glasgow Haskell Compiler / GHC
Commits:
d14fb4db by Rodrigo Mesquita at 2024-10-28T17:24:30+00: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!
Improves on #9557
- - - - -
8c21d4a6 by Rodrigo Mesquita at 2024-10-28T17:24:38+00: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
- - - - -
637fdb5b by Rodrigo Mesquita at 2024-10-28T17:24:42+00:00
Dont' eta expand cons when deriving Data
This eta expansion was introduced with the initial commit for Linear
types.
I believe this isn't needed any longer. My guess is it is an artifact
from the initial linear types implementation: data constructors are
linear, but they shouldn't need to be eta expanded to be used as higher
order functions. I suppose in the early days this wasn't true.
For instance, this works now:
data T x = T x
f = \(x :: forall y. y -> T y) -> x True
f T -- ok!
T is linear, but can be passed where an unrestricted higher order
function is expected. I recall there being some magic around to make
this work for data constructors...
Since this works, there's no need to eta_expand the data constructors in
the derived Data instances.
- - - - -
ac5656fb by Rodrigo Mesquita at 2024-10-28T17:24:46+00:00
X WRNOG BRANCH
- - - - -
c333577d by Rodrigo Mesquita at 2024-10-28T17:24:49+00:00
Revert "X WRNOG BRANCH"
This reverts commit 407f922cbfebaeeca8c924c651b4fdbb5b6c12e9.
- - - - -
12e8e83e by Rodrigo Mesquita at 2024-10-28T17:24:54+00:00
deriving Traversable: Eta reduce more constructor
- - - - -
af62a1eb by Rodrigo Mesquita at 2024-10-28T17:24:55+00:00
Revert "Deriving Ord: compare and <= only"
This reverts commit 6ba798876891693425edc4b3352f201bde14ddd5.
- - - - -
36c10986 by Rodrigo Mesquita at 2024-10-28T17:24:57+00:00
restore b_expr
- - - - -
3 changed files:
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Tc/Deriv/Functor.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/Functor.hs
=====================================
@@ -689,9 +689,16 @@ mkSimpleConMatch2 ctxt fold extra_pats con insides = do
con_expr
| null asWithTyVar = nlHsApps con_name asWithoutTyVar
| otherwise =
- let bs = filterByList argTysTyVarInfo bs_RDRs
- vars = filterByLists argTysTyVarInfo bs_Vars as_Vars
- in mkHsLam (noLocA (map nlVarPat bs)) (nlHsApps con_name vars)
+ let -- All trailing b-args can be eta-reduced:
+ -- (\b1 b2 b3 -> A b1 a2 b2 b3) ==> (\b1 -> A b1 a2)
+ -- We do this by counting the n of args to keep
+ keep_n = length $ dropWhile (== True) $ reverse argTysTyVarInfo
+ bs = filterByList (take keep_n argTysTyVarInfo) bs_RDRs
+ vars = take keep_n $
+ filterByLists argTysTyVarInfo bs_Vars as_Vars
+ in if keep_n == 0
+ then nlHsVar con_name
+ else mkHsLam (noLocA (map nlVarPat bs)) (nlHsApps con_name vars)
rhs <- fold con_expr exps
return $ mkMatch ctxt (noLocA (extra_pats ++ [pat])) rhs emptyLocalBinds
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1407,7 +1407,7 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
gfoldl_eqn con
= ([nlVarPat k_RDR, z_Pat, nlConVarPat con_name as_needed],
- foldl' mk_k_app (z_Expr `nlHsApp` (eta_expand_data_con con)) as_needed)
+ foldl' mk_k_app (z_Expr `nlHsApp` (nlHsVar (getRdrName con))) as_needed)
where
con_name :: RdrName
con_name = getRdrName con
@@ -1427,16 +1427,17 @@ gen_Data_binds loc (DerivInstTys{dit_rep_tc = rep_tc})
gunfold_alt dc = mkHsCaseAlt (mk_unfold_pat dc) (mk_unfold_rhs dc)
mk_unfold_rhs dc = foldr nlHsApp
- (z_Expr `nlHsApp` (eta_expand_data_con dc))
+ (z_Expr `nlHsApp` (nlHsVar (getRdrName dc)))
(replicate (dataConSourceArity dc) (nlHsVar k_RDR))
- eta_expand_data_con dc =
- mkHsLam (noLocA eta_expand_pats)
- (foldl nlHsApp (nlHsVar (getRdrName dc)) eta_expand_hsvars)
- where
- eta_expand_pats = map nlVarPat eta_expand_vars
- eta_expand_hsvars = map nlHsVar eta_expand_vars
- eta_expand_vars = take (dataConSourceArity dc) as_RDRs
+ -- This was needed by the original implementation of Linear Types. But not anymore...?
+ -- eta_expand_data_con dc =
+ -- mkHsLam (noLocA eta_expand_pats)
+ -- (foldl nlHsApp (nlHsVar (getRdrName dc)) eta_expand_hsvars)
+ -- where
+ -- eta_expand_pats = map nlVarPat eta_expand_vars
+ -- eta_expand_hsvars = map nlHsVar eta_expand_vars
+ -- eta_expand_vars = take (dataConSourceArity dc) as_RDRs
mk_unfold_pat dc -- Last one is a wild-pat, to avoid
@@ -2528,11 +2529,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/aa1bf18ef4111055c4b4d22c473b9715d3b7f909...36c10986dd71c60e106891dfe333f93255cd0332
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/aa1bf18ef4111055c4b4d22c473b9715d3b7f909...36c10986dd71c60e106891dfe333f93255cd0332
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/20241028/5bc433e8/attachment-0001.html>
More information about the ghc-commits
mailing list