Commit 0dcea0d9 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Whitespace only

parent ecfe3ca0
......@@ -311,75 +311,80 @@ gen_Ord_binds loc tycon
| Just (con, prim_tc) <- primWrapperType_maybe tycon
= gen_PrimOrd_binds con prim_tc
| otherwise
| otherwise
= (unitBag compare, aux_binds)
-- `AndMonoBinds` compare
-- The default declaration in PrelBase handles this
-- `AndMonoBinds` compare
-- The default declaration in PrelBase handles this
where
aux_binds | single_con_type = []
| otherwise = [GenCon2Tag tycon]
| otherwise = [GenCon2Tag tycon]
compare = L loc (mkFunBind (L loc compare_RDR) compare_matches)
compare_matches = [mkMatch [a_Pat, b_Pat] compare_rhs cmp_eq_binds]
cmp_eq_binds = HsValBinds (ValBindsIn (unitBag cmp_eq) [])
compare_rhs
| single_con_type = cmp_eq_Expr a_Expr b_Expr
| otherwise
= untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
(cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
(cmp_eq_Expr a_Expr b_Expr) -- True case
-- False case; they aren't equal
-- So we need to do a less-than comparison on the tags
(cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr))
| single_con_type = cmp_eq_Expr a_Expr b_Expr
| otherwise
= untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
(cmp_tags_Expr eqInt_RDR ah_RDR bh_RDR
(cmp_eq_Expr a_Expr b_Expr) -- True case
-- False case; they aren't equal
-- So we need to do a less-than comparison on the tags
(cmp_tags_Expr ltInt_RDR ah_RDR bh_RDR
ltTag_Expr gtTag_Expr))
tycon_data_cons = tyConDataCons tycon
single_con_type = isSingleton tycon_data_cons
(nullary_cons, nonnullary_cons)
| isNewTyCon tycon = ([], tyConDataCons tycon)
| otherwise = partition isNullarySrcDataCon tycon_data_cons
| otherwise = partition isNullarySrcDataCon tycon_data_cons
cmp_eq = mk_FunBind loc cmp_eq_RDR cmp_eq_match
cmp_eq_match
| isEnumerationTyCon tycon
-- We know the tags are equal, so if it's an enumeration TyCon,
-- then there is nothing left to do
-- Catch this specially to avoid warnings
-- about overlapping patterns from the desugarer,
-- and to avoid unnecessary pattern-matching
-- We know the tags are equal, so if it's an
-- enumeration TyCon,
-- then there is nothing left to do
-- Catch this specially to avoid warnings
-- about overlapping patterns from the desugarer,
-- and to avoid unnecessary pattern-matching
= [([nlWildPat,nlWildPat], eqTag_Expr)]
| otherwise
= map pats_etc nonnullary_cons ++
(if single_con_type then -- Omit wildcards when there's just one
[] -- constructor, to silence desugarer
else
(if single_con_type then -- Omit wildcards when there's just one
[] -- constructor, to silence desugarer
else
[([nlWildPat, nlWildPat], default_rhs)])
default_rhs | null nullary_cons = impossible_Expr -- Keep desugarer from complaining about
-- inexhaustive patterns
| otherwise = eqTag_Expr -- Some nullary constructors;
-- Tags are equal, no args => return EQ
default_rhs | null nullary_cons = -- Keep desugarer from complaining about
-- inexhaustive patterns
impossible_Expr
| otherwise = -- Some nullary constructors;
-- Tags are equal, no args => return EQ
eqTag_Expr
pats_etc data_con
= ([con1_pat, con2_pat],
nested_compare_expr tys_needed as_needed bs_needed)
where
con1_pat = nlConVarPat data_con_RDR as_needed
con2_pat = nlConVarPat data_con_RDR bs_needed
data_con_RDR = getRdrName data_con
con_arity = length tys_needed
as_needed = take con_arity as_RDRs
bs_needed = take con_arity bs_RDRs
tys_needed = dataConOrigArgTys data_con
nested_compare_expr [ty] [a] [b]
= careful_compare_Case tycon ty eqTag_Expr (nlHsVar a) (nlHsVar b)
nested_compare_expr (ty:tys) (a:as) (b:bs)
= let eq_expr = nested_compare_expr tys as bs
in careful_compare_Case tycon ty eq_expr (nlHsVar a) (nlHsVar b)
nested_compare_expr _ _ _ = panic "nested_compare_expr" -- Args always equal length
= ([con1_pat, con2_pat],
nested_compare_expr tys_needed as_needed bs_needed)
where
con1_pat = nlConVarPat data_con_RDR as_needed
con2_pat = nlConVarPat data_con_RDR bs_needed
data_con_RDR = getRdrName data_con
con_arity = length tys_needed
as_needed = take con_arity as_RDRs
bs_needed = take con_arity bs_RDRs
tys_needed = dataConOrigArgTys data_con
nested_compare_expr [ty] [a] [b]
= careful_compare_Case tycon ty eqTag_Expr (nlHsVar a) (nlHsVar b)
nested_compare_expr (ty:tys) (a:as) (b:bs)
= let eq_expr = nested_compare_expr tys as bs
in careful_compare_Case tycon ty eq_expr (nlHsVar a) (nlHsVar b)
-- Args always equal length
nested_compare_expr _ _ _ = panic "nested_compare_expr"
\end{code}
Note [Comparision of primitive types]
......
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