[commit: ghc] master: Generate better derived code for Eq (08af551)
Simon Peyton Jones
simonpj at microsoft.com
Wed Feb 13 17:55:10 CET 2013
Repository : ssh://darcs.haskell.org//srv/darcs/ghc
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/08af5517f9057f999ef6db382b2b9b51aea215c9
>---------------------------------------------------------------
commit 08af5517f9057f999ef6db382b2b9b51aea215c9
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Wed Feb 13 08:52:44 2013 +0000
Generate better derived code for Eq
In particular, when there are only a few nullary constructors generate
regular pattern matching code, rather than using con2Tag. This avoids
generating unnecessary join points, which can make the code noticably
worse in the few-constructors case.
>---------------------------------------------------------------
compiler/typecheck/TcGenDeriv.lhs | 117 +++++++++++++++++--------------------
1 files changed, 53 insertions(+), 64 deletions(-)
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index b45177e..5726031 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -101,105 +101,94 @@ data DerivStuff -- Please add this auxiliary stuff
%* *
%************************************************************************
-Here are the heuristics for the code we generate for @Eq@:
-\begin{itemize}
-\item
- Let's assume we have a data type with some (possibly zero) nullary
- data constructors and some ordinary, non-nullary ones (the rest,
- also possibly zero of them). Here's an example, with both \tr{N}ullary
- and \tr{O}rdinary data cons.
-\begin{verbatim}
-data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
-\end{verbatim}
+Here are the heuristics for the code we generate for @Eq at . Let's
+assume we have a data type with some (possibly zero) nullary data
+constructors and some ordinary, non-nullary ones (the rest, also
+possibly zero of them). Here's an example, with both \tr{N}ullary and
+\tr{O}rdinary data cons.
+
+ data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
-\item
- For the ordinary constructors (if any), we emit clauses to do The
+* For the ordinary constructors (if any), we emit clauses to do The
Usual Thing, e.g.,:
-\begin{verbatim}
-(==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2
-(==) (O2 a1) (O2 a2) = a1 == a2
-(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
-\end{verbatim}
+ (==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2
+ (==) (O2 a1) (O2 a2) = a1 == a2
+ (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
- Note: if we're comparing unlifted things, e.g., if \tr{a1} and
- \tr{a2} are \tr{Float#}s, then we have to generate
-\begin{verbatim}
-case (a1 `eqFloat#` a2) of
- r -> r
-\end{verbatim}
+ Note: if we're comparing unlifted things, e.g., if 'a1' and
+ 'a2' are Float#s, then we have to generate
+ case (a1 `eqFloat#` a2) of r -> r
for that particular test.
-\item
- If there are any nullary constructors, we emit a catch-all clause of
- the form:
+* If there are a lot of (more than en) nullary constructors, we emit a
+ catch-all clause of the form:
-\begin{verbatim}
-(==) a b = case (con2tag_Foo a) of { a# ->
- case (con2tag_Foo b) of { b# ->
- case (a# ==# b#) of {
- r -> r
- }}}
-\end{verbatim}
+ (==) a b = case (con2tag_Foo a) of { a# ->
+ case (con2tag_Foo b) of { b# ->
+ case (a# ==# b#) of {
+ r -> r }}}
- If there aren't any nullary constructors, we emit a simpler
+ If con2tag gets inlined this leads to join point stuff, so
+ it's better to use regular pattern matching if there aren't too
+ many nullary constructors. "Ten" is arbitrary, of course
+
+* If there aren't any nullary constructors, we emit a simpler
catch-all:
-\begin{verbatim}
-(==) a b = False
-\end{verbatim}
-\item
- For the @(/=)@ method, we normally just use the default method.
+ (==) a b = False
+* For the @(/=)@ method, we normally just use the default method.
If the type is an enumeration type, we could/may/should? generate
special code that calls @con2tag_Foo@, much like for @(==)@ shown
above.
-\item
- We thought about doing this: If we're also deriving @Ord@ for this
- tycon, we generate:
-\begin{verbatim}
-instance ... Eq (Foo ...) where
- (==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
- (/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
-\begin{verbatim}
- However, that requires that \tr{Ord <whatever>} was put in the context
- for the instance decl, which it probably wasn't, so the decls
- produced don't get through the typechecker.
-\end{itemize}
-
+We thought about doing this: If we're also deriving 'Ord' for this
+tycon, we generate:
+ instance ... Eq (Foo ...) where
+ (==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
+ (/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
+However, that requires that (Ord <whatever>) was put in the context
+for the instance decl, which it probably wasn't, so the decls
+produced don't get through the typechecker.
\begin{code}
gen_Eq_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
gen_Eq_binds loc tycon
= (method_binds, aux_binds)
where
- (nullary_cons, non_nullary_cons)
- | isNewTyCon tycon = ([], tyConDataCons tycon)
- | otherwise = partition isNullarySrcDataCon (tyConDataCons tycon)
+ all_cons = tyConDataCons tycon
+ (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
- no_nullary_cons = null nullary_cons
+ -- If there are ten or more (arbitrary number) nullary constructors,
+ -- use the con2tag stuff. For small types it's better to use
+ -- ordinary pattern matching.
+ (tag_match_cons, pat_match_cons)
+ | nullary_cons `lengthExceeds` 10 = (nullary_cons, non_nullary_cons)
+ | otherwise = ([], all_cons)
+
+ no_tag_match_cons = null tag_match_cons
fall_through_eqn
- | no_nullary_cons -- All constructors have arguments
- = case non_nullary_cons of
+ | no_tag_match_cons -- All constructors have arguments
+ = case pat_match_cons of
[] -> [] -- No constructors; no fall-though case
[_] -> [] -- One constructor; no fall-though case
_ -> -- Two or more constructors; add fall-through of
-- (==) _ _ = False
[([nlWildPat, nlWildPat], false_Expr)]
- | otherwise -- One or more nullary cons; add fall-through of
+ | otherwise -- One or more tag_match cons; add fall-through of
-- extract tags compare for equality
= [([a_Pat, b_Pat],
untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
(genOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
- aux_binds | no_nullary_cons = emptyBag
- | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
+ aux_binds | no_tag_match_cons = emptyBag
+ | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
method_binds = listToBag [eq_bind, ne_bind]
- eq_bind = mk_FunBind loc eq_RDR (map pats_etc non_nullary_cons ++ fall_through_eqn)
+ eq_bind = mk_FunBind loc eq_RDR (map pats_etc pat_match_cons ++ fall_through_eqn)
ne_bind = mk_easy_FunBind loc ne_RDR [a_Pat, b_Pat] (
nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
More information about the ghc-commits
mailing list