X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=963f93c2e30711920351efc20446a40c82a91188;hb=362750fbc91116ccc12b8b30d9a496803fa036f3;hp=6f8803c365bdb9465653899d7dae78d84d77d03e;hpb=388e3356f71daffa62f1d4157e1e07e4c68f218a;p=ghc-hetmet.git diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 6f8803c..963f93c 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 @@ -36,9 +37,9 @@ module TyCon( isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, isSynTyCon, isClosedSynTyCon, isOpenSynTyCon, - isSuperKindTyCon, + isSuperKindTyCon, isDecomposableTyCon, isCoercionTyCon, isCoercionTyCon_maybe, - isForeignTyCon, isAnyTyCon, + isForeignTyCon, isAnyTyCon, tyConHasKind, isInjectiveTyCon, isDataTyCon, isProductTyCon, isEnumerationTyCon, @@ -124,7 +125,7 @@ data TyCon FunTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity } @@ -133,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. @@ -171,7 +172,7 @@ data TyCon | TupleTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity, tyConBoxed :: Boxity, tyConTyVars :: [TyVar], @@ -183,7 +184,7 @@ data TyCon | SynTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + tc_kind :: Kind, tyConArity :: Arity, tyConTyVars :: [TyVar], -- Bound tyvars @@ -199,14 +200,14 @@ data TyCon | PrimTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind, + 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 tyConKind = * + -- Only relevant if tc_kind = * isUnLifted :: Bool, -- ^ Most primitive tycons are unlifted (may not contain bottom) -- but foreign-imported ones may be lifted @@ -216,18 +217,14 @@ data TyCon } -- | 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 @@ -239,7 +236,7 @@ data TyCon | AnyTyCon { tyConUnique :: Unique, tyConName :: Name, - tyConKind :: Kind -- Never = *; that is done via PrimTyCon + tc_kind :: Kind -- Never = *; that is done via PrimTyCon -- See Note [Any types] in TysPrim } @@ -311,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. @@ -364,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 @@ -396,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] @@ -407,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 @@ -425,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] @@ -578,7 +589,7 @@ mkFunTyCon name kind = FunTyCon { tyConUnique = nameUnique name, tyConName = name, - tyConKind = kind, + tc_kind = kind, tyConArity = 2 } @@ -598,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, @@ -626,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, @@ -647,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, @@ -675,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, @@ -688,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, @@ -696,19 +707,20 @@ 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, - tyConKind = kind, + = AnyTyCon { tyConName = name, + tc_kind = kind, tyConUnique = nameUnique name } -- | Create a super-kind 'TyCon' @@ -823,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 decompose (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 @@ -831,6 +850,7 @@ 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? @@ -938,15 +958,15 @@ 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 @@ -966,7 +986,7 @@ isImplicitTyCon tycon | isTyConAssoc tycon = True isTupleTyCon tycon isImplicitTyCon _other = True -- catches: FunTyCon, PrimTyCon, - -- CoercionTyCon, SuperKindTyCon + -- CoTyCon, SuperKindTyCon \end{code} @@ -1023,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] @@ -1051,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} @@ -1199,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)