[Git][ghc/ghc][wip/romes/9557-easy] 2 commits: Improve performance of deriving Show
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Tue Dec 17 17:02:19 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/9557-easy at Glasgow Haskell Compiler / GHC
Commits:
10f348b5 by Rodrigo Mesquita at 2024-12-17T17:02:06+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
-------------------------
Metric Decrease:
InstanceMatching
T12707
T3294
------------------------
- - - - -
3438cf21 by Rodrigo Mesquita at 2024-12-17T17:02:06+00:00
Don't 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.
- - - - -
6 changed files:
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- testsuite/tests/deriving/should_compile/T14682.stderr
- testsuite/tests/deriving/should_run/T9576.stderr
- testsuite/tests/typecheck/should_fail/T15883d.stderr
- testsuite/tests/typecheck/should_fail/T15883e.stderr
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
=====================================
@@ -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,18 +1427,9 @@ 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
-
-
mk_unfold_pat dc -- Last one is a wild-pat, to avoid
-- redundant test, and annoying warning
| tag-fIRST_TAG == n_cons-1 = nlWildPat -- Last constructor
@@ -2528,21 +2519,22 @@ 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
+ -- Previously we used (`.`), but inlining its definition improves compiler
+ -- performance significantly since we no longer need to typecheck lots of
+ -- (.) applications (each which needed three type applications, all @String)
+ -- (See #25453 for why this is especially slow currently)
+ go [] = panic "nested_compose_expr" -- Arg is always non-empty
+ go [e] = nlHsApp e z_Expr
+ go (e:es) = nlHsApp 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!
error_Expr :: FastString -> LHsExpr GhcPs
error_Expr string = nlHsApp (nlHsVar error_RDR) (nlHsLit (mkHsStringFS string))
-parenify :: LHsExpr GhcPs -> LHsExpr GhcPs
-parenify e@(L _ (HsVar _ _)) = e
-parenify e = mkHsPar e
-
-- genOpApp wraps brackets round the operator application, so that the
-- renamer won't subsequently try to re-associate it.
genOpApp :: LHsExpr GhcPs -> RdrName -> LHsExpr GhcPs -> LHsExpr GhcPs
=====================================
testsuite/tests/deriving/should_compile/T14682.stderr
=====================================
@@ -5,12 +5,13 @@ Derived class instances:
GHC.Internal.Show.showsPrec a (T14682.Foo b1 b2)
= GHC.Internal.Show.showParen
(a GHC.Classes.>= 11)
- ((GHC.Internal.Base..)
- (GHC.Internal.Show.showString "Foo ")
- ((GHC.Internal.Base..)
- (GHC.Internal.Show.showsPrec 11 b1)
- ((GHC.Internal.Base..)
- GHC.Internal.Show.showSpace (GHC.Internal.Show.showsPrec 11 b2))))
+ (\ z
+ -> GHC.Internal.Show.showString
+ "Foo "
+ (GHC.Internal.Show.showsPrec
+ 11 b1
+ (GHC.Internal.Show.showSpace
+ (GHC.Internal.Show.showsPrec 11 b2 z))))
instance GHC.Internal.TH.Lift.Lift T14682.Foo where
GHC.Internal.TH.Lift.lift (T14682.Foo a1 a2)
@@ -25,9 +26,8 @@ Derived class instances:
instance GHC.Internal.Data.Data.Data T14682.Foo where
GHC.Internal.Data.Data.gfoldl k z (T14682.Foo a1 a2)
- = ((z (\ a1 a2 -> T14682.Foo a1 a2) `k` a1) `k` a2)
- GHC.Internal.Data.Data.gunfold k z _
- = k (k (z (\ a1 a2 -> T14682.Foo a1 a2)))
+ = ((z T14682.Foo `k` a1) `k` a2)
+ GHC.Internal.Data.Data.gunfold k z _ = k (k (z T14682.Foo))
GHC.Internal.Data.Data.toConstr (T14682.Foo _ _) = $cFoo
GHC.Internal.Data.Data.dataTypeOf _ = $tFoo
=====================================
testsuite/tests/deriving/should_run/T9576.stderr
=====================================
@@ -2,11 +2,11 @@ T9576: Uncaught exception ghc-internal:GHC.Internal.Control.Exception.Base.TypeE
T9576.hs:6:31: error: [GHC-39999]
• No instance for ‘Show Foo’ arising from a use of ‘showsPrec’
- • In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
+ • In the second argument of ‘showString’, namely
+ ‘(showsPrec 11 b1 z)’
+ In the expression: showString "MkBar " (showsPrec 11 b1 z)
In the second argument of ‘showParen’, namely
- ‘((.) (showString "MkBar ") (showsPrec 11 b1))’
- In the expression:
- showParen (a >= 11) ((.) (showString "MkBar ") (showsPrec 11 b1))
+ ‘(\ z -> showString "MkBar " (showsPrec 11 b1 z))’
When typechecking the code for ‘showsPrec’
in a derived instance for ‘Show Bar’:
To see the code I am typechecking, use -ddump-deriv
=====================================
testsuite/tests/typecheck/should_fail/T15883d.stderr
=====================================
@@ -1,4 +1,3 @@
-
T15883d.hs:14:1: error: [GHC-39999]
• Ambiguous type variable ‘a0’ arising from a use of ‘showsPrec’
prevents the constraint ‘(Show a0)’ from being solved.
@@ -9,11 +8,12 @@ T15883d.hs:14:1: error: [GHC-39999]
...plus 29 others
...plus 10 instances involving out-of-scope types
(use -fprint-potential-instances to see them all)
- • In the second argument of ‘(.)’, namely ‘(showsPrec 11 b1)’
+ • In the second argument of ‘showString’, namely
+ ‘(showsPrec 11 b1 z)’
+ In the expression: showString "MkFoo " (showsPrec 11 b1 z)
In the second argument of ‘showParen’, namely
- ‘((.) (showString "MkFoo ") (showsPrec 11 b1))’
- In the expression:
- showParen (a >= 11) ((.) (showString "MkFoo ") (showsPrec 11 b1))
+ ‘(\ z -> showString "MkFoo " (showsPrec 11 b1 z))’
When typechecking the code for ‘showsPrec’
in a derived instance for ‘Show (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
+
=====================================
testsuite/tests/typecheck/should_fail/T15883e.stderr
=====================================
@@ -1,71 +1,26 @@
-
-T15883e.hs:16:1: error: [GHC-39999]
- • Ambiguous type variable ‘d0’ arising from a use of ‘k’
- prevents the constraint ‘(Data d0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘d0’ should be.
- Potentially matching instances:
- instance (Data a, Data b) => Data (Either a b)
- -- Defined in ‘GHC.Internal.Data.Data’
- instance Data a => Data (Down a)
- -- Defined in ‘GHC.Internal.Data.Data’
- ...plus 20 others
- ...plus 47 instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
- • In the expression: z (\ a1 -> MkFoo a1) `k` a1
- In an equation for ‘GHC.Internal.Data.Data.gfoldl’:
- GHC.Internal.Data.Data.gfoldl k z (MkFoo a1)
- = (z (\ a1 -> MkFoo a1) `k` a1)
- When typechecking the code for ‘GHC.Internal.Data.Data.gfoldl’
- in a derived instance for ‘Data (Foo LiftedRep)’:
- To see the code I am typechecking, use -ddump-deriv
- In the instance declaration for ‘Data (Foo LiftedRep)’
-
-T15883e.hs:16:1: error: [GHC-46956]
- • Couldn't match expected type ‘a’ with actual type ‘d0’
- because type variable ‘a’ would escape its scope
- This (rigid, skolem) type variable is bound by
- a type expected by the context:
- forall a. a
- at T15883e.hs:16:1-52
- • In the first argument of ‘MkFoo’, namely ‘a1’
- In the expression: MkFoo a1
- In the first argument of ‘z’, namely ‘(\ a1 -> MkFoo a1)’
+T15883e.hs:16:1: error: [GHC-91028]
+ • Couldn't match type ‘d0’ with ‘forall a. a’
+ Expected: d0 -> Foo LiftedRep
+ Actual: (forall a. a) -> Foo LiftedRep
+ Cannot instantiate unification variable ‘d0’
+ with a type involving polytypes: forall a. a
+ • In the first argument of ‘z’, namely ‘MkFoo’
+ In the first argument of ‘k’, namely ‘z MkFoo’
+ In the expression: z MkFoo `k` a1
When typechecking the code for ‘GHC.Internal.Data.Data.gfoldl’
in a derived instance for ‘Data (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
- • Relevant bindings include a1 :: d0 (bound at T15883e.hs:16:1)
-T15883e.hs:16:1: error: [GHC-39999]
- • Ambiguous type variable ‘b0’ arising from a use of ‘k’
- prevents the constraint ‘(Data b0)’ from being solved.
- Probable fix: use a type annotation to specify what ‘b0’ should be.
- Potentially matching instances:
- instance (Data a, Data b) => Data (Either a b)
- -- Defined in ‘GHC.Internal.Data.Data’
- instance Data a => Data (Down a)
- -- Defined in ‘GHC.Internal.Data.Data’
- ...plus 20 others
- ...plus 47 instances involving out-of-scope types
- (use -fprint-potential-instances to see them all)
- • In the expression: k (z (\ a1 -> MkFoo a1))
- In an equation for ‘GHC.Internal.Data.Data.gunfold’:
- GHC.Internal.Data.Data.gunfold k z _ = k (z (\ a1 -> MkFoo a1))
+T15883e.hs:16:1: error: [GHC-91028]
+ • Couldn't match type ‘b0’ with ‘forall a. a’
+ Expected: b0 -> Foo LiftedRep
+ Actual: (forall a. a) -> Foo LiftedRep
+ Cannot instantiate unification variable ‘b0’
+ with a type involving polytypes: forall a. a
+ • In the first argument of ‘z’, namely ‘MkFoo’
+ In the first argument of ‘k’, namely ‘(z MkFoo)’
+ In the expression: k (z MkFoo)
When typechecking the code for ‘GHC.Internal.Data.Data.gunfold’
in a derived instance for ‘Data (Foo LiftedRep)’:
To see the code I am typechecking, use -ddump-deriv
- In the instance declaration for ‘Data (Foo LiftedRep)’
-T15883e.hs:16:1: error: [GHC-46956]
- • Couldn't match expected type ‘a’ with actual type ‘b0’
- because type variable ‘a’ would escape its scope
- This (rigid, skolem) type variable is bound by
- a type expected by the context:
- forall a. a
- at T15883e.hs:16:1-52
- • In the first argument of ‘MkFoo’, namely ‘a1’
- In the expression: MkFoo a1
- In the first argument of ‘z’, namely ‘(\ a1 -> MkFoo a1)’
- When typechecking the code for ‘GHC.Internal.Data.Data.gunfold’
- in a derived instance for ‘Data (Foo LiftedRep)’:
- To see the code I am typechecking, use -ddump-deriv
- • Relevant bindings include a1 :: b0 (bound at T15883e.hs:16:1)
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1f7a9d27adeab926777d39ffc0263a453904f34...3438cf2131189b7dbc3cd7a6b75fe63dab946955
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f1f7a9d27adeab926777d39ffc0263a453904f34...3438cf2131189b7dbc3cd7a6b75fe63dab946955
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/20241217/85afcfac/attachment-0001.html>
More information about the ghc-commits
mailing list