\begin{code}
module TyCon(
-- * Main TyCon data types
- TyCon, FieldLabel,
+ TyCon, FieldLabel,
AlgTyConRhs(..), visibleDataCons,
TyConParent(..),
SynTyConRhs(..),
+ CoTyConDesc(..),
+ AssocFamilyPermutation,
-- ** Constructing TyCons
mkAlgTyCon,
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
- mkVoidPrimTyCon,
+ mkKindTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
mkSuperKindTyCon,
mkCoercionTyCon,
mkForeignTyCon,
+ mkAnyTyCon,
-- ** Predicates on TyCons
isAlgTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
- isSuperKindTyCon,
+ isSuperKindTyCon, isDecomposableTyCon,
isCoercionTyCon, isCoercionTyCon_maybe,
- isForeignTyCon,
+ isForeignTyCon, isAnyTyCon, tyConHasKind,
+ isInjectiveTyCon,
isDataTyCon, isProductTyCon, isEnumerationTyCon,
isNewTyCon, isAbstractTyCon, isOpenTyCon,
isUnLiftedTyCon,
tyConTyVars,
tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe,
tyConFamilySize,
- tyConSelIds,
tyConStupidTheta,
tyConArity,
tyConClass_maybe,
import Outputable
import FastString
import Constants
+import Util
+import qualified Data.Data as Data
+import Data.List( elemIndex )
\end{code}
+-----------------------------------------------
+ Notes about type families
+-----------------------------------------------
+
+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...
+
+* 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!
+
+* 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".
+
+* 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
+ FamilyTyCon 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
+
+ FamilyTyCon 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}
%************************************************************************
\begin{code}
--- | Represents type constructors. Type constructors are introduced by things such as:
+-- | TyCons represent type constructors. Type constructors are introduced by things such as:
--
-- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@
--
-- 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
+-- 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.
FunTyCon {
tyConUnique :: Unique,
tyConName :: Name,
- tyConKind :: Kind,
+ tc_kind :: Kind,
tyConArity :: Arity
}
| AlgTyCon {
tyConUnique :: Unique,
tyConName :: Name,
- tyConKind :: Kind,
+ tc_kind :: Kind,
tyConArity :: Arity,
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.
- algTcSelIds :: [Id], -- ^ The record selectors of this type (possibly emptys)
-
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 ...@.
| TupleTyCon {
tyConUnique :: Unique,
tyConName :: Name,
- tyConKind :: Kind,
+ tc_kind :: Kind,
tyConArity :: Arity,
tyConBoxed :: Boxity,
tyConTyVars :: [TyVar],
| SynTyCon {
tyConUnique :: Unique,
tyConName :: Name,
- tyConKind :: Kind,
+ tc_kind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar], -- Bound tyvars
| PrimTyCon {
tyConUnique :: Unique,
tyConName :: Name,
- tyConKind :: Kind,
- 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
-
- 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
+ tc_kind :: Kind,
+ 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 = *
+
+ 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
}
- -- | Type coercions, such as @(:=:)@, @sym@, @trans@, @left@ and @right@.
- -- INVARIANT: coercions are always fully applied
- | CoercionTyCon {
+ -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@.
+ -- INVARIANT: Coercion TyCons are always fully applied
+ -- But note that a CoTyCon can be *over*-saturated in a type.
+ -- E.g. (sym g1) Int will be represented as (TyConApp sym [g1,Int])
+ | CoTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConArity :: Arity,
- coKindFun :: [Type] -> (Type,Type)
- -- ^ Function that when given a list of the type arguments to the 'TyCon'
- -- constructs the types that the resulting coercion relates.
- --
- -- INVARIANT: 'coKindFun' is always applied to exactly 'tyConArity' args
- -- E.g. for @trans (c1 :: ta=tb) (c2 :: tb=tc)@, the 'coKindFun' returns
- -- the kind as a pair of types: @(ta, tc)@
+ coTcDesc :: CoTyConDesc
+ }
+
+ -- | Any types. Like tuples, this is a potentially-infinite family of TyCons
+ -- one for each distinct Kind. They have no values at all.
+ -- Because there are infinitely many of them (like tuples) they are
+ -- defined in GHC.Prim and have names like "Any(*->*)".
+ -- Their Unique is derived from the OccName.
+ -- See Note [Any types] in TysPrim
+ | AnyTyCon {
+ tyConUnique :: Unique,
+ tyConName :: Name,
+ tc_kind :: Kind -- Never = *; that is done via PrimTyCon
+ -- See Note [Any types] in TysPrim
}
-- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs.
-- > data T b :: *
| OpenTyCon {
-
- otArgPoss :: Maybe [Int]
- -- ^ @Nothing@ iff this is a top-level indexed type family.
- -- @Just ns@ iff this is an associated (not top-level) family
- --
- -- In the latter case, for each 'TyVar' in the associated type declaration,
- -- @ns@ gives the position of that tyvar in the class argument list (starting
- -- from 0).
- --
- -- NB: The length of this list is less than the accompanying 'tyConArity' iff
- -- we have a higher kind signature.
+ otArgPoss :: AssocFamilyPermutation
}
-- | Information about those 'TyCon's derived from a @data@ declaration. This includes
-- See Note [Newtype eta]
- nt_co :: Maybe TyCon -- ^ A 'TyCon' (which is always a 'CoercionTyCon') that can have a 'Coercion'
+ 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.
-- 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!
visibleDataCons :: AlgTyConRhs -> [DataCon]
-- of the current 'TyCon' (not the family one). INVARIANT:
-- the number of types matches the arity of the family 'TyCon'
--
- -- 3) A 'CoercionTyCon' identifying the representation
+ -- 3) A 'CoTyCon' identifying the representation
-- type with the type instance family
- | FamilyTyCon
+ | FamilyTyCon -- See Note [Data type families]
TyCon
[Type]
TyCon -- c.f. Note [Newtype coercions]
- --
- -- 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
-- | Checks the invariants of a 'TyConParent' given the appropriate type class name, if any
okParent :: Name -> TyConParent -> Bool
-- | Information pertaining to the expansion of a type synonym (@type@)
data SynTyConRhs
- = OpenSynTyCon Kind
- (Maybe [Int]) -- ^ A Type family synonym. The /result/ 'Kind' is
- -- given for associated families, and in this case the
- -- list of @Int@s is not empty, and for each 'TyVar' in
- -- the associated type declaration, it gives the position
- -- of that 'TyVar' in the class argument list (starting
- -- from 0).
- --
- -- NB: The length of this list will be less than 'tyConArity' iff
- -- the family has a higher kind signature.
+ = 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 Type -- ^ The synonym mentions head type variables. It acts as a
-- template for the expansion when the 'TyCon' is applied to some
-- types.
+
+--------------------
+data CoTyConDesc
+ = CoSym | CoTrans
+ | CoLeft | CoRight
+ | CoCsel1 | CoCsel2 | CoCselR
+ | CoInst
+
+ | CoAxiom -- C tvs : F lhs-tys ~ rhs-ty
+ { co_ax_tvs :: [TyVar]
+ , co_ax_lhs :: Type
+ , co_ax_rhs :: Type }
+
+ | CoUnsafe
\end{code}
Note [Newtype coercions]
newtype T a = MkT (a -> a)
-the NewTyCon for T will contain nt_co = CoT where CoT t : T t :=: t ->
-t. This TyCon is a CoercionTyCon, so it does not have a kind on its
+the NewTyCon for T will contain nt_co = CoT where CoT t : T t ~ t ->
+t. This TyCon is a CoTyCon, so it does not have a kind on its
own; it basically has its own typing rule for the fully-applied
version. If the newtype T has k type variables then CoT has arity at
most k. In the case that the right hand side is a type application
newtype S a = MkT [a]
-then we would generate the arity 0 coercion CoS : S :=: []. The
+then we would generate the arity 0 coercion CoS : S ~ []. The
primary reason we do this is to make newtype deriving cleaner.
In the paper we'd write
- axiom CoT : (forall t. T t) :=: (forall t. [t])
+ axiom CoT : (forall t. T t) ~ (forall t. [t])
and then when we used CoT at a particular type, s, we'd say
CoT @ s
which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
-But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
+But in GHC we instead make CoT into a new piece of type syntax, CoTyCon,
(like instCoercionTyCon, symCoercionTyCon etc), which must always
be saturated, but which encodes as
TyConApp CoT [s]
In the vocabulary of the paper it's as if we had axiom declarations
like
- axiom CoT t : T t :=: [t]
+ axiom CoT t : T t ~ [t]
Note [Newtype eta]
~~~~~~~~~~~~~~~~~~
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}
%************************************************************************
A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
-MachRep (see cmm/MachOp), although each of these types has a distinct
+MachRep (see cmm/CmmExpr), although each of these types has a distinct
and clearly defined purpose:
- A PrimRep is a CgRep + information about signedness + information
= FunTyCon {
tyConUnique = nameUnique name,
tyConName = name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = 2
}
-> [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
- -> [Id] -- ^ Selector 'Id's
-> TyConParent
-> RecFlag -- ^ Is the 'TyCon' recursive?
-> Bool -- ^ Does it have generic functions? See 'hasGenerics'
-> Bool -- ^ Was the 'TyCon' declared with GADT syntax?
-> TyCon
-mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
+mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
algTcStupidTheta = stupid,
algTcRhs = rhs,
- algTcSelIds = sel_ids,
algTcParent = ASSERT( okParent name parent ) parent,
algTcRec = is_rec,
algTcGadtSyntax = gadt_syn,
- hasGenerics = gen_info
+ hasGenerics = gen_info
}
-- | Simpler specialization of 'mkAlgTyCon' for classes
mkClassTyCon :: Name -> Kind -> [TyVar] -> AlgTyConRhs -> Class -> RecFlag -> TyCon
mkClassTyCon name kind tyvars rhs clas is_rec =
- mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
+ mkAlgTyCon name kind tyvars [] rhs (ClassTyCon clas) is_rec False False
mkTupleTyCon :: Name
-> Kind -- ^ Kind of the resulting 'TyCon'
= TupleTyCon {
tyConUnique = nameUnique name,
tyConName = name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = arity,
tyConBoxed = boxed,
tyConTyVars = tyvars,
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = arity,
primTyConRep = PtrRep, -- they all do
isUnLifted = False,
mkPrimTyCon name kind arity rep
= mkPrimTyCon' name kind arity rep True
--- | Create the special void 'TyCon' which is unlifted and has 'VoidRep'
-mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon
-mkVoidPrimTyCon name kind arity
- = mkPrimTyCon' name kind arity VoidRep True
+-- | Kind constructors
+mkKindTyCon :: Name -> Kind -> TyCon
+mkKindTyCon name kind
+ = mkPrimTyCon' name kind 0 VoidRep True
-- | Create a lifted primitive 'TyCon' such as @RealWorld@
mkLiftedPrimTyCon :: Name -> Kind -> Arity -> PrimRep -> TyCon
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = arity,
primTyConRep = rep,
isUnLifted = is_unlifted,
= SynTyCon {
tyConName = name,
tyConUnique = nameUnique name,
- tyConKind = kind,
+ tc_kind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
synTcRhs = rhs,
}
-- | Create a coercion 'TyCon'
-mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon
-mkCoercionTyCon name arity kindRule
- = CoercionTyCon {
- tyConName = name,
+mkCoercionTyCon :: Name -> Arity
+ -> CoTyConDesc
+ -> TyCon
+mkCoercionTyCon name arity desc
+ = CoTyCon {
+ tyConName = name,
tyConUnique = nameUnique name,
- tyConArity = arity,
- coKindFun = kindRule
- }
+ tyConArity = arity,
+ coTcDesc = desc }
+
+mkAnyTyCon :: Name -> Kind -> TyCon
+mkAnyTyCon name kind
+ = AnyTyCon { tyConName = name,
+ tc_kind = kind,
+ tyConUnique = nameUnique name }
-- | Create a super-kind 'TyCon'
mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero
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
+isDecomposableTyCon (SynTyCon {}) = False
+isDecomposableTyCon (CoTyCon {}) = False
+isDecomposableTyCon _other = True
+
-- | Is this an algebraic 'TyCon' declared with the GADT syntax?
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
-- | Is this an algebraic 'TyCon' which is just an enumeration of values?
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
+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
+isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon {}}) = True
+isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}}) = True
+isOpenTyCon _ = False
+
+-- | Injective 'TyCon's can be decomposed, so that
+-- T ty1 ~ T ty2 => ty1 ~ ty2
+isInjectiveTyCon :: TyCon -> Bool
+isInjectiveTyCon tc = not (isSynTyCon tc)
+ -- Ultimately we may have injective associated types
+ -- in which case this test will become more interesting
+ --
+ -- It'd be unusual to call isInjectiveTyCon on a regular H98
+ -- 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
isTyConAssoc :: TyCon -> Bool
isTyConAssoc = isJust . assocTyConArgPoss_maybe
--- | Sets up a 'TyVar' to family argument-list mapping in the given 'TyCon' if it is
--- an open 'TyCon'. Panics otherwise
-setTyConArgPoss :: TyCon -> [Int] -> TyCon
-setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs }) poss =
- tc { algTcRhs = rhs {otArgPoss = Just poss} }
-setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss =
- tc { synTcRhs = OpenSynTyCon ki (Just poss) }
-setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
+-- | 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
-- The unit tycon didn't used to be classed as a tuple tycon
-- but I thought that was silly so I've undone it
isSuperKindTyCon (SuperKindTyCon {}) = True
isSuperKindTyCon _ = False
+-- | Is this an AnyTyCon?
+isAnyTyCon :: TyCon -> Bool
+isAnyTyCon (AnyTyCon {}) = True
+isAnyTyCon _ = False
+
-- | Attempt to pull a 'TyCon' apart into the arity and 'coKindFun' of
-- a coercion 'TyCon'. Returns @Nothing@ if the 'TyCon' is not of the
-- appropriate kind
-isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
-isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
- = Just (ar, rule)
+isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, CoTyConDesc)
+isCoercionTyCon_maybe (CoTyCon {tyConArity = ar, coTcDesc = desc})
+ = Just (ar, desc)
isCoercionTyCon_maybe _ = Nothing
-- | Is this a 'TyCon' that represents a coercion?
isCoercionTyCon :: TyCon -> Bool
-isCoercionTyCon (CoercionTyCon {}) = True
-isCoercionTyCon _ = False
+isCoercionTyCon (CoTyCon {}) = True
+isCoercionTyCon _ = False
-- | Identifies implicit tycons that, in particular, do not go into interface
-- files (because they are implicitly reconstructed when the interface is
isTupleTyCon tycon
isImplicitTyCon _other = True
-- catches: FunTyCon, PrimTyCon,
- -- CoercionTyCon, SuperKindTyCon
+ -- CoTyCon, SuperKindTyCon
\end{code}
-- ^ Used to create the view /Core/ has on 'TyCon's. We expand not only closed synonyms like 'tcExpandTyCon_maybe',
-- but also non-recursive @newtype@s
-coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive
+coreExpandTyCon_maybe (AlgTyCon {
algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
= case etad_rhs of -- Don't do this in the pattern match, lest we accidentally
-- match the etad_rhs of a *recursive* newtype
tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
tyConHasGenerics _ = False -- Synonyms
+tyConKind :: TyCon -> Kind
+tyConKind (FunTyCon { tc_kind = k }) = k
+tyConKind (AlgTyCon { tc_kind = k }) = k
+tyConKind (TupleTyCon { tc_kind = k }) = k
+tyConKind (SynTyCon { tc_kind = k }) = k
+tyConKind (PrimTyCon { tc_kind = k }) = k
+tyConKind (AnyTyCon { tc_kind = k }) = k
+tyConKind tc = pprPanic "tyConKind" (ppr tc) -- SuperKindTyCon and CoTyCon
+
+tyConHasKind :: TyCon -> Bool
+tyConHasKind (SuperKindTyCon {}) = False
+tyConHasKind (CoTyCon {}) = False
+tyConHasKind _ = True
+
-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
-- could be found
tyConDataCons :: TyCon -> [DataCon]
tyConFamilySize (TupleTyCon {}) = 1
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
--- | Extract the record selector 'Id's from an algebraic 'TyCon' and returns the empty list otherwise
-tyConSelIds :: TyCon -> [Id]
-tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs
-tyConSelIds _ = []
-
-- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple
-- 'TyCon'. Panics for any other sort of 'TyCon'
algTyConRhs :: TyCon -> AlgTyConRhs
-algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs
-algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
+algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs
+algTyConRhs (TupleTyCon {dataCon = con, tyConArity = arity})
+ = DataTyCon { data_cons = [con], is_enum = arity == 0 }
algTyConRhs other = pprPanic "algTyConRhs" (ppr other)
\end{code}
-- has more than one constructor, or represents a primitive or function type constructor then
-- @Nothing@ is returned. In any other case, the function panics
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon {data_cons = [c] }}) = Just c
-tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }}) = Just c
-tyConSingleDataCon_maybe (AlgTyCon {}) = Nothing
-tyConSingleDataCon_maybe (TupleTyCon {dataCon = con}) = Just con
-tyConSingleDataCon_maybe (PrimTyCon {}) = Nothing
-tyConSingleDataCon_maybe (FunTyCon {}) = Nothing -- case at funty
-tyConSingleDataCon_maybe tc = pprPanic "tyConSingleDataCon_maybe: unexpected tycon " $ ppr tc
+tyConSingleDataCon_maybe (TupleTyCon {dataCon = c}) = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = [c] }}) = Just c
+tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }}) = Just c
+tyConSingleDataCon_maybe _ = Nothing
\end{code}
\begin{code}
instance Uniquable TyCon where
getUnique tc = tyConUnique tc
+instance Outputable CoTyConDesc where
+ ppr CoSym = ptext (sLit "SYM")
+ ppr CoTrans = ptext (sLit "TRANS")
+ ppr CoLeft = ptext (sLit "LEFT")
+ ppr CoRight = ptext (sLit "RIGHT")
+ ppr CoCsel1 = ptext (sLit "CSEL1")
+ ppr CoCsel2 = ptext (sLit "CSEL2")
+ ppr CoCselR = ptext (sLit "CSELR")
+ ppr CoInst = ptext (sLit "INST")
+ ppr CoUnsafe = ptext (sLit "UNSAFE")
+ ppr (CoAxiom {}) = ptext (sLit "AXIOM")
+
instance Outputable TyCon where
ppr tc = ppr (getName tc)
instance NamedThing TyCon where
getName = tyConName
+
+instance Data.Typeable TyCon where
+ typeOf _ = Data.mkTyConApp (Data.mkTyCon "TyCon") []
+
+instance Data.Data TyCon where
+ -- don't traverse?
+ toConstr _ = abstractConstr "TyCon"
+ gunfold _ _ = error "gunfold"
+ dataTypeOf _ = mkNoRepType "TyCon"
\end{code}