Initial commit for Pedro's new generic default methods

[ghc-hetmet.git] / compiler / iface / BuildTyCl.lhs

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index de57feb..805fcd7 100644 (file)
--- 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
-                  --   <mod>_<type>_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) }