X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=2f6168bafb0cf1c8e1146c37d7ff58cc9816650f;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=d01b25fac0d6071f1857b0fca16656ab6eb736f5;hpb=9e93335020e64a811dbbb223e1727c76933a93ae;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index d01b25f..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,34 +28,39 @@ module TysPrim( mutVarPrimTyCon, mkMutVarPrimTy, mVarPrimTyCon, mkMVarPrimTy, + tVarPrimTyCon, mkTVarPrimTy, stablePtrPrimTyCon, mkStablePtrPrimTy, stableNamePrimTyCon, mkStableNamePrimTy, bcoPrimTyCon, bcoPrimTy, weakPrimTyCon, mkWeakPrimTy, - foreignObjPrimTyCon, foreignObjPrimTy, threadIdPrimTyCon, threadIdPrimTy, int32PrimTyCon, int32PrimTy, word32PrimTyCon, word32PrimTy, int64PrimTyCon, int64PrimTy, - word64PrimTyCon, word64PrimTy, - - primRepTyCon + word64PrimTyCon, word64PrimTy ) where #include "HsVersions.h" -import Var ( TyVar, mkSysTyVar ) -import Name ( Name ) -import PrimRep ( PrimRep(..) ) -import TyCon ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon ) +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, mkArrowKinds + unliftedTypeKind, liftedTypeKind, openTypeKind, + Kind, mkArrowKinds, + TyThing(..) ) +import SrcLoc ( noSrcLoc ) import Unique ( mkAlphaTyVarUnique ) import PrelNames +import FastString ( FastString, mkFastString ) import Outputable + +import Char ( ord, chr ) \end{code} %************************************************************************ @@ -79,12 +81,12 @@ primTyCons , intPrimTyCon , int32PrimTyCon , int64PrimTyCon - , foreignObjPrimTyCon , bcoPrimTyCon , weakPrimTyCon , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon , mVarPrimTyCon + , tVarPrimTyCon , mutVarPrimTyCon , realWorldTyCon , stablePtrPrimTyCon @@ -95,8 +97,40 @@ primTyCons , 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} %************************************************************************ %* * @@ -104,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 liftedTypeKind - | u <- map mkAlphaTyVarUnique [2..] ] +alphaTyVars = tyVarList liftedTypeKind betaTyVars = tail alphaTyVars @@ -120,12 +166,8 @@ alphaTys = mkTyVarTys alphaTyVars -- openAlphaTyVar is prepared to be instantiated -- 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 @@ -163,13 +205,13 @@ pcPrimTyCon0 name rep result_kind = unliftedTypeKind -- all primitive types are unlifted charPrimTy = mkTyConTy charPrimTyCon -charPrimTyCon = pcPrimTyCon0 charPrimTyConName CharRep +charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep intPrimTy = mkTyConTy intPrimTyCon intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep int32PrimTy = mkTyConTy int32PrimTyCon -int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep +int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep int64PrimTy = mkTyConTy int64PrimTyCon int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep @@ -178,7 +220,7 @@ wordPrimTy = mkTyConTy wordPrimTyCon wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep word32PrimTy = mkTyConTy word32PrimTyCon -word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName Word32Rep +word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep word64PrimTy = mkTyConTy word64PrimTyCon word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep @@ -215,11 +257,11 @@ statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep \end{code} RealWorld is deeply magical. It is *primitive*, but it is not -*unlifted* (hence PrimPtrRep). We never manipulate values of type +*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 [] PrimPtrRep +realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep realWorldTy = mkTyConTy realWorldTyCon realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} @@ -235,10 +277,10 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConName vrcsP ArrayRep -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConName vrcsZP ArrayRep -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConName vrcsZ ByteArrayRep -byteArrayPrimTyCon = pcPrimTyCon0 byteArrayPrimTyConName 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 @@ -253,7 +295,7 @@ mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PrimPtrRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} @@ -265,56 +307,47 @@ mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName 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 stablePtrPrimTyConName 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 stableNamePrimTyConName 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 = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} - + %************************************************************************ %* * \subsection[TysPrim-BCOs]{The ``bytecode object'' type} @@ -323,7 +356,7 @@ foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName ForeignObjRep \begin{code} bcoPrimTy = mkTyConTy bcoPrimTyCon -bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep \end{code} %************************************************************************ @@ -333,7 +366,7 @@ bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName BCORep %************************************************************************ \begin{code} -weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP WeakPtrRep +weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} @@ -355,33 +388,5 @@ to the thread id internally. \begin{code} threadIdPrimTy = mkTyConTy threadIdPrimTyCon -threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName 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 Int32Rep = int32PrimTyCon -primRepTyCon Int64Rep = int64PrimTyCon -primRepTyCon Word32Rep = word32PrimTyCon -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}