From 811746d7b3462b62aa233a17e778c1de1d0817dd Mon Sep 17 00:00:00 2001 From: Jose Pedro Magalhaes Date: Mon, 9 May 2011 09:46:38 +0200 Subject: [PATCH] Rename `Representable0` to `Generic`. Remove a few other `0`s from names. --- compiler/main/DynFlags.hs | 8 ++-- compiler/prelude/PrelNames.lhs | 50 ++++++++---------------- compiler/typecheck/TcDeriv.lhs | 83 ++++++++++++++++------------------------ compiler/types/Generics.lhs | 36 ++++++++--------- 4 files changed, 71 insertions(+), 106 deletions(-) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 3960717..ea10993 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -342,7 +342,7 @@ data ExtensionFlag | Opt_DeriveFunctor | Opt_DeriveTraversable | Opt_DeriveFoldable - | Opt_DeriveRepresentable -- Allow deriving Representable0/1 + | Opt_DeriveGeneric -- Allow deriving Generic/1 | Opt_DefaultSignatures -- Allow extra signatures for defmeths | Opt_Generics -- Generic deriving mechanism @@ -1682,7 +1682,7 @@ xFlags = [ ( "DeriveFunctor", Opt_DeriveFunctor, nop ), ( "DeriveTraversable", Opt_DeriveTraversable, nop ), ( "DeriveFoldable", Opt_DeriveFoldable, nop ), - ( "DeriveRepresentable", Opt_DeriveRepresentable, nop ), + ( "DeriveGeneric", Opt_DeriveGeneric, nop ), ( "DefaultSignatures", Opt_DefaultSignatures, nop ), ( "TypeSynonymInstances", Opt_TypeSynonymInstances, nop ), ( "FlexibleContexts", Opt_FlexibleContexts, nop ), @@ -1751,7 +1751,7 @@ impliedFlags , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp) -- The new behavior of the XGenerics flag is just to turn on these two flags , (Opt_Generics, turnOn, Opt_DefaultSignatures) - , (Opt_Generics, turnOn, Opt_DeriveRepresentable) + , (Opt_Generics, turnOn, Opt_DeriveGeneric) ] optLevelFlags :: [([Int], DynFlag)] @@ -1867,7 +1867,7 @@ glasgowExtsFlags = [ , Opt_DeriveFunctor , Opt_DeriveFoldable , Opt_DeriveTraversable - , Opt_DeriveRepresentable + , Opt_DeriveGeneric , Opt_FlexibleContexts , Opt_FlexibleInstances , Opt_ConstrainedClassMethods diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index d3f0602..a678a9d 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -224,7 +224,7 @@ basicKnownKeyNames , marshalStringName, unmarshalStringName, checkDotnetResName -- Generics - , rep0ClassName, rep1ClassName + , genClassName, gen1ClassName , datatypeClassName, constructorClassName, selectorClassName -- Monad comprehensions @@ -236,15 +236,12 @@ basicKnownKeyNames genericTyConNames :: [Name] genericTyConNames = [ - -- Old stuff - crossTyConName, plusTyConName, genUnitTyConName, - -- New stuff v1TyConName, u1TyConName, par1TyConName, rec1TyConName, k1TyConName, m1TyConName, sumTyConName, prodTyConName, compTyConName, rTyConName, pTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, par0TyConName, d1TyConName, c1TyConName, s1TyConName, noSelTyConName, - rep0TyConName, rep1TyConName + repTyConName, rep1TyConName ] -- Know names from the DPH package which vary depending on the selected DPH backend. @@ -563,14 +560,13 @@ genUnitDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Unit") -- Generics (constructors and functions) u1DataCon_RDR, par1DataCon_RDR, rec1DataCon_RDR, k1DataCon_RDR, m1DataCon_RDR, l1DataCon_RDR, r1DataCon_RDR, - prodDataCon_RDR, comp1DataCon_RDR, from0_RDR, from1_RDR, - to0_RDR, to1_RDR, datatypeName_RDR, moduleName_RDR, conName_RDR, + prodDataCon_RDR, comp1DataCon_RDR, from_RDR, from1_RDR, + to_RDR, to1_RDR, datatypeName_RDR, moduleName_RDR, conName_RDR, conFixity_RDR, conIsRecord_RDR, noArityDataCon_RDR, arityDataCon_RDR, selName_RDR, prefixDataCon_RDR, infixDataCon_RDR, leftAssocDataCon_RDR, rightAssocDataCon_RDR, notAssocDataCon_RDR :: RdrName ---v1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "V1") u1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "U1") par1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Par1") rec1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Rec1") @@ -583,9 +579,9 @@ r1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "R1") prodDataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit ":*:") comp1DataCon_RDR = dataQual_RDR gHC_GENERICS (fsLit "Comp1") -from0_RDR = varQual_RDR gHC_GENERICS (fsLit "from0") +from_RDR = varQual_RDR gHC_GENERICS (fsLit "from") from1_RDR = varQual_RDR gHC_GENERICS (fsLit "from1") -to0_RDR = varQual_RDR gHC_GENERICS (fsLit "to0") +to_RDR = varQual_RDR gHC_GENERICS (fsLit "to") to1_RDR = varQual_RDR gHC_GENERICS (fsLit "to1") datatypeName_RDR = varQual_RDR gHC_GENERICS (fsLit "datatypeName") @@ -649,19 +645,13 @@ eitherTyConName = tcQual dATA_EITHER (fsLit "Either") eitherTyConKey leftDataConName = conName dATA_EITHER (fsLit "Left") leftDataConKey rightDataConName = conName dATA_EITHER (fsLit "Right") rightDataConKey --- Old Generics (types) -crossTyConName, plusTyConName, genUnitTyConName :: Name -crossTyConName = tcQual gHC_GENERICS (fsLit ":*:") crossTyConKey -plusTyConName = tcQual gHC_GENERICS (fsLit ":+:") plusTyConKey -genUnitTyConName = tcQual gHC_GENERICS (fsLit "Unit") genUnitTyConKey - -- Generics (types) v1TyConName, u1TyConName, par1TyConName, rec1TyConName, k1TyConName, m1TyConName, sumTyConName, prodTyConName, compTyConName, rTyConName, pTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, par0TyConName, d1TyConName, c1TyConName, s1TyConName, noSelTyConName, - rep0TyConName, rep1TyConName :: Name + repTyConName, rep1TyConName :: Name v1TyConName = tcQual gHC_GENERICS (fsLit "V1") v1TyConKey u1TyConName = tcQual gHC_GENERICS (fsLit "U1") u1TyConKey @@ -687,7 +677,7 @@ c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey -rep0TyConName = tcQual gHC_GENERICS (fsLit "Rep0") rep0TyConKey +repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey -- Base strings Strings @@ -864,11 +854,11 @@ showClassName = clsQual gHC_SHOW (fsLit "Show") showClassKey readClassName :: Name readClassName = clsQual gHC_READ (fsLit "Read") readClassKey --- Classes Representable0 and Representable1, Datatype, Constructor and Selector -rep0ClassName, rep1ClassName, datatypeClassName, constructorClassName, +-- Classes Generic and Generic1, Datatype, Constructor and Selector +genClassName, gen1ClassName, datatypeClassName, constructorClassName, selectorClassName :: Name -rep0ClassName = clsQual gHC_GENERICS (fsLit "Representable0") rep0ClassKey -rep1ClassName = clsQual gHC_GENERICS (fsLit "Representable1") rep1ClassKey +genClassName = clsQual gHC_GENERICS (fsLit "Generic") genClassKey +gen1ClassName = clsQual gHC_GENERICS (fsLit "Generic1") gen1ClassKey datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassKey constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey @@ -1072,10 +1062,10 @@ applicativeClassKey = mkPreludeClassUnique 34 foldableClassKey = mkPreludeClassUnique 35 traversableClassKey = mkPreludeClassUnique 36 -rep0ClassKey, rep1ClassKey, datatypeClassKey, constructorClassKey, +genClassKey, gen1ClassKey, datatypeClassKey, constructorClassKey, selectorClassKey :: Unique -rep0ClassKey = mkPreludeClassUnique 37 -rep1ClassKey = mkPreludeClassUnique 38 +genClassKey = mkPreludeClassUnique 37 +gen1ClassKey = mkPreludeClassUnique 38 datatypeClassKey = mkPreludeClassUnique 39 constructorClassKey = mkPreludeClassUnique 40 @@ -1165,12 +1155,6 @@ ptrTyConKey = mkPreludeTyConUnique 74 funPtrTyConKey = mkPreludeTyConUnique 75 tVarPrimTyConKey = mkPreludeTyConUnique 76 --- Old Generic Type Constructors -crossTyConKey, plusTyConKey, genUnitTyConKey :: Unique -crossTyConKey = mkPreludeTyConUnique 79 -plusTyConKey = mkPreludeTyConUnique 80 -genUnitTyConKey = mkPreludeTyConUnique 81 - -- Parallel array type constructor parrTyConKey :: Unique parrTyConKey = mkPreludeTyConUnique 82 @@ -1228,7 +1212,7 @@ v1TyConKey, u1TyConKey, par1TyConKey, rec1TyConKey, compTyConKey, rTyConKey, pTyConKey, dTyConKey, cTyConKey, sTyConKey, rec0TyConKey, par0TyConKey, d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey, - rep0TyConKey, rep1TyConKey :: Unique + repTyConKey, rep1TyConKey :: Unique v1TyConKey = mkPreludeTyConUnique 135 u1TyConKey = mkPreludeTyConUnique 136 @@ -1254,7 +1238,7 @@ c1TyConKey = mkPreludeTyConUnique 152 s1TyConKey = mkPreludeTyConUnique 153 noSelTyConKey = mkPreludeTyConUnique 154 -rep0TyConKey = mkPreludeTyConUnique 155 +repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 ---------------- Template Haskell ------------------- diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 5d292fd..ffd7bac 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -328,9 +328,9 @@ tcDeriving tycl_decls inst_decls deriv_decls ; gen_binds <- return emptyBag -- mkGenericBinds is_boot tycl_decls {- - -- Generate the generic Representable0 instances + -- Generate the Generic instances -- from each type declaration - ; repInstsMeta <- genGenericRepBinds is_boot tycl_decls + ; repInstsMeta <- genGenericAlls is_boot tycl_decls ; let repInsts = concat (map (\(a,_,_) -> a) repInstsMeta) repMetaTys = map (\(_,b,_) -> b) repInstsMeta @@ -461,10 +461,10 @@ stored in NewTypeDerived. \begin{code} {- --- Make the EarlyDerivSpec for Representable0 +-- Make the EarlyDerivSpec for Generic mkGenDerivSpec :: TyCon -> TcRn (EarlyDerivSpec) mkGenDerivSpec tc = do - { cls <- tcLookupClass rep0ClassName + { cls <- tcLookupClass genClassName ; let tc_tvs = tyConTyVars tc ; let tc_app = mkTyConApp tc (mkTyVarTys tc_tvs) ; let cls_tys = [] @@ -494,17 +494,17 @@ makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls | otherwise = do { eqns1 <- mapAndRecoverM deriveTyData all_tydata ; eqns2 <- mapAndRecoverM deriveStandalone deriv_decls - -- Generate EarlyDerivSpec's for Representable, if asked for + -- Generate EarlyDerivSpec's for Generic, if asked for -- ; (xGenerics, xDerRep) <- genericsFlags ; xDerRep <- genericsFlag ; let allTyNames = [ tcdName d | L _ d <- tycl_decls, isDataDecl d ] -- ; allTyDecls <- mapM tcLookupTyCon allTyNames - -- Select only those types that derive Representable + -- Select only those types that derive Generic ; let sel_tydata = [ tcdName t | (L _ c, L _ t) <- all_tydata - , getClassName c == Just rep0ClassName ] + , getClassName c == Just genClassName ] ; let sel_deriv_decls = catMaybes [ getTypeName t | L _ (DerivDecl (L _ t)) <- deriv_decls - , getClassName t == Just rep0ClassName ] + , getClassName t == Just genClassName ] ; derTyDecls <- mapM tcLookupTyCon $ filter (needsExtras xDerRep (sel_tydata ++ sel_deriv_decls)) allTyNames @@ -528,8 +528,8 @@ makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls ; return ( eqns1 ++ eqns2 -- ++ generic_instances , generic_extras_deriv {- ++ generic_extras_flag -}) } where - -- We need extras if the flag DeriveRepresentable is on and this type is - -- deriving Representable + -- We need extras if the flag DeriveGeneric is on and this type is + -- deriving Generic needsExtras xDerRep tydata tc_name = xDerRep && tc_name `elem` tydata -- Extracts the name of the class in the deriving @@ -561,7 +561,7 @@ makeDerivSpecs is_boot tycl_decls inst_decls deriv_decls genericsFlag :: TcM Bool genericsFlag = do dOpts <- getDOpts return ( xopt Opt_Generics dOpts - || xopt Opt_DeriveRepresentable dOpts) + || xopt Opt_DeriveGeneric dOpts) ------------------------------------------------------------------ deriveStandalone :: LDerivDecl Name -> TcM EarlyDerivSpec @@ -831,8 +831,8 @@ inferConstraints :: [TyVar] -> Class -> [TcType] -> TyCon -> [TcType] -> ThetaTy -- generated method definitions should succeed. This set will be simplified -- before being used in the instance declaration inferConstraints _ cls inst_tys rep_tc rep_tc_args - -- Representable0 constraints are easy - | cls `hasKey` rep0ClassKey + -- Generic constraints are easy + | cls `hasKey` genClassKey = [] -- The others are a bit more complicated | otherwise @@ -939,8 +939,8 @@ sideConditions mtheta cls cond_functorOK False) -- Functor/Fold/Trav works ok for rank-n types | cls_key == traversableClassKey = Just (checkFlag Opt_DeriveTraversable `andCond` cond_functorOK False) - | cls_key == rep0ClassKey = Just (cond_RepresentableOk `andCond` - (checkFlag Opt_DeriveRepresentable `orCond` + | cls_key == genClassKey = Just (cond_RepresentableOk `andCond` + (checkFlag Opt_DeriveGeneric `orCond` checkFlag Opt_Generics)) | otherwise = Nothing where @@ -995,7 +995,7 @@ no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+> -- JPM TODO: should give better error message cond_RepresentableOk :: Condition cond_RepresentableOk (_,t) | canDoGenerics t = Nothing - | otherwise = Just (ptext (sLit "Cannot derive Representable for type") <+> ppr t) + | otherwise = Just (ptext (sLit "Cannot derive Generic for type") <+> ppr t) cond_enumOrProduct :: Condition cond_enumOrProduct = cond_isEnumeration `orCond` @@ -1116,11 +1116,11 @@ std_class_via_iso clas non_iso_class :: Class -> Bool --- *Never* derive Read,Show,Typeable,Data,Representable0 by isomorphism, +-- *Never* derive Read, Show, Typeable, Data, Generic by isomorphism, -- even with -XGeneralizedNewtypeDeriving non_iso_class cls = classKey cls `elem` ([ readClassKey, showClassKey, dataClassKey - , rep0ClassKey] ++ typeableClassKeys) + , genClassKey] ++ typeableClassKeys) typeableClassKeys :: [Unique] typeableClassKeys = map getUnique typeableClassNames @@ -1581,7 +1581,7 @@ genDerivBinds loc fix_env clas tycon ,(functorClassKey, gen_Functor_binds) ,(foldableClassKey, gen_Foldable_binds) ,(traversableClassKey, gen_Traversable_binds) - ,(rep0ClassKey, gen_Rep0_binds) + ,(genClassKey, genGenericBinds) ] \end{code} @@ -1593,37 +1593,18 @@ genDerivBinds loc fix_env clas tycon For the generic representation we need to generate: \begin{itemize} -\item A Representable0 instance -\item A Rep0 type instance +\item A Generic instance +\item A Rep type instance \item Many auxiliary datatypes and instances for them (for the meta-information) \end{itemize} -@gen_Rep0_binds@ does (1) +@genGenericBinds@ does (1) @genGenericRepExtras@ does (2) and (3) -@genGenericRepBind@ does all of them +@genGenericAll@ does all of them \begin{code} -{- -genGenericRepBinds :: Bool -> [LTyClDecl Name] - -> TcM [([(InstInfo RdrName, DerivAuxBinds)] - , MetaTyCons, TyCon)] -genGenericRepBinds isBoot tyclDecls - | isBoot = return [] - | otherwise = do - allTyDecls <- mapM tcLookupTyCon [ tcdName d | L _ d <- tyclDecls - , isDataDecl d ] - let tyDecls = filter tyConHasGenerics allTyDecls - inst1 <- mapM genGenericRepBind tyDecls - let (_repInsts, metaTyCons, _repTys) = unzip3 inst1 - metaInsts <- ASSERT (length tyDecls == length metaTyCons) - mapM genDtMeta (zip tyDecls metaTyCons) - return (ASSERT (length inst1 == length metaInsts) - [ (ri : mi, ms, rt) - | ((ri, ms, rt), mi) <- zip inst1 metaInsts ]) --} - -gen_Rep0_binds :: SrcSpan -> TyCon -> (LHsBinds RdrName, DerivAuxBinds) -gen_Rep0_binds _ tc = (mkBindsRep0 tc, [ {- No DerivAuxBinds -} ]) +genGenericBinds :: SrcSpan -> TyCon -> (LHsBinds RdrName, DerivAuxBinds) +genGenericBinds _ tc = (mkBindsRep tc, [ {- No DerivAuxBinds -} ]) genGenericRepExtras :: TyCon -> TcM (MetaTyCons, TyCon) genGenericRepExtras tc = @@ -1665,27 +1646,27 @@ genGenericRepExtras tc = let metaDts = MetaTyCons metaDTyCon metaCTyCons metaSTyCons - rep0_tycon <- tc_mkRep0TyCon tc metaDts + rep0_tycon <- tc_mkRepTyCon tc metaDts return (metaDts, rep0_tycon) {- -genGenericRepBind :: TyCon +genGenericAll :: TyCon -> TcM ((InstInfo RdrName, DerivAuxBinds), MetaTyCons, TyCon) -genGenericRepBind tc = +genGenericAll tc = do (metaDts, rep0_tycon) <- genGenericRepExtras tc - clas <- tcLookupClass rep0ClassName + clas <- tcLookupClass genClassName dfun_name <- new_dfun_name clas tc let - mkInstRep0 = (InstInfo { iSpec = inst, iBinds = binds } + mkInstRep = (InstInfo { iSpec = inst, iBinds = binds } , [ {- No DerivAuxBinds -} ]) inst = mkLocalInstance dfun NoOverlap - binds = VanillaInst (mkBindsRep0 tc) [] False + binds = VanillaInst (mkBindsRep tc) [] False tvs = tyConTyVars tc tc_ty = mkTyConApp tc (mkTyVarTys tvs) dfun = mkDictFunId dfun_name (tyConTyVars tc) [] clas [tc_ty] - return (mkInstRep0, metaDts, rep0_tycon) + return (mkInstRep, metaDts, rep0_tycon) -} genDtMeta :: (TyCon, MetaTyCons) -> TcM [(InstInfo RdrName, DerivAuxBinds)] genDtMeta (tc,metaDts) = diff --git a/compiler/types/Generics.lhs b/compiler/types/Generics.lhs index 50b6b96..940f36f 100644 --- a/compiler/types/Generics.lhs +++ b/compiler/types/Generics.lhs @@ -5,7 +5,7 @@ \begin{code} module Generics ( canDoGenerics, - mkBindsRep0, tc_mkRep0TyCon, mkBindsMetaD, + mkBindsRep, tc_mkRepTyCon, mkBindsMetaD, MetaTyCons(..), metaTyCons2TyCons ) where @@ -77,33 +77,33 @@ canDoGenerics tycon type US = Int -- Local unique supply, just a plain Int type Alt = (LPat RdrName, LHsExpr RdrName) --- Bindings for the Representable0 instance -mkBindsRep0 :: TyCon -> LHsBinds RdrName -mkBindsRep0 tycon = - unitBag (L loc (mkFunBind (L loc from0_RDR) from0_matches)) +-- Bindings for the Generic instance +mkBindsRep :: TyCon -> LHsBinds RdrName +mkBindsRep tycon = + unitBag (L loc (mkFunBind (L loc from_RDR) from_matches)) `unionBags` - unitBag (L loc (mkFunBind (L loc to0_RDR) to0_matches)) + unitBag (L loc (mkFunBind (L loc to_RDR) to_matches)) where - from0_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from0_alts] - to0_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- to0_alts ] + from_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts] + to_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- to_alts ] loc = srcLocSpan (getSrcLoc tycon) datacons = tyConDataCons tycon -- Recurse over the sum first - from0_alts, to0_alts :: [Alt] - (from0_alts, to0_alts) = mkSum (1 :: US) tycon datacons + from_alts, to_alts :: [Alt] + (from_alts, to_alts) = mkSum (1 :: US) tycon datacons -------------------------------------------------------------------------------- -- Type representation -------------------------------------------------------------------------------- -tc_mkRep0Ty :: -- The type to generate representation for +tc_mkRepTy :: -- The type to generate representation for TyCon -- Metadata datatypes to refer to -> MetaTyCons -- Generated representation0 type -> TcM Type -tc_mkRep0Ty tycon metaDts = +tc_mkRepTy tycon metaDts = do d1 <- tcLookupTyCon d1TyConName c1 <- tcLookupTyCon c1TyConName @@ -155,18 +155,18 @@ tc_mkRep0Ty tycon metaDts = return (mkD tycon) -tc_mkRep0TyCon :: TyCon -- The type to generate representation for +tc_mkRepTyCon :: TyCon -- The type to generate representation for -> MetaTyCons -- Metadata datatypes to refer to -> TcM TyCon -- Generated representation0 type -tc_mkRep0TyCon tycon metaDts = +tc_mkRepTyCon tycon metaDts = -- Consider the example input tycon `D`, where data D a b = D_ a do uniq1 <- newUnique uniq2 <- newUnique -- `rep0Ty` = D1 ... (C1 ... (S1 ... (Rec0 a))) :: * -> * - rep0Ty <- tc_mkRep0Ty tycon metaDts - -- `rep0` = GHC.Generics.Rep0 (type family) - rep0 <- tcLookupTyCon rep0TyConName + rep0Ty <- tc_mkRepTy tycon metaDts + -- `rep0` = GHC.Generics.Rep (type family) + rep0 <- tcLookupTyCon repTyConName let modl = nameModule (tyConName tycon) loc = nameSrcSpan (tyConName tycon) @@ -185,7 +185,7 @@ tc_mkRep0TyCon tycon metaDts = tyvars (SynonymTyCon rep0Ty) (FamInstTyCon rep0 appT (mkCoercionTyCon coName (tyConArity tycon) - -- co : forall a b. Rep0 (D a b) ~ `rep0Ty` a b + -- co : forall a b. Rep (D a b) ~ `rep0Ty` a b (CoAxiom tyvars (mkTyConApp rep0 appT) rep0Ty))) return res -- 1.7.10.4