%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
The @TyCon@ datatype
\begin{code}
module TyCon(
TyCon, FieldLabel,
AlgTyConRhs(..), visibleDataCons,
TyConParent(..), isNoParent,
SynTyConRhs(..),
CoTyConDesc(..),
mkAlgTyCon,
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
mkKindTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
mkSuperKindTyCon,
mkCoercionTyCon,
mkForeignTyCon,
mkAnyTyCon,
isAlgTyCon,
isClassTyCon, isFamInstTyCon,
isFunTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isSynTyCon, isClosedSynTyCon,
isSuperKindTyCon, isDecomposableTyCon,
isCoercionTyCon, isCoercionTyCon_maybe,
isForeignTyCon, isAnyTyCon, tyConHasKind,
isInjectiveTyCon,
isDataTyCon, isProductTyCon, isEnumerationTyCon,
isNewTyCon, isAbstractTyCon,
isFamilyTyCon, isSynFamilyTyCon, isDataFamilyTyCon,
isUnLiftedTyCon,
isGadtSyntaxTyCon,
isTyConAssoc,
isRecursiveTyCon,
isHiBootTyCon,
isImplicitTyCon, tyConHasGenerics,
tyConName,
tyConKind,
tyConUnique,
tyConTyVars,
tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe,
tyConFamilySize,
tyConStupidTheta,
tyConArity,
tyConParent,
tyConClass_maybe,
tyConFamInst_maybe, tyConFamilyCoercion_maybe,tyConFamInstSig_maybe,
synTyConDefn, synTyConRhs, synTyConType,
tyConExtName,
algTyConRhs,
newTyConRhs, newTyConEtadRhs, unwrapNewTyCon_maybe,
tupleTyConBoxity,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
makeTyConAbstract,
newTyConCo_maybe,
PrimRep(..),
tyConPrimRep,
primRepSizeW
) where
#include "HsVersions.h"
import TypeRep ( Kind, Type, PredType )
import DataCon ( DataCon, isVanillaDataCon )
import Var
import Class
import BasicTypes
import Name
import PrelNames
import Maybes
import Outputable
import FastString
import Constants
import Util
import qualified Data.Data as Data
\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}
%* *
%************************************************************************
\begin{code}
data TyCon
=
FunTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind,
tyConArity :: Arity
}
| AlgTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar],
algTcGadtSyntax :: Bool,
algTcStupidTheta :: [PredType],
algTcRhs :: AlgTyConRhs,
algTcRec :: RecFlag,
hasGenerics :: Bool,
algTcParent :: TyConParent
}
| TupleTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind,
tyConArity :: Arity,
tyConBoxed :: Boxity,
tyConTyVars :: [TyVar],
dataCon :: DataCon,
hasGenerics :: Bool
}
| SynTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar],
synTcRhs :: SynTyConRhs,
synTcParent :: TyConParent
}
| PrimTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind,
tyConArity :: Arity,
primTyConRep :: PrimRep,
isUnLifted :: Bool,
tyConExtName :: Maybe FastString
}
| CoTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConArity :: Arity,
coTcDesc :: CoTyConDesc
}
| AnyTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tc_kind :: Kind
}
| SuperKindTyCon {
tyConUnique :: Unique,
tyConName :: Name
}
type FieldLabel = Name
data AlgTyConRhs
= AbstractTyCon
| DataFamilyTyCon
| DataTyCon {
data_cons :: [DataCon],
is_enum :: Bool
}
| NewTyCon {
data_con :: DataCon,
nt_rhs :: Type,
nt_etad_rhs :: ([TyVar], Type),
nt_co :: Maybe TyCon
}
visibleDataCons :: AlgTyConRhs -> [DataCon]
visibleDataCons AbstractTyCon = []
visibleDataCons DataFamilyTyCon {} = []
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
data TyConParent
=
NoParentTyCon
| ClassTyCon
Class
| AssocFamilyTyCon
Class
| FamInstTyCon
TyCon
[Type]
TyCon
okParent :: Name -> TyConParent -> Bool
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
data SynTyConRhs
=
SynonymTyCon
Type
| SynFamilyTyCon
data CoTyConDesc
= CoSym | CoTrans
| CoLeft | CoRight
| CoCsel1 | CoCsel2 | CoCselR
| CoInst
| CoAxiom
{ co_ax_tvs :: [TyVar]
, co_ax_lhs :: Type
, co_ax_rhs :: Type }
| CoUnsafe
\end{code}
Note [Enumeration types]
~~~~~~~~~~~~~~~~~~~~~~~~
We define datatypes with no constructors to *not* be
enumerations; this fixes trac #2578, Otherwise we
end up generating an empty table for
__closure_tbl
which is used by tagToEnum# to map Int# to constructors
in an enumeration. The empty table apparently upset
the linker.
Moreover, all the data constructor must be enumerations, meaning
they have type (forall abc. T a b c). GADTs are not enumerations.
For example consider
data T a where
T1 :: T Int
T2 :: T Bool
T3 :: T a
What would [T1 ..] be? [T1,T3] :: T Int? Easiest thing is to exclude them.
See Trac #4528.
Note [Newtype coercions]
~~~~~~~~~~~~~~~~~~~~~~~~
The NewTyCon field nt_co is a a TyCon (a coercion constructor in fact)
which is used for coercing from the representation type of the
newtype, to the newtype itself. For example,
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 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
ending with the same type variables as the left hand side, we
"eta-contract" the coercion. So if we had
newtype S a = MkT [a]
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])
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, 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]
Note [Newtype eta]
~~~~~~~~~~~~~~~~~~
Consider
newtype Parser m a = MkParser (Foogle m a)
Are these two types equal (to Core)?
Monad (Parser m)
Monad (Foogle m)
Well, yes. But to see that easily we eta-reduce the RHS type of
Parser, in this case to ([], Froogle), so that even unsaturated applications
of Parser will work right. This eta reduction is done when the type
constructor is built, and cached in NewTyCon. The cached field is
only used in coreExpandTyCon_maybe.
Here's an example that I think showed up in practice
Source code:
newtype T a = MkT [a]
newtype Foo m = MkFoo (forall a. m a -> Int)
w1 :: Foo []
w1 = ...
w2 :: Foo T
w2 = MkFoo (\(MkT x) -> case w1 of MkFoo f -> f x)
After desugaring, and discarding the data constructors for the newtypes,
we get:
w2 :: Foo T
w2 = w1
And now Lint complains unless Foo T == Foo [], and that requires T==[]
This point carries over to the newtype coercion, because we need to
say
w2 = w1 `cast` Foo CoT
so the coercion tycon CoT must have
kind: T ~ []
and arity: 0
%************************************************************************
%* *
\subsection{PrimRep}
%* *
%************************************************************************
A PrimRep is somewhat similar to a CgRep (see codeGen/SMRep) and a
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
about primitive pointers (AddrRep). Signedness and primitive
pointers are required when passing a primitive type to a foreign
function, but aren't needed for call/return conventions of Haskell
functions.
- A MachRep is a basic machine type (non-void, doesn't contain
information on pointerhood or signedness, but contains some
reps that don't have corresponding Haskell types).
\begin{code}
data PrimRep
= VoidRep
| PtrRep
| IntRep
| WordRep
| Int64Rep
| Word64Rep
| AddrRep
| FloatRep
| DoubleRep
deriving( Eq, Show )
instance Outputable PrimRep where
ppr r = text (show r)
primRepSizeW :: PrimRep -> Int
primRepSizeW IntRep = 1
primRepSizeW WordRep = 1
primRepSizeW Int64Rep = wORD64_SIZE `quot` wORD_SIZE
primRepSizeW Word64Rep= wORD64_SIZE `quot` wORD_SIZE
primRepSizeW FloatRep = 1
primRepSizeW DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE
primRepSizeW AddrRep = 1
primRepSizeW PtrRep = 1
primRepSizeW VoidRep = 0
\end{code}
%************************************************************************
%* *
\subsection{TyCon Construction}
%* *
%************************************************************************
Note: the TyCon constructors all take a Kind as one argument, even though
they could, in principle, work out their Kind from their other arguments.
But to do so they need functions from Types, and that makes a nasty
module mutual-recursion. And they aren't called from many places.
So we compromise, and move their Kind calculation to the call site.
\begin{code}
mkFunTyCon :: Name -> Kind -> TyCon
mkFunTyCon name kind
= FunTyCon {
tyConUnique = nameUnique name,
tyConName = name,
tc_kind = kind,
tyConArity = 2
}
mkAlgTyCon :: Name
-> Kind
-> [TyVar]
-> [PredType]
-> AlgTyConRhs
-> TyConParent
-> RecFlag
-> Bool
-> Bool
-> TyCon
mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tc_kind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
algTcStupidTheta = stupid,
algTcRhs = rhs,
algTcParent = ASSERT( okParent name parent ) parent,
algTcRec = is_rec,
algTcGadtSyntax = gadt_syn,
hasGenerics = gen_info
}
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
mkTupleTyCon :: Name
-> Kind
-> Arity
-> [TyVar]
-> DataCon
-> Boxity
-> Bool
-> TyCon
mkTupleTyCon name kind arity tyvars con boxed gen_info
= TupleTyCon {
tyConUnique = nameUnique name,
tyConName = name,
tc_kind = kind,
tyConArity = arity,
tyConBoxed = boxed,
tyConTyVars = tyvars,
dataCon = con,
hasGenerics = gen_info
}
mkForeignTyCon :: Name
-> Maybe FastString
-> Kind
-> Arity
-> TyCon
mkForeignTyCon name ext_name kind arity
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tc_kind = kind,
tyConArity = arity,
primTyConRep = PtrRep,
isUnLifted = False,
tyConExtName = ext_name
}
mkPrimTyCon :: Name -> Kind -> Arity -> PrimRep -> TyCon
mkPrimTyCon name kind arity rep
= mkPrimTyCon' name kind arity rep True
mkKindTyCon :: Name -> Kind -> TyCon
mkKindTyCon name kind
= mkPrimTyCon' name kind 0 VoidRep True
mkLiftedPrimTyCon :: Name -> Kind -> Arity -> PrimRep -> TyCon
mkLiftedPrimTyCon name kind arity rep
= mkPrimTyCon' name kind arity rep False
mkPrimTyCon' :: Name -> Kind -> Arity -> PrimRep -> Bool -> TyCon
mkPrimTyCon' name kind arity rep is_unlifted
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tc_kind = kind,
tyConArity = arity,
primTyConRep = rep,
isUnLifted = is_unlifted,
tyConExtName = Nothing
}
mkSynTyCon :: Name -> Kind -> [TyVar] -> SynTyConRhs -> TyConParent -> TyCon
mkSynTyCon name kind tyvars rhs parent
= SynTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tc_kind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
synTcRhs = rhs,
synTcParent = parent
}
mkCoercionTyCon :: Name -> Arity
-> CoTyConDesc
-> TyCon
mkCoercionTyCon name arity desc
= CoTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConArity = arity,
coTcDesc = desc }
mkAnyTyCon :: Name -> Kind -> TyCon
mkAnyTyCon name kind
= AnyTyCon { tyConName = name,
tc_kind = kind,
tyConUnique = nameUnique name }
mkSuperKindTyCon :: Name -> TyCon
mkSuperKindTyCon name
= SuperKindTyCon {
tyConName = name,
tyConUnique = nameUnique name
}
\end{code}
\begin{code}
isFunTyCon :: TyCon -> Bool
isFunTyCon (FunTyCon {}) = True
isFunTyCon _ = False
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True
isAbstractTyCon _ = False
makeTyConAbstract :: TyCon -> TyCon
makeTyConAbstract tc@(AlgTyCon {}) = tc { algTcRhs = AbstractTyCon }
makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)
isPrimTyCon :: TyCon -> Bool
isPrimTyCon (PrimTyCon {}) = True
isPrimTyCon _ = False
isUnLiftedTyCon :: TyCon -> Bool
isUnLiftedTyCon (PrimTyCon {isUnLifted = is_unlifted}) = is_unlifted
isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
isUnLiftedTyCon _ = False
isAlgTyCon :: TyCon -> Bool
isAlgTyCon (AlgTyCon {}) = True
isAlgTyCon (TupleTyCon {}) = True
isAlgTyCon _ = False
isDataTyCon :: TyCon -> Bool
isDataTyCon (AlgTyCon {algTcRhs = rhs})
= case rhs of
DataFamilyTyCon {} -> False
DataTyCon {} -> True
NewTyCon {} -> False
AbstractTyCon -> False
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isDataTyCon _ = False
isNewTyCon :: TyCon -> Bool
isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
isNewTyCon _ = False
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, Maybe TyCon)
unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs,
algTcRhs = NewTyCon { nt_co = mb_co,
nt_rhs = rhs }})
= Just (tvs, rhs, mb_co)
unwrapNewTyCon_maybe _ = Nothing
isProductTyCon :: TyCon -> Bool
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
DataTyCon{ data_cons = [data_con] }
-> isVanillaDataCon data_con
NewTyCon {} -> True
_ -> False
isProductTyCon (TupleTyCon {}) = True
isProductTyCon _ = False
isSynTyCon :: TyCon -> Bool
isSynTyCon (SynTyCon {}) = True
isSynTyCon _ = False
isDecomposableTyCon :: TyCon -> Bool
isDecomposableTyCon (SynTyCon {}) = False
isDecomposableTyCon (CoTyCon {}) = False
isDecomposableTyCon _other = True
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon _ = False
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0
isEnumerationTyCon _ = False
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True
isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
isFamilyTyCon _ = False
isSynFamilyTyCon :: TyCon -> Bool
isSynFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True
isSynFamilyTyCon _ = False
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
isDataFamilyTyCon _ = False
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isFamilyTyCon tycon)
isInjectiveTyCon :: TyCon -> Bool
isInjectiveTyCon tc = not (isSynTyCon tc)
isTyConAssoc :: TyCon -> Bool
isTyConAssoc tc = case tyConParent tc of
AssocFamilyTyCon {} -> True
_ -> False
isTupleTyCon :: TyCon -> Bool
isTupleTyCon (TupleTyCon {}) = True
isTupleTyCon _ = False
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity)
isUnboxedTupleTyCon _ = False
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isBoxedTupleTyCon _ = False
tupleTyConBoxity :: TyCon -> Boxity
tupleTyConBoxity tc = tyConBoxed tc
isRecursiveTyCon :: TyCon -> Bool
isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
isRecursiveTyCon _ = False
isHiBootTyCon :: TyCon -> Bool
isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True
isHiBootTyCon _ = False
isForeignTyCon :: TyCon -> Bool
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon _ = False
isSuperKindTyCon :: TyCon -> Bool
isSuperKindTyCon (SuperKindTyCon {}) = True
isSuperKindTyCon _ = False
isAnyTyCon :: TyCon -> Bool
isAnyTyCon (AnyTyCon {}) = True
isAnyTyCon _ = False
isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, CoTyConDesc)
isCoercionTyCon_maybe (CoTyCon {tyConArity = ar, coTcDesc = desc})
= Just (ar, desc)
isCoercionTyCon_maybe _ = Nothing
isCoercionTyCon :: TyCon -> Bool
isCoercionTyCon (CoTyCon {}) = True
isCoercionTyCon _ = False
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon tycon | isTyConAssoc tycon = True
| isSynTyCon tycon = False
| isAlgTyCon tycon = isClassTyCon tycon ||
isTupleTyCon tycon
isImplicitTyCon _other = True
\end{code}
-----------------------------------------------
-- Expand type-constructor applications
-----------------------------------------------
\begin{code}
tcExpandTyCon_maybe, coreExpandTyCon_maybe
:: TyCon
-> [Type]
-> Maybe ([(TyVar,Type)],
Type,
[Type])
tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
synTcRhs = SynonymTyCon rhs }) tys
= expand tvs rhs tys
tcExpandTyCon_maybe _ _ = Nothing
coreExpandTyCon_maybe (AlgTyCon {
algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs, nt_co = Nothing }}) tys
= case etad_rhs of
(tvs,rhs) -> expand tvs rhs tys
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
expand :: [TyVar] -> Type
-> [Type]
-> Maybe ([(TyVar,Type)], Type, [Type])
expand tvs rhs tys
= case n_tvs `compare` length tys of
LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
EQ -> Just (tvs `zip` tys, rhs, [])
GT -> Nothing
where
n_tvs = length tvs
\end{code}
\begin{code}
tyConHasGenerics :: TyCon -> Bool
tyConHasGenerics (AlgTyCon {hasGenerics = hg}) = hg
tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg
tyConHasGenerics _ = False
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)
tyConHasKind :: TyCon -> Bool
tyConHasKind (SuperKindTyCon {}) = False
tyConHasKind (CoTyCon {}) = False
tyConHasKind _ = True
tyConDataCons :: TyCon -> [DataCon]
tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }}) = Just [con]
tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con]
tyConDataCons_maybe _ = Nothing
tyConFamilySize :: TyCon -> Int
tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon {data_cons = cons}}) =
length cons
tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
tyConFamilySize (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = 0
tyConFamilySize (TupleTyCon {}) = 1
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
algTyConRhs :: TyCon -> AlgTyConRhs
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}
\begin{code}
newTyConRhs :: TyCon -> ([TyVar], Type)
newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)
newTyConEtadRhs :: TyCon -> ([TyVar], Type)
newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)
newTyConCo_maybe :: TyCon -> Maybe TyCon
newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = co
newTyConCo_maybe _ = Nothing
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep
\end{code}
\begin{code}
tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
tyConStupidTheta (TupleTyCon {}) = []
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
\end{code}
\begin{code}
synTyConDefn :: TyCon -> ([TyVar], Type)
synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
= (tyvars, ty)
synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
synTyConRhs :: TyCon -> SynTyConRhs
synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
synTyConRhs tc = pprPanic "synTyConRhs" (ppr tc)
synTyConType :: TyCon -> Type
synTyConType tc = case synTcRhs tc of
SynonymTyCon t -> t
_ -> pprPanic "synTyConType" (ppr tc)
\end{code}
\begin{code}
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
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}
isClassTyCon :: TyCon -> Bool
isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
isClassTyCon _ = False
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
isFamInstTyCon :: TyCon -> Bool
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
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe tc
= case tyConParent tc of
FamInstTyCon f ts _ -> Just (f, ts)
_ -> Nothing
tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
tyConFamilyCoercion_maybe tc
= case tyConParent tc of
FamInstTyCon _ _ co -> Just co
_ -> Nothing
\end{code}
%************************************************************************
%* *
\subsection[TyCon-instances]{Instance declarations for @TyCon@}
%* *
%************************************************************************
@TyCon@s are compared by comparing their @Unique@s.
The strictness analyser needs @Ord@. It is a lexicographic order with
the property @(a<=b) || (b<=a)@.
\begin{code}
instance Eq TyCon where
a == b = case (a `compare` b) of { EQ -> True; _ -> False }
a /= b = case (a `compare` b) of { EQ -> False; _ -> True }
instance Ord TyCon where
a <= b = case (a `compare` b) of { LT -> True; EQ -> True; GT -> False }
a < b = case (a `compare` b) of { LT -> True; EQ -> False; GT -> False }
a >= b = case (a `compare` b) of { LT -> False; EQ -> True; GT -> True }
a > b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True }
compare a b = getUnique a `compare` getUnique b
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
toConstr _ = abstractConstr "TyCon"
gunfold _ _ = error "gunfold"
dataTypeOf _ = mkNoRepType "TyCon"
\end{code}