Commit 811746d7 authored by dreixel's avatar dreixel

Rename `Representable0` to `Generic`.

Remove a few other `0`s from names.
parent b5070429
......@@ -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
......
......@@ -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 -------------------
......
......@@ -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) =
......
......@@ -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
......
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