X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=b91ebfa078b4c98c174e7808bc694d49a68bf5a6;hb=8c63d0ff9123be6ae33502c26229a647c9fd0482;hp=8b96d6e654406215a0279f0126e27940bbef06e8;hpb=0b8c23bc97500b0538aab5e1bc1219b18f1a0473;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 8b96d6e..b91ebfa 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -49,15 +49,13 @@ module TysPrim( #include "HsVersions.h" import Var ( TyVar, mkSysTyVar ) -import Name ( mkWiredInTyConName ) -import OccName ( mkOccFS, tcName ) +import Name ( Name ) import PrimRep ( PrimRep(..), isFollowableRep ) -import TyCon ( mkPrimTyCon, TyCon, ArgVrcs ) -import Type ( Type, - mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, - unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds +import TyCon ( TyCon, ArgVrcs, mkPrimTyCon ) +import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, + unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds ) -import Unique ( Unique, mkAlphaTyVarUnique ) +import Unique ( mkAlphaTyVarUnique ) import PrelNames import Outputable \end{code} @@ -105,7 +103,7 @@ primTyCons \begin{code} alphaTyVars :: [TyVar] -alphaTyVars = [ mkSysTyVar u boxedTypeKind +alphaTyVars = [ mkSysTyVar u liftedTypeKind | u <- map mkAlphaTyVarUnique [2..] ] betaTyVars = tail alphaTyVars @@ -117,7 +115,7 @@ alphaTys = mkTyVarTys alphaTyVars (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys -- openAlphaTyVar is prepared to be instantiated - -- to a boxed or unboxed type variable. It's used for the + -- to a lifted or unlifted type variable. It's used for the -- result type for "error", so that we can have (error Int# "Help") openAlphaTyVar :: TyVar openAlphaTyVar = mkSysTyVar (mkAlphaTyVarUnique 1) openTypeKind @@ -147,39 +145,37 @@ vrcsZP = [vrcZero,vrcPos] \begin{code} -- only used herein -pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep -> TyCon -pcPrimTyCon key str arity arg_vrcs rep +pcPrimTyCon :: Name -> Int -> ArgVrcs -> PrimRep -> TyCon +pcPrimTyCon name arity arg_vrcs rep = the_tycon where - name = mkWiredInTyConName key pREL_GHC (mkOccFS tcName str) the_tycon - the_tycon = mkPrimTyCon name kind arity arg_vrcs rep - kind = mkArrowKinds (take arity (repeat boxedTypeKind)) result_kind - result_kind | isFollowableRep rep = boxedTypeKind -- Represented by a GC-ish ptr - | otherwise = unboxedTypeKind -- Represented by a non-ptr + the_tycon = mkPrimTyCon name kind arity arg_vrcs rep + kind = mkArrowKinds (take arity (repeat liftedTypeKind)) result_kind + result_kind = unliftedTypeKind -- all primitive types are unlifted charPrimTy = mkTyConTy charPrimTyCon -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 [] CharRep +charPrimTyCon = pcPrimTyCon charPrimTyConName 0 [] CharRep intPrimTy = mkTyConTy intPrimTyCon -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 [] IntRep +intPrimTyCon = pcPrimTyCon intPrimTyConName 0 [] IntRep int64PrimTy = mkTyConTy int64PrimTyCon -int64PrimTyCon = pcPrimTyCon int64PrimTyConKey SLIT("Int64#") 0 [] Int64Rep +int64PrimTyCon = pcPrimTyCon int64PrimTyConName 0 [] Int64Rep wordPrimTy = mkTyConTy wordPrimTyCon -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 [] WordRep +wordPrimTyCon = pcPrimTyCon wordPrimTyConName 0 [] WordRep word64PrimTy = mkTyConTy word64PrimTyCon -word64PrimTyCon = pcPrimTyCon word64PrimTyConKey SLIT("Word64#") 0 [] Word64Rep +word64PrimTyCon = pcPrimTyCon word64PrimTyConName 0 [] Word64Rep addrPrimTy = mkTyConTy addrPrimTyCon -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 [] AddrRep +addrPrimTyCon = pcPrimTyCon addrPrimTyConName 0 [] AddrRep floatPrimTy = mkTyConTy floatPrimTyCon -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 [] FloatRep +floatPrimTyCon = pcPrimTyCon floatPrimTyConName 0 [] FloatRep doublePrimTy = mkTyConTy doublePrimTyCon -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep +doublePrimTyCon = pcPrimTyCon doublePrimTyConName 0 [] DoubleRep \end{code} @@ -189,7 +185,7 @@ doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep %* * %************************************************************************ -State# is the primitive, unboxed type of states. It has one type parameter, +State# is the primitive, unlifted type of states. It has one type parameter, thus State# RealWorld or @@ -200,17 +196,16 @@ keep different state threads separate. It is represented by nothing at all. \begin{code} mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] -statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 vrcsZ VoidRep +statePrimTyCon = pcPrimTyCon statePrimTyConName 1 vrcsZ VoidRep \end{code} -@_RealWorld@ is deeply magical. It {\em is primitive}, but it -{\em is not unboxed} (hence PtrRep). -We never manipulate values of type RealWorld; it's only used in the type -system, to parameterise State#. +RealWorld is deeply magical. It is *primitive*, but it is not +*unlifted* (hence PrimPtrRep). We never manipulate values of type +RealWorld; it's only used in the type system, to parameterise State#. \begin{code} +realWorldTyCon = mkPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep realWorldTy = mkTyConTy realWorldTyCon -realWorldTyCon = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PrimPtrRep realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} @@ -225,15 +220,10 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 vrcsP ArrayRep - -byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 [] ByteArrayRep - -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") - 2 vrcsZP ArrayRep - -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") - 1 vrcsZ ByteArrayRep +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName 1 vrcsP ArrayRep +byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConName 0 [] ByteArrayRep +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName 2 vrcsZP ArrayRep +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName 1 vrcsZ ByteArrayRep mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon @@ -248,8 +238,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") - 2 vrcsZP PrimPtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName 2 vrcsZP PrimPtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -261,8 +250,7 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") - 2 vrcsZP PrimPtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName 2 vrcsZP PrimPtrRep mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} @@ -274,8 +262,7 @@ mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") - 1 vrcsP StablePtrRep +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName 1 vrcsP StablePtrRep mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] \end{code} @@ -287,8 +274,7 @@ mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] %************************************************************************ \begin{code} -stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#") - 1 vrcsP StableNameRep +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName 1 vrcsP StableNameRep mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} @@ -311,7 +297,7 @@ dead before it really was. \begin{code} foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon -foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [] ForeignObjRep +foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConName 0 [] ForeignObjRep \end{code} %************************************************************************ @@ -322,7 +308,7 @@ foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [ \begin{code} bcoPrimTy = mkTyConTy bcoPrimTyCon -bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep +bcoPrimTyCon = pcPrimTyCon bcoPrimTyConName 0 [] BCORep \end{code} %************************************************************************ @@ -332,7 +318,7 @@ bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 vrcsP WeakPtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName 1 vrcsP WeakPtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -354,7 +340,7 @@ to the thread id internally. \begin{code} threadIdPrimTy = mkTyConTy threadIdPrimTyCon -threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConKey SLIT("ThreadId#") 0 [] ThreadIdRep +threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConName 0 [] ThreadIdRep \end{code} %************************************************************************ @@ -368,17 +354,17 @@ PrimRep (see PrimRep.lhs). The following function returns the primitive TyCon for a given PrimRep. \begin{code} -primRepTyCon CharRep = charPrimTyCon -primRepTyCon Int8Rep = charPrimTyCon -primRepTyCon IntRep = intPrimTyCon -primRepTyCon WordRep = wordPrimTyCon -primRepTyCon Int64Rep = int64PrimTyCon -primRepTyCon Word64Rep = word64PrimTyCon -primRepTyCon AddrRep = addrPrimTyCon -primRepTyCon FloatRep = floatPrimTyCon -primRepTyCon DoubleRep = doublePrimTyCon +primRepTyCon CharRep = charPrimTyCon +primRepTyCon Int8Rep = charPrimTyCon +primRepTyCon IntRep = intPrimTyCon +primRepTyCon WordRep = wordPrimTyCon +primRepTyCon Int64Rep = int64PrimTyCon +primRepTyCon Word64Rep = word64PrimTyCon +primRepTyCon AddrRep = addrPrimTyCon +primRepTyCon FloatRep = floatPrimTyCon +primRepTyCon DoubleRep = doublePrimTyCon primRepTyCon StablePtrRep = stablePtrPrimTyCon primRepTyCon ForeignObjRep = foreignObjPrimTyCon -primRepTyCon WeakPtrRep = weakPrimTyCon -primRepTyCon other = pprPanic "primRepTyCon" (ppr other) +primRepTyCon WeakPtrRep = weakPrimTyCon +primRepTyCon other = pprPanic "primRepTyCon" (ppr other) \end{code}