%
+% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-\section[TyCon]{The @TyCon@ datatype}
+
+The @TyCon@ datatype
\begin{code}
module TyCon(
PrimRep(..),
tyConPrimRep,
- AlgTyConRhs(..), visibleDataCons,
+ AlgTyConRhs(..), visibleDataCons,
+ AlgTyConParent(..), hasParent,
SynTyConRhs(..),
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
- isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
+ isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
+ isPrimTyCon,
isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
+ assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
- isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo,
+ isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
isHiBootTyCon, isSuperKindTyCon,
isCoercionTyCon_maybe, isCoercionTyCon,
+ isImplicitTyCon,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
tyConStupidTheta,
tyConArity,
isClassTyCon, tyConClass_maybe,
+ isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
tyConExtName, -- External name for foreign types
#include "HsVersions.h"
-import {-# SOURCE #-} TypeRep ( Kind, Type, Coercion, PredType )
+import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
-import Var ( TyVar, Id )
-import Class ( Class )
-import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed )
-import Name ( Name, nameUnique, NamedThing(getName) )
-import PrelNames ( Unique, Uniquable(..) )
-import Maybes ( orElse )
+import Var
+import Class
+import BasicTypes
+import Name
+import PrelNames
+import Maybe
+import Maybes
import Outputable
import FastString
\end{code}
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
-
+
tyConTyVars :: [TyVar], -- Scopes over (a) the algTcStupidTheta
-- (b) the cached types in
-- algTyConRhs.NewTyCon
+ -- (c) the family instance
+ -- types if present
-- But not over the data constructors
+
+ tyConArgPoss :: Maybe [Int], -- for associated families: for each
+ -- tyvar in the AT decl, gives the
+ -- position of that tyvar in the class
+ -- argument list (starting from 0).
+ -- NB: Length is less than tyConArity
+ -- if higher kind signature.
+
algTcSelIds :: [Id], -- Its record selectors (empty if none)
algTcGadtSyntax :: Bool, -- True <=> the data type was declared using GADT syntax
hasGenerics :: Bool, -- True <=> generic to/from functions are available
-- (in the exports of the data type's source module)
- algTcClass :: Maybe Class
- -- Just cl if this tycon came from a class declaration
+ algTcParent :: AlgTyConParent -- Gives the class or family tycon for
+ -- derived tycons representing classes
+ -- or family instances, respectively.
}
| TupleTyCon {
}
| SynTyCon {
- tyConUnique :: Unique,
- tyConName :: Name,
- tyConKind :: Kind,
- tyConArity :: Arity,
-
- tyConTyVars :: [TyVar], -- Bound tyvars
- synTcRhs :: SynTyConRhs -- Expanded type in here
+ tyConUnique :: Unique,
+ tyConName :: Name,
+ tyConKind :: Kind,
+ tyConArity :: Arity,
+
+ tyConTyVars :: [TyVar], -- Bound tyvars
+
+ tyConArgPoss :: Maybe [Int], -- for associated families: for each
+ -- tyvar in the AT decl, gives the
+ -- position of that tyvar in the class
+ -- argument list (starting from 0).
+ -- NB: Length is less than tyConArity
+ -- if higher kind signature.
+
+ synTcRhs :: SynTyConRhs -- Expanded type in here
}
| PrimTyCon { -- Primitive types; cannot be defined in Haskell
tyConUnique :: Unique,
tyConName :: Name,
tyConArity :: Arity,
- coKindFun :: [Type] -> Kind
- }
+ coKindFun :: [Type] -> (Type,Type)
+ } -- INVARAINT: coKindFun is always applied to exactly 'arity' args
+ -- E.g. for trans (c1 :: ta=tb) (c2 :: tb=tc), the coKindFun returns
+ -- the kind as a pair of types: (ta,tc)
| SuperKindTyCon { -- Super Kinds, TY (box) and CO (diamond).
-- They have no kind; and arity zero
tyConName :: Name
}
-type KindCon = TyCon
-
-type SuperKindCon = TyCon
-
type FieldLabel = Name
data AlgTyConRhs
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
+-- Both type classes as well as data/newtype family instances imply implicit
+-- type constructors. These implicit type constructors refer to their parent
+-- structure (ie, the class or family from which they derive) using a type of
+-- the following form.
+--
+data AlgTyConParent = -- An ordinary type constructor has no parent.
+ NoParentTyCon
+
+ -- Type constructors representing a class dictionary.
+ | ClassTyCon Class
+
+ -- Type constructors representing an instances of a type
+ -- family.
+ | FamilyTyCon TyCon -- the type family
+ [Type] -- instance types
+ TyCon -- a *coercion* identifying
+ -- the representation type
+ -- with the type instance
+
+hasParent :: AlgTyConParent -> Bool
+hasParent NoParentTyCon = False
+hasParent _other = True
+
data SynTyConRhs
= OpenSynTyCon Kind -- Type family: *result* kind given
| SynonymTyCon Type -- Mentioning head type vars. Acts as a template for
-- This is the making of a TyCon. Just the same as the old mkAlgTyCon,
-- but now you also have to pass in the generic information about the type
-- constructor - you can get hold of it easily (see Generics module)
-mkAlgTyCon name kind tyvars stupid rhs sel_ids is_rec gen_info gadt_syn
+mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
+ tyConArgPoss = Nothing,
algTcStupidTheta = stupid,
algTcRhs = rhs,
algTcSelIds = sel_ids,
- algTcClass = Nothing,
+ algTcParent = parent,
algTcRec = is_rec,
algTcGadtSyntax = gadt_syn,
hasGenerics = gen_info
}
-mkClassTyCon name kind tyvars rhs clas is_rec
- = AlgTyCon {
- tyConName = name,
- tyConUnique = nameUnique name,
- tyConKind = kind,
- tyConArity = length tyvars,
- tyConTyVars = tyvars,
- algTcStupidTheta = [],
- algTcRhs = rhs,
- algTcSelIds = [],
- algTcClass = Just clas,
- algTcRec = is_rec,
- algTcGadtSyntax = False, -- Doesn't really matter
- hasGenerics = False
- }
-
+mkClassTyCon name kind tyvars rhs clas is_rec =
+ mkAlgTyCon name kind tyvars [] rhs [] (ClassTyCon clas) is_rec False False
mkTupleTyCon name kind arity tyvars con boxed gen_info
= TupleTyCon {
tyConKind = kind,
tyConArity = length tyvars,
tyConTyVars = tyvars,
+ tyConArgPoss = Nothing,
synTcRhs = rhs
}
OpenNewTyCon -> False
NewTyCon {} -> False
AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
-
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isDataTyCon other = False
isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
-isNewTyCon other = False
+isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
+ OpenNewTyCon -> True
+ NewTyCon {} -> True
+ _ -> False
+isNewTyCon other = False
+
+-- This is an important refinement as typical newtype optimisations do *not*
+-- hold for newtype families. Why? Given a type `T a', if T is a newtype
+-- family, there is no unique right hand side by which `T a' can be replaced
+-- by a cast.
+--
+isClosedNewTyCon :: TyCon -> Bool
+isClosedNewTyCon tycon = isNewTyCon tycon && not (isOpenTyCon tycon)
isProductTyCon :: TyCon -> Bool
-- A "product" tycon
isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon }) = True
isOpenTyCon _ = False
+assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
+assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss
+assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss
+assocTyConArgPoss_maybe _ = Nothing
+
+isTyConAssoc :: TyCon -> Bool
+isTyConAssoc = isJust . assocTyConArgPoss_maybe
+
+setTyConArgPoss :: TyCon -> [Int] -> TyCon
+setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss }
+setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss }
+setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
+
isTupleTyCon :: TyCon -> Bool
-- 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 other = False
-isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> Kind)
+isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type))
isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule})
= Just (ar, rule)
isCoercionTyCon_maybe other = Nothing
+isCoercionTyCon :: TyCon -> Bool
isCoercionTyCon (CoercionTyCon {}) = True
isCoercionTyCon other = False
+
+isImplicitTyCon :: TyCon -> Bool
+isImplicitTyCon SynTyCon{} = False
+isImplicitTyCon AlgTyCon{algTcParent = parent} = hasParent parent
+isImplicitTyCon other = True
+ -- catches: FunTyCon, TupleTyCon, PrimTyCon,
+ -- CoercionTyCon, SuperKindTyCon
\end{code}
tyConDataCons_maybe other = Nothing
tyConFamilySize :: TyCon -> Int
-tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = length cons
-tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
-tyConFamilySize (TupleTyCon {}) = 1
+tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon {data_cons = cons}}) =
+ length cons
+tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon {}}) = 1
+tyConFamilySize (AlgTyCon {algTcRhs = OpenDataTyCon}) = 0
+tyConFamilySize (TupleTyCon {}) = 1
#ifdef DEBUG
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
#endif
newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep)
newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon)
-newTyConCo :: TyCon -> Maybe TyCon
-newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co
-newTyConCo tycon = pprPanic "newTyConCo" (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
\begin{code}
isClassTyCon :: TyCon -> Bool
-isClassTyCon (AlgTyCon {algTcClass = Just _}) = True
-isClassTyCon other_tycon = False
+isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
+isClassTyCon other_tycon = False
tyConClass_maybe :: TyCon -> Maybe Class
-tyConClass_maybe (AlgTyCon {algTcClass = maybe_clas}) = maybe_clas
-tyConClass_maybe ther_tycon = Nothing
+tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
+tyConClass_maybe ther_tycon = Nothing
+
+isFamInstTyCon :: TyCon -> Bool
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon other_tycon = False
+
+tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
+tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) =
+ Just (fam, instTys)
+tyConFamInst_maybe ther_tycon =
+ Nothing
+
+tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
+ Just coe
+tyConFamilyCoercion_maybe ther_tycon =
+ Nothing
\end{code}
projects / ghc-hetmet.git / blobdiff