From: sof Date: Thu, 5 Jun 1997 19:55:57 +0000 (+0000) Subject: [project @ 1997-06-05 19:55:57 by sof] X-Git-Tag: Approximately_1000_patches_recorded~415 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=60f01b7024c151795674d36ed301e78a1eb54eae;p=ghc-hetmet.git [project @ 1997-06-05 19:55:57 by sof] Only generate tag2con for data cons (not newtypes) --- diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs index e54b7af..c3a7dc8 100644 --- a/ghc/compiler/typecheck/TcDeriv.lhs +++ b/ghc/compiler/typecheck/TcDeriv.lhs @@ -52,7 +52,7 @@ import Pretty ( ($$), vcat, hsep, hcat, ptext, text, char, hang, Doc ) import SrcLoc ( mkGeneratedSrcLoc, SrcLoc ) import TyCon ( tyConTyVars, tyConDataCons, tyConDerivings, - tyConTheta, maybeTyConSingleCon, + tyConTheta, maybeTyConSingleCon, isDataTyCon, isEnumerationTyCon, isAlgTyCon, TyCon ) import Type ( GenType(..), SYN_IE(TauType), mkTyVarTys, applyTyCon, @@ -678,17 +678,18 @@ gen_taggery_Names inst_infos (tycons_of_interest, _) = removeDups cmp all_tycons do_con2tag acc_Names tycon - = if (we_are_deriving eqClassKey tycon + | isDataTyCon tycon && + (we_are_deriving eqClassKey tycon && any isNullaryDataCon (tyConDataCons tycon)) - || (we_are_deriving ordClassKey tycon + || (we_are_deriving ordClassKey tycon && not (maybeToBool (maybeTyConSingleCon tycon))) - || (we_are_deriving enumClassKey tycon) - || (we_are_deriving ixClassKey tycon) - then - returnTc ((con2tag_RDR tycon, tycon, GenCon2Tag) + || (we_are_deriving enumClassKey tycon) + || (we_are_deriving ixClassKey tycon) + + = returnTc ((con2tag_RDR tycon, tycon, GenCon2Tag) : acc_Names) - else - returnTc acc_Names + | otherwise + = returnTc acc_Names do_tag2con acc_Names tycon = if (we_are_deriving enumClassKey tycon)