X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypes%2FTyCon.lhs;h=5ede243737eb50afe931aa06e581ad9dd96318b7;hb=61fae1d3fb61c5f53c3fbcb94afe7c548ad31591;hp=015d0b3193717d367e21f5487d52c1ad311e406a;hpb=0004357ccaa3149cb112f5f5df1af60e65baad79;p=ghc-hetmet.git diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index 015d0b3..5ede243 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -19,6 +19,7 @@ module TyCon( mkClassTyCon, mkFunTyCon, mkPrimTyCon, + mkLiftedPrimTyCon, mkTupleTyCon, mkSynTyCon, mkKindCon, @@ -63,7 +64,9 @@ import BasicTypes ( Arity, RecFlag(..), Boxity(..), import Name ( Name, nameUnique, NamedThing(getName) ) import PrelNames ( Unique, Uniquable(..), anyBoxConKey ) import PrimRep ( PrimRep(..), isFollowableRep ) +import Util ( lengthIs ) import Outputable +import FastString \end{code} %************************************************************************ @@ -135,8 +138,9 @@ data TyCon primTyConRep :: PrimRep, -- Many primitive tycons are unboxed, but some are -- boxed (represented by pointers). The PrimRep tells. - isUnLifted :: Bool -- Most primitive tycons are unlifted, + isUnLifted :: Bool, -- Most primitive tycons are unlifted, -- but foreign-imported ones may not be + tyConExtName :: Maybe FastString } | TupleTyCon { @@ -180,15 +184,17 @@ type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)] data AlgTyConFlavour = DataTyCon -- Data type + | EnumTyCon -- Special sort of enumeration type + | NewTyCon Type -- Newtype, with its *ultimate* representation type -- By 'ultimate' I mean that the rep type is not itself -- a newtype or type synonym. - -- The rep type has explicit for-alls for the tyvars of - -- the TyCon. Thus: + -- The rep type has free type variables the tyConTyVars + -- Thus: -- newtype T a = MkT [(a,Int)] - -- The rep type is forall a. [(a,Int)] + -- The rep type is [(a,Int)] -- -- The rep type isn't entirely simple: -- for a recursive newtype we pick () as the rep type @@ -265,7 +271,7 @@ mkAlgTyCon name kind tyvars theta argvrcs cons ncons sels flavour rec genInfo = gen_info } -mkClassTyCon name kind tyvars argvrcs con clas flavour +mkClassTyCon name kind tyvars argvrcs con clas flavour rec = AlgTyCon { tyConName = name, tyConUnique = nameUnique name, @@ -279,7 +285,7 @@ mkClassTyCon name kind tyvars argvrcs con clas flavour noOfDataCons = 1, algTyConClass = Just clas, algTyConFlavour = flavour, - algTyConRec = NonRecursive, + algTyConRec = rec, genInfo = Nothing } @@ -297,9 +303,11 @@ mkTupleTyCon name kind arity tyvars con boxed gen_info } -- Foreign-imported (.NET) type constructors are represented --- as primitive, but *lifted*, TyCons for now. --- They have PtrRep -mkForeignTyCon name kind arity arg_vrcs +-- 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, tyConUnique = nameUnique name, @@ -307,11 +315,20 @@ mkForeignTyCon name kind arity arg_vrcs tyConArity = arity, tyConArgVrcs = arg_vrcs, primTyConRep = PtrRep, - isUnLifted = False + isUnLifted = False, + tyConExtName = ext_name } +-- most Prim tycons are lifted mkPrimTyCon name kind arity arg_vrcs rep + = mkPrimTyCon' name kind arity arg_vrcs rep True + +-- but RealWorld is lifted +mkLiftedPrimTyCon name kind arity arg_vrcs rep + = mkPrimTyCon' name kind arity arg_vrcs rep False + +mkPrimTyCon' name kind arity arg_vrcs rep is_unlifted = PrimTyCon { tyConName = name, tyConUnique = nameUnique name, @@ -319,7 +336,8 @@ mkPrimTyCon name kind arity arg_vrcs rep tyConArity = arity, tyConArgVrcs = arg_vrcs, primTyConRep = rep, - isUnLifted = True + isUnLifted = is_unlifted, + tyConExtName = Nothing } mkSynTyCon name kind arity tyvars rhs argvrcs @@ -359,18 +377,26 @@ isAlgTyCon (AlgTyCon {}) = True isAlgTyCon (TupleTyCon {}) = True isAlgTyCon other = False --- isDataTyCon returns False for @newtype@ and for unboxed tuples -isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data}) = case new_or_data of - NewTyCon _ -> False - other -> True +-- isDataTyCon returns True for data types that are represented by +-- heap-allocated constructors. +-- These are srcutinised by Core-level @case@ expressions, and they +-- get info tables allocated for them. +-- True for all @data@ types +-- False for newtypes +-- unboxed tuples +isDataTyCon (AlgTyCon {algTyConFlavour = new_or_data, algTyConRec = is_rec}) + = case new_or_data of + NewTyCon _ -> False + other -> True + isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity isDataTyCon other = False isNewTyCon (AlgTyCon {algTyConFlavour = NewTyCon _}) = True isNewTyCon other = False -newTyConRep (AlgTyCon {algTyConFlavour = NewTyCon rep}) = Just rep -newTyConRep other = Nothing +newTyConRep :: TyCon -> ([TyVar], Type) +newTyConRep (AlgTyCon {tyConTyVars = tvs, algTyConFlavour = NewTyCon rep}) = (tvs, rep) -- A "product" tycon -- has *one* constructor, @@ -414,7 +440,7 @@ isForeignTyCon other = False \begin{code} tyConDataCons :: TyCon -> [DataCon] -tyConDataCons tycon = ASSERT2( length cons == tyConFamilySize tycon, ppr tycon ) +tyConDataCons tycon = ASSERT2( cons `lengthIs` (tyConFamilySize tycon), ppr tycon ) cons where cons = tyConDataConsIfAvailable tycon @@ -441,13 +467,17 @@ tyConSelIds other_tycon = [] \begin{code} tyConPrimRep :: TyCon -> PrimRep tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep -tyConPrimRep _ = PtrRep +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. \end{code} \begin{code} tyConTheta :: TyCon -> [PredType] tyConTheta (AlgTyCon {algTyConTheta = theta}) = theta --- should ask about anything else +tyConTheta (TupleTyCon {}) = [] +-- shouldn't ask about anything else \end{code} @tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for