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

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
%* *
%************************************************************************
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@. 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])))
......
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