Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,265
Issues
4,265
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
421
Merge Requests
421
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
6571f4f1
Commit
6571f4f1
authored
Feb 13, 2013
by
Simon Peyton Jones
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'master' of darcs.haskell.org:/home/darcs/ghc
parents
44302272
c08295a1
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
56 additions
and
63 deletions
+56
-63
compiler/coreSyn/CoreUtils.lhs
compiler/coreSyn/CoreUtils.lhs
+5
-1
compiler/typecheck/TcGenDeriv.lhs
compiler/typecheck/TcGenDeriv.lhs
+51
-62
No files found.
compiler/coreSyn/CoreUtils.lhs
View file @
6571f4f1
...
...
@@ -1456,7 +1456,11 @@ exprStats (Cast e co) = coStats co `plusCS` exprStats e
exprStats (Tick _ e) = exprStats e
altStats :: CoreAlt -> CoreStats
altStats (_, bs, r) = sumCS bndrStats bs `plusCS` exprStats r
altStats (_, bs, r) = altBndrStats bs `plusCS` exprStats r
altBndrStats :: [Var] -> CoreStats
-- Charge one for the alternative, not for each binder
altBndrStats vs = oneTM `plusCS` sumCS (tyStats . varType) vs
tyStats :: Type -> CoreStats
tyStats ty = zeroCS { cs_ty = typeSize ty }
...
...
compiler/typecheck/TcGenDeriv.lhs
View file @
6571f4f1
...
...
@@ -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])))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment