From: ralf <unknown>
Date: Sat, 28 Feb 2004 15:37:09 +0000 (+0000)
Subject: [project @ 2004-02-28 15:37:09 by ralf]
X-Git-Tag: Approx_11550_changesets_converted~39
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=0dca9ac529728ae9dbcdbf07ab9a80767534874c

[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
--- 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")