%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 19921998
%
The @TyCon@ datatype
\begin{code}
module TyCon(
TyCon, FieldLabel,
AlgTyConRhs(..), visibleDataCons,
TyConParent(..),
SynTyConRhs(..),
AssocFamilyPermutation,
mkAlgTyCon,
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
mkVoidPrimTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
mkSuperKindTyCon,
mkCoercionTyCon,
mkForeignTyCon,
isAlgTyCon,
isClassTyCon, isFamInstTyCon,
isFunTyCon,
isPrimTyCon,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon,
isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
isSuperKindTyCon,
isCoercionTyCon, isCoercionTyCon_maybe,
isForeignTyCon,
isInjectiveTyCon,
isDataTyCon, isProductTyCon, isEnumerationTyCon,
isNewTyCon, isAbstractTyCon, isOpenTyCon,
isUnLiftedTyCon,
isGadtSyntaxTyCon,
isTyConAssoc,
isRecursiveTyCon,
isHiBootTyCon,
isImplicitTyCon, tyConHasGenerics,
tyConName,
tyConKind,
tyConUnique,
tyConTyVars,
tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe,
tyConFamilySize,
tyConStupidTheta,
tyConArity,
tyConClass_maybe,
tyConFamInst_maybe, tyConFamilyCoercion_maybe,
synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
tyConExtName,
algTyConRhs,
newTyConRhs, newTyConEtadRhs, unwrapNewTyCon_maybe,
assocTyConArgPoss_maybe,
tupleTyConBoxity,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
makeTyConAbstract,
newTyConCo_maybe,
setTyConArgPoss,
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 Data.List( elemIndex )
\end{code}
%************************************************************************
%* *
\subsection{The data type}
%* *
%************************************************************************
\begin{code}
data TyCon
=
FunTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity
}
| AlgTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar],
algTcGadtSyntax :: Bool,
algTcStupidTheta :: [PredType],
algTcRhs :: AlgTyConRhs,
algTcRec :: RecFlag,
hasGenerics :: Bool,
algTcParent :: TyConParent
}
| TupleTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
tyConBoxed :: Boxity,
tyConTyVars :: [TyVar],
dataCon :: DataCon,
hasGenerics :: Bool
}
| SynTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
tyConTyVars :: [TyVar],
synTcRhs :: SynTyConRhs,
synTcParent :: TyConParent
}
| PrimTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
primTyConRep :: PrimRep,
isUnLifted :: Bool,
tyConExtName :: Maybe FastString
}
| CoercionTyCon {
tyConUnique :: Unique,
tyConName :: Name,
tyConArity :: Arity,
coKindFun :: [Type] -> (Type,Type)
}
| SuperKindTyCon {
tyConUnique :: Unique,
tyConName :: Name
}
type FieldLabel = Name
data AlgTyConRhs
= AbstractTyCon
| OpenTyCon {
otArgPoss :: AssocFamilyPermutation
}
| DataTyCon {
data_cons :: [DataCon],
is_enum :: Bool
}
| NewTyCon {
data_con :: DataCon,
nt_rhs :: Type,
nt_etad_rhs :: ([TyVar], Type),
nt_co :: Maybe TyCon
}
type AssocFamilyPermutation
= Maybe [Int]
visibleDataCons :: AlgTyConRhs -> [DataCon]
visibleDataCons AbstractTyCon = []
visibleDataCons OpenTyCon {} = []
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
data TyConParent
=
NoParentTyCon
| ClassTyCon
Class
| FamilyTyCon
TyCon
[Type]
TyCon
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
data SynTyConRhs
= OpenSynTyCon
Kind
AssocFamilyPermutation
| SynonymTyCon Type
\end{code}
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 CoercionTyCon, so it does not have a kind on its
own; it basically has its own typing rule for the fullyapplied
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, CoercionTyCon,
(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 etareduce 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
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 toplevel 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 sourcelevel
"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/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 (nonvoid, 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 mutualrecursion. 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,
tyConKind = 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,
tyConKind = 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,
tyConKind = 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,
tyConKind = 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
mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon
mkVoidPrimTyCon name kind arity
= mkPrimTyCon' name kind arity 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,
tyConKind = 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,
tyConKind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
synTcRhs = rhs,
synTcParent = parent
}
mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon
mkCoercionTyCon name arity kindRule
= CoercionTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConArity = arity,
coKindFun = kindRule
}
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
OpenTyCon {} -> 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
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
isOpenSynTyCon :: TyCon -> Bool
isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon _ = False
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon _ = False
isOpenTyCon :: TyCon -> Bool
isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon {}}) = True
isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}}) = True
isOpenTyCon _ = False
isInjectiveTyCon :: TyCon -> Bool
isInjectiveTyCon tc = not (isSynTyCon tc)
assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
assocTyConArgPoss_maybe (AlgTyCon {
algTcRhs = OpenTyCon {otArgPoss = poss}}) = poss
assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss
assocTyConArgPoss_maybe _ = Nothing
isTyConAssoc :: TyCon -> Bool
isTyConAssoc = isJust . assocTyConArgPoss_maybe
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]
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
isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
= Just (ar, rule)
isCoercionTyCon_maybe _ = Nothing
isCoercionTyCon :: TyCon -> Bool
isCoercionTyCon (CoercionTyCon {}) = 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}
\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
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 = OpenTyCon {}}) = 0
tyConFamilySize (TupleTyCon {}) = 1
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs
algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False }
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)
synTyConResKind :: TyCon -> Kind
synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind
synTyConResKind tycon = pprPanic "synTyConResKind" (ppr tycon)
\end{code}
\begin{code}
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
tyConSingleDataCon_maybe tc = pprPanic "tyConSingleDataCon_maybe: unexpected tycon " $ ppr tc
\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
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
isFamInstTyCon _ = False
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
tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
Just coe
tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) =
Just coe
tyConFamilyCoercion_maybe _ =
Nothing
\end{code}
%************************************************************************
%* *
\subsection[TyConinstances]{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 TyCon where
ppr tc = ppr (getName tc)
instance NamedThing TyCon where
getName = tyConName
\end{code}