X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FTyCon.lhs;h=51b81d6e995072d957b78474f71eb8d1a0cebf92;hb=423d477bfecd490de1449c59325c8776f91d7aac;hp=ca41d14be401b9590f29972bc585eda88b92e84d;hpb=dfc75488f4cd1d4f6bf9896f5a901996c77bbc77;p=ghc-hetmet.git diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index ca41d14..51b81d6 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -5,16 +5,18 @@ \begin{code} module TyCon( - TyCon, KindCon, SuperKindCon, ArgVrcs, + TyCon, ArgVrcs, - AlgTyConFlavour(..), - DataConDetails(..), visibleDataCons, + PrimRep(..), + tyConPrimRep, + + AlgTyConRhs(..), visibleDataCons, - isFunTyCon, isUnLiftedTyCon, isBoxedTyCon, isProductTyCon, + isFunTyCon, isUnLiftedTyCon, isProductTyCon, isAbstractTyCon, isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isEnumerationTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity, - isRecursiveTyCon, newTyConRep, + isRecursiveTyCon, newTyConRep, newTyConRhs, isHiBootTyCon, mkForeignTyCon, isForeignTyCon, @@ -25,35 +27,29 @@ module TyCon( mkLiftedPrimTyCon, mkTupleTyCon, mkSynTyCon, - mkKindCon, - mkSuperKindCon, - - setTyConName, tyConName, tyConKind, tyConUnique, tyConTyVars, - tyConArgVrcs_maybe, - tyConDataConDetails, tyConDataCons, tyConDataCons_maybe, tyConFamilySize, + tyConArgVrcs, + algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize, tyConSelIds, tyConTheta, - tyConPrimRep, tyConArity, isClassTyCon, tyConClass_maybe, getSynTyConDefn, + tyConExtName, -- External name for foreign types maybeTyConSingleCon, - matchesTyCon, - -- Generics - tyConGenIds, tyConGenInfo + tyConHasGenerics ) where #include "HsVersions.h" -import {-# SOURCE #-} TypeRep ( Type, PredType, Kind, SuperKind ) +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. @@ -62,11 +58,10 @@ import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon ) import Var ( TyVar, Id ) import Class ( Class ) -import BasicTypes ( Arity, RecFlag(..), Boxity(..), - isBoxed, EP(..) ) +import Kind ( Kind ) +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed ) import Name ( Name, nameUnique, NamedThing(getName) ) -import PrelNames ( Unique, Uniquable(..), anyBoxConKey ) -import PrimRep ( PrimRep(..), isFollowableRep ) +import PrelNames ( Unique, Uniquable(..) ) import Maybes ( orElse ) import Outputable import FastString @@ -79,9 +74,6 @@ import FastString %************************************************************************ \begin{code} -type KindCon = TyCon -type SuperKindCon = TyCon - data TyCon = FunTyCon { tyConUnique :: Unique, @@ -91,7 +83,7 @@ data TyCon } - | AlgTyCon { -- Tuples, data type, and newtype decls. + | AlgTyCon { -- Data type, and newtype decls. -- All lifted, all boxed tyConUnique :: Unique, tyConName :: Name, @@ -99,21 +91,18 @@ data TyCon tyConArity :: Arity, tyConTyVars :: [TyVar], - tyConArgVrcs :: ArgVrcs, + argVrcs :: ArgVrcs, algTyConTheta :: [PredType], - dataCons :: DataConDetails DataCon, + selIds :: [Id], -- Its record selectors (if any) - selIds :: [Id], -- Its record selectors (if any) + algRhs :: AlgTyConRhs, -- Data constructors in here - algTyConFlavour :: AlgTyConFlavour, - algTyConRec :: RecFlag, -- Tells whether the data type is part of + algTyConRec :: RecFlag, -- Tells whether the data type is part of -- a mutually-recursive group or not - genInfo :: Maybe (EP Id), -- Convert T <-> Tring - -- Some TyCons don't have it; - -- e.g. the TyCon for a Class dictionary, - -- and TyCons with unboxed arguments + hasGenerics :: Bool, -- True <=> generic to/from functions are available + -- (in the exports of the data type's source module) algTyConClass :: Maybe Class -- Just cl if this tycon came from a class declaration @@ -121,21 +110,22 @@ data TyCon | PrimTyCon { -- Primitive types; cannot be defined in Haskell -- Now includes foreign-imported types - tyConUnique :: Unique, - tyConName :: Name, - tyConKind :: Kind, - tyConArity :: Arity, - tyConArgVrcs :: ArgVrcs, - primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are - -- boxed (represented by pointers). The PrimRep tells. - - isUnLifted :: Bool, -- Most primitive tycons are unlifted, - -- but foreign-imported ones may not be - tyConExtName :: Maybe FastString + tyConUnique :: Unique, + tyConName :: Name, + tyConKind :: Kind, + tyConArity :: Arity, + argVrcs :: ArgVrcs, + + primTyConRep :: PrimRep, + -- Many primitive tycons are unboxed, but some are + -- boxed (represented by pointers). The CgRep tells. + + isUnLifted :: Bool, -- Most primitive tycons are unlifted, + -- but foreign-imported ones may not be + tyConExtName :: Maybe FastString -- Just xx for foreign-imported types } | TupleTyCon { - tyConUnique :: Unique, tyConName :: Name, tyConKind :: Kind, @@ -143,7 +133,7 @@ data TyCon tyConBoxed :: Boxity, tyConTyVars :: [TyVar], dataCon :: DataCon, - genInfo :: Maybe (EP Id) -- Generic type and conv funs + hasGenerics :: Bool } | SynTyCon { @@ -156,29 +146,29 @@ data TyCon synTyConDefn :: Type, -- Right-hand side, mentioning these type vars. -- Acts as a template for the expansion when -- the tycon is applied to some types. - tyConArgVrcs :: ArgVrcs - } - - | KindCon { -- Type constructor at the kind level - tyConUnique :: Unique, - tyConName :: Name, - tyConKind :: SuperKind, - tyConArity :: Arity - } - - | SuperKindCon { -- The type of kind variables or boxity variables, - tyConUnique :: Unique, - tyConName :: Name + argVrcs :: ArgVrcs } type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)] + -- [] means "no information, assume the worst" + +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 -data AlgTyConFlavour - = DataTyCon -- Data type + | DataTyCon + [DataCon] -- The constructors; can be empty if the user declares + -- the type to have no constructors + Bool -- Cached: True <=> an enumeration type - | EnumTyCon -- Special sort of enumeration type + | NewTyCon -- Newtypes always have exactly one constructor + DataCon -- The unique constructor; it has no existentials + Type -- Cached: the argument type of the constructor + -- = the representation type of the tycon - | NewTyCon Type -- Newtype, with its *ultimate* representation type + Type -- Cached: the *ultimate* representation type -- By 'ultimate' I mean that the rep type is not itself -- a newtype or type synonym. -- The rep type isn't entirely simple: @@ -191,24 +181,50 @@ data AlgTyConFlavour -- The rep type is [(a,Int)] -- NB: the rep type isn't necessarily the original RHS of the -- newtype decl, because the rep type looks through other - -- newtypes. If you want hte original RHS, look at the - -- argument type of the data constructor. + -- newtypes. -data DataConDetails datacon - = DataCons [datacon] -- Its data constructors, with fully polymorphic types - -- A type can have zero constructors +visibleDataCons :: AlgTyConRhs -> [DataCon] +visibleDataCons AbstractTyCon = [] +visibleDataCons (DataTyCon cs _) = cs +visibleDataCons (NewTyCon c _ _) = [c] +\end{code} - | Unknown -- We're importing this data type from an hi-boot file - -- and we don't know what its constructors are +%************************************************************************ +%* * +\subsection{PrimRep} +%* * +%************************************************************************ - | HasCons Int -- In a quest for compilation speed we have imported - -- only the number of constructors (to get return - -- conventions right) but not the constructors themselves +A PrimRep is an abstraction of a type. It contains information that +the code generator needs in order to pass arguments, return results, +and store values of this type. -visibleDataCons (DataCons cs) = cs -visibleDataCons other = [] -\end{code} +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 +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 -- signed, word-sized + | WordRep -- unsinged, word-sized + | Int64Rep -- signed, 64 bit (32-bit words only) + | Word64Rep -- unsigned, 64 bit (32-bit words only) + | AddrRep -- a pointer, but not to a Haskell value + | FloatRep + | DoubleRep +\end{code} %************************************************************************ %* * @@ -223,21 +239,6 @@ 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} -mkSuperKindCon :: Name -> SuperKindCon -mkSuperKindCon name = SuperKindCon { - tyConUnique = nameUnique name, - tyConName = name - } - -mkKindCon :: Name -> SuperKind -> KindCon -mkKindCon name kind - = KindCon { - tyConUnique = nameUnique name, - tyConName = name, - tyConArity = 0, - tyConKind = kind - } - mkFunTyCon :: Name -> Kind -> TyCon mkFunTyCon name kind = FunTyCon { @@ -247,53 +248,39 @@ mkFunTyCon name kind tyConArity = 2 } -tyConGenInfo :: TyCon -> Maybe (EP Id) -tyConGenInfo (AlgTyCon { genInfo = info }) = info -tyConGenInfo (TupleTyCon { genInfo = info }) = info -tyConGenInfo other = Nothing - -tyConGenIds :: TyCon -> [Id] --- Returns the generic-programming Ids; these Ids need bindings -tyConGenIds tycon = case tyConGenInfo tycon of - Nothing -> [] - Just (EP from to) -> [from,to] - -- 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 theta argvrcs cons sels flavour rec - gen_info +mkAlgTyCon name kind tyvars theta argvrcs rhs sels is_rec gen_info = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - tyConArgVrcs = argvrcs, - algTyConTheta = theta, - dataCons = cons, - selIds = sels, - algTyConClass = Nothing, - algTyConFlavour = flavour, - algTyConRec = rec, - genInfo = gen_info + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTyConTheta = theta, + algRhs = rhs, + selIds = sels, + algTyConClass = Nothing, + algTyConRec = is_rec, + hasGenerics = gen_info } -mkClassTyCon name kind tyvars argvrcs con clas flavour rec +mkClassTyCon name kind tyvars argvrcs rhs clas is_rec = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - tyConArgVrcs = argvrcs, - algTyConTheta = [], - dataCons = DataCons [con], - selIds = [], - algTyConClass = Just clas, - algTyConFlavour = flavour, - algTyConRec = rec, - genInfo = Nothing + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTyConTheta = [], + algRhs = rhs, + selIds = [], + algTyConClass = Just clas, + algTyConRec = is_rec, + hasGenerics = False } @@ -306,22 +293,21 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info tyConBoxed = boxed, tyConTyVars = tyvars, dataCon = con, - genInfo = gen_info + hasGenerics = gen_info } -- Foreign-imported (.NET) type constructors are represented -- 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 --- They have PtrRep mkForeignTyCon name ext_name kind arity arg_vrcs = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = arity, - tyConArgVrcs = arg_vrcs, - primTyConRep = PtrRep, + argVrcs = arg_vrcs, + primTyConRep = PtrRep, -- they all do isUnLifted = False, tyConExtName = ext_name } @@ -341,25 +327,22 @@ mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted tyConUnique = nameUnique name, tyConKind = kind, tyConArity = arity, - tyConArgVrcs = arg_vrcs, + argVrcs = arg_vrcs, primTyConRep = rep, isUnLifted = is_unlifted, tyConExtName = Nothing } -mkSynTyCon name kind arity tyvars rhs argvrcs +mkSynTyCon name kind tyvars rhs argvrcs = SynTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, - tyConArity = arity, + tyConArity = length tyvars, tyConTyVars = tyvars, synTyConDefn = rhs, - tyConArgVrcs = argvrcs + argVrcs = argvrcs } - -setTyConName tc name = tc {tyConName = name, tyConUnique = nameUnique name} - \end{code} \begin{code} @@ -367,6 +350,10 @@ isFunTyCon :: TyCon -> Bool isFunTyCon (FunTyCon {}) = True isFunTyCon _ = False +isAbstractTyCon :: TyCon -> Bool +isAbstractTyCon (AlgTyCon { algRhs = AbstractTyCon }) = True +isAbstractTyCon _ = False + isPrimTyCon :: TyCon -> Bool isPrimTyCon (PrimTyCon {}) = True isPrimTyCon _ = False @@ -376,19 +363,16 @@ isUnLiftedTyCon (PrimTyCon {isUnLifted = is_unlifted}) = is_unlifted isUnLiftedTyCon (TupleTyCon {tyConBoxed = boxity}) = not (isBoxed boxity) isUnLiftedTyCon _ = False --- isBoxedTyCon should not be applied to SynTyCon, nor KindCon -isBoxedTyCon :: TyCon -> Bool -isBoxedTyCon (AlgTyCon {}) = True -isBoxedTyCon (FunTyCon {}) = True -isBoxedTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity -isBoxedTyCon (PrimTyCon {primTyConRep = rep}) = isFollowableRep rep - -- isAlgTyCon returns True for both @data@ and @newtype@ isAlgTyCon :: TyCon -> Bool isAlgTyCon (AlgTyCon {}) = True isAlgTyCon (TupleTyCon {}) = True isAlgTyCon other = False +algTyConRhs :: TyCon -> AlgTyConRhs +algTyConRhs (AlgTyCon {algRhs = rhs}) = rhs +algTyConRhs (TupleTyCon {dataCon = dc}) = DataTyCon [dc] False + isDataTyCon :: TyCon -> Bool -- isDataTyCon returns True for data types that are represented by -- heap-allocated constructors. @@ -397,17 +381,18 @@ isDataTyCon :: TyCon -> Bool -- True for all @data@ types -- False for newtypes -- unboxed tuples -isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data}) - = case new_or_data of - NewTyCon _ -> False - other -> True +isDataTyCon (AlgTyCon {algRhs = rhs}) + = case rhs of + DataTyCon _ _ -> True + NewTyCon _ _ _ -> False + AbstractTyCon -> panic "isDataTyCon" isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algTyConFlavour = NewTyCon _}) = True -isNewTyCon other = False +isNewTyCon (AlgTyCon {algRhs = NewTyCon _ _ _}) = True +isNewTyCon other = False isProductTyCon :: TyCon -> Bool -- A "product" tycon @@ -417,17 +402,20 @@ isProductTyCon :: TyCon -> Bool -- may be DataType or NewType, -- may be unboxed or not, -- may be recursive or not -isProductTyCon (AlgTyCon {dataCons = DataCons [data_con]}) = not (isExistentialDataCon data_con) -isProductTyCon (TupleTyCon {}) = True -isProductTyCon other = False +isProductTyCon tc@(AlgTyCon {}) = case algRhs tc of + DataTyCon [data_con] _ -> not (isExistentialDataCon data_con) + NewTyCon _ _ _ -> True + other -> False +isProductTyCon (TupleTyCon {}) = True +isProductTyCon other = False isSynTyCon :: TyCon -> Bool isSynTyCon (SynTyCon {}) = True isSynTyCon _ = False isEnumerationTyCon :: TyCon -> Bool -isEnumerationTyCon (AlgTyCon {algTyConFlavour = EnumTyCon}) = True -isEnumerationTyCon other = False +isEnumerationTyCon (AlgTyCon {algRhs = DataTyCon _ is_enum}) = is_enum +isEnumerationTyCon other = False isTupleTyCon :: TyCon -> Bool -- The unit tycon didn't used to be classed as a tuple tycon @@ -450,18 +438,22 @@ isRecursiveTyCon :: TyCon -> Bool isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True isRecursiveTyCon other = False +isHiBootTyCon :: TyCon -> Bool +-- Used for knot-tying in hi-boot files +isHiBootTyCon (AlgTyCon {algRhs = AbstractTyCon}) = True +isHiBootTyCon other = False + isForeignTyCon :: TyCon -> Bool -- isForeignTyCon identifies foreign-imported type constructors --- For the moment, they are primitive but lifted, but that may change -isForeignTyCon (PrimTyCon {isUnLifted = is_unlifted}) = not is_unlifted -isForeignTyCon other = False +isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True +isForeignTyCon other = False \end{code} \begin{code} -tyConDataConDetails :: TyCon -> DataConDetails DataCon -tyConDataConDetails (AlgTyCon {dataCons = cons}) = cons -tyConDataConDetails (TupleTyCon {dataCon = con}) = DataCons [con] -tyConDataConDetails other = Unknown +tyConHasGenerics :: TyCon -> Bool +tyConHasGenerics (AlgTyCon {hasGenerics = hg}) = hg +tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg +tyConHasGenerics other = False -- Synonyms tyConDataCons :: TyCon -> [DataCon] -- It's convenient for tyConDataCons to return the @@ -469,14 +461,15 @@ tyConDataCons :: TyCon -> [DataCon] tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` [] tyConDataCons_maybe :: TyCon -> Maybe [DataCon] -tyConDataCons_maybe (AlgTyCon {dataCons = DataCons cons}) = Just cons -tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] -tyConDataCons_maybe other = Nothing +tyConDataCons_maybe (AlgTyCon {algRhs = DataTyCon cons _}) = Just cons +tyConDataCons_maybe (AlgTyCon {algRhs = NewTyCon con _ _}) = Just [con] +tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] +tyConDataCons_maybe other = Nothing tyConFamilySize :: TyCon -> Int -tyConFamilySize (AlgTyCon {dataCons = DataCons cs}) = length cs -tyConFamilySize (AlgTyCon {dataCons = HasCons n}) = n -tyConFamilySize (TupleTyCon {}) = 1 +tyConFamilySize (AlgTyCon {algRhs = DataTyCon cons _}) = length cons +tyConFamilySize (AlgTyCon {algRhs = NewTyCon _ _ _}) = 1 +tyConFamilySize (TupleTyCon {}) = 1 #ifdef DEBUG tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) #endif @@ -488,14 +481,16 @@ tyConSelIds other_tycon = [] \begin{code} newTyConRep :: TyCon -> ([TyVar], Type) -newTyConRep (AlgTyCon {tyConTyVars = tvs, algTyConFlavour = NewTyCon rep}) = (tvs, rep) +newTyConRep (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ _ rep}) = (tvs, rep) +newTyConRhs :: TyCon -> ([TyVar], Type) +newTyConRhs (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ rhs _}) = (tvs, rhs) +\end{code} + +\begin{code} tyConPrimRep :: TyCon -> PrimRep tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep -tyConPrimRep tc = ASSERT( not (isUnboxedTupleTyCon tc) ) - PtrRep - -- We should not be asking what the representation of an - -- unboxed tuple is, because it isn't a first class value. +tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep \end{code} \begin{code} @@ -510,14 +505,12 @@ each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is actually computed (in another file). \begin{code} -tyConArgVrcs_maybe :: TyCon -> Maybe ArgVrcs - -tyConArgVrcs_maybe (FunTyCon {} ) = Just [(False,True),(True,False)] -tyConArgVrcs_maybe (AlgTyCon {tyConArgVrcs = oi}) = Just oi -tyConArgVrcs_maybe (PrimTyCon {tyConArgVrcs = oi}) = Just oi -tyConArgVrcs_maybe (TupleTyCon {tyConArity = arity }) = Just (replicate arity (True,False)) -tyConArgVrcs_maybe (SynTyCon {tyConArgVrcs = oi }) = Just oi -tyConArgVrcs_maybe _ = Nothing +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} @@ -527,8 +520,9 @@ getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,t \begin{code} maybeTyConSingleCon :: TyCon -> Maybe DataCon -maybeTyConSingleCon (AlgTyCon {dataCons = DataCons [c]}) = Just c -maybeTyConSingleCon (AlgTyCon {}) = Nothing +maybeTyConSingleCon (AlgTyCon {algRhs = DataTyCon [c] _}) = Just c +maybeTyConSingleCon (AlgTyCon {algRhs = NewTyCon c _ _}) = Just c +maybeTyConSingleCon (AlgTyCon {}) = Nothing maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con maybeTyConSingleCon (PrimTyCon {}) = Nothing maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty @@ -578,28 +572,3 @@ instance Outputable TyCon where instance NamedThing TyCon where getName = tyConName \end{code} - - -%************************************************************************ -%* * -\subsection{Kind constructors} -%* * -%************************************************************************ - -@matchesTyCon tc1 tc2@ checks whether an appliation -(tc1 t1..tn) matches (tc2 t1..tn). By "matches" we basically mean "equals", -except that at the kind level tc2 might have more boxity info than tc1. - -\begin{code} -matchesTyCon :: TyCon -- Expected (e.g. arg type of function) - -> TyCon -- Inferred (e.g. type of actual arg to function) - -> Bool - -matchesTyCon tc1 tc2 = uniq1 == uniq2 || uniq1 == anyBoxConKey - where - uniq1 = tyConUnique tc1 - uniq2 = tyConUnique tc2 -\end{code} - - -