X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=09596993569fc1eab3e51e2e734b344f387bdfd2;hb=0252f1a49233b7618dc8923f257a37579802fce9;hp=120e1b95e69a9fe4b850936a54afee3ecbade14e;hpb=9ffadf219cbc4f8ec57264786df936a3cee88aec;p=ghc-hetmet.git diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 120e1b9..0959699 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -8,11 +8,12 @@ The @TyCon@ datatype \begin{code} module TyCon( -- * Main TyCon data types - TyCon, FieldLabel, + TyCon, FieldLabel, AlgTyConRhs(..), visibleDataCons, TyConParent(..), SynTyConRhs(..), + CoTyConDesc(..), AssocFamilyPermutation, -- ** Constructing TyCons @@ -20,13 +21,14 @@ module TyCon( mkClassTyCon, mkFunTyCon, mkPrimTyCon, - mkVoidPrimTyCon, + mkKindTyCon, mkLiftedPrimTyCon, mkTupleTyCon, mkSynTyCon, mkSuperKindTyCon, mkCoercionTyCon, mkForeignTyCon, + mkAnyTyCon, -- ** Predicates on TyCons isAlgTyCon, @@ -35,10 +37,11 @@ module TyCon( isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, - isSuperKindTyCon, + isSuperKindTyCon, isDecomposableTyCon, isCoercionTyCon, isCoercionTyCon_maybe, - isForeignTyCon, + isForeignTyCon, isAnyTyCon, tyConHasKind, + isInjectiveTyCon, isDataTyCon, isProductTyCon, isEnumerationTyCon, isNewTyCon, isAbstractTyCon, isOpenTyCon, isUnLiftedTyCon, @@ -102,7 +105,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 @*@ -- @@ -122,7 +125,7 @@ data TyCon FunTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity } @@ -131,7 +134,7 @@ data TyCon | AlgTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity, tyConTyVars :: [TyVar], -- ^ The type variables used in the type constructor. @@ -149,6 +152,7 @@ data TyCon -- 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 ...@. @@ -168,7 +172,7 @@ data TyCon | TupleTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity, tyConBoxed :: Boxity, tyConTyVars :: [TyVar], @@ -180,7 +184,7 @@ data TyCon | SynTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity, tyConTyVars :: [TyVar], -- Bound tyvars @@ -196,33 +200,44 @@ data TyCon | PrimTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, - 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 - - 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 + tc_kind :: Kind, + 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 tc_kind = * + + 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@. - -- INVARIANT: coercions are always fully applied - | CoercionTyCon { + -- INVARIANT: Coercion TyCons are always fully applied + -- But note that a CoTyCon can be *over*-saturated in a type. + -- E.g. (sym g1) Int will be represented as (TyConApp sym [g1,Int]) + | CoTyCon { tyConUnique :: Unique, tyConName :: Name, tyConArity :: Arity, - coKindFun :: [Type] -> (Type,Type) - -- ^ Function that when given a list of the type arguments to the 'TyCon' - -- constructs the types that the resulting coercion relates. - -- - -- INVARIANT: 'coKindFun' is always applied to exactly 'tyConArity' args - -- E.g. for @trans (c1 :: ta=tb) (c2 :: tb=tc)@, the 'coKindFun' returns - -- the kind as a pair of types: @(ta, tc)@ + coTcDesc :: CoTyConDesc + } + + -- | 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, + tc_kind :: 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. @@ -293,7 +308,7 @@ data AlgTyConRhs -- See Note [Newtype eta] - nt_co :: Maybe TyCon -- ^ A 'TyCon' (which is always a 'CoercionTyCon') that can have a 'Coercion' + nt_co :: Maybe TyCon -- ^ A 'TyCon' (which is always a 'CoTyCon') that can have a 'Coercion' -- extracted from it to create the @newtype@ from the representation 'Type'. -- -- This field is optional for non-recursive @newtype@s only. @@ -346,7 +361,7 @@ data TyConParent -- of the current 'TyCon' (not the family one). INVARIANT: -- the number of types matches the arity of the family 'TyCon' -- - -- 3) A 'CoercionTyCon' identifying the representation + -- 3) A 'CoTyCon' identifying the representation -- type with the type instance family | FamilyTyCon TyCon @@ -378,6 +393,20 @@ data SynTyConRhs | SynonymTyCon Type -- ^ The synonym mentions head type variables. It acts as a -- template for the expansion when the 'TyCon' is applied to some -- types. + +-------------------- +data CoTyConDesc + = CoSym | CoTrans + | CoLeft | CoRight + | CoCsel1 | CoCsel2 | CoCselR + | CoInst + + | CoAxiom -- C tvs : F lhs-tys ~ rhs-ty + { co_ax_tvs :: [TyVar] + , co_ax_lhs :: Type + , co_ax_rhs :: Type } + + | CoUnsafe \end{code} Note [Newtype coercions] @@ -389,7 +418,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 -> -t. This TyCon is a CoercionTyCon, so it does not have a kind on its +t. This TyCon is a CoTyCon, 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 @@ -407,7 +436,7 @@ 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, +But in GHC we instead make CoT into a new piece of type syntax, CoTyCon, (like instCoercionTyCon, symCoercionTyCon etc), which must always be saturated, but which encodes as TyConApp CoT [s] @@ -494,7 +523,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 @@ -560,7 +589,7 @@ mkFunTyCon name kind = FunTyCon { tyConUnique = nameUnique name, tyConName = name, - tyConKind = kind, + tc_kind = kind, tyConArity = 2 } @@ -580,7 +609,7 @@ mkAlgTyCon name kind tyvars stupid rhs parent is_rec gen_info gadt_syn = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, - tyConKind = kind, + tc_kind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, algTcStupidTheta = stupid, @@ -608,7 +637,7 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info = TupleTyCon { tyConUnique = nameUnique name, tyConName = name, - tyConKind = kind, + tc_kind = kind, tyConArity = arity, tyConBoxed = boxed, tyConTyVars = tyvars, @@ -629,7 +658,7 @@ mkForeignTyCon name ext_name kind arity = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, - tyConKind = kind, + tc_kind = kind, tyConArity = arity, primTyConRep = PtrRep, -- they all do isUnLifted = False, @@ -642,10 +671,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 @@ -657,7 +686,7 @@ mkPrimTyCon' name kind arity rep is_unlifted = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, - tyConKind = kind, + tc_kind = kind, tyConArity = arity, primTyConRep = rep, isUnLifted = is_unlifted, @@ -670,7 +699,7 @@ mkSynTyCon name kind tyvars rhs parent = SynTyCon { tyConName = name, tyConUnique = nameUnique name, - tyConKind = kind, + tc_kind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, synTcRhs = rhs, @@ -678,14 +707,21 @@ mkSynTyCon name kind tyvars rhs parent } -- | Create a coercion 'TyCon' -mkCoercionTyCon :: Name -> Arity -> ([Type] -> (Type,Type)) -> TyCon -mkCoercionTyCon name arity kindRule - = CoercionTyCon { - tyConName = name, +mkCoercionTyCon :: Name -> Arity + -> CoTyConDesc + -> TyCon +mkCoercionTyCon name arity desc + = CoTyCon { + tyConName = name, tyConUnique = nameUnique name, - tyConArity = arity, - coKindFun = kindRule - } + tyConArity = arity, + coTcDesc = desc } + +mkAnyTyCon :: Name -> Kind -> TyCon +mkAnyTyCon name kind + = AnyTyCon { tyConName = name, + tc_kind = kind, + tyConUnique = nameUnique name } -- | Create a super-kind 'TyCon' mkSuperKindTyCon :: Name -> TyCon -- Super kinds always have arity zero @@ -799,6 +835,13 @@ isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon) isOpenSynTyCon :: TyCon -> Bool isOpenSynTyCon tycon = isSynTyCon tycon && isOpenTyCon tycon +isDecomposableTyCon :: TyCon -> Bool +-- True iff we can deocmpose (T a b c) into ((T a b) c) +-- Specifically NOT true of synonyms (open and otherwise) and coercions +isDecomposableTyCon (SynTyCon {}) = False +isDecomposableTyCon (CoTyCon {}) = False +isDecomposableTyCon _other = True + -- | Is this an algebraic 'TyCon' declared with the GADT syntax? isGadtSyntaxTyCon :: TyCon -> Bool isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res @@ -807,13 +850,25 @@ isGadtSyntaxTyCon _ = False -- | Is this an algebraic 'TyCon' which is just an enumeration of values? isEnumerationTyCon :: TyCon -> Bool isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res +isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0 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 @@ -895,18 +950,23 @@ 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 -isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, [Type] -> (Type,Type)) -isCoercionTyCon_maybe (CoercionTyCon {tyConArity = ar, coKindFun = rule}) - = Just (ar, rule) +isCoercionTyCon_maybe :: TyCon -> Maybe (Arity, CoTyConDesc) +isCoercionTyCon_maybe (CoTyCon {tyConArity = ar, coTcDesc = desc}) + = Just (ar, desc) isCoercionTyCon_maybe _ = Nothing -- | Is this a 'TyCon' that represents a coercion? isCoercionTyCon :: TyCon -> Bool -isCoercionTyCon (CoercionTyCon {}) = True -isCoercionTyCon _ = False +isCoercionTyCon (CoTyCon {}) = True +isCoercionTyCon _ = False -- | Identifies implicit tycons that, in particular, do not go into interface -- files (because they are implicitly reconstructed when the interface is @@ -926,7 +986,7 @@ isImplicitTyCon tycon | isTyConAssoc tycon = True isTupleTyCon tycon isImplicitTyCon _other = True -- catches: FunTyCon, PrimTyCon, - -- CoercionTyCon, SuperKindTyCon + -- CoTyCon, SuperKindTyCon \end{code} @@ -954,7 +1014,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 @@ -983,6 +1043,20 @@ tyConHasGenerics (AlgTyCon {hasGenerics = hg}) = hg tyConHasGenerics (TupleTyCon {hasGenerics = hg}) = hg tyConHasGenerics _ = False -- Synonyms +tyConKind :: TyCon -> Kind +tyConKind (FunTyCon { tc_kind = k }) = k +tyConKind (AlgTyCon { tc_kind = k }) = k +tyConKind (TupleTyCon { tc_kind = k }) = k +tyConKind (SynTyCon { tc_kind = k }) = k +tyConKind (PrimTyCon { tc_kind = k }) = k +tyConKind (AnyTyCon { tc_kind = k }) = k +tyConKind tc = pprPanic "tyConKind" (ppr tc) -- SuperKindTyCon and CoTyCon + +tyConHasKind :: TyCon -> Bool +tyConHasKind (SuperKindTyCon {}) = False +tyConHasKind (CoTyCon {}) = False +tyConHasKind _ = True + -- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors -- could be found tyConDataCons :: TyCon -> [DataCon] @@ -1011,8 +1085,9 @@ tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) -- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple -- 'TyCon'. Panics for any other sort of 'TyCon' algTyConRhs :: TyCon -> AlgTyConRhs -algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs -algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon { data_cons = [con], is_enum = False } +algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs +algTyConRhs (TupleTyCon {dataCon = con, tyConArity = arity}) + = DataTyCon { data_cons = [con], is_enum = arity == 0 } algTyConRhs other = pprPanic "algTyConRhs" (ppr other) \end{code} @@ -1085,13 +1160,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} @@ -1162,6 +1234,18 @@ instance Ord TyCon where instance Uniquable TyCon where getUnique tc = tyConUnique tc +instance Outputable CoTyConDesc where + ppr CoSym = ptext (sLit "SYM") + ppr CoTrans = ptext (sLit "TRANS") + ppr CoLeft = ptext (sLit "LEFT") + ppr CoRight = ptext (sLit "RIGHT") + ppr CoCsel1 = ptext (sLit "CSEL1") + ppr CoCsel2 = ptext (sLit "CSEL2") + ppr CoCselR = ptext (sLit "CSELR") + ppr CoInst = ptext (sLit "INST") + ppr CoUnsafe = ptext (sLit "UNSAFE") + ppr (CoAxiom {}) = ptext (sLit "AXIOM") + instance Outputable TyCon where ppr tc = ppr (getName tc)