Commit 629b8c60 authored by sof's avatar sof
Browse files

[project @ 2001-11-08 19:34:23 by sof]

gen_Eq_binds: when comparing constructor tags, emit just

   a == b = case con2tag_Foo# a of
              a# -> case con2tag_Foo# b of b# -> a# PrelGHC.==# b#

and not

   a == b = case con2tag_Foo# a of
              a# -> case con2tag_Foo# b of
                      b# -> if a# PrelGHC.==# b# then PrelBase.True else PrelBase.False

(Not that this wouldn't get simplified, but still).
parent 56883a7f
......@@ -184,7 +184,7 @@ gen_Eq_binds tycon
else -- calc. and compare the tags
[([a_Pat, b_Pat],
untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
(cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR true_Expr false_Expr))]
(genOpApp (HsVar ah_RDR) eqH_Int_RDR (HsVar bh_RDR)))]
in
mk_FunMonoBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest)
`AndMonoBinds`
......@@ -1191,10 +1191,10 @@ compare_gen_Case fun lt eq gt a b
generatedSrcLoc
careful_compare_Case ty lt eq gt a b
= if not (isUnLiftedType ty) then
| not (isUnLiftedType ty) =
compare_gen_Case compare_RDR lt eq gt a b
else -- we have to do something special for primitive things...
| otherwise =
-- we have to do something special for primitive things...
HsIf (genOpApp a relevant_eq_op b)
eq
(HsIf (genOpApp a relevant_lt_op b) lt gt generatedSrcLoc)
......@@ -1237,13 +1237,14 @@ append_Expr a b = genOpApp a append_RDR b
-----------------------------------------------------------------------
eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
eq_Expr ty a b
= if not (isUnLiftedType ty) then
genOpApp a eq_RDR b
else -- we have to do something special for primitive things...
genOpApp a relevant_eq_op b
where
relevant_eq_op = assoc_ty_id eq_op_tbl ty
eq_Expr ty a b = genOpApp a eq_op b
where
eq_op
| not (isUnLiftedType ty) = eq_RDR
| otherwise =
-- we have to do something special for primitive things...
assoc_ty_id eq_op_tbl ty
\end{code}
\begin{code}
......
Supports Markdown
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