[project @ 2004-02-28 15:37:09 by ralf]

Revised dataTypeOf member in "deriving ( ... Data ...)".
This revised schemes relies on the updated modules
Data.Typeable and Data.Generics*.

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index e922146..7309b27 100644 (file)
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -1085,16 +1085,32 @@ gen_Data_binds fix_env tycon
     to_con_eqn dc = ([nlWildConPat dc], nlHsVar (mk_constr_name dc))
     
        ------------ dataTypeOf
-    dataTypeOf_bind = mk_easy_FunBind tycon_loc dataTypeOf_RDR [wildPat] 
-                                         emptyBag (nlHsVar data_type_name)
+    dataTypeOf_bind = mkVarBind
+                        tycon_loc
+                        dataTypeOf_RDR
+                        (nlHsVar data_type_name)
 
        ------------ $dT
+
+    data_type_name = mkDerivedRdrName tycon_name mkDataTOcc
+    datatype_bind  = mk_easy_FunBind
+                       tycon_loc
+                       data_type_name
+                       [a_Pat]
+                       emptyBag
+                      (           nlHsVar mkDataType_RDR 
+                         `nlHsApp` nlList constrs
+                         `nlHsApp` nlHsVar a_RDR
+                       )
+    constrs = [nlHsVar (mk_constr_name con) | con <- data_cons]
+
+{-
     data_type_name = mkDerivedRdrName tycon_name mkDataTOcc
     datatype_bind  = mkVarBind tycon_loc data_type_name
                                   (nlHsVar mkDataType_RDR `nlHsApp` 
                                    nlList constrs)
     constrs = [nlHsVar (mk_constr_name con) | con <- data_cons]
-
+-}
 
        ------------ $cT1 etc
     mk_constr_name con = mkDerivedRdrName (dataConName con) mkDataCOcc
@@ -1113,7 +1129,7 @@ gfoldl_RDR     = varQual_RDR gENERICS_Name FSLIT("gfoldl")
 fromConstr_RDR = varQual_RDR gENERICS_Name FSLIT("fromConstr")
 toConstr_RDR   = varQual_RDR gENERICS_Name FSLIT("toConstr")
 dataTypeOf_RDR = varQual_RDR gENERICS_Name FSLIT("dataTypeOf")
-mkConstr_RDR   = varQual_RDR gENERICS_Name FSLIT("mkConstr")
+mkConstr_RDR   = varQual_RDR gENERICS_Name FSLIT("mkDataConstr")
 mkDataType_RDR = varQual_RDR gENERICS_Name FSLIT("mkDataType")
 conIndex_RDR   = varQual_RDR gENERICS_Name FSLIT("conIndex")
 prefix_RDR     = dataQual_RDR gENERICS_Name FSLIT("Prefix")