X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=b552c24b63f1649a3f7b080eed57b011c33ad3d1;hp=340ccbaa96a227b1e7835cf4324ea2c91853e3d0;hb=d2ce0f52d42edf32bb9f13796e6ba6edba8bd516;hpb=f278f0676579f67075033a4f9857715909c4b71e diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 340ccba..b552c24 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -11,10 +11,9 @@ module TyCon( TyCon, FieldLabel, AlgTyConRhs(..), visibleDataCons, - TyConParent(..), + TyConParent(..), isNoParent, SynTyConRhs(..), CoTyConDesc(..), - AssocFamilyPermutation, -- ** Constructing TyCons mkAlgTyCon, @@ -36,14 +35,15 @@ module TyCon( isFunTyCon, isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, - isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, + isSynTyCon, isClosedSynTyCon, isSuperKindTyCon, isDecomposableTyCon, isCoercionTyCon, isCoercionTyCon_maybe, isForeignTyCon, isAnyTyCon, tyConHasKind, isInjectiveTyCon, isDataTyCon, isProductTyCon, isEnumerationTyCon, - isNewTyCon, isAbstractTyCon, isOpenTyCon, + isNewTyCon, isAbstractTyCon, + isFamilyTyCon, isSynFamilyTyCon, isDataFamilyTyCon, isUnLiftedTyCon, isGadtSyntaxTyCon, isTyConAssoc, @@ -60,20 +60,19 @@ module TyCon( tyConFamilySize, tyConStupidTheta, tyConArity, + tyConParent, tyConClass_maybe, - tyConFamInst_maybe, tyConFamilyCoercion_maybe, - synTyConDefn, synTyConRhs, synTyConType, synTyConResKind, + tyConFamInst_maybe, tyConFamilyCoercion_maybe,tyConFamInstSig_maybe, + synTyConDefn, synTyConRhs, synTyConType, tyConExtName, -- External name for foreign types algTyConRhs, newTyConRhs, newTyConEtadRhs, unwrapNewTyCon_maybe, - assocTyConArgPoss_maybe, tupleTyConBoxity, -- ** Manipulating TyCons tcExpandTyCon_maybe, coreExpandTyCon_maybe, makeTyConAbstract, newTyConCo_maybe, - setTyConArgPoss, -- * Primitive representations of Types PrimRep(..), @@ -97,9 +96,146 @@ import FastString import Constants import Util import qualified Data.Data as Data -import Data.List( elemIndex ) \end{code} +----------------------------------------------- + Notes about type families +----------------------------------------------- + +Note [Type synonym families] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +* Type synonym families, also known as "type functions", map directly + onto the type functions in FC: + + type family F a :: * + type instance F Int = Bool + ..etc... + +* Reply "yes" to isSynFamilyTyCon, and isFamilyTyCon + +* From the user's point of view (F Int) and Bool are simply + equivalent types. + +* A Haskell 98 type synonym is a degenerate form of a type synonym + family. + +* Type functions can't appear in the LHS of a type function: + type instance F (F Int) = ... -- BAD! + +* Translation of type family decl: + type family F a :: * + translates to + a SynTyCon 'F', whose SynTyConRhs is SynFamilyTyCon + +* Translation of type instance decl: + type instance F [a] = Maybe a + translates to + A SynTyCon 'R:FList a', whose + SynTyConRhs is (SynonymTyCon (Maybe a)) + TyConParent is (FamInstTyCon F [a] co) + where co :: F [a] ~ R:FList a + Notice that we introduce a gratuitous vanilla type synonym + type R:FList a = Maybe a + solely so that type and data families can be treated more + uniformly, via a single FamInstTyCon descriptor + +* In the future we might want to support + * closed type families (esp when we have proper kinds) + * injective type families (allow decomposition) + but we don't at the moment [2010] + +Note [Data type families] +~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Wrappers for data instance tycons] in MkId.lhs + +* Data type families are declared thus + data family T a :: * + data instance T Int = T1 | T2 Bool + + Here T is the "family TyCon". + +* Reply "yes" to isDataFamilyTyCon, and isFamilyTyCon + +* The user does not see any "equivalent types" as he did with type + synonym families. He just sees constructors with types + T1 :: T Int + T2 :: Bool -> T Int + +* Here's the FC version of the above declarations: + + data T a + data R:TInt = T1 | T2 Bool + axiom ax_ti : T Int ~ R:TInt + + The R:TInt is the "representation TyCons". + It has an AlgTyConParent of + FamInstTyCon T [Int] ax_ti + +* The data contructor T2 has a wrapper (which is what the + source-level "T2" invokes): + + $WT2 :: Bool -> T Int + $WT2 b = T2 b `cast` sym ax_ti + +* A data instance can declare a fully-fledged GADT: + + data instance T (a,b) where + X1 :: T (Int,Bool) + X2 :: a -> b -> T (a,b) + + Here's the FC version of the above declaration: + + data R:TPair a where + X1 :: R:TPair Int Bool + X2 :: a -> b -> R:TPair a b + axiom ax_pr :: T (a,b) ~ R:TPair a b + + $WX1 :: forall a b. a -> b -> T (a,b) + $WX1 a b (x::a) (y::b) = X2 a b x y `cast` sym (ax_pr a b) + + The R:TPair are the "representation TyCons". + We have a bit of work to do, to unpick the result types of the + data instance declaration for T (a,b), to get the result type in the + representation; e.g. T (a,b) --> R:TPair a b + + The representation TyCon R:TList, has an AlgTyConParent of + + FamInstTyCon T [(a,b)] ax_pr + +* Notice that T is NOT translated to a FC type function; it just + becomes a "data type" with no constructors, which can be coerced inot + into R:TInt, R:TPair by the axioms. These axioms + axioms come into play when (and *only* when) you + - use a data constructor + - do pattern matching + Rather like newtype, in fact + + As a result + + - T behaves just like a data type so far as decomposition is concerned + + - (T Int) is not implicitly converted to R:TInt during type inference. + Indeed the latter type is unknown to the programmer. + + - There *is* an instance for (T Int) in the type-family instance + environment, but it is only used for overlap checking + + - It's fine to have T in the LHS of a type function: + type instance F (T a) = [a] + + It was this last point that confused me! The big thing is that you + should not think of a data family T as a *type function* at all, not + even an injective one! We can't allow even injective type functions + on the LHS of a type function: + type family injective G a :: * + type instance F (G Int) = Bool + is no good, even if G is injective, because consider + type instance G Int = Bool + type instance F Bool = Char + + So a data type family is not an injective type function. It's just a + data type with some axioms that connect it to other data types. + %************************************************************************ %* * \subsection{The data type} @@ -117,8 +253,8 @@ import Data.List( elemIndex ) -- -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor of kind @*@ -- --- 5) Type coercions! This is because we represent a coercion from @t1@ to @t2@ as a 'Type', where --- that type has kind @t1 ~ t2@. See "Coercion" for more on this +-- 5) Type coercions! This is because we represent a coercion from @t1@ to @t2@ +-- as a 'Type', where that type has kind @t1 ~ t2@. See "Coercion" for more on this -- -- This data type also encodes a number of primitive, built in type constructors such as those -- for function and tuple types. @@ -131,46 +267,56 @@ data TyCon tyConArity :: Arity } - -- | Algebraic type constructors, which are defined to be those arising @data@ type and @newtype@ declarations. - -- All these constructors are lifted and boxed. See 'AlgTyConRhs' for more information. + -- | Algebraic type constructors, which are defined to be those + -- arising @data@ type and @newtype@ declarations. All these + -- constructors are lifted and boxed. See 'AlgTyConRhs' for more + -- information. | AlgTyCon { tyConUnique :: Unique, tyConName :: Name, tc_kind :: Kind, tyConArity :: Arity, - tyConTyVars :: [TyVar], -- ^ The type variables used in the type constructor. - -- Precisely, this list scopes over: - -- - -- 1. The 'algTcStupidTheta' - -- - -- 2. The cached types in 'algTyConRhs.NewTyCon' - -- - -- 3. The family instance types if present - -- - -- Note that it does /not/ scope over the data constructors. - - algTcGadtSyntax :: Bool, -- ^ Was the data type declared with GADT syntax? If so, - -- that doesn't mean it's a true GADT; only that the "where" - -- form was used. This field is used only to guide - -- pretty-printing - - algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data type (always empty for GADTs). - -- A \"stupid theta\" is the context to the left of an algebraic type - -- declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@. - - algTcRhs :: AlgTyConRhs, -- ^ Contains information about the data constructors of the algebraic type - - algTcRec :: RecFlag, -- ^ Tells us whether the data type is part of a mutually-recursive group or not - - hasGenerics :: Bool, -- ^ Whether generic (in the -XGenerics sense) to\/from functions are - -- available in the exports of the data type's source module. - - algTcParent :: TyConParent -- ^ Gives the class or family declaration 'TyCon' for derived 'TyCon's - -- representing class or family instances, respectively. See also 'synTcParent' + tyConTyVars :: [TyVar], -- ^ The type variables used in the type constructor. + -- Invariant: length tyvars = arity + -- Precisely, this list scopes over: + -- + -- 1. The 'algTcStupidTheta' + -- 2. The cached types in 'algTyConRhs.NewTyCon' + -- 3. The family instance types if present + -- + -- Note that it does /not/ scope over the data constructors. + + algTcGadtSyntax :: Bool, -- ^ Was the data type declared with GADT syntax? + -- If so, that doesn't mean it's a true GADT; + -- only that the "where" form was used. + -- This field is used only to guide pretty-printing + + algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data type + -- (always empty for GADTs). + -- A \"stupid theta\" is the context to the left + -- of an algebraic type declaration, + -- e.g. @Eq a@ in the declaration + -- @data Eq a => T a ...@. + + algTcRhs :: AlgTyConRhs, -- ^ Contains information about the + -- data constructors of the algebraic type + + algTcRec :: RecFlag, -- ^ Tells us whether the data type is part + -- of a mutually-recursive group or not + + hasGenerics :: Bool, -- ^ Whether generic (in the -XGenerics sense) + -- to\/from functions are available in the exports + -- of the data type's source module. + + algTcParent :: TyConParent -- ^ Gives the class or family declaration 'TyCon' + -- for derived 'TyCon's representing class + -- or family instances, respectively. + -- See also 'synTcParent' } - -- | Represents the infinite family of tuple type constructors, @()@, @(a,b)@, @(# a, b #)@ etc. + -- | Represents the infinite family of tuple type constructors, + -- @()@, @(a,b)@, @(# a, b #)@ etc. | TupleTyCon { tyConUnique :: Unique, tyConName :: Name, @@ -191,31 +337,35 @@ data TyCon tyConTyVars :: [TyVar], -- Bound tyvars - synTcRhs :: SynTyConRhs, -- ^ Contains information about the expansion of the synonym + synTcRhs :: SynTyConRhs, -- ^ Contains information about the + -- expansion of the synonym - synTcParent :: TyConParent -- ^ Gives the family declaration 'TyCon' of 'TyCon's representing family instances + synTcParent :: TyConParent -- ^ Gives the family declaration 'TyCon' + -- of 'TyCon's representing family instances } - -- | Primitive types; cannot be defined in Haskell. This includes the usual suspects (such as @Int#@) - -- as well as foreign-imported types and kinds + -- | Primitive types; cannot be defined in Haskell. This includes + -- the usual suspects (such as @Int#@) as well as foreign-imported + -- types and kinds | PrimTyCon { tyConUnique :: Unique, tyConName :: Name, tc_kind :: Kind, - tyConArity :: Arity, -- SLPJ Oct06: I'm not sure what the significance - -- of the arity of a primtycon is! + tyConArity :: Arity, -- SLPJ Oct06: I'm not sure what the significance + -- of the arity of a primtycon is! - primTyConRep :: PrimRep, -- ^ Many primitive tycons are unboxed, but some are - -- boxed (represented by pointers). This 'PrimRep' holds - -- that information. - -- Only relevant if tc_kind = * + primTyConRep :: PrimRep, -- ^ Many primitive tycons are unboxed, but some are + -- boxed (represented by pointers). This 'PrimRep' + -- holds that information. + -- Only relevant if tc_kind = * - isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted (may not contain bottom) - -- but foreign-imported ones may be lifted + isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted + -- (may not contain bottom) + -- but foreign-imported ones may be lifted - tyConExtName :: Maybe FastString -- ^ @Just e@ for foreign-imported types, - -- holds the name of the imported thing + tyConExtName :: Maybe FastString -- ^ @Just e@ for foreign-imported types, + -- holds the name of the imported thing } -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@. @@ -242,10 +392,11 @@ data TyCon -- See Note [Any types] in TysPrim } - -- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs. - -- There are only two super-kinds: TY (aka "box"), which is the super-kind of kinds that - -- construct types eventually, and CO (aka "diamond"), which is the super-kind of kinds - -- that just represent coercions. + -- | Super-kinds. These are "kinds-of-kinds" and are never seen in + -- Haskell source programs. There are only two super-kinds: TY (aka + -- "box"), which is the super-kind of kinds that construct types + -- eventually, and CO (aka "diamond"), which is the super-kind of + -- kinds that just represent coercions. -- -- Super-kinds have no kind themselves, and have arity zero | SuperKindTyCon { @@ -259,86 +410,78 @@ type FieldLabel = Name -- | Represents right-hand-sides of 'TyCon's for algebraic types data AlgTyConRhs - -- | Says that we know nothing about this data type, except that it's represented - -- by a pointer. Used when we export a data type abstractly into an .hi file. + -- | Says that we know nothing about this data type, except that + -- it's represented by a pointer. Used when we export a data type + -- abstractly into an .hi file. = AbstractTyCon - -- | Represents an open type family without a fixed right hand - -- side. Additional instances can appear at any time. - -- - -- These are introduced by either a top level declaration: - -- - -- > data T a :: * - -- - -- Or an assoicated data type declaration, within a class declaration: - -- - -- > class C a b where - -- > data T b :: * - - | OpenTyCon { - otArgPoss :: AssocFamilyPermutation - } - - -- | Information about those 'TyCon's derived from a @data@ declaration. This includes - -- data types with no constructors at all. + -- | Represents an open type family without a fixed right hand + -- side. Additional instances can appear at any time. + -- + -- These are introduced by either a top level declaration: + -- + -- > data T a :: * + -- + -- Or an associated data type declaration, within a class declaration: + -- + -- > class C a b where + -- > data T b :: * + | DataFamilyTyCon + + -- | Information about those 'TyCon's derived from a @data@ + -- declaration. This includes data types with no constructors at + -- all. | DataTyCon { data_cons :: [DataCon], - -- ^ The data type constructors; can be empty if the user declares - -- the type to have no constructors - -- - -- INVARIANT: Kept in order of increasing 'DataCon' tag - - -- (see the tag assignment in DataCon.mkDataCon) - is_enum :: Bool -- ^ Cached value: is this an enumeration type? (See 'isEnumerationTyCon') + -- ^ The data type constructors; can be empty if the user + -- declares the type to have no constructors + -- + -- INVARIANT: Kept in order of increasing 'DataCon' tag + -- (see the tag assignment in DataCon.mkDataCon) + + is_enum :: Bool -- ^ Cached value: is this an enumeration type? + -- (See 'isEnumerationTyCon') } -- | Information about those 'TyCon's derived from a @newtype@ declaration | NewTyCon { - data_con :: DataCon, -- ^ The unique constructor for the @newtype@. It has no existentials + data_con :: DataCon, -- ^ The unique constructor for the @newtype@. + -- It has no existentials - nt_rhs :: Type, -- ^ Cached value: the argument type of the constructor, which - -- is just the representation type of the 'TyCon' (remember that - -- @newtype@s do not exist at runtime so need a different representation - -- type). + nt_rhs :: Type, -- ^ Cached value: the argument type of the constructor, + -- which is just the representation type of the 'TyCon' + -- (remember that @newtype@s do not exist at runtime + -- so need a different representation type). -- - -- The free 'TyVar's of this type are the 'tyConTyVars' from the corresponding - -- 'TyCon' + -- The free 'TyVar's of this type are the 'tyConTyVars' + -- from the corresponding 'TyCon' nt_etad_rhs :: ([TyVar], Type), - -- ^ Same as the 'nt_rhs', but this time eta-reduced. Hence the list of 'TyVar's in - -- this field may be shorter than the declared arity of the 'TyCon'. + -- ^ Same as the 'nt_rhs', but this time eta-reduced. + -- Hence the list of 'TyVar's in this field may be + -- shorter than the declared arity of the 'TyCon'. -- See Note [Newtype eta] - nt_co :: Maybe TyCon -- ^ A 'TyCon' (which is always a 'CoTyCon') that can have a 'Coercion' - -- extracted from it to create the @newtype@ from the representation 'Type'. - -- - -- This field is optional for non-recursive @newtype@s only. - - -- See Note [Newtype coercions] - -- Invariant: arity = #tvs in nt_etad_rhs; - -- See Note [Newtype eta] - -- Watch out! If any newtypes become transparent - -- again check Trac #1072. + nt_co :: Maybe TyCon -- ^ A 'TyCon' (which is always a 'CoTyCon') that can + -- have a 'Coercion' extracted from it to create + -- the @newtype@ from the representation 'Type'. + -- + -- This field is optional for non-recursive @newtype@s only. + + -- See Note [Newtype coercions] + -- Invariant: arity = #tvs in nt_etad_rhs; + -- See Note [Newtype eta] + -- Watch out! If any newtypes become transparent + -- again check Trac #1072. } -type AssocFamilyPermutation - = Maybe [Int] -- Nothing for *top-level* type families - -- For *associated* type families, gives the position - -- of that 'TyVar' in the class argument list (0-indexed) - -- e.g. class C a b c where { type F c a :: *->* } - -- Then we get Just [2,0] - -- For *synonyms*, the length of the list is identical to - -- the TyCon's arity - -- For *data types*, the length may be smaller than the - -- TyCon's arity; e.g. class C a where { data D a :: *->* } - -- here D gets arity 2 - --- | Extract those 'DataCon's that we are able to learn about. Note that visibility in this sense does not --- correspond to visibility in the context of any particular user program! +-- | Extract those 'DataCon's that we are able to learn about. Note +-- that visibility in this sense does not correspond to visibility in +-- the context of any particular user program! visibleDataCons :: AlgTyConRhs -> [DataCon] visibleDataCons AbstractTyCon = [] -visibleDataCons OpenTyCon {} = [] +visibleDataCons DataFamilyTyCon {} = [] visibleDataCons (DataTyCon{ data_cons = cs }) = cs visibleDataCons (NewTyCon{ data_con = c }) = [c] @@ -355,6 +498,10 @@ data TyConParent | ClassTyCon Class -- INVARIANT: the classTyCon of this Class is the current tycon + -- | An *associated* type of a class. + | AssocFamilyTyCon + Class -- The class in whose declaration the family is declared + -- | Type constructors representing an instance of a type family. Parameters: -- -- 1) The type family in question @@ -365,36 +512,39 @@ data TyConParent -- -- 3) A 'CoTyCon' identifying the representation -- type with the type instance family - | FamilyTyCon - TyCon - [Type] - TyCon -- c.f. Note [Newtype coercions] + | FamInstTyCon -- See Note [Data type families] + -- and Note [Type synonym families] + TyCon -- The family TyCon + [Type] -- Argument types (mentions the tyConTyVars of this TyCon) + TyCon -- The coercion constructor - -- -- E.g. data intance T [a] = ... -- gives a representation tycon: - -- data :R7T a = ... - -- axiom co a :: T [a] ~ :R7T a - -- with :R7T's algTcParent = FamilyTyCon T [a] co + -- data R:TList a = ... + -- axiom co a :: T [a] ~ R:TList a + -- with R:TList's algTcParent = FamInstTyCon T [a] co -- | Checks the invariants of a 'TyConParent' given the appropriate type class name, if any okParent :: Name -> TyConParent -> Bool -okParent _ NoParentTyCon = True -okParent tc_name (ClassTyCon cls) = tyConName (classTyCon cls) == tc_name -okParent _ (FamilyTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length tys +okParent _ NoParentTyCon = True +okParent tc_name (AssocFamilyTyCon cls) = tc_name `elem` map tyConName (classATs cls) +okParent tc_name (ClassTyCon cls) = tc_name == tyConName (classTyCon cls) +okParent _ (FamInstTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length tys + +isNoParent :: TyConParent -> Bool +isNoParent NoParentTyCon = True +isNoParent _ = False -------------------- -- | Information pertaining to the expansion of a type synonym (@type@) data SynTyConRhs - = OpenSynTyCon -- e.g. type family F x y :: * -> * - Kind -- Kind of the "rhs"; ie *excluding type indices* - -- In the example, the kind is (*->*) - AssocFamilyPermutation + = SynonymTyCon -- ^ An ordinary type synony + Type -- ^ The rhs, which mentions head type variables. It acts as a + -- template for the expansion when the 'TyCon' is applied to some + -- types. - | SynonymTyCon Type -- ^ The synonym mentions head type variables. It acts as a - -- template for the expansion when the 'TyCon' is applied to some - -- types. + | SynFamilyTyCon -- A type synonym family e.g. type family F x y :: * -> * -------------------- data CoTyConDesc @@ -485,39 +635,6 @@ so the coercion tycon CoT must have and arity: 0 -Note [Indexed data types] (aka data type families) -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - See also Note [Wrappers for data instance tycons] in MkId.lhs - -Consider - data family T a - - data instance T (b,c) where - T1 :: b -> c -> T (b,c) - -Then - * T is the "family TyCon" - - * We make "representation TyCon" :R1T, thus: - data :R1T b c where - T1 :: forall b c. b -> c -> :R1T b c - - * It has a top-level coercion connecting it to the family TyCon - - axiom :Co:R1T b c : T (b,c) ~ :R1T b c - - * The data contructor T1 has a wrapper (which is what the source-level - "T1" invokes): - - $WT1 :: forall b c. b -> c -> T (b,c) - $WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c) - - * The representation TyCon :R1T has an AlgTyConParent of - - FamilyTyCon T [(b,c)] :Co:R1T - - - %************************************************************************ %* * \subsection{PrimRep} @@ -595,11 +712,14 @@ mkFunTyCon name kind tyConArity = 2 } --- | This is the making of an algebraic 'TyCon'. Notably, you have to pass in the generic (in the -XGenerics sense) --- information about the type constructor - you can get hold of it easily (see Generics module) +-- | This is the making of an algebraic 'TyCon'. Notably, you have to +-- pass in the generic (in the -XGenerics sense) information about the +-- type constructor - you can get hold of it easily (see Generics +-- module) mkAlgTyCon :: Name -> Kind -- ^ Kind of the resulting 'TyCon' - -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'. Arity is inferred from the length of this list + -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'. + -- Arity is inferred from the length of this list -> [PredType] -- ^ Stupid theta: see 'algTcStupidTheta' -> AlgTyConRhs -- ^ Information about dat aconstructors -> TyConParent @@ -611,7 +731,7 @@ mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, - tc_kind = kind, + tc_kind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, algTcStupidTheta = stupid, @@ -619,7 +739,7 @@ mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn algTcParent = ASSERT( okParent name parent ) parent, algTcRec = is_rec, algTcGadtSyntax = gadt_syn, - hasGenerics = gen_info + hasGenerics = gen_info } -- | Simpler specialization of 'mkAlgTyCon' for classes @@ -761,7 +881,8 @@ isUnLiftedTyCon (PrimTyCon {isUnLifted = is_unlifted}) = is_unlifted isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity) isUnLiftedTyCon _ = False --- | Returns @True@ if the supplied 'TyCon' resulted from either a @data@ or @newtype@ declaration +-- | Returns @True@ if the supplied 'TyCon' resulted from either a +-- @data@ or @newtype@ declaration isAlgTyCon :: TyCon -> Bool isAlgTyCon (AlgTyCon {}) = True isAlgTyCon (TupleTyCon {}) = True @@ -780,7 +901,7 @@ isDataTyCon :: TyCon -> Bool -- get an info table. The family declaration 'TyCon' does not isDataTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of - OpenTyCon {} -> False + DataFamilyTyCon {} -> False DataTyCon {} -> True NewTyCon {} -> False AbstractTyCon -> False -- We don't know, so return False @@ -829,14 +950,6 @@ isSynTyCon _ = False -- right hand side to which a synonym family application can expand. -- --- | Is this a synonym 'TyCon' that can have no further instances appear? -isClosedSynTyCon :: TyCon -> Bool -isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon) - --- | Is this a synonym 'TyCon' that can have may have further instances appear? -isOpenSynTyCon :: TyCon -> Bool -isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon - isDecomposableTyCon :: TyCon -> Bool -- True iff we can decompose (T a b c) into ((T a b) c) -- Specifically NOT true of synonyms (open and otherwise) and coercions @@ -856,10 +969,24 @@ isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0 isEnumerationTyCon _ = False -- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear? -isOpenTyCon :: TyCon -> Bool -isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon {}}) = True -isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}}) = True -isOpenTyCon _ = False +isFamilyTyCon :: TyCon -> Bool +isFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True +isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True +isFamilyTyCon _ = False + +-- | Is this a synonym 'TyCon' that can have may have further instances appear? +isSynFamilyTyCon :: TyCon -> Bool +isSynFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True +isSynFamilyTyCon _ = False + +-- | Is this a synonym 'TyCon' that can have may have further instances appear? +isDataFamilyTyCon :: TyCon -> Bool +isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True +isDataFamilyTyCon _ = False + +-- | Is this a synonym 'TyCon' that can have no further instances appear? +isClosedSynTyCon :: TyCon -> Bool +isClosedSynTyCon tycon = isSynTyCon tycon && not (isFamilyTyCon tycon) -- | Injective 'TyCon's can be decomposed, so that -- T ty1 ~ T ty2 => ty1 ~ ty2 @@ -872,36 +999,12 @@ isInjectiveTyCon tc = not (isSynTyCon tc) -- type synonym, because you should probably have expanded it first -- But regardless, it's not injective! --- | Extract the mapping from 'TyVar' indexes to indexes in the corresponding family --- argument lists form an open 'TyCon' of any sort, if the given 'TyCon' is indeed --- such a beast and that information is available -assocTyConArgPoss_maybe :: TyCon -> Maybe [Int] -assocTyConArgPoss_maybe (AlgTyCon { - algTcRhs = OpenTyCon {otArgPoss = poss}}) = poss -assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss -assocTyConArgPoss_maybe _ = Nothing - -- | Are we able to extract informationa 'TyVar' to class argument list -- mappping from a given 'TyCon'? isTyConAssoc :: TyCon -> Bool -isTyConAssoc = isJust . assocTyConArgPoss_maybe - --- | Set the AssocFamilyPermutation structure in an --- associated data or type synonym. The [TyVar] are the --- class type variables. Remember, the tyvars of an associated --- data/type are a subset of the class tyvars; except that an --- associated data type can have extra type variables at the --- end (see Note [Avoid name clashes for associated data types] in TcHsType) -setTyConArgPoss :: [TyVar] -> TyCon -> TyCon -setTyConArgPoss clas_tvs tc - = case tc of - AlgTyCon { algTcRhs = rhs } -> tc { algTcRhs = rhs {otArgPoss = Just ps} } - SynTyCon { synTcRhs = OpenSynTyCon ki _ } -> tc { synTcRhs = OpenSynTyCon ki (Just ps) } - _ -> pprPanic "setTyConArgPoss" (ppr tc) - where - ps = catMaybes [tv `elemIndex` clas_tvs | tv <- tyConTyVars tc] - -- We will get Nothings for the "extra" type variables in an - -- associated data type +isTyConAssoc tc = case tyConParent tc of + AssocFamilyTyCon {} -> True + _ -> False -- The unit tycon didn't used to be classed as a tuple tycon -- but I thought that was silly so I've undone it @@ -1079,9 +1182,9 @@ tyConDataCons_maybe _ = Not tyConFamilySize :: TyCon -> Int tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon {data_cons = cons}}) = length cons -tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1 -tyConFamilySize (AlgTyCon {algTcRhs = OpenTyCon {}}) = 0 -tyConFamilySize (TupleTyCon {}) = 1 +tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1 +tyConFamilySize (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = 0 +tyConFamilySize (TupleTyCon {}) = 1 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) -- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple @@ -1149,11 +1252,6 @@ synTyConType :: TyCon -> Type synTyConType tc = case synTcRhs tc of SynonymTyCon t -> t _ -> pprPanic "synTyConType" (ppr tc) - --- | Find the 'Kind' of an open type synonym. Panics if the 'TyCon' is not an open type synonym -synTyConResKind :: TyCon -> Kind -synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind -synTyConResKind tycon = pprPanic "synTyConResKind" (ppr tycon) \end{code} \begin{code} @@ -1180,33 +1278,41 @@ tyConClass_maybe :: TyCon -> Maybe Class tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas tyConClass_maybe _ = Nothing +---------------------------------------------------------------------------- +tyConParent :: TyCon -> TyConParent +tyConParent (AlgTyCon {algTcParent = parent}) = parent +tyConParent (SynTyCon {synTcParent = parent}) = parent +tyConParent _ = NoParentTyCon + -- | Is this 'TyCon' that for a family instance, be that for a synonym or an -- algebraic family instance? isFamInstTyCon :: TyCon -> Bool -isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True -isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True -isFamInstTyCon _ = False +isFamInstTyCon tc = case tyConParent tc of + FamInstTyCon {} -> True + _ -> False + +tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], TyCon) +tyConFamInstSig_maybe tc + = case tyConParent tc of + FamInstTyCon f ts co_tc -> Just (f, ts, co_tc) + _ -> Nothing -- | If this 'TyCon' is that of a family instance, return the family in question -- and the instance types. Otherwise, return @Nothing@ tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type]) -tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = - Just (fam, instTys) -tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) = - Just (fam, instTys) -tyConFamInst_maybe _ = - Nothing +tyConFamInst_maybe tc + = case tyConParent tc of + FamInstTyCon f ts _ -> Just (f, ts) + _ -> Nothing -- | If this 'TyCon' is that of a family instance, return a 'TyCon' which represents -- a coercion identifying the representation type with the type instance family. -- Otherwise, return @Nothing@ tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon -tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = - Just coe -tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) = - Just coe -tyConFamilyCoercion_maybe _ = - Nothing +tyConFamilyCoercion_maybe tc + = case tyConParent tc of + FamInstTyCon _ _ co -> Just co + _ -> Nothing \end{code}