Commit 32beaa8d authored by ralf's avatar ralf
Browse files

[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.
parent 59df6a26
...@@ -1030,9 +1030,9 @@ From the data type ...@@ -1030,9 +1030,9 @@ From the data type
we generate we generate
$cT1 = mkConstr 1 "T1" Prefix $cT1 = mkDataCon $dT "T1" Prefix
$cT2 = mkConstr 2 "T2" Prefix $cT2 = mkDataCon $dT "T2" Prefix
$dT = mkDataType [$con_T1, $con_T2] $dT = mkDataType "Module.T" [$con_T1, $con_T2]
instance (Data a, Data b) => Data (T a b) where instance (Data a, Data b) => Data (T a b) where
gfoldl k z (T1 a b) = z T `k` a `k` b gfoldl k z (T1 a b) = z T `k` a `k` b
...@@ -1085,40 +1085,37 @@ gen_Data_binds fix_env tycon ...@@ -1085,40 +1085,37 @@ gen_Data_binds fix_env tycon
to_con_eqn dc = ([nlWildConPat dc], nlHsVar (mk_constr_name dc)) to_con_eqn dc = ([nlWildConPat dc], nlHsVar (mk_constr_name dc))
------------ dataTypeOf ------------ dataTypeOf
dataTypeOf_bind = mkVarBind dataTypeOf_bind = mk_easy_FunBind
tycon_loc tycon_loc
dataTypeOf_RDR dataTypeOf_RDR
[wildPat]
emptyBag
(nlHsVar data_type_name) (nlHsVar data_type_name)
------------ $dT ------------ $dT
data_type_name = mkDerivedRdrName tycon_name mkDataTOcc data_type_name = mkDerivedRdrName tycon_name mkDataTOcc
datatype_bind = mk_easy_FunBind datatype_bind = mkVarBind
tycon_loc tycon_loc
data_type_name data_type_name
[a_Pat]
emptyBag
( nlHsVar mkDataType_RDR ( nlHsVar mkDataType_RDR
`nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon)))
`nlHsApp` nlList constrs `nlHsApp` nlList constrs
`nlHsApp` nlHsVar a_RDR
) )
constrs = [nlHsVar (mk_constr_name con) | con <- data_cons] 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 ------------ $cT1 etc
mk_constr_name con = mkDerivedRdrName (dataConName con) mkDataCOcc mk_constr_name con = mkDerivedRdrName (dataConName con) mkDataCOcc
mk_con_bind dc = mkVarBind tycon_loc (mk_constr_name dc) mk_con_bind dc = mkVarBind
(nlHsApps mkConstr_RDR (constr_args dc)) tycon_loc
constr_args dc = [nlHsIntLit (toInteger (dataConTag dc)), -- Tag (mk_constr_name dc)
nlHsLit (mkHsString (occNameUserString dc_occ)), -- String name (nlHsApps mkConstr_RDR (constr_args dc))
nlHsVar fixity] -- Fixity constr_args dc =
[ -- nlHsIntLit (toInteger (dataConTag dc)), -- Tag
nlHsVar data_type_name, -- DataType
nlHsLit (mkHsString (occNameUserString dc_occ)), -- String name
nlHsVar fixity] -- Fixity
where where
dc_occ = getOccName dc dc_occ = getOccName dc
is_infix = isDataSymOcc dc_occ is_infix = isDataSymOcc dc_occ
...@@ -1129,7 +1126,7 @@ gfoldl_RDR = varQual_RDR gENERICS_Name FSLIT("gfoldl") ...@@ -1129,7 +1126,7 @@ gfoldl_RDR = varQual_RDR gENERICS_Name FSLIT("gfoldl")
fromConstr_RDR = varQual_RDR gENERICS_Name FSLIT("fromConstr") fromConstr_RDR = varQual_RDR gENERICS_Name FSLIT("fromConstr")
toConstr_RDR = varQual_RDR gENERICS_Name FSLIT("toConstr") toConstr_RDR = varQual_RDR gENERICS_Name FSLIT("toConstr")
dataTypeOf_RDR = varQual_RDR gENERICS_Name FSLIT("dataTypeOf") 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") mkDataType_RDR = varQual_RDR gENERICS_Name FSLIT("mkDataType")
conIndex_RDR = varQual_RDR gENERICS_Name FSLIT("conIndex") conIndex_RDR = varQual_RDR gENERICS_Name FSLIT("conIndex")
prefix_RDR = dataQual_RDR gENERICS_Name FSLIT("Prefix") prefix_RDR = dataQual_RDR gENERICS_Name FSLIT("Prefix")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment