Commit 08af5517 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

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.
parent f525c0b2
...@@ -101,105 +101,94 @@ data DerivStuff -- Please add this auxiliary stuff ...@@ -101,105 +101,94 @@ data DerivStuff -- Please add this auxiliary stuff
%* * %* *
%************************************************************************ %************************************************************************
Here are the heuristics for the code we generate for @Eq@: Here are the heuristics for the code we generate for @Eq@. Let's
\begin{itemize} assume we have a data type with some (possibly zero) nullary data
\item constructors and some ordinary, non-nullary ones (the rest, also
Let's assume we have a data type with some (possibly zero) nullary possibly zero of them). Here's an example, with both \tr{N}ullary and
data constructors and some ordinary, non-nullary ones (the rest, \tr{O}rdinary data cons.
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 | ...
\begin{verbatim}
data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
\end{verbatim}
\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.,: Usual Thing, e.g.,:
\begin{verbatim} (==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2
(==) (O1 a1 b1) (O1 a2 b2) = a1 == a2 && b1 == b2 (==) (O2 a1) (O2 a2) = a1 == a2
(==) (O2 a1) (O2 a2) = a1 == a2 (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
(==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
\end{verbatim}
Note: if we're comparing unlifted things, e.g., if \tr{a1} and Note: if we're comparing unlifted things, e.g., if 'a1' and
\tr{a2} are \tr{Float#}s, then we have to generate 'a2' are Float#s, then we have to generate
\begin{verbatim} case (a1 `eqFloat#` a2) of r -> r
case (a1 `eqFloat#` a2) of
r -> r
\end{verbatim}
for that particular test. for that particular test.
\item * If there are a lot of (more than en) nullary constructors, we emit a
If there are any nullary constructors, we emit a catch-all clause of catch-all clause of the form:
the form:
\begin{verbatim} (==) a b = case (con2tag_Foo a) of { a# ->
(==) a b = case (con2tag_Foo a) of { a# -> case (con2tag_Foo b) of { b# ->
case (con2tag_Foo b) of { b# -> case (a# ==# b#) of {
case (a# ==# b#) of { r -> r }}}
r -> r
}}}
\end{verbatim}
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: catch-all:
\begin{verbatim}
(==) a b = False
\end{verbatim}
\item (==) a b = False
For the @(/=)@ method, we normally just use the default method.
* For the @(/=)@ method, we normally just use the default method.
If the type is an enumeration type, we could/may/should? generate If the type is an enumeration type, we could/may/should? generate
special code that calls @con2tag_Foo@, much like for @(==)@ shown special code that calls @con2tag_Foo@, much like for @(==)@ shown
above. above.
\item We thought about doing this: If we're also deriving 'Ord' for this
We thought about doing this: If we're also deriving @Ord@ for this tycon, we generate:
tycon, we generate: instance ... Eq (Foo ...) where
\begin{verbatim} (==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
instance ... Eq (Foo ...) where (/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
(==) a b = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False} However, that requires that (Ord <whatever>) was put in the context
(/=) a b = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True } for the instance decl, which it probably wasn't, so the decls
\begin{verbatim} produced don't get through the typechecker.
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}
\begin{code} \begin{code}
gen_Eq_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff) gen_Eq_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, BagDerivStuff)
gen_Eq_binds loc tycon gen_Eq_binds loc tycon
= (method_binds, aux_binds) = (method_binds, aux_binds)
where where
(nullary_cons, non_nullary_cons) all_cons = tyConDataCons tycon
| isNewTyCon tycon = ([], tyConDataCons tycon) (nullary_cons, non_nullary_cons) = partition isNullarySrcDataCon all_cons
| otherwise = partition isNullarySrcDataCon (tyConDataCons tycon)
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 fall_through_eqn
| no_nullary_cons -- All constructors have arguments | no_tag_match_cons -- All constructors have arguments
= case non_nullary_cons of = case pat_match_cons of
[] -> [] -- No constructors; no fall-though case [] -> [] -- No constructors; no fall-though case
[_] -> [] -- One constructor; no fall-though case [_] -> [] -- One constructor; no fall-though case
_ -> -- Two or more constructors; add fall-through of _ -> -- Two or more constructors; add fall-through of
-- (==) _ _ = False -- (==) _ _ = False
[([nlWildPat, nlWildPat], false_Expr)] [([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 -- extract tags compare for equality
= [([a_Pat, b_Pat], = [([a_Pat, b_Pat],
untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)] untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
(genOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))] (genOpApp (nlHsVar ah_RDR) eqInt_RDR (nlHsVar bh_RDR)))]
aux_binds | no_nullary_cons = emptyBag aux_binds | no_tag_match_cons = emptyBag
| otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon | otherwise = unitBag $ DerivAuxBind $ DerivCon2Tag tycon
method_binds = listToBag [eq_bind, ne_bind] 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] ( ne_bind = mk_easy_FunBind loc ne_RDR [a_Pat, b_Pat] (
nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR]))) nlHsApp (nlHsVar not_RDR) (nlHsPar (nlHsVarApps eq_RDR [a_RDR, b_RDR])))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment