X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=6f8803c365bdb9465653899d7dae78d84d77d03e;hp=fdd21be02b95ec23c3c3b7f739ca60bc76120091;hb=388e3356f71daffa62f1d4157e1e07e4c68f218a;hpb=46934dd87e13143ec2e97f075309a9e2c0945889 diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index fdd21be..6f8803c 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -20,13 +20,14 @@ module TyCon( mkClassTyCon, mkFunTyCon, mkPrimTyCon, - mkVoidPrimTyCon, + mkKindTyCon, mkLiftedPrimTyCon, mkTupleTyCon, mkSynTyCon, mkSuperKindTyCon, mkCoercionTyCon, mkForeignTyCon, + mkAnyTyCon, -- ** Predicates on TyCons isAlgTyCon, @@ -37,8 +38,9 @@ module TyCon( isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, isSuperKindTyCon, isCoercionTyCon, isCoercionTyCon_maybe, - isForeignTyCon, + isForeignTyCon, isAnyTyCon, + isInjectiveTyCon, isDataTyCon, isProductTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isOpenTyCon, isUnLiftedTyCon, @@ -55,7 +57,6 @@ module TyCon( tyConTyVars, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConFamilySize, - tyConSelIds, tyConStupidTheta, tyConArity, tyConClass_maybe, @@ -103,7 +104,7 @@ import Data.List( elemIndex ) %************************************************************************ \begin{code} --- | Represents type constructors. Type constructors are introduced by things such as: +-- | TyCons represent type constructors. Type constructors are introduced by things such as: -- -- 1) Data declarations: @data Foo = ...@ creates the @Foo@ type constructor of kind @*@ -- @@ -146,12 +147,11 @@ data TyCon -- -- Note that it does /not/ scope over the data constructors. - algTcSelIds :: [Id], -- ^ The record selectors of this type (possibly emptys) - algTcGadtSyntax :: Bool, -- ^ Was the data type declared with GADT syntax? If so, -- that doesn't mean it's a true GADT; only that the "where" -- form was used. This field is used only to guide -- pretty-printing + algTcStupidTheta :: [PredType], -- ^ The \"stupid theta\" for the data type (always empty for GADTs). -- A \"stupid theta\" is the context to the left of an algebraic type -- declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@. @@ -200,17 +200,19 @@ data TyCon tyConUnique :: Unique, tyConName :: Name, tyConKind :: Kind, - tyConArity :: Arity, -- SLPJ Oct06: I'm not sure what the significance - -- of the arity of a primtycon is! + 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 + -- boxed (represented by pointers). This 'PrimRep' holds + -- that information. + -- Only relevant if tyConKind = * - primTyConRep :: PrimRep, - -- ^ Many primitive tycons are unboxed, but some are - -- boxed (represented by pointers). This 'PrimRep' holds - -- that information + isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted (may not contain bottom) + -- but foreign-imported ones may be lifted - isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted (may not contain bottom) - -- but foreign-imported ones may be lifted - tyConExtName :: Maybe FastString -- ^ @Just e@ for foreign-imported types, holds the name of the imported thing + tyConExtName :: Maybe FastString -- ^ @Just e@ for foreign-imported types, + -- holds the name of the imported thing } -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@. @@ -228,6 +230,19 @@ data TyCon -- the kind as a pair of types: @(ta, tc)@ } + -- | Any types. Like tuples, this is a potentially-infinite family of TyCons + -- one for each distinct Kind. They have no values at all. + -- Because there are infinitely many of them (like tuples) they are + -- defined in GHC.Prim and have names like "Any(*->*)". + -- Their Unique is derived from the OccName. + -- See Note [Any types] in TysPrim + | AnyTyCon { + tyConUnique :: Unique, + tyConName :: Name, + tyConKind :: Kind -- Never = *; that is done via PrimTyCon + -- See Note [Any types] in TysPrim + } + -- | Super-kinds. These are "kinds-of-kinds" and are never seen in Haskell source programs. -- There are only two super-kinds: TY (aka "box"), which is the super-kind of kinds that -- construct types eventually, and CO (aka "diamond"), which is the super-kind of kinds @@ -497,7 +512,7 @@ Then %************************************************************************ 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 +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 @@ -574,13 +589,12 @@ mkAlgTyCon :: Name -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'. Arity is inferred from the length of this list -> [PredType] -- ^ Stupid theta: see 'algTcStupidTheta' -> AlgTyConRhs -- ^ Information about dat aconstructors - -> [Id] -- ^ Selector 'Id's -> TyConParent -> RecFlag -- ^ Is the 'TyCon' recursive? -> Bool -- ^ Does it have generic functions? See 'hasGenerics' -> Bool -- ^ Was the 'TyCon' declared with GADT syntax? -> TyCon -mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn +mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, @@ -589,7 +603,6 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn tyConTyVars = tyvars, algTcStupidTheta = stupid, algTcRhs = rhs, - algTcSelIds = sel_ids, algTcParent = ASSERT( okParent name parent ) parent, algTcRec = is_rec, algTcGadtSyntax = gadt_syn, @@ -599,7 +612,7 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn -- | Simpler specialization of 'mkAlgTyCon' for classes 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 + mkAlgTyCon name kind tyvars [] rhs (ClassTyCon clas) is_rec False False mkTupleTyCon :: Name -> Kind -- ^ Kind of the resulting 'TyCon' @@ -647,10 +660,10 @@ mkPrimTyCon :: Name -> Kind -> Arity -> PrimRep -> TyCon mkPrimTyCon name kind arity rep = mkPrimTyCon' name kind arity rep True --- | Create the special void 'TyCon' which is unlifted and has 'VoidRep' -mkVoidPrimTyCon :: Name -> Kind -> Arity -> TyCon -mkVoidPrimTyCon name kind arity - = mkPrimTyCon' name kind arity VoidRep True +-- | Kind constructors +mkKindTyCon :: Name -> Kind -> TyCon +mkKindTyCon name kind + = mkPrimTyCon' name kind 0 VoidRep True -- | Create a lifted primitive 'TyCon' such as @RealWorld@ mkLiftedPrimTyCon :: Name -> Kind -> Arity -> PrimRep -> TyCon @@ -692,6 +705,12 @@ mkCoercionTyCon name arity kindRule coKindFun = kindRule } +mkAnyTyCon :: Name -> Kind -> TyCon +mkAnyTyCon name kind + = AnyTyCon { tyConName = name, + tyConKind = kind, + tyConUnique = nameUnique name } + -- | Create a super-kind 'TyCon' mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero mkSuperKindTyCon name @@ -816,9 +835,20 @@ isEnumerationTyCon _ = False -- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear? isOpenTyCon :: TyCon -> Bool -isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True -isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {} }) = True -isOpenTyCon _ = False +isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon {}}) = True +isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}}) = True +isOpenTyCon _ = False + +-- | Injective 'TyCon's can be decomposed, so that +-- T ty1 ~ T ty2 => ty1 ~ ty2 +isInjectiveTyCon :: TyCon -> Bool +isInjectiveTyCon tc = not (isSynTyCon tc) + -- Ultimately we may have injective associated types + -- in which case this test will become more interesting + -- + -- It'd be unusual to call isInjectiveTyCon on a regular H98 + -- type synonym, because you should probably have expanded it first + -- But regardless, it's not injective! -- | Extract the mapping from 'TyVar' indexes to indexes in the corresponding family -- argument lists form an open 'TyCon' of any sort, if the given 'TyCon' is indeed @@ -900,6 +930,11 @@ isSuperKindTyCon :: TyCon -> Bool isSuperKindTyCon (SuperKindTyCon {}) = True isSuperKindTyCon _ = False +-- | Is this an AnyTyCon? +isAnyTyCon :: TyCon -> Bool +isAnyTyCon (AnyTyCon {}) = True +isAnyTyCon _ = False + -- | Attempt to pull a 'TyCon' apart into the arity and 'coKindFun' of -- a coercion 'TyCon'. Returns @Nothing@ if the 'TyCon' is not of the -- appropriate kind @@ -959,7 +994,7 @@ tcExpandTyCon_maybe _ _ = Nothing -- ^ Used to create the view /Core/ has on 'TyCon's. We expand not only closed synonyms like 'tcExpandTyCon_maybe', -- but also non-recursive @newtype@s -coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive +coreExpandTyCon_maybe (AlgTyCon { 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 @@ -1013,11 +1048,6 @@ tyConFamilySize (AlgTyCon {algTcRhs = OpenTyCon {}}) = 0 tyConFamilySize (TupleTyCon {}) = 1 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) --- | Extract the record selector 'Id's from an algebraic 'TyCon' and returns the empty list otherwise -tyConSelIds :: TyCon -> [Id] -tyConSelIds (AlgTyCon {algTcSelIds = fs}) = fs -tyConSelIds _ = [] - -- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple -- 'TyCon'. Panics for any other sort of 'TyCon' algTyConRhs :: TyCon -> AlgTyConRhs @@ -1095,13 +1125,10 @@ synTyConResKind tycon = pprPanic "synTyConResKind" (ppr tycon) -- has more than one constructor, or represents a primitive or function type constructor then -- @Nothing@ is returned. In any other case, the function panics 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 -- case at funty -tyConSingleDataCon_maybe tc = pprPanic "tyConSingleDataCon_maybe: unexpected tycon " $ ppr tc +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}