X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=2f6168bafb0cf1c8e1146c37d7ff58cc9816650f;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=5e7b4a3782a86a3fab065d5a96a7e713a78805b5;hpb=710e207487929c4a5977b5ee3bc6e539091953db;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 5e7b4a3..2f6168b 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -3,9 +3,6 @@ % \section[TysPrim]{Wired-in knowledge about primitive types} -This module tracks the ``state interface'' document, ``GHC prelude: -types and operations.'' - \begin{code} module TysPrim( alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, @@ -31,35 +28,39 @@ module TysPrim( mutVarPrimTyCon, mkMutVarPrimTy, mVarPrimTyCon, mkMVarPrimTy, + tVarPrimTyCon, mkTVarPrimTy, stablePtrPrimTyCon, mkStablePtrPrimTy, stableNamePrimTyCon, mkStableNamePrimTy, bcoPrimTyCon, bcoPrimTy, weakPrimTyCon, mkWeakPrimTy, - foreignObjPrimTyCon, foreignObjPrimTy, threadIdPrimTyCon, threadIdPrimTy, - int64PrimTyCon, int64PrimTy, - word64PrimTyCon, word64PrimTy, - - primRepTyCon, + int32PrimTyCon, int32PrimTy, + word32PrimTyCon, word32PrimTy, - pcPrimTyCon + int64PrimTyCon, int64PrimTy, + word64PrimTyCon, word64PrimTy ) where #include "HsVersions.h" -import Var ( TyVar, mkSysTyVar ) -import Name ( mkWiredInTyConName ) -import OccName ( mkSrcOccFS, tcName ) -import PrimRep ( PrimRep(..), isFollowableRep ) -import TyCon ( mkPrimTyCon, TyCon, ArgVrcs ) -import Type ( Type, - mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, - unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds +import Var ( TyVar, mkTyVar ) +import Name ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName ) +import OccName ( mkOccNameFS, tcName, mkTyVarOcc ) +import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon, + PrimRep(..) ) +import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, + unliftedTypeKind, liftedTypeKind, openTypeKind, + Kind, mkArrowKinds, + TyThing(..) ) -import Unique ( Unique, mkAlphaTyVarUnique ) +import SrcLoc ( noSrcLoc ) +import Unique ( mkAlphaTyVarUnique ) import PrelNames +import FastString ( FastString, mkFastString ) import Outputable + +import Char ( ord, chr ) \end{code} %************************************************************************ @@ -78,13 +79,14 @@ primTyCons , doublePrimTyCon , floatPrimTyCon , intPrimTyCon + , int32PrimTyCon , int64PrimTyCon - , foreignObjPrimTyCon , bcoPrimTyCon , weakPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon , mVarPrimTyCon + , tVarPrimTyCon , mutVarPrimTyCon , realWorldTyCon , stablePtrPrimTyCon @@ -92,10 +94,43 @@ primTyCons , statePrimTyCon , threadIdPrimTyCon , wordPrimTyCon + , word32PrimTyCon , word64PrimTyCon ] -\end{code} +mkPrimTc :: FastString -> Unique -> TyCon -> Name +mkPrimTc fs uniq tycon + = mkWiredInName gHC_PRIM (mkOccNameFS tcName fs) + uniq + Nothing -- No parent object + (ATyCon tycon) -- Relevant TyCon + UserSyntax -- None are built-in syntax + +charPrimTyConName = mkPrimTc FSLIT("Char#") charPrimTyConKey charPrimTyCon +intPrimTyConName = mkPrimTc FSLIT("Int#") intPrimTyConKey intPrimTyCon +int32PrimTyConName = mkPrimTc FSLIT("Int32#") int32PrimTyConKey int32PrimTyCon +int64PrimTyConName = mkPrimTc FSLIT("Int64#") int64PrimTyConKey int64PrimTyCon +wordPrimTyConName = mkPrimTc FSLIT("Word#") wordPrimTyConKey wordPrimTyCon +word32PrimTyConName = mkPrimTc FSLIT("Word32#") word32PrimTyConKey word32PrimTyCon +word64PrimTyConName = mkPrimTc FSLIT("Word64#") word64PrimTyConKey word64PrimTyCon +addrPrimTyConName = mkPrimTc FSLIT("Addr#") addrPrimTyConKey addrPrimTyCon +floatPrimTyConName = mkPrimTc FSLIT("Float#") floatPrimTyConKey floatPrimTyCon +doublePrimTyConName = mkPrimTc FSLIT("Double#") doublePrimTyConKey doublePrimTyCon +statePrimTyConName = mkPrimTc FSLIT("State#") statePrimTyConKey statePrimTyCon +realWorldTyConName = mkPrimTc FSLIT("RealWorld") realWorldTyConKey realWorldTyCon +arrayPrimTyConName = mkPrimTc FSLIT("Array#") arrayPrimTyConKey arrayPrimTyCon +byteArrayPrimTyConName = mkPrimTc FSLIT("ByteArray#") byteArrayPrimTyConKey byteArrayPrimTyCon +mutableArrayPrimTyConName = mkPrimTc FSLIT("MutableArray#") mutableArrayPrimTyConKey mutableArrayPrimTyCon +mutableByteArrayPrimTyConName = mkPrimTc FSLIT("MutableByteArray#") mutableByteArrayPrimTyConKey mutableByteArrayPrimTyCon +mutVarPrimTyConName = mkPrimTc FSLIT("MutVar#") mutVarPrimTyConKey mutVarPrimTyCon +mVarPrimTyConName = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon +tVarPrimTyConName = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon +stablePtrPrimTyConName = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon +stableNamePrimTyConName = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon +bcoPrimTyConName = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon +weakPrimTyConName = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon +threadIdPrimTyConName = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon +\end{code} %************************************************************************ %* * @@ -103,10 +138,22 @@ primTyCons %* * %************************************************************************ +alphaTyVars is a list of type variables for use in templates: + ["a", "b", ..., "z", "t1", "t2", ... ] + \begin{code} +tyVarList :: Kind -> [TyVar] +tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u) + (mkTyVarOcc (mkFastString name)) + noSrcLoc) kind + | u <- [2..], + let name | c <= 'z' = [c] + | otherwise = 't':show u + where c = chr (u-2 + ord 'a') + ] + alphaTyVars :: [TyVar] -alphaTyVars = [ mkSysTyVar u boxedTypeKind - | u <- map mkAlphaTyVarUnique [2..] ] +alphaTyVars = tyVarList liftedTypeKind betaTyVars = tail alphaTyVars @@ -117,14 +164,10 @@ 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 - openAlphaTyVars :: [TyVar] -openAlphaTyVars = [ mkSysTyVar u openTypeKind - | u <- map mkAlphaTyVarUnique [2..] ] +openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind openAlphaTy = mkTyVarTy openAlphaTyVar @@ -147,39 +190,49 @@ vrcsZP = [vrcZero,vrcPos] \begin{code} -- only used herein -pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep -> TyCon -pcPrimTyCon key str arity arg_vrcs rep - = the_tycon +pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon +pcPrimTyCon name arg_vrcs rep + = mkPrimTyCon name kind arity arg_vrcs rep where - name = mkWiredInTyConName key pREL_GHC (mkSrcOccFS 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 + arity = length arg_vrcs + kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind + result_kind = unliftedTypeKind -- all primitive types are unlifted + +pcPrimTyCon0 :: Name -> PrimRep -> TyCon +pcPrimTyCon0 name rep + = mkPrimTyCon name result_kind 0 [] rep + where + result_kind = unliftedTypeKind -- all primitive types are unlifted charPrimTy = mkTyConTy charPrimTyCon -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 [] CharRep +charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep intPrimTy = mkTyConTy intPrimTyCon -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 [] IntRep +intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep + +int32PrimTy = mkTyConTy int32PrimTyCon +int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep int64PrimTy = mkTyConTy int64PrimTyCon -int64PrimTyCon = pcPrimTyCon int64PrimTyConKey SLIT("Int64#") 0 [] Int64Rep +int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep wordPrimTy = mkTyConTy wordPrimTyCon -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 [] WordRep +wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep + +word32PrimTy = mkTyConTy word32PrimTyCon +word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep word64PrimTy = mkTyConTy word64PrimTyCon -word64PrimTyCon = pcPrimTyCon word64PrimTyConKey SLIT("Word64#") 0 [] Word64Rep +word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep addrPrimTy = mkTyConTy addrPrimTyCon -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 [] AddrRep +addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep floatPrimTy = mkTyConTy floatPrimTyCon -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 [] FloatRep +floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep doublePrimTy = mkTyConTy doublePrimTyCon -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep +doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep \end{code} @@ -189,7 +242,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 +253,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 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 ptrArg). We never manipulate values of type +RealWorld; it's only used in the type system, to parameterise State#. \begin{code} +realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep realWorldTy = mkTyConTy realWorldTyCon -realWorldTyCon = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PrimPtrRep realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} @@ -225,15 +277,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 vrcsP PtrRep +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP PtrRep +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ PtrRep +byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName PtrRep mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon @@ -248,8 +295,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") - 2 vrcsZP PrimPtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -261,59 +307,47 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") - 2 vrcsZP PrimPtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} %************************************************************************ %* * -\subsection[TysPrim-stable-ptrs]{The stable-pointer type} +\subsection[TysPrim-stm-var]{The transactional variable type} %* * %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") - 1 vrcsP StablePtrRep +tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep -mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] +mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] \end{code} %************************************************************************ %* * -\subsection[TysPrim-stable-names]{The stable-name type} +\subsection[TysPrim-stable-ptrs]{The stable-pointer type} %* * %************************************************************************ \begin{code} -stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#") - 1 vrcsP StableNameRep +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep -mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] +mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] \end{code} %************************************************************************ %* * -\subsection[TysPrim-foreign-objs]{The ``foreign object'' type} +\subsection[TysPrim-stable-names]{The stable-name type} %* * %************************************************************************ -A Foreign Object is just a boxed, unlifted, Addr#. They're needed -because finalisers (weak pointers) can't watch Addr#s, they can only -watch heap-resident objects. - -We can't use a lifted Addr# (such as Addr) because race conditions -could bite us. For example, if the program deconstructed the Addr -before passing its contents to a ccall, and a weak pointer was -watching the Addr, the weak pointer might deduce that the Addr was -dead before it really was. - \begin{code} -foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon -foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [] ForeignObjRep +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} - + %************************************************************************ %* * \subsection[TysPrim-BCOs]{The ``bytecode object'' type} @@ -322,7 +356,7 @@ foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 [ \begin{code} bcoPrimTy = mkTyConTy bcoPrimTyCon -bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep \end{code} %************************************************************************ @@ -332,7 +366,7 @@ bcoPrimTyCon = pcPrimTyCon bcoPrimTyConKey SLIT("BCO#") 0 [] BCORep %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 vrcsP WeakPtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -354,31 +388,5 @@ to the thread id internally. \begin{code} threadIdPrimTy = mkTyConTy threadIdPrimTyCon -threadIdPrimTyCon = pcPrimTyCon threadIdPrimTyConKey SLIT("ThreadId#") 0 [] ThreadIdRep -\end{code} - -%************************************************************************ -%* * -\subsection[TysPrim-PrimRep]{Making types from PrimReps} -%* * -%************************************************************************ - -Each of the primitive types from this module is equivalent to a -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 StablePtrRep = stablePtrPrimTyCon -primRepTyCon ForeignObjRep = foreignObjPrimTyCon -primRepTyCon WeakPtrRep = weakPrimTyCon -primRepTyCon other = pprPanic "primRepTyCon" (ppr other) +threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep \end{code}