X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=b91ebfa078b4c98c174e7808bc694d49a68bf5a6;hb=20d387c481324aed48e8469d3fbf0695b3b2e365;hp=08d49a88be6df3f470d30441240a289c732e25fd;hpb=ae45ff0e9831a0dc862a5d68d03e355d7e323c62;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 08d49a8..b91ebfa 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,30 +7,136 @@ This module tracks the ``state interface'' document, ``GHC prelude: types and operations.'' \begin{code} -#include "HsVersions.h" +module TysPrim( + alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar, + alphaTy, betaTy, gammaTy, deltaTy, + openAlphaTy, openAlphaTyVar, openAlphaTyVars, + + primTyCons, + + 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, + bcoPrimTyCon, bcoPrimTy, + weakPrimTyCon, mkWeakPrimTy, + foreignObjPrimTyCon, foreignObjPrimTy, + threadIdPrimTyCon, threadIdPrimTy, + + int64PrimTyCon, int64PrimTy, + word64PrimTyCon, word64PrimTy, + + primRepTyCon, + + pcPrimTyCon + ) where -module TysPrim where +#include "HsVersions.h" -IMP_Ubiq(){-uitous-} +import Var ( TyVar, mkSysTyVar ) +import Name ( Name ) +import PrimRep ( PrimRep(..), isFollowableRep ) +import TyCon ( TyCon, ArgVrcs, mkPrimTyCon ) +import Type ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy, + unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKinds + ) +import Unique ( mkAlphaTyVarUnique ) +import PrelNames +import Outputable +\end{code} -import Kind ( mkUnboxedTypeKind, mkBoxedTypeKind, mkTypeKind, mkArrowKind ) -import Name ( mkPrimitiveName ) -import PrelMods ( gHC_BUILTINS ) -import PrimRep ( PrimRep(..) ) -- getPrimRepInfo uses PrimRep repn -import TyCon ( mkPrimTyCon, mkDataTyCon, NewOrData(..) ) -import Type ( mkTyConTy ) -import TyVar ( GenTyVar(..), alphaTyVars ) -import Type ( applyTyCon, mkTyVarTys ) -import Usage ( usageOmega ) -import Unique +%************************************************************************ +%* * +\subsection{Primitive type constructors} +%* * +%************************************************************************ +\begin{code} +primTyCons :: [TyCon] +primTyCons + = [ addrPrimTyCon + , arrayPrimTyCon + , byteArrayPrimTyCon + , charPrimTyCon + , doublePrimTyCon + , floatPrimTyCon + , intPrimTyCon + , int64PrimTyCon + , foreignObjPrimTyCon + , bcoPrimTyCon + , weakPrimTyCon + , mutableArrayPrimTyCon + , mutableByteArrayPrimTyCon + , mVarPrimTyCon + , mutVarPrimTyCon + , realWorldTyCon + , stablePtrPrimTyCon + , stableNamePrimTyCon + , statePrimTyCon + , threadIdPrimTyCon + , wordPrimTyCon + , word64PrimTyCon + ] \end{code} + +%************************************************************************ +%* * +\subsection{Support code} +%* * +%************************************************************************ + \begin{code} +alphaTyVars :: [TyVar] +alphaTyVars = [ mkSysTyVar u liftedTypeKind + | u <- map mkAlphaTyVarUnique [2..] ] + +betaTyVars = tail alphaTyVars + +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 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..] ] + +openAlphaTy = mkTyVarTy openAlphaTyVar + +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-basic]{Basic primitive types (@Char#@, @Int#@, etc.)} @@ -39,53 +145,39 @@ alphaTys = mkTyVarTys alphaTyVars \begin{code} -- only used herein -pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon - -pcPrimTyCon key str arity primrep - = mkPrimTyCon name (mk_kind arity) primrep +pcPrimTyCon :: Name -> Int -> ArgVrcs -> PrimRep -> TyCon +pcPrimTyCon name arity arg_vrcs rep + = the_tycon where - name = mkPrimitiveName key (OrigName gHC_BUILTINS str) + 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 - mk_kind 0 = mkUnboxedTypeKind - mk_kind n = mkTypeKind `mkArrowKind` mk_kind (n-1) +charPrimTy = mkTyConTy charPrimTyCon +charPrimTyCon = pcPrimTyCon charPrimTyConName 0 [] CharRep +intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon = pcPrimTyCon intPrimTyConName 0 [] IntRep -charPrimTy = applyTyCon charPrimTyCon [] -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 CharRep +int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon = pcPrimTyCon int64PrimTyConName 0 [] Int64Rep -intPrimTy = applyTyCon intPrimTyCon [] -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 IntRep +wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon = pcPrimTyCon wordPrimTyConName 0 [] WordRep -wordPrimTy = applyTyCon wordPrimTyCon [] -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 WordRep +word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon = pcPrimTyCon word64PrimTyConName 0 [] Word64Rep -addrPrimTy = applyTyCon addrPrimTyCon [] -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 AddrRep +addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon = pcPrimTyCon addrPrimTyConName 0 [] AddrRep -floatPrimTy = applyTyCon floatPrimTyCon [] -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 FloatRep +floatPrimTy = mkTyConTy floatPrimTyCon +floatPrimTyCon = pcPrimTyCon floatPrimTyConName 0 [] FloatRep -doublePrimTy = applyTyCon doublePrimTyCon [] -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 DoubleRep +doublePrimTy = mkTyConTy doublePrimTyCon +doublePrimTyCon = pcPrimTyCon doublePrimTyConName 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.) - -\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) -\end{code} %************************************************************************ %* * @@ -93,7 +185,7 @@ getPrimRepInfo DoubleRep = ("Double", doublePrimTy, doublePrimTyCon) %* * %************************************************************************ -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 @@ -103,54 +195,23 @@ 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 VoidRep +mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty] +statePrimTyCon = pcPrimTyCon statePrimTyConName 1 vrcsZ VoidRep \end{code} -@_RealWorld@ is deeply magical. It {\em is primitive}, but it -{\em is not unboxed}. -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} -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 = mkPrimitiveName realWorldTyConKey (OrigName gHC_BUILTINS SLIT("RealWorld")) - -realWorldStatePrimTy = mkStatePrimTy realWorldTy +realWorldTyCon = mkPrimTyCon realWorldTyConName liftedTypeKind 0 [] PrimPtrRep +realWorldTy = mkTyConTy realWorldTyCon +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. -\begin{code} --- The Void type is represented as a data type with no constructors --- It's a built in type (i.e. there's no way to define it in Haskell; --- the nearest would be --- --- data Void = -- No constructors! --- --- ) It's boxed; there is only one value of this --- type, namely "void", whose semantics is just bottom. -voidTy = mkTyConTy voidTyCon - -voidTyCon - = mkDataTyCon name mkBoxedTypeKind - [{-no tyvars-}] - [{-no context-}] - [{-no data cons!-}] - [{-no derivings-}] - DataType - where - name = mkPrimitiveName voidTyConKey (OrigName gHC_BUILTINS SLIT("Void")) -\end{code} %************************************************************************ %* * @@ -159,18 +220,27 @@ voidTyCon %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 ArrayRep - -byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 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 +mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] +\end{code} -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 ArrayRep +%************************************************************************ +%* * +\subsection[TysPrim-mut-var]{The mutable variable type} +%* * +%************************************************************************ -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 ByteArrayRep +\begin{code} +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName 2 vrcsZP PrimPtrRep -mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt] -byteArrayPrimTy = applyTyCon byteArrayPrimTyCon [] -mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt] -mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] +mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -180,9 +250,9 @@ mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] %************************************************************************ \begin{code} -synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 PtrRep +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName 2 vrcsZP PrimPtrRep -mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] +mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -192,9 +262,21 @@ mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName 1 vrcsP StablePtrRep -mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] +mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-stable-names]{The stable-name type} +%* * +%************************************************************************ + +\begin{code} +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName 1 vrcsP StableNameRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] \end{code} %************************************************************************ @@ -203,21 +285,86 @@ mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] %* * %************************************************************************ -Foreign objects (formerly ``Malloc'' pointers) provide a mechanism which -will let Haskell's garbage collector communicate with a {\em simple\/} -garbage collector in the IO world. 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 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 foreignObjPrimTyConName 0 [] ForeignObjRep +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-BCOs]{The ``bytecode object'' type} +%* * +%************************************************************************ + +\begin{code} +bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon = pcPrimTyCon bcoPrimTyConName 0 [] BCORep +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-Weak]{The ``weak pointer'' type} +%* * +%************************************************************************ + +\begin{code} +weakPrimTyCon = pcPrimTyCon weakPrimTyConName 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 threadIdPrimTyConName 0 [] ThreadIdRep +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-PrimRep]{Making types from PrimReps} +%* * +%************************************************************************ -There are no primitive operations on @ForeignObj#@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} -foreignObjPrimTy = applyTyCon foreignObjPrimTyCon [] -foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 ForeignObjRep +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) \end{code}