X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=4acf8a55b3e673f6e2004531aa1cbed213e3c53d;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=a64821db44e40d641de98b87be1793dc965f5c50;hpb=f9120c200bcf613b58d742802172fb4c08171f0d;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index a64821d..4acf8a5 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The AQUA Project, Glasgow University, 1994-1998 % \section[TysPrim]{Wired-in knowledge about primitive types} @@ -7,27 +7,76 @@ This module tracks the ``state interface'' document, ``GHC prelude: types and operations.'' \begin{code} -#include "HsVersions.h" - -module TysPrim where +module TysPrim( + alphaTyVars, 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, + weakPrimTyCon, mkWeakPrimTy, + foreignObjPrimTyCon, foreignObjPrimTy, + threadIdPrimTyCon, threadIdPrimTy, + + int64PrimTyCon, int64PrimTy, + word64PrimTyCon, word64PrimTy, + + primRepTyCon, + + pcPrimTyCon + ) where -import Ubiq +#include "HsVersions.h" -import Kind ( mkUnboxedTypeKind, mkBoxedTypeKind ) -import Name ( mkBuiltinName ) -import PrelMods ( pRELUDE_BUILTIN ) -import PrimRep ( PrimRep(..) ) -- getPrimRepInfo uses PrimRep repn -import TyCon ( mkPrimTyCon, mkDataTyCon, NewOrData(..) ) -import TyVar ( GenTyVar(..), alphaTyVars ) -import Type ( applyTyCon, mkTyVarTys ) -import Usage ( usageOmega ) +import Var ( TyVar, mkSysTyVar ) +import Name ( mkWiredInTyConName ) +import PrimRep ( PrimRep(..), isFollowableRep ) +import TyCon ( mkPrimTyCon, TyCon ) +import Type ( Type, + mkTyConApp, mkTyConTy, mkTyVarTys, + unboxedTypeKind, boxedTypeKind, openTypeKind, mkArrowKinds + ) +import PrelMods ( pREL_GHC ) +import Outputable import Unique - \end{code} \begin{code} +alphaTyVars :: [TyVar] +alphaTyVars = [ mkSysTyVar u boxedTypeKind + | u <- map mkAlphaTyVarUnique [2..] ] + +alphaTyVar, betaTyVar, gammaTyVar :: TyVar +(alphaTyVar:betaTyVar:gammaTyVar:deltaTyVar:_) = alphaTyVars + 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 + -- 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..] ] \end{code} %************************************************************************ @@ -38,64 +87,41 @@ alphaTys = mkTyVarTys alphaTyVars \begin{code} -- only used herein -pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING - -> Int -> ([PrimRep] -> PrimRep) -> TyCon -pcPrimTyCon key str arity{-UNUSED-} kind_fn{-UNUSED-} - = mkPrimTyCon name mkUnboxedTypeKind +pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon +pcPrimTyCon key str arity rep + = the_tycon where - name = mkBuiltinName key pRELUDE_BUILTIN str + name = mkWiredInTyConName key pREL_GHC str the_tycon + the_tycon = mkPrimTyCon name kind arity rep + kind = mkArrowKinds (take arity (repeat openTypeKind)) 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 -charPrimTy = applyTyCon charPrimTyCon [] -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 (\ [] -> CharRep) +intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 IntRep -intPrimTy = applyTyCon intPrimTyCon [] -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 (\ [] -> IntRep) +int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon = pcPrimTyCon int64PrimTyConKey SLIT("Int64#") 0 Int64Rep -wordPrimTy = applyTyCon wordPrimTyCon [] -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 (\ [] -> WordRep) +wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 WordRep -addrPrimTy = applyTyCon addrPrimTyCon [] -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 (\ [] -> AddrRep) +word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon = pcPrimTyCon word64PrimTyConKey SLIT("Word64#") 0 Word64Rep -floatPrimTy = applyTyCon floatPrimTyCon [] -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 (\ [] -> FloatRep) +addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 AddrRep -doublePrimTy = applyTyCon doublePrimTyCon [] -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 (\ [] -> DoubleRep) -\end{code} - -@PrimitiveKinds@ are used in @PrimitiveOps@, for which we often need -to reconstruct various type information. (It's slightly more -convenient/efficient to make type info from kinds, than kinds [etc.] -from type info.) +floatPrimTy = mkTyConTy floatPrimTyCon +floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 FloatRep -\begin{code} -getPrimRepInfo :: - PrimRep -> (String, -- tag string - Type, TyCon) -- prim type and tycon - -getPrimRepInfo CharRep = ("Char", charPrimTy, charPrimTyCon) -getPrimRepInfo IntRep = ("Int", intPrimTy, intPrimTyCon) -getPrimRepInfo WordRep = ("Word", wordPrimTy, wordPrimTyCon) -getPrimRepInfo AddrRep = ("Addr", addrPrimTy, addrPrimTyCon) -getPrimRepInfo FloatRep = ("Float", floatPrimTy, floatPrimTyCon) -getPrimRepInfo DoubleRep = ("Double", doublePrimTy, doublePrimTyCon) +doublePrimTy = mkTyConTy doublePrimTyCon +doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 DoubleRep \end{code} -%************************************************************************ -%* * -\subsection[TysPrim-void]{The @Void#@ type} -%* * -%************************************************************************ - -Very similar to the @State#@ type. -\begin{code} -voidPrimTy = applyTyCon voidPrimTyCon [] - where - voidPrimTyCon = pcPrimTyCon voidPrimTyConKey SLIT("Void#") 0 - (\ [] -> VoidRep) -\end{code} %************************************************************************ %* * @@ -103,32 +129,35 @@ voidPrimTy = applyTyCon voidPrimTyCon [] %* * %************************************************************************ +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] -> VoidRep) +mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] +statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1 VoidRep \end{code} @_RealWorld@ is deeply magical. It {\em is primitive}, but it -{\em is not unboxed}. -\begin{code} -realWorldTy = applyTyCon realWorldTyCon [] -realWorldTyCon - = mkDataTyCon name mkBoxedTypeKind - [{-no tyvars-}] - [{-no context-}] - [{-no data cons!-}] -- we tell you *nothing* about this guy - [{-no derivings-}] - DataType - where - name = mkBuiltinName realWorldTyConKey pRELUDE_BUILTIN SLIT("_RealWorld") +{\em is not unboxed} (hence PtrRep). +We never manipulate values of type RealWorld; it's only used in the type +system, to parameterise State#. +\begin{code} +realWorldTy = mkTyConTy realWorldTyCon +realWorldTyCon = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 PtrRep realWorldStatePrimTy = mkStatePrimTy realWorldTy \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} @@ -136,22 +165,30 @@ defined in \tr{TysWiredIn.lhs}, not here. %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 - (\ [elt_kind] -> ArrayRep) +arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 ArrayRep -byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 - (\ [] -> ByteArrayRep) +byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 ByteArrayRep -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 - (\ [s_kind, elt_kind] -> ArrayRep) +mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 ArrayRep -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 - (\ [s_kind] -> ByteArrayRep) +mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 ByteArrayRep -mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt] -byteArrayPrimTy = applyTyCon byteArrayPrimTyCon [] -mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt] -mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] +mkArrayPrimTy elt = mkTyConApp arrayPrimTyCon [elt] +byteArrayPrimTy = mkTyConTy byteArrayPrimTyCon +mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-mut-var]{The mutable variable type} +%* * +%************************************************************************ + +\begin{code} +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#") 2 PtrRep + +mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -161,10 +198,9 @@ mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 - (\ [s_kind, elt_kind] -> PtrRep) +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#") 2 PtrRep -mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] +mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -174,33 +210,85 @@ mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 - (\ [elt_kind] -> StablePtrRep) +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep + +mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [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 WeakPtrRep -mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] +mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} %************************************************************************ %* * -\subsection[TysPrim-malloc-ptrs]{The ``malloc''-pointer type} +\subsection[TysPrim-thread-ids]{The ``thread id'' 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. +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 - (\ [] -> MallocPtrRep) +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}