X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=694492e3330127d3fdf3e2c5349bc0f20bfdf756;hb=f016aea1357b8ce5a4f3cd866b32761cfd25f841;hp=d70ed565dbaccd85bd62612695dca3846ff2ba2a;hpb=e7d21ee4f8ac907665a7e170c71d59e13a01da09;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index d70ed56..694492e 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1995 +% (c) The AQUA Project, Glasgow University, 1994-1998 % \section[TysPrim]{Wired-in knowledge about primitive types} @@ -7,84 +7,169 @@ This module tracks the ``state interface'' document, ``GHC prelude: types and operations.'' \begin{code} -#include "HsVersions.h" - -module TysPrim where +module TysPrim( + alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, + alphaTy, betaTy, gammaTy, deltaTy, + openAlphaTyVar, openAlphaTyVars, + + charPrimTyCon, charPrimTy, + intPrimTyCon, intPrimTy, + wordPrimTyCon, wordPrimTy, + addrPrimTyCon, addrPrimTy, + floatPrimTyCon, floatPrimTy, + doublePrimTyCon, doublePrimTy, + + statePrimTyCon, mkStatePrimTy, + realWorldTyCon, realWorldTy, realWorldStatePrimTy, + + arrayPrimTyCon, mkArrayPrimTy, + byteArrayPrimTyCon, byteArrayPrimTy, + mutableArrayPrimTyCon, mkMutableArrayPrimTy, + mutableByteArrayPrimTyCon, mkMutableByteArrayPrimTy, + mutVarPrimTyCon, mkMutVarPrimTy, + + mVarPrimTyCon, mkMVarPrimTy, + stablePtrPrimTyCon, mkStablePtrPrimTy, + stableNamePrimTyCon, mkStableNamePrimTy, + weakPrimTyCon, mkWeakPrimTy, + foreignObjPrimTyCon, foreignObjPrimTy, + threadIdPrimTyCon, threadIdPrimTy, + + int64PrimTyCon, int64PrimTy, + word64PrimTyCon, word64PrimTy, + + primRepTyCon, + + pcPrimTyCon + ) where -import PrelFuns -- help functions, types and things -import PrimKind +#include "HsVersions.h" -import AbsUniType ( applyTyCon ) +import Var ( TyVar, mkSysTyVar ) +import Name ( mkWiredInTyConName ) +import PrimRep ( PrimRep(..), isFollowableRep ) +import TyCon ( mkPrimTyCon, TyCon, ArgVrcs ) +import Type ( Type, + mkTyConApp, mkTyConTy, mkTyVarTys, + unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds + ) +import PrelMods ( pREL_GHC ) +import Outputable import Unique -import Util \end{code} -%************************************************************************ -%* * -\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} -%* * -%************************************************************************ - \begin{code} -charPrimTy = applyTyCon charPrimTyCon [] -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 (\ [] -> CharKind) +alphaTyVars :: [TyVar] +alphaTyVars = [ mkSysTyVar u boxedTypeKind + | u <- map mkAlphaTyVarUnique [2..] ] -intPrimTy = applyTyCon intPrimTyCon [] -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 (\ [] -> IntKind) +betaTyVars = tail alphaTyVars -wordPrimTy = applyTyCon wordPrimTyCon [] -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 (\ [] -> WordKind) +alphaTyVar, betaTyVar, gammaTyVar :: TyVar +(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars -addrPrimTy = applyTyCon addrPrimTyCon [] -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 (\ [] -> AddrKind) +alphaTys = mkTyVarTys alphaTyVars +(alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys -floatPrimTy = applyTyCon floatPrimTyCon [] -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 (\ [] -> FloatKind) + -- openAlphaTyVar is prepared to be instantiated + -- to a boxed or unboxed 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 -doublePrimTy = applyTyCon doublePrimTyCon [] -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 (\ [] -> DoubleKind) +openAlphaTyVars :: [TyVar] +openAlphaTyVars = [ mkSysTyVar u openTypeKind + | u <- map mkAlphaTyVarUnique [2..] ] + +vrcPos,vrcZero :: (Bool,Bool) +vrcPos = (True,False) +vrcZero = (False,False) + +vrcsP,vrcsZ,vrcsZP :: ArgVrcs +vrcsP = [vrcPos] +vrcsZ = [vrcZero] +vrcsZP = [vrcZero,vrcPos] \end{code} %************************************************************************ %* * -\subsection[TysPrim-void]{The @Void#@ type} +\subsection[TysPrim-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} %* * %************************************************************************ -Very similar to the @State#@ type. \begin{code} -voidPrimTy = applyTyCon voidPrimTyCon [] +-- only used herein +pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep -> TyCon +pcPrimTyCon key str arity arg_vrcs rep + = the_tycon where - voidPrimTyCon = pcPrimTyCon voidPrimTyConKey SLIT("Void#") 0 - (\ [] -> VoidKind) + name = mkWiredInTyConName key pREL_GHC 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 + +charPrimTy = mkTyConTy charPrimTyCon +charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 [] CharRep + +intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 [] IntRep + +int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon = pcPrimTyCon int64PrimTyConKey SLIT("Int64#") 0 [] Int64Rep + +wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 [] WordRep + +word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon = pcPrimTyCon word64PrimTyConKey SLIT("Word64#") 0 [] Word64Rep + +addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 [] AddrRep + +floatPrimTy = mkTyConTy floatPrimTyCon +floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 [] FloatRep + +doublePrimTy = mkTyConTy doublePrimTyCon +doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 [] DoubleRep \end{code} + %************************************************************************ %* * \subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)} %* * %************************************************************************ +State# is the primitive, unboxed type of states. It has one type parameter, +thus + State# RealWorld +or + State# s + +where s is a type variable. The only purpose of the type parameter is to +keep different state threads separate. It is represented by nothing at all. + \begin{code} -mkStatePrimTy ty = applyTyCon statePrimTyCon [ty] -statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 - (\ [s_kind] -> VoidKind) +mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] +statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 vrcsZ VoidRep \end{code} @_RealWorld@ is deeply magical. It {\em is primitive}, but it -{\em is not unboxed}. -\begin{code} -realWorldTy = applyTyCon realWorldTyCon [] -realWorldTyCon - = pcDataTyCon realWorldTyConKey pRELUDE_BUILTIN SLIT("_RealWorld") [] - [{-no data cons!-}] -- we tell you *nothing* about this guy +{\em is not unboxed} (hence PtrRep). +We never manipulate values of type RealWorld; it's only used in the type +system, to parameterise State#. -realWorldStatePrimTy = mkStatePrimTy realWorldTy +\begin{code} +realWorldTy = mkTyConTy realWorldTyCon +realWorldTyCon = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PtrRep +realWorldStatePrimTy = mkStatePrimTy realWorldTy -- State# RealWorld \end{code} Note: the ``state-pairing'' types are not truly primitive, so they are defined in \tr{TysWiredIn.lhs}, not here. + %************************************************************************ %* * \subsection[TysPrim-arrays]{The primitive array types} @@ -92,22 +177,33 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 - (\ [elt_kind] -> ArrayKind) +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 vrcsP ArrayRep + +byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 [] ByteArrayRep -byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 - (\ [] -> ByteArrayKind) +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") + 2 vrcsZP ArrayRep -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 - (\ [s_kind, elt_kind] -> ArrayKind) +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") + 1 vrcsZ ByteArrayRep -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 - (\ [s_kind] -> ByteArrayKind) +mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] +byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon +mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] +\end{code} -mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt] -byteArrayPrimTy = applyTyCon byteArrayPrimTyCon [] -mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt] -mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] +%************************************************************************ +%* * +\subsection[TysPrim-mut-var]{The mutable variable type} +%* * +%************************************************************************ + +\begin{code} +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") + 2 vrcsZP PtrRep + +mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -117,10 +213,10 @@ mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 - (\ [s_kind, elt_kind] -> PtrKind) +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") + 2 vrcsZP PtrRep -mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] +mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -130,33 +226,99 @@ mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 - (\ [elt_kind] -> StablePtrKind) +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") + 1 vrcsP StablePtrRep -mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] +mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] \end{code} %************************************************************************ %* * -\subsection[TysPrim-malloc-ptrs]{The ``malloc''-pointer type} +\subsection[TysPrim-stable-names]{The stable-name type} %* * %************************************************************************ -``Malloc'' pointers provide a mechanism which will let Haskell's -garbage collector communicate with a {\em simple\/} garbage collector -in the IO world (probably \tr{malloc}, hence the name).We want Haskell -to be able to hold onto references to objects in the IO world and for -Haskell's garbage collector to tell the IO world when these references -become garbage. We are not aiming to provide a mechanism that could -talk to a sophisticated garbage collector such as that provided by a -LISP system (with a correspondingly complex interface); in particular, -we shall ignore the danger of circular structures spread across the -two systems. +\begin{code} +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#") + 1 vrcsP StableNameRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-foreign-objs]{The ``foreign object'' 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 +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-Weak]{The ``weak pointer'' type} +%* * +%************************************************************************ + +\begin{code} +weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 vrcsP WeakPtrRep + +mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-thread-ids]{The ``thread id'' type} +%* * +%************************************************************************ + +A thread id is represented by a pointer to the TSO itself, to ensure +that they are always unique and we can always find the TSO for a given +thread id. However, this has the unfortunate consequence that a +ThreadId# for a given thread is treated as a root by the garbage +collector and can keep TSOs around for too long. + +Hence the programmer API for thread manipulation uses a weak pointer +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} +%* * +%************************************************************************ -There are no primitive operations on @CHeapPtr#@s (although equality -could possibly be added?) +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} -mallocPtrPrimTyCon = pcPrimTyCon mallocPtrPrimTyConKey SLIT("MallocPtr#") 0 - (\ [] -> MallocPtrKind) +primRepTyCon CharRep = 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) \end{code}