%
+% (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}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TyCon(
- TyCon, ArgVrcs, FieldLabel,
+ TyCon, FieldLabel,
PrimRep(..),
tyConPrimRep,
+ sizeofPrimRep,
- AlgTyConRhs(..), visibleDataCons,
+ AlgTyConRhs(..), visibleDataCons,
+ TyConParent(..),
+ SynTyConRhs(..),
isFunTyCon, isUnLiftedTyCon, isProductTyCon,
- isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
- isEnumerationTyCon,
+ isAlgTyCon, isDataTyCon,
+ isNewTyCon, unwrapNewTyCon_maybe,
+ isSynTyCon, isClosedSynTyCon, isOpenSynTyCon,
+ isPrimTyCon,
+
+ isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
+ assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
- isRecursiveTyCon, newTyConRep, newTyConRhs,
- isHiBootTyCon,
+ isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConCo_maybe,
+ isHiBootTyCon, isSuperKindTyCon,
+ isCoercionTyCon_maybe, isCoercionTyCon,
+ isImplicitTyCon,
tcExpandTyCon_maybe, coreExpandTyCon_maybe,
mkClassTyCon,
mkFunTyCon,
mkPrimTyCon,
+ mkVoidPrimTyCon,
mkLiftedPrimTyCon,
mkTupleTyCon,
mkSynTyCon,
+ mkSuperKindTyCon,
+ mkCoercionTyCon,
tyConName,
tyConKind,
tyConUnique,
tyConTyVars,
- tyConArgVrcs,
algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize,
tyConSelIds,
tyConStupidTheta,
tyConArity,
isClassTyCon, tyConClass_maybe,
- synTyConDefn, synTyConRhs,
+ isFamInstTyCon, tyConFamInst_maybe, tyConFamilyCoercion_maybe,
+ synTyConDefn, synTyConRhs, synTyConType, synTyConResKind,
tyConExtName, -- External name for foreign types
maybeTyConSingleCon,
#include "HsVersions.h"
-import {-# SOURCE #-} TypeRep ( Type, PredType )
- -- Should just be Type(Type), but this fails due to bug present up to
- -- and including 4.02 involving slurping of hi-boot files. Bug is now fixed.
-
+import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
-
-import Var ( TyVar, Id )
-import Class ( Class )
-import Kind ( Kind )
-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 Maybes
import Outputable
import FastString
+import Constants
\end{code}
%************************************************************************
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
-
- tyConTyVars :: [TyVar], -- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon
- -- (b) the cached types in AlgTyConRhs.NewTyCon
+
+ 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
- argVrcs :: ArgVrcs,
- algTcSelIds :: [Id], -- Its record selectors (empty if none):
+ algTcSelIds :: [Id], -- Its record selectors (empty if none)
+ algTcGadtSyntax :: Bool, -- True <=> the data type was declared using GADT syntax
+ -- That doesn't mean it's a true GADT; only that the "where"
+ -- form was used. This field is used only to guide
+ -- pretty-printinng
algTcStupidTheta :: [PredType], -- The "stupid theta" for the data type
-- (always empty for GADTs)
algTcRhs :: AlgTyConRhs, -- Data constructors in here
- algTcRec :: RecFlag, -- Tells whether the data type is part of
- -- a mutually-recursive group or not
+ algTcRec :: RecFlag, -- Tells whether the data type is part
+ -- of a mutually-recursive group or not
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 :: TyConParent -- Gives the class or family tycon for
+ -- derived tycons representing classes
+ -- or family instances, respectively.
+ }
+
+ | 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], -- Bound tyvars
+
+ synTcRhs :: SynTyConRhs, -- Expanded type in here
+
+ synTcParent :: TyConParent -- Gives the family tycon of
+ -- representation tycons of family
+ -- instances
+
}
| PrimTyCon { -- Primitive types; cannot be defined in Haskell
-- Now includes foreign-imported types
+ -- Also includes Kinds
tyConUnique :: Unique,
tyConName :: Name,
tyConKind :: Kind,
- tyConArity :: Arity,
- argVrcs :: ArgVrcs,
+ 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
tyConExtName :: Maybe FastString -- Just xx for foreign-imported types
}
- | TupleTyCon {
- tyConUnique :: Unique,
- tyConName :: Name,
- tyConKind :: Kind,
- tyConArity :: Arity,
- tyConBoxed :: Boxity,
- tyConTyVars :: [TyVar],
- dataCon :: DataCon,
- hasGenerics :: Bool
- }
-
- | SynTyCon {
+ | CoercionTyCon { -- E.g. (:=:), sym, trans, left, right
+ -- INVARIANT: coercions are always fully applied
tyConUnique :: Unique,
- tyConName :: Name,
- tyConKind :: Kind,
+ tyConName :: Name,
tyConArity :: Arity,
-
- tyConTyVars :: [TyVar], -- Bound tyvars
- synTcRhs :: Type, -- Right-hand side, mentioning these type vars.
- -- Acts as a template for the expansion when
- -- the tycon is applied to some types.
- argVrcs :: ArgVrcs
+ 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
+ tyConUnique :: Unique,
+ tyConName :: Name
}
type FieldLabel = Name
-type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)]
- -- [] means "no information, assume the worst"
-
+-- Right hand sides of type constructors for algebraic types
+--
data AlgTyConRhs
- = AbstractTyCon -- 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
+
+ -- 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
+
+ -- The constructor represents an open family without a fixed right hand
+ -- side. Additional instances can appear at any time.
+ --
+ -- These are introduced by either a top level decl:
+ -- data T a :: *
+ -- or an assoicated data type decl, in a class decl:
+ -- class C a b where
+ -- data T b :: *
+
+ | OpenTyCon {
+
+ otArgPoss :: Maybe [Int]
+ -- Nothing <=> top-level indexed type family
+ -- Just ns <=> associated (not toplevel) family
+ -- In the latter case, for each tyvar in the AT decl, 'ns' gives the
+ -- position of that tyvar in the class argument list (starting from 0).
+ -- NB: Length is less than tyConArity iff higher kind signature.
+
+ }
| DataTyCon {
data_cons :: [DataCon],
-- The constructors; can be empty if the user declares
-- the type to have no constructors
-- INVARIANT: Kept in order of increasing tag
- -- (see the tag assignment in DataCon.mkDataCon)
+ -- (see the tag assignment in DataCon.mkDataCon)
is_enum :: Bool -- Cached: True <=> an enumeration type
} -- Includes data types with no constructors.
nt_rhs :: Type, -- Cached: the argument type of the constructor
-- = the representation type of the tycon
+ -- The free tyvars of this type are the tyConTyVars
+
+ nt_co :: Maybe TyCon, -- The coercion used to create the newtype
+ -- from the representation
+ -- optional for non-recursive newtypes
+ -- See Note [Newtype coercions]
nt_etad_rhs :: ([TyVar], Type) ,
-- The same again, but this time eta-reduced
visibleDataCons :: AlgTyConRhs -> [DataCon]
visibleDataCons AbstractTyCon = []
+visibleDataCons OpenTyCon {} = []
visibleDataCons (DataTyCon{ data_cons = cs }) = cs
visibleDataCons (NewTyCon{ data_con = c }) = [c]
+
+-- Both type classes as well as 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. We use `TyConParent' for both algebraic and synonym
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
+
+data TyConParent
+ = NoParentTyCon -- An ordinary type constructor has no parent.
+
+ | ClassTyCon -- Type constructors representing a class dictionary.
+ Class -- INVARIANT: the classTyCon of this Class is the current tycon
+
+ | FamilyTyCon -- Type constructors representing an instance of a type
+ TyCon -- The type family
+ [Type] -- Instance types; free variables are the tyConTyVars
+ -- of the current TyCon (not the family one)
+ -- INVARIANT: the number of types matches the arity
+ -- of the family tycon
+ TyCon -- A CoercionTyCon identifying the representation
+ -- type with the type instance family.
+ -- 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
+
+okParent :: Name -> TyConParent -> Bool -- Checks invariants
+okParent tc_name NoParentTyCon = True
+okParent tc_name (ClassTyCon cls) = tyConName (classTyCon cls) == tc_name
+okParent tc_name (FamilyTyCon fam_tc tys co_tc) = tyConArity fam_tc == length tys
+
+--------------------
+data SynTyConRhs
+ = OpenSynTyCon Kind -- Type family: *result* kind given
+ (Maybe [Int]) -- for associated families: for each tyvars 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.
+
+ | SynonymTyCon Type -- Mentioning head type vars. Acts as a template for
+ -- the expansion when the tycon is applied to some
+ -- types.
\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 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, 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
And now Lint complains unless Foo T == Foo [], and that requires T==[]
+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}
| AddrRep -- a pointer, but not to a Haskell value
| FloatRep
| DoubleRep
+
+-- Size of a PrimRep, in bytes
+sizeofPrimRep :: PrimRep -> Int
+sizeofPrimRep IntRep = wORD_SIZE
+sizeofPrimRep WordRep = wORD_SIZE
+sizeofPrimRep Int64Rep = wORD64_SIZE
+sizeofPrimRep Word64Rep= wORD64_SIZE
+sizeofPrimRep FloatRep = 4
+sizeofPrimRep DoubleRep= 8
+sizeofPrimRep AddrRep = wORD_SIZE
+sizeofPrimRep PtrRep = wORD_SIZE
+sizeofPrimRep VoidRep = 0
\end{code}
%************************************************************************
-- 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 argvrcs stupid rhs sel_ids is_rec gen_info
+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,
- argVrcs = argvrcs,
algTcStupidTheta = stupid,
algTcRhs = rhs,
algTcSelIds = sel_ids,
- algTcClass = Nothing,
+ algTcParent = ASSERT( okParent name parent ) parent,
algTcRec = is_rec,
+ algTcGadtSyntax = gadt_syn,
hasGenerics = gen_info
}
-mkClassTyCon name kind tyvars argvrcs rhs clas is_rec
- = AlgTyCon {
- tyConName = name,
- tyConUnique = nameUnique name,
- tyConKind = kind,
- tyConArity = length tyvars,
- tyConTyVars = tyvars,
- argVrcs = argvrcs,
- algTcStupidTheta = [],
- algTcRhs = rhs,
- algTcSelIds = [],
- algTcClass = Just clas,
- algTcRec = is_rec,
- 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 {
-- as primitive, but *lifted*, TyCons for now. They are lifted
-- because the Haskell type T representing the (foreign) .NET
-- type T is actually implemented (in ILX) as a thunk<T>
-mkForeignTyCon name ext_name kind arity arg_vrcs
+mkForeignTyCon name ext_name kind arity
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = arity,
- argVrcs = arg_vrcs,
primTyConRep = PtrRep, -- they all do
isUnLifted = False,
tyConExtName = ext_name
-- most Prim tycons are lifted
-mkPrimTyCon name kind arity arg_vrcs rep
- = mkPrimTyCon' name kind arity arg_vrcs rep True
+mkPrimTyCon name kind arity rep
+ = mkPrimTyCon' name kind arity rep True
+
+mkVoidPrimTyCon name kind arity
+ = mkPrimTyCon' name kind arity VoidRep True
-- but RealWorld is lifted
-mkLiftedPrimTyCon name kind arity arg_vrcs rep
- = mkPrimTyCon' name kind arity arg_vrcs rep False
+mkLiftedPrimTyCon name kind arity rep
+ = mkPrimTyCon' name kind arity rep False
-mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted
+mkPrimTyCon' name kind arity rep is_unlifted
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = arity,
- argVrcs = arg_vrcs,
primTyConRep = rep,
isUnLifted = is_unlifted,
tyConExtName = Nothing
}
-mkSynTyCon name kind tyvars rhs argvrcs
+mkSynTyCon name kind tyvars rhs parent
= SynTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConArity = length tyvars,
tyConTyVars = tyvars,
synTcRhs = rhs,
- argVrcs = argvrcs
+ synTcParent = parent
}
+
+mkCoercionTyCon name arity kindRule
+ = CoercionTyCon {
+ tyConName = name,
+ tyConUnique = nameUnique name,
+ tyConArity = arity,
+ coKindFun = kindRule
+ }
+
+-- Super kinds always have arity zero
+mkSuperKindTyCon name
+ = SuperKindTyCon {
+ tyConName = name,
+ tyConUnique = nameUnique name
+ }
\end{code}
\begin{code}
isAlgTyCon other = False
isDataTyCon :: TyCon -> Bool
--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
+-- isDataTyCon returns True for data types that are definitely
+-- represented by heap-allocated constructors.
-- These are srcutinised by Core-level @case@ expressions, and they
-- get info tables allocated for them.
-- True for all @data@ types
-- False for newtypes
-- unboxed tuples
+-- type families
+--
+-- NB: for a data type family, T, only the *instance* tycons are
+-- get an info table etc. The family tycon does not.
+-- Hence False for OpenTyCon
isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})
= case rhs of
+ OpenTyCon {} -> False
DataTyCon {} -> True
NewTyCon {} -> False
- AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
-
+ AbstractTyCon -> False -- We don't know, so return False
isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
isDataTyCon other = False
isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
-isNewTyCon other = False
+isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
+isNewTyCon other = 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 other = Nothing
isProductTyCon :: TyCon -> Bool
-- A "product" tycon
-- has *one* constructor,
-- is *not* existential
-- but
--- may be DataType or NewType,
+-- may be DataType, NewType
-- may be unboxed or not,
-- may be recursive or not
+--
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
DataTyCon{ data_cons = [data_con] }
-> isVanillaDataCon data_con
isSynTyCon (SynTyCon {}) = True
isSynTyCon _ = False
+-- As for newtypes, it is in some contexts important to distinguish between
+-- closed synonyms and synonym families, as synonym families have no unique
+-- right hand side to which a synonym family application can expand.
+--
+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 other = False
+
isEnumerationTyCon :: TyCon -> Bool
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon other = False
+isOpenTyCon :: TyCon -> Bool
+isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
+isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {} }) = True
+isOpenTyCon _ = False
+
+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 :: 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)
+
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
-- isForeignTyCon identifies foreign-imported type constructors
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon other = False
+
+isSuperKindTyCon :: TyCon -> Bool
+isSuperKindTyCon (SuperKindTyCon {}) = True
+isSuperKindTyCon other = False
+
+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
+
+-- Identifies implicit tycons that, in particular, do not go into interface
+-- files (because they are implicitly reconstructed when the interface is
+-- read).
+--
+-- Note that
+--
+-- * associated families are implicit, as they are re-constructed from
+-- the class declaration in which they reside, and
+-- * family instances are *not* implicit as they represent the instance body
+-- (similar to a dfun does that for a class instance).
+--
+isImplicitTyCon :: TyCon -> Bool
+isImplicitTyCon tycon | isTyConAssoc tycon = True
+ | isSynTyCon tycon = False
+ | isAlgTyCon tycon = isClassTyCon tycon ||
+ isTupleTyCon tycon
+isImplicitTyCon _other = True
+ -- catches: FunTyCon, PrimTyCon,
+ -- CoercionTyCon, SuperKindTyCon
\end{code}
[Type]) -- Leftover args
-- For the *typechecker* view, we expand synonyms only
-tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs, synTcRhs = rhs }) tys
+tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
+ synTcRhs = SynonymTyCon rhs }) tys
= expand tvs rhs tys
tcExpandTyCon_maybe other_tycon tys = Nothing
---------------
--- For the *Core* view, we expand synonyms *and* non-recursive newtypes
+-- For the *Core* view, we expand synonyms only as well
+
coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive
- algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys
+ 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
(tvs,rhs) -> expand tvs rhs tys
-
+
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys
+
----------------
expand :: [TyVar] -> Type -- Template
-> [Type] -- Args
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 = OpenTyCon {}}) = 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_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
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)
\end{code}
-@tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
-each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is
-actually computed (in another file).
-
-\begin{code}
-tyConArgVrcs :: TyCon -> ArgVrcs
-tyConArgVrcs (FunTyCon {}) = [(False,True),(True,False)]
-tyConArgVrcs (AlgTyCon {argVrcs = oi}) = oi
-tyConArgVrcs (PrimTyCon {argVrcs = oi}) = oi
-tyConArgVrcs (TupleTyCon {tyConArity = arity}) = (replicate arity (True,False))
-tyConArgVrcs (SynTyCon {argVrcs = oi}) = oi
-\end{code}
-
\begin{code}
synTyConDefn :: TyCon -> ([TyVar], Type)
-synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = ty}) = (tyvars,ty)
+synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
+ = (tyvars, ty)
synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)
-synTyConRhs :: TyCon -> Type
-synTyConRhs tc = synTcRhs tc
+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}
\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 other_tycon = Nothing
+
+isFamInstTyCon :: TyCon -> Bool
+isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon other_tycon = 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 other_tycon =
+ Nothing
+
+tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
+tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) =
+ Just coe
+tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) =
+ Just coe
+tyConFamilyCoercion_maybe other_tycon =
+ Nothing
\end{code}