+
+genAuxBind loc (MkTyCon tycon) -- $dT
+ = mkVarBind loc (mk_data_type_name tycon)
+ ( nlHsVar mkDataType_RDR
+ `nlHsApp` nlHsLit (mkHsString (showSDoc (ppr tycon)))
+ `nlHsApp` nlList constrs )
+ where
+ constrs = [nlHsVar (mk_constr_name con) | con <- tyConDataCons tycon]
+
+genAuxBind loc (MkDataCon dc) -- $cT1 etc
+ = mkVarBind loc (mk_constr_name dc)
+ (nlHsApps mkConstr_RDR constr_args)
+ where
+ constr_args
+ = [ -- nlHsIntLit (toInteger (dataConTag dc)), -- Tag
+ nlHsVar (mk_data_type_name (dataConTyCon dc)), -- DataType
+ nlHsLit (mkHsString (occNameString dc_occ)), -- String name
+ nlList labels, -- Field labels
+ nlHsVar fixity] -- Fixity
+
+ labels = map (nlHsLit . mkHsString . getOccString)
+ (dataConFieldLabels dc)
+ dc_occ = getOccName dc
+ is_infix = isDataSymOcc dc_occ
+ fixity | is_infix = infix_RDR
+ | otherwise = prefix_RDR
+
+mk_data_type_name :: TyCon -> RdrName -- "$tT"
+mk_data_type_name tycon = mkAuxBinderName (tyConName tycon) mkDataTOcc
+
+mk_constr_name :: DataCon -> RdrName -- "$cC"
+mk_constr_name con = mkAuxBinderName (dataConName con) mkDataCOcc