X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FBuildTyCl.lhs;h=805fcd72e3521cc1555f3750f03fb1b2a6401de1;hb=fbff1b7b9c89f6369c4394a0b10fa7c06e011698;hp=de57feb928e1b9d9f689f392c701c3f25aa01819;hpb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;p=ghc-hetmet.git diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs index de57feb..805fcd7 100644 --- a/compiler/iface/BuildTyCl.lhs +++ b/compiler/iface/BuildTyCl.lhs @@ -112,16 +112,14 @@ mkDataTyConRhs :: [DataCon] -> AlgTyConRhs mkDataTyConRhs cons = DataTyCon { data_cons = cons, - is_enum = -- We define datatypes with no constructors to not be - -- enumerations; this fixes trac #2578, Otherwise we - -- end up generating an empty table for - -- __closure_tbl - -- which is used by tagToEnum# to map Int# to constructors - -- in an enumeration. The empty table apparently upset - -- the linker. - not (null cons) && - all isNullarySrcDataCon cons + is_enum = not (null cons) && all is_enum_con cons + -- See Note [Enumeration types] in TyCon } + where + is_enum_con con + | (_tvs, theta, arg_tys, _res) <- dataConSig con + = null theta && null arg_tys + mkNewTyConRhs :: Name -> TyCon -> DataCon -> TcRnIf m n AlgTyConRhs -- ^ Monadic because it makes a Name for the coercion TyCon @@ -231,8 +229,9 @@ mkDataConStupidTheta tycon arg_tys univ_tvs ------------------------------------------------------ \begin{code} -type TcMethInfo = (Name, DefMethSpec, Type) -- A temporary intermediate, to communicate - -- between tcClassSigs and buildClass +type TcMethInfo = (Name, DefMethSpec, Type) + -- A temporary intermediate, to communicate between tcClassSigs and + -- buildClass. buildClass :: Bool -- True <=> do not include unfoldings -- on dict selectors @@ -334,7 +333,8 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec mk_op_item rec_clas (op_name, dm_spec, _) = do { dm_info <- case dm_spec of NoDM -> return NoDefMeth - GenericDM -> return GenDefMeth + GenericDM -> do { dm_name <- newImplicitBinder op_name mkGenDefMethodOcc + ; return (GenDefMeth dm_name) } VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc ; return (DefMeth dm_name) } ; return (mkDictSelId no_unf op_name rec_clas, dm_info) }