X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FTyCon.lhs;h=7fdf2e3a296e56de2085861212d84094968b5a6a;hb=b374a3eea08e9dcb5d937232ce06bcf1eb3a73df;hp=5115bebf7c611a38185207c3e4c06fe01e16345c;hpb=b37a8d6a4364ed3e5192a2bc67f5434ce49db322;p=ghc-hetmet.git diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 5115beb..7fdf2e3 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -5,7 +5,10 @@ \begin{code} module TyCon( - TyCon, ArgVrcs, + TyCon, ArgVrcs, FieldLabel, + + PrimRep(..), + tyConPrimRep, AlgTyConRhs(..), visibleDataCons, @@ -13,7 +16,7 @@ module TyCon( isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon, isEnumerationTyCon, isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity, - isRecursiveTyCon, newTyConRep, newTyConRhs, isHiBootTyCon, + isRecursiveTyCon, newTyConRep, newTyConRhs, newTyConRhs_maybe, isHiBootTyCon, mkForeignTyCon, isForeignTyCon, @@ -31,9 +34,8 @@ module TyCon( tyConTyVars, tyConArgVrcs, algTyConRhs, tyConDataCons, tyConDataCons_maybe, tyConFamilySize, - tyConSelIds, - tyConTheta, - tyConPrimRep, + tyConFields, tyConSelIds, + tyConStupidTheta, tyConArity, isClassTyCon, tyConClass_maybe, getSynTyConDefn, @@ -51,7 +53,7 @@ import {-# SOURCE #-} TypeRep ( Type, PredType ) -- Should just be Type(Type), but this fails due to bug present up to -- and including 4.02 involving slurping of hi-boot files. Bug is now fixed. -import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon ) +import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon ) import Var ( TyVar, Id ) @@ -60,8 +62,8 @@ import Kind ( Kind ) import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed ) import Name ( Name, nameUnique, NamedThing(getName) ) import PrelNames ( Unique, Uniquable(..) ) -import PrimRep ( PrimRep(..) ) import Maybes ( orElse ) +import Util ( equalLength ) import Outputable import FastString \end{code} @@ -89,33 +91,41 @@ data TyCon tyConKind :: Kind, tyConArity :: Arity, - tyConTyVars :: [TyVar], - argVrcs :: ArgVrcs, - algTyConTheta :: [PredType], + tyConTyVars :: [TyVar], -- Scopes over (a) the [PredType] in AlgTyConRhs.DataTyCon + -- (b) the cached types in AlgTyConRhs.NewTyCon + -- (c) the types in algTcFields + -- But not over the data constructors + argVrcs :: ArgVrcs, - selIds :: [Id], -- Its record selectors (if any) + algTcFields :: [(FieldLabel, Type, Id)], + -- Its fields (empty if none): + -- * field name + -- * its type (scoped over tby tyConTyVars) + -- * record selector (name = field name) - algRhs :: AlgTyConRhs, -- Data constructors in here + algTcRhs :: AlgTyConRhs, -- Data constructors in here - algTyConRec :: RecFlag, -- Tells whether the data type is part of + algTcRec :: RecFlag, -- Tells whether the data type is part of -- a mutually-recursive group or not hasGenerics :: Bool, -- True <=> generic to/from functions are available -- (in the exports of the data type's source module) - algTyConClass :: Maybe Class + algTcClass :: Maybe Class -- Just cl if this tycon came from a class declaration } | PrimTyCon { -- Primitive types; cannot be defined in Haskell -- Now includes foreign-imported types - tyConUnique :: Unique, - tyConName :: Name, - tyConKind :: Kind, - tyConArity :: Arity, - argVrcs :: ArgVrcs, - primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are - -- boxed (represented by pointers). The PrimRep tells. + tyConUnique :: Unique, + tyConName :: Name, + tyConKind :: Kind, + tyConArity :: Arity, + argVrcs :: ArgVrcs, + + primTyConRep :: PrimRep, + -- Many primitive tycons are unboxed, but some are + -- boxed (represented by pointers). The CgRep tells. isUnLifted :: Bool, -- Most primitive tycons are unlifted, -- but foreign-imported ones may not be @@ -146,6 +156,8 @@ data TyCon argVrcs :: ArgVrcs } +type FieldLabel = Name + type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)] -- [] means "no information, assume the worst" @@ -156,8 +168,17 @@ data AlgTyConRhs -- an hi file | DataTyCon + (Maybe [PredType]) -- Just theta => this tycon was declared in H98 syntax + -- with the specified "stupid theta" + -- e.g. data Ord a => T a = ... + -- Nothing => this tycon was declared by giving the + -- type signatures for each constructor + -- (new GADT stuff) + -- e.g. data T a where { ... } [DataCon] -- The constructors; can be empty if the user declares -- the type to have no constructors + -- INVARIANT: Kept in order of increasing tag + -- (see the tag assignment in DataCon.mkDataCon) Bool -- Cached: True <=> an enumeration type | NewTyCon -- Newtypes always have exactly one constructor @@ -181,11 +202,47 @@ data AlgTyConRhs -- newtypes. visibleDataCons :: AlgTyConRhs -> [DataCon] -visibleDataCons AbstractTyCon = [] -visibleDataCons (DataTyCon cs _) = cs -visibleDataCons (NewTyCon c _ _) = [c] +visibleDataCons AbstractTyCon = [] +visibleDataCons (DataTyCon _ cs _) = cs +visibleDataCons (NewTyCon c _ _) = [c] \end{code} +%************************************************************************ +%* * +\subsection{PrimRep} +%* * +%************************************************************************ + +A PrimRep is an abstraction of a type. It contains information that +the code generator needs in order to pass arguments, return results, +and store values of this type. + +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 +and clearly defined purpose: + + - A PrimRep is a CgRep + information about signedness + information + about primitive pointers (AddrRep). Signedness and primitive + pointers are required when passing a primitive type to a foreign + function, but aren't needed for call/return conventions of Haskell + functions. + + - A MachRep is a basic machine type (non-void, doesn't contain + information on pointerhood or signedness, but contains some + reps that don't have corresponding Haskell types). + +\begin{code} +data PrimRep + = VoidRep + | PtrRep + | IntRep -- signed, word-sized + | WordRep -- unsinged, word-sized + | Int64Rep -- signed, 64 bit (32-bit words only) + | Word64Rep -- unsigned, 64 bit (32-bit words only) + | AddrRep -- a pointer, but not to a Haskell value + | FloatRep + | DoubleRep +\end{code} %************************************************************************ %* * @@ -212,36 +269,34 @@ 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 theta argvrcs rhs sels is_rec gen_info +mkAlgTyCon name kind tyvars argvrcs rhs flds is_rec gen_info = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - argVrcs = argvrcs, - algTyConTheta = theta, - algRhs = rhs, - selIds = sels, - algTyConClass = Nothing, - algTyConRec = is_rec, - hasGenerics = gen_info + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTcRhs = rhs, + algTcFields = flds, + algTcClass = Nothing, + algTcRec = is_rec, + hasGenerics = gen_info } mkClassTyCon name kind tyvars argvrcs rhs clas is_rec = AlgTyCon { - tyConName = name, - tyConUnique = nameUnique name, - tyConKind = kind, - tyConArity = length tyvars, - tyConTyVars = tyvars, - argVrcs = argvrcs, - algTyConTheta = [], - algRhs = rhs, - selIds = [], - algTyConClass = Just clas, - algTyConRec = is_rec, - hasGenerics = False + tyConName = name, + tyConUnique = nameUnique name, + tyConKind = kind, + tyConArity = length tyvars, + tyConTyVars = tyvars, + argVrcs = argvrcs, + algTcRhs = rhs, + algTcFields = [], + algTcClass = Just clas, + algTcRec = is_rec, + hasGenerics = False } @@ -261,7 +316,6 @@ 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 --- They have PtrRep mkForeignTyCon name ext_name kind arity arg_vrcs = PrimTyCon { tyConName = name, @@ -269,7 +323,7 @@ mkForeignTyCon name ext_name kind arity arg_vrcs tyConKind = kind, tyConArity = arity, argVrcs = arg_vrcs, - primTyConRep = PtrRep, + primTyConRep = PtrRep, -- they all do isUnLifted = False, tyConExtName = ext_name } @@ -313,7 +367,7 @@ isFunTyCon (FunTyCon {}) = True isFunTyCon _ = False isAbstractTyCon :: TyCon -> Bool -isAbstractTyCon (AlgTyCon { algRhs = AbstractTyCon }) = True +isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon }) = True isAbstractTyCon _ = False isPrimTyCon :: TyCon -> Bool @@ -331,10 +385,6 @@ isAlgTyCon (AlgTyCon {}) = True isAlgTyCon (TupleTyCon {}) = True isAlgTyCon other = False -algTyConRhs :: TyCon -> AlgTyConRhs -algTyConRhs (AlgTyCon {algRhs = rhs}) = rhs -algTyConRhs (TupleTyCon {dataCon = dc}) = DataTyCon [dc] False - isDataTyCon :: TyCon -> Bool -- isDataTyCon returns True for data types that are represented by -- heap-allocated constructors. @@ -343,18 +393,18 @@ isDataTyCon :: TyCon -> Bool -- True for all @data@ types -- False for newtypes -- unboxed tuples -isDataTyCon (AlgTyCon {algRhs = rhs}) +isDataTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of - DataTyCon _ _ -> True - NewTyCon _ _ _ -> False - AbstractTyCon -> panic "isDataTyCon" + DataTyCon _ _ _ -> True + NewTyCon _ _ _ -> False + AbstractTyCon -> panic "isDataTyCon" isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon :: TyCon -> Bool -isNewTyCon (AlgTyCon {algRhs = NewTyCon _ _ _}) = True -isNewTyCon other = False +isNewTyCon (AlgTyCon {algTcRhs = NewTyCon _ _ _}) = True +isNewTyCon other = False isProductTyCon :: TyCon -> Bool -- A "product" tycon @@ -364,10 +414,10 @@ isProductTyCon :: TyCon -> Bool -- may be DataType or NewType, -- may be unboxed or not, -- may be recursive or not -isProductTyCon tc@(AlgTyCon {}) = case algRhs tc of - DataTyCon [data_con] _ -> not (isExistentialDataCon data_con) - NewTyCon _ _ _ -> True - other -> False +isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of + DataTyCon _ [data_con] _ -> isVanillaDataCon data_con + NewTyCon _ _ _ -> True + other -> False isProductTyCon (TupleTyCon {}) = True isProductTyCon other = False @@ -376,8 +426,8 @@ isSynTyCon (SynTyCon {}) = True isSynTyCon _ = False isEnumerationTyCon :: TyCon -> Bool -isEnumerationTyCon (AlgTyCon {algRhs = DataTyCon _ is_enum}) = is_enum -isEnumerationTyCon other = False +isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon _ _ is_enum}) = is_enum +isEnumerationTyCon other = False isTupleTyCon :: TyCon -> Bool -- The unit tycon didn't used to be classed as a tuple tycon @@ -397,13 +447,13 @@ isBoxedTupleTyCon other = False tupleTyConBoxity tc = tyConBoxed tc isRecursiveTyCon :: TyCon -> Bool -isRecursiveTyCon (AlgTyCon {algTyConRec = Recursive}) = True +isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True isRecursiveTyCon other = False isHiBootTyCon :: TyCon -> Bool -- Used for knot-tying in hi-boot files -isHiBootTyCon (AlgTyCon {algRhs = AbstractTyCon}) = True -isHiBootTyCon other = False +isHiBootTyCon (AlgTyCon {algTcRhs = AbstractTyCon}) = True +isHiBootTyCon other = False isForeignTyCon :: TyCon -> Bool -- isForeignTyCon identifies foreign-imported type constructors @@ -423,43 +473,65 @@ tyConDataCons :: TyCon -> [DataCon] tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` [] tyConDataCons_maybe :: TyCon -> Maybe [DataCon] -tyConDataCons_maybe (AlgTyCon {algRhs = DataTyCon cons _}) = Just cons -tyConDataCons_maybe (AlgTyCon {algRhs = NewTyCon con _ _}) = Just [con] -tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] -tyConDataCons_maybe other = Nothing +tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon _ cons _}) = Just cons +tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon con _ _}) = Just [con] +tyConDataCons_maybe (TupleTyCon {dataCon = con}) = Just [con] +tyConDataCons_maybe other = Nothing tyConFamilySize :: TyCon -> Int -tyConFamilySize (AlgTyCon {algRhs = DataTyCon cons _}) = length cons -tyConFamilySize (AlgTyCon {algRhs = NewTyCon _ _ _}) = 1 -tyConFamilySize (TupleTyCon {}) = 1 +tyConFamilySize (AlgTyCon {algTcRhs = DataTyCon _ cons _}) = length cons +tyConFamilySize (AlgTyCon {algTcRhs = NewTyCon _ _ _}) = 1 +tyConFamilySize (TupleTyCon {}) = 1 #ifdef DEBUG tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other) #endif +tyConFields :: TyCon -> [(FieldLabel,Type,Id)] +tyConFields (AlgTyCon {algTcFields = fs}) = fs +tyConFields other_tycon = [] + tyConSelIds :: TyCon -> [Id] -tyConSelIds (AlgTyCon {selIds = sels}) = sels -tyConSelIds other_tycon = [] +tyConSelIds tc = [id | (_,_,id) <- tyConFields tc] + +algTyConRhs :: TyCon -> AlgTyConRhs +algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs +algTyConRhs (TupleTyCon {dataCon = con}) = DataTyCon (Just []) [con] False +algTyConRhs other = pprPanic "algTyConRhs" (ppr other) \end{code} \begin{code} -newTyConRep :: TyCon -> ([TyVar], Type) -newTyConRep (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ _ rep}) = (tvs, rep) - newTyConRhs :: TyCon -> ([TyVar], Type) -newTyConRhs (AlgTyCon {tyConTyVars = tvs, algRhs = NewTyCon _ rhs _}) = (tvs, rhs) +newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon _ rhs _}) = (tvs, rhs) + +newTyConRhs_maybe :: TyCon + -> [Type] -- Args to tycon + -> Maybe ([(TyVar,Type)], -- Substitution + Type) -- Body type (not yet substituted) +-- Non-recursive newtypes are transparent to Core; +-- Given an application to some types, return Just (tenv, ty) +-- if it's a saturated, non-recursive newtype. +newTyConRhs_maybe (AlgTyCon {tyConTyVars = tvs, + algTcRec = NonRecursive, -- Not recursive + algTcRhs = NewTyCon _ rhs _}) tys + | tvs `equalLength` tys -- Saturated + = Just (tvs `zip` tys, rhs) + +newTyConRhs_maybe other_tycon tys = Nothing + + +newTyConRep :: TyCon -> ([TyVar], Type) +newTyConRep (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon _ _ rep}) = (tvs, rep) tyConPrimRep :: TyCon -> PrimRep tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep -tyConPrimRep tc = ASSERT( not (isUnboxedTupleTyCon tc) ) - PtrRep - -- We should not be asking what the representation of an - -- unboxed tuple is, because it isn't a first class value. +tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep \end{code} \begin{code} -tyConTheta :: TyCon -> [PredType] -tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta -tyConTheta (TupleTyCon {}) = [] +tyConStupidTheta :: TyCon -> [PredType] +tyConStupidTheta (AlgTyCon {algTcRhs = DataTyCon mb_th _ _}) = mb_th `orElse` [] +tyConStupidTheta (AlgTyCon {algTcRhs = other}) = [] +tyConStupidTheta (TupleTyCon {}) = [] -- shouldn't ask about anything else \end{code} @@ -483,22 +555,22 @@ getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,t \begin{code} maybeTyConSingleCon :: TyCon -> Maybe DataCon -maybeTyConSingleCon (AlgTyCon {algRhs = DataTyCon [c] _}) = Just c -maybeTyConSingleCon (AlgTyCon {algRhs = NewTyCon c _ _}) = Just c -maybeTyConSingleCon (AlgTyCon {}) = Nothing -maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con -maybeTyConSingleCon (PrimTyCon {}) = Nothing -maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty +maybeTyConSingleCon (AlgTyCon {algTcRhs = DataTyCon _ [c] _}) = Just c +maybeTyConSingleCon (AlgTyCon {algTcRhs = NewTyCon c _ _}) = Just c +maybeTyConSingleCon (AlgTyCon {}) = Nothing +maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con +maybeTyConSingleCon (PrimTyCon {}) = Nothing +maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $ ppr tc \end{code} \begin{code} isClassTyCon :: TyCon -> Bool -isClassTyCon (AlgTyCon {algTyConClass = Just _}) = True +isClassTyCon (AlgTyCon {algTcClass = Just _}) = True isClassTyCon other_tycon = False tyConClass_maybe :: TyCon -> Maybe Class -tyConClass_maybe (AlgTyCon {algTyConClass = maybe_clas}) = maybe_clas +tyConClass_maybe (AlgTyCon {algTcClass = maybe_clas}) = maybe_clas tyConClass_maybe ther_tycon = Nothing \end{code}