X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FTyCon.lhs;h=99afac952bf4b622621327ba37b085ccceb19970;hb=67ee8a93fc96a38c3f73468cb86d8421a11d2911;hp=479ea7c110a81070d00e1042767629020b70bfc8;hpb=c76c69c5b62f1ca4fa52d75b0dfbd37b7eddbb09;p=ghc-hetmet.git diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs index 479ea7c..99afac9 100644 --- a/compiler/types/TyCon.lhs +++ b/compiler/types/TyCon.lhs @@ -5,7 +5,7 @@ \begin{code} module TyCon( - TyCon, ArgVrcs, FieldLabel, + TyCon, FieldLabel, PrimRep(..), tyConPrimRep, @@ -20,7 +20,7 @@ module TyCon( isHiBootTyCon, isSuperKindTyCon, isCoercionTyCon_maybe, isCoercionTyCon, - tcExpandTyCon_maybe, coreExpandTyCon_maybe, stgExpandTyCon_maybe, + tcExpandTyCon_maybe, coreExpandTyCon_maybe, makeTyConAbstract, isAbstractTyCon, @@ -41,7 +41,6 @@ module TyCon( tyConKind, tyConUnique, tyConTyVars, - tyConArgVrcs, algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize, tyConSelIds, tyConStupidTheta, @@ -97,8 +96,6 @@ data TyCon tyConTyVars :: [TyVar], -- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon -- (b) the cached types in AlgTyConRhs.NewTyCon -- But not over the data constructors - argVrcs :: ArgVrcs, - algTcSelIds :: [Id], -- Its record selectors (empty if none): algTcGadtSyntax :: Bool, -- True <=> the data type was declared using GADT syntax @@ -138,10 +135,9 @@ data TyCon tyConArity :: Arity, tyConTyVars :: [TyVar], -- Bound tyvars - synTcRhs :: Type, -- Right-hand side, mentioning these type vars. + synTcRhs :: Type -- Right-hand side, mentioning these type vars. -- Acts as a template for the expansion when -- the tycon is applied to some types. - argVrcs :: ArgVrcs } | PrimTyCon { -- Primitive types; cannot be defined in Haskell @@ -151,7 +147,6 @@ data TyCon tyConName :: Name, tyConKind :: Kind, tyConArity :: Arity, - argVrcs :: ArgVrcs, primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are @@ -182,9 +177,6 @@ type SuperKindCon = TyCon type FieldLabel = Name -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 @@ -207,8 +199,9 @@ data AlgTyConRhs -- = the representation type of the tycon -- The free tyvars of this type are the tyConTyVars - nt_co :: TyCon, -- The coercion used to create the newtype + nt_co :: Maybe TyCon, -- The coercion used to create the newtype -- from the representation + -- optional for non-recursive newtypes -- See Note [Newtype coercions] nt_etad_rhs :: ([TyVar], Type) , @@ -252,6 +245,20 @@ 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 k. +In the paper we'd write + axiom CoT : (forall t. [t]) :=: (forall t. 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]) + +But in GHC we instead make CoT into a new piece of type syntax +(like instCoercionTyCon, symCoercionTyCon etc), which must always +be saturated, but which encodes as + TyConAp CoT [s] +In the vocabulary of the paper it's as if we had axiom declarations +like + axiom CoT t : ([t] :=: T t) + Note [Newtype eta] ~~~~~~~~~~~~~~~~~~ Consider @@ -345,14 +352,13 @@ mkFunTyCon name kind -- 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 argvrcs stupid rhs sel_ids is_rec gen_info gadt_syn +mkAlgTyCon name kind tyvars stupid rhs sel_ids is_rec gen_info gadt_syn = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, - argVrcs = argvrcs, algTcStupidTheta = stupid, algTcRhs = rhs, algTcSelIds = sel_ids, @@ -362,14 +368,13 @@ mkAlgTyCon name kind tyvars argvrcs stupid rhs sel_ids is_rec gen_info gadt_syn hasGenerics = gen_info } -mkClassTyCon name kind tyvars argvrcs rhs clas is_rec +mkClassTyCon name kind tyvars rhs clas is_rec = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, - argVrcs = argvrcs, algTcStupidTheta = [], algTcRhs = rhs, algTcSelIds = [], @@ -396,13 +401,12 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info -- 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 -mkForeignTyCon name ext_name kind arity arg_vrcs +mkForeignTyCon name ext_name kind arity = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = arity, - argVrcs = arg_vrcs, primTyConRep = PtrRep, -- they all do isUnLifted = False, tyConExtName = ext_name @@ -410,37 +414,35 @@ mkForeignTyCon name ext_name kind arity arg_vrcs -- most Prim tycons are lifted -mkPrimTyCon name kind arity arg_vrcs rep - = mkPrimTyCon' name kind arity arg_vrcs rep True +mkPrimTyCon name kind arity rep + = mkPrimTyCon' name kind arity rep True -mkVoidPrimTyCon name kind arity arg_vrcs - = mkPrimTyCon' name kind arity arg_vrcs VoidRep True +mkVoidPrimTyCon name kind arity + = mkPrimTyCon' name kind arity VoidRep True -- but RealWorld is lifted -mkLiftedPrimTyCon name kind arity arg_vrcs rep - = mkPrimTyCon' name kind arity arg_vrcs rep False +mkLiftedPrimTyCon name kind arity rep + = mkPrimTyCon' name kind arity rep False -mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted +mkPrimTyCon' name kind arity rep is_unlifted = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = arity, - argVrcs = arg_vrcs, primTyConRep = rep, isUnLifted = is_unlifted, tyConExtName = Nothing } -mkSynTyCon name kind tyvars rhs argvrcs +mkSynTyCon name kind tyvars rhs = SynTyCon { tyConName = name, tyConUnique = nameUnique name, tyConKind = kind, tyConArity = length tyvars, tyConTyVars = tyvars, - synTcRhs = rhs, - argVrcs = argvrcs + synTcRhs = rhs } mkCoercionTyCon name arity kindRule @@ -513,9 +515,10 @@ isProductTyCon :: TyCon -> Bool -- has *one* constructor, -- is *not* existential -- but --- may be DataType or NewType, +-- may be DataType, NewType -- may be unboxed or not, -- may be recursive or not +-- isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of DataTyCon{ data_cons = [data_con] } -> isVanillaDataCon data_con @@ -605,24 +608,15 @@ tcExpandTyCon_maybe other_tycon tys = Nothing --------------- -- For the *Core* view, we expand synonyms only as well -{- + coreExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive - algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys + 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 (tvs,rhs) -> expand tvs rhs tys --} -coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys ---------------- --- For the *STG* view, we expand synonyms *and* non-recursive newtypes -stgExpandTyCon_maybe (AlgTyCon {algTcRec = NonRecursive, -- Not recursive - algTcRhs = NewTyCon { nt_etad_rhs = etad_rhs }}) tys - = case etad_rhs of -- Don't do this in the pattern match, lest we accidentally - -- match the etad_rhs of a *recursive* newtype - (tvs,rhs) -> expand tvs rhs tys +coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys -stgExpandTyCon_maybe tycon tys = coreExpandTyCon_maybe tycon tys ---------------- expand :: [TyVar] -> Type -- Template @@ -681,7 +675,7 @@ newTyConRep :: TyCon -> ([TyVar], Type) newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rep = rep }}) = (tvs, rep) newTyConRep tycon = pprPanic "newTyConRep" (ppr tycon) -newTyConCo :: TyCon -> TyCon +newTyConCo :: TyCon -> Maybe TyCon newTyConCo (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_co = co }}) = co newTyConCo tycon = pprPanic "newTyConCo" (ppr tycon) @@ -697,19 +691,6 @@ tyConStupidTheta (TupleTyCon {}) = [] tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon) \end{code} -@tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for -each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is -actually computed (in another file). - -\begin{code} -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} synTyConDefn :: TyCon -> ([TyVar], Type) synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = ty}) = (tyvars,ty)