From 32beaa8d5849022120095258e6392673b0a208a5 Mon Sep 17 00:00:00 2001
From: ralf <unknown>
Date: Tue, 2 Mar 2004 22:22:48 +0000
Subject: [PATCH] [project @ 2004-03-02 22:22:48 by ralf] Once more revised
 some details of the Data class. Comitting the
 Data.Generics* library in a second.

---
 ghc/compiler/typecheck/TcGenDeriv.lhs |   39 +++++++++++++++------------------
 1 file changed, 18 insertions(+), 21 deletions(-)

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index 7309b27..e15574a 100644
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -1030,9 +1030,9 @@ From the data type
 
 we generate
 
-  $cT1 = mkConstr 1 "T1" Prefix
-  $cT2 = mkConstr 2 "T2" Prefix
-  $dT  = mkDataType [$con_T1, $con_T2]
+  $cT1 = mkDataCon $dT "T1" Prefix
+  $cT2 = mkDataCon $dT "T2" Prefix
+  $dT  = mkDataType "Module.T" [$con_T1, $con_T2]
 
   instance (Data a, Data b) => Data (T a b) where
     gfoldl k z (T1 a b) = z T `k` a `k` b
@@ -1085,40 +1085,37 @@ gen_Data_binds fix_env tycon
     to_con_eqn dc = ([nlWildConPat dc], nlHsVar (mk_constr_name dc))
     
 	------------ dataTypeOf
-    dataTypeOf_bind = mkVarBind
+    dataTypeOf_bind = mk_easy_FunBind
                         tycon_loc
                         dataTypeOf_RDR
+			[wildPat]
+                        emptyBag
                         (nlHsVar data_type_name)
 
 	------------ $dT
 
     data_type_name = mkDerivedRdrName tycon_name mkDataTOcc
-    datatype_bind  = mk_easy_FunBind
+    datatype_bind  = mkVarBind
                        tycon_loc
                        data_type_name
-                       [a_Pat]
-                       emptyBag
 		       (           nlHsVar mkDataType_RDR 
+                         `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon)))
                          `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
-    mk_con_bind dc = mkVarBind tycon_loc (mk_constr_name dc) 
-					     (nlHsApps mkConstr_RDR (constr_args dc))
-    constr_args dc = [nlHsIntLit (toInteger (dataConTag dc)),		-- Tag
-		      nlHsLit (mkHsString (occNameUserString dc_occ)),	-- String name
-		      nlHsVar fixity]					-- Fixity
+    mk_con_bind dc = mkVarBind
+                       tycon_loc
+                       (mk_constr_name dc) 
+		       (nlHsApps mkConstr_RDR (constr_args dc))
+    constr_args dc =
+	 [ -- nlHsIntLit (toInteger (dataConTag dc)),		-- Tag
+	   nlHsVar data_type_name,				-- DataType
+	   nlHsLit (mkHsString (occNameUserString dc_occ)),	-- String name
+	   nlHsVar fixity]					-- Fixity
 	where
 	  dc_occ   = getOccName dc
 	  is_infix = isDataSymOcc dc_occ
@@ -1129,7 +1126,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("mkDataConstr")
+mkConstr_RDR   = varQual_RDR gENERICS_Name FSLIT("mkDataCon")
 mkDataType_RDR = varQual_RDR gENERICS_Name FSLIT("mkDataType")
 conIndex_RDR   = varQual_RDR gENERICS_Name FSLIT("conIndex")
 prefix_RDR     = dataQual_RDR gENERICS_Name FSLIT("Prefix")
-- 
1.7.10.4