X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=6f8803c365bdb9465653899d7dae78d84d77d03e;hb=fb6d198f498d4e325a540f28aaa6e1d1530839c3;hp=09caf8e31cbdbe5ae3cc0921c157540d9c3bd409;hpb=2cd930397966d27a221998c8ac060151e2027e90;p=ghc-hetmet.git diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 09caf8e..6f8803c 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -13,19 +13,21 @@ module TyCon( AlgTyConRhs(..), visibleDataCons, TyConParent(..), SynTyConRhs(..), + AssocFamilyPermutation, -- ** Constructing TyCons mkAlgTyCon, mkClassTyCon, mkFunTyCon, mkPrimTyCon, - mkVoidPrimTyCon, + mkKindTyCon, mkLiftedPrimTyCon, mkTupleTyCon, mkSynTyCon, mkSuperKindTyCon, mkCoercionTyCon, mkForeignTyCon, + mkAnyTyCon, -- ** Predicates on TyCons isAlgTyCon, @@ -36,8 +38,9 @@ module TyCon( isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, isSuperKindTyCon, isCoercionTyCon, isCoercionTyCon_maybe, - isForeignTyCon, + isForeignTyCon, isAnyTyCon, + isInjectiveTyCon, isDataTyCon, isProductTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isOpenTyCon, isUnLiftedTyCon, @@ -54,7 +57,6 @@ module TyCon( tyConTyVars, tyConDataCons, tyConDataCons_maybe, tyConSingleDataCon_maybe, tyConFamilySize, - tyConSelIds, tyConStupidTheta, tyConArity, tyConClass_maybe, @@ -92,6 +94,7 @@ import Maybes import Outputable import FastString import Constants +import Data.List( elemIndex ) \end{code} %************************************************************************ @@ -101,7 +104,7 @@ import Constants %************************************************************************ \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 @*@ -- @@ -112,7 +115,7 @@ import Constants -- 4) Class declarations: @class Foo where@ creates the @Foo@ type constructor of kind @*@ -- -- 5) Type coercions! This is because we represent a coercion from @t1@ to @t2@ as a 'Type', where --- that type has kind @t1 :=: t2@. See "Coercion" for more on this +-- that type has kind @t1 ~ t2@. See "Coercion" for more on this -- -- This data type also encodes a number of primitive, built in type constructors such as those -- for function and tuple types. @@ -144,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 ...@. @@ -198,20 +200,22 @@ 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 + primTyConRep :: PrimRep, -- ^ Many primitive tycons are unboxed, but some are + -- boxed (represented by pointers). This 'PrimRep' holds + -- that information. + -- Only relevant if tyConKind = * - 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 + 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 } - -- | Type coercions, such as @(:=:)@, @sym@, @trans@, @left@ and @right@. + -- | Type coercions, such as @(~)@, @sym@, @trans@, @left@ and @right@. -- INVARIANT: coercions are always fully applied | CoercionTyCon { tyConUnique :: Unique, @@ -226,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 @@ -260,17 +277,7 @@ data AlgTyConRhs -- > data T b :: * | OpenTyCon { - - otArgPoss :: Maybe [Int] - -- ^ @Nothing@ iff this is a top-level indexed type family. - -- @Just ns@ iff this is an associated (not top-level) family - -- - -- In the latter case, for each 'TyVar' in the associated type declaration, - -- @ns@ gives the position of that tyvar in the class argument list (starting - -- from 0). - -- - -- NB: The length of this list is less than the accompanying 'tyConArity' iff - -- we have a higher kind signature. + otArgPoss :: AssocFamilyPermutation } -- | Information about those 'TyCon's derived from a @data@ declaration. This includes @@ -316,6 +323,18 @@ data AlgTyConRhs -- again check Trac #1072. } +type AssocFamilyPermutation + = Maybe [Int] -- Nothing for *top-level* type families + -- For *associated* type families, gives the position + -- of that 'TyVar' in the class argument list (0-indexed) + -- e.g. class C a b c where { type F c a :: *->* } + -- Then we get Just [2,0] + -- For *synonyms*, the length of the list is identical to + -- the TyCon's arity + -- For *data types*, the length may be smaller than the + -- TyCon's arity; e.g. class C a where { data D a :: *->* } + -- here D gets arity 2 + -- | Extract those 'DataCon's that we are able to learn about. Note that visibility in this sense does not -- correspond to visibility in the context of any particular user program! visibleDataCons :: AlgTyConRhs -> [DataCon] @@ -369,16 +388,10 @@ okParent _ (FamilyTyCon fam_tc tys _co_tc) = tyConArity fam_tc == length t -- | Information pertaining to the expansion of a type synonym (@type@) data SynTyConRhs - = OpenSynTyCon Kind - (Maybe [Int]) -- ^ A Type family synonym. The /result/ 'Kind' is - -- given for associated families, and in this case the - -- list of @Int@s is not empty, and for each 'TyVar' in - -- the associated type declaration, it gives the position - -- of that 'TyVar' in the class argument list (starting - -- from 0). - -- - -- NB: The length of this list will be less than 'tyConArity' iff - -- the family has a higher kind signature. + = OpenSynTyCon -- e.g. type family F x y :: * -> * + Kind -- Kind of the "rhs"; ie *excluding type indices* + -- In the example, the kind is (*->*) + AssocFamilyPermutation | SynonymTyCon Type -- ^ The synonym mentions head type variables. It acts as a -- template for the expansion when the 'TyCon' is applied to some @@ -393,7 +406,7 @@ 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 -> +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 @@ -403,11 +416,11 @@ ending with the same type variables as the left hand side, we newtype S a = MkT [a] -then we would generate the arity 0 coercion CoS : S :=: []. The +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]) + 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]) @@ -418,7 +431,7 @@ 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] + axiom CoT t : T t ~ [t] Note [Newtype eta] ~~~~~~~~~~~~~~~~~~ @@ -499,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 @@ -576,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, @@ -591,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, @@ -601,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' @@ -649,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 @@ -694,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 @@ -818,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 @@ -836,14 +864,22 @@ assocTyConArgPoss_maybe _ = Nothing isTyConAssoc :: TyCon -> Bool isTyConAssoc = isJust . assocTyConArgPoss_maybe --- | Sets up a 'TyVar' to family argument-list mapping in the given 'TyCon' if it is --- an open 'TyCon'. Panics otherwise -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) +-- | Set the AssocFamilyPermutation structure in an +-- associated data or type synonym. The [TyVar] are the +-- class type variables. Remember, the tyvars of an associated +-- data/type are a subset of the class tyvars; except that an +-- associated data type can have extra type variables at the +-- end (see Note [Avoid name clashes for associated data types] in TcHsType) +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] + -- We will get Nothings for the "extra" type variables in an + -- associated data type -- The unit tycon didn't used to be classed as a tuple tycon -- but I thought that was silly so I've undone it @@ -894,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 @@ -953,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 @@ -1007,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 @@ -1089,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}