X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Fprelude%2FTysPrim.lhs;h=2f6168bafb0cf1c8e1146c37d7ff58cc9816650f;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=954659a01726da3f4f9e3b6dc05534c2b7bf4ddc;hpb=26741ec416bae2c502ef00a2ba0e79050a32cb67;p=ghc-hetmet.git diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 954659a..2f6168b 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -1,34 +1,187 @@ % -% (c) The AQUA Project, Glasgow University, 1994-1996 +% (c) The AQUA Project, Glasgow University, 1994-1998 % \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, + 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, + tVarPrimTyCon, mkTVarPrimTy, + stablePtrPrimTyCon, mkStablePtrPrimTy, + stableNamePrimTyCon, mkStableNamePrimTy, + bcoPrimTyCon, bcoPrimTy, + weakPrimTyCon, mkWeakPrimTy, + threadIdPrimTyCon, threadIdPrimTy, + + int32PrimTyCon, int32PrimTy, + word32PrimTyCon, word32PrimTy, + + int64PrimTyCon, int64PrimTy, + word64PrimTyCon, word64PrimTy + ) where + #include "HsVersions.h" -module TysPrim where +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 SrcLoc ( noSrcLoc ) +import Unique ( mkAlphaTyVarUnique ) +import PrelNames +import FastString ( FastString, mkFastString ) +import Outputable + +import Char ( ord, chr ) +\end{code} -IMP_Ubiq(){-uitous-} +%************************************************************************ +%* * +\subsection{Primitive type constructors} +%* * +%************************************************************************ -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 ( applyTyCon, mkTyVarTys, mkTyConTy ) -import TyVar ( GenTyVar(..), alphaTyVars ) -import Usage ( usageOmega ) -import Unique +\begin{code} +primTyCons :: [TyCon] +primTyCons + = [ addrPrimTyCon + , arrayPrimTyCon + , byteArrayPrimTyCon + , charPrimTyCon + , doublePrimTyCon + , floatPrimTyCon + , intPrimTyCon + , int32PrimTyCon + , int64PrimTyCon + , bcoPrimTyCon + , weakPrimTyCon + , mutableArrayPrimTyCon + , mutableByteArrayPrimTyCon + , mVarPrimTyCon + , tVarPrimTyCon + , mutVarPrimTyCon + , realWorldTyCon + , stablePtrPrimTyCon + , stableNamePrimTyCon + , statePrimTyCon + , threadIdPrimTyCon + , wordPrimTyCon + , word32PrimTyCon + , word64PrimTyCon + ] + +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} +%************************************************************************ +%* * +\subsection{Support code} +%* * +%************************************************************************ + +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 = tyVarList liftedTypeKind + +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") +openAlphaTyVars :: [TyVar] +openAlphaTyVars@(openAlphaTyVar:_) = tyVarList openTypeKind + +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.)} @@ -37,61 +190,59 @@ alphaTys = mkTyVarTys alphaTyVars \begin{code} -- only used herein -pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon +pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon +pcPrimTyCon name arg_vrcs rep + = mkPrimTyCon name kind arity arg_vrcs rep + where + arity = length arg_vrcs + kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind + result_kind = unliftedTypeKind -- all primitive types are unlifted -pcPrimTyCon key str arity primrep - = mkPrimTyCon name (mk_kind arity) primrep +pcPrimTyCon0 :: Name -> PrimRep -> TyCon +pcPrimTyCon0 name rep + = mkPrimTyCon name result_kind 0 [] rep where - name = mkPrimitiveName key (OrigName gHC_BUILTINS str) + 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 = pcPrimTyCon0 charPrimTyConName WordRep +intPrimTy = mkTyConTy intPrimTyCon +intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep -charPrimTy = applyTyCon charPrimTyCon [] -charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 CharRep +int32PrimTy = mkTyConTy int32PrimTyCon +int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep -intPrimTy = applyTyCon intPrimTyCon [] -intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 IntRep +int64PrimTy = mkTyConTy int64PrimTyCon +int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep -wordPrimTy = applyTyCon wordPrimTyCon [] -wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 WordRep +wordPrimTy = mkTyConTy wordPrimTyCon +wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep -addrPrimTy = applyTyCon addrPrimTyCon [] -addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 AddrRep +word32PrimTy = mkTyConTy word32PrimTyCon +word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep -floatPrimTy = applyTyCon floatPrimTyCon [] -floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 FloatRep +word64PrimTy = mkTyConTy word64PrimTyCon +word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep -doublePrimTy = applyTyCon doublePrimTyCon [] -doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 DoubleRep -\end{code} +addrPrimTy = mkTyConTy addrPrimTyCon +addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep -@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 = pcPrimTyCon0 floatPrimTyConName 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 = pcPrimTyCon0 doublePrimTyConName 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, +State# is the primitive, unlifted type of states. It has one type parameter, thus State# RealWorld or @@ -101,86 +252,76 @@ 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 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 ptrArg). 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 = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind 0 [] PtrRep +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. + +%************************************************************************ +%* * +\subsection[TysPrim-arrays]{The primitive array types} +%* * +%************************************************************************ + \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")) +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 +mkMutableArrayPrimTy s elt = mkTyConApp mutableArrayPrimTyCon [s, elt] +mkMutableByteArrayPrimTy s = mkTyConApp mutableByteArrayPrimTyCon [s] \end{code} %************************************************************************ %* * -\subsection[TysPrim-arrays]{The primitive array types} +\subsection[TysPrim-mut-var]{The mutable variable type} %* * %************************************************************************ \begin{code} -arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 ArrayRep +mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep -byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 ByteArrayRep +mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt] +\end{code} -mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 ArrayRep +%************************************************************************ +%* * +\subsection[TysPrim-synch-var]{The synchronizing variable type} +%* * +%************************************************************************ -mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 ByteArrayRep +\begin{code} +mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep -mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt] -byteArrayPrimTy = applyTyCon byteArrayPrimTyCon [] -mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt] -mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s] +mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt] \end{code} %************************************************************************ %* * -\subsection[TysPrim-synch-var]{The synchronizing variable type} +\subsection[TysPrim-stm-var]{The transactional variable type} %* * %************************************************************************ \begin{code} -synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2 PtrRep +tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep -mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] +mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt] \end{code} %************************************************************************ @@ -190,32 +331,62 @@ mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt] %************************************************************************ \begin{code} -stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep +stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep + +mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-stable-names]{The stable-name type} +%* * +%************************************************************************ + +\begin{code} +stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep + +mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-BCOs]{The ``bytecode object'' type} +%* * +%************************************************************************ + +\begin{code} +bcoPrimTy = mkTyConTy bcoPrimTyCon +bcoPrimTyCon = pcPrimTyCon0 bcoPrimTyConName PtrRep +\end{code} + +%************************************************************************ +%* * +\subsection[TysPrim-Weak]{The ``weak pointer'' type} +%* * +%************************************************************************ + +\begin{code} +weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep -mkStablePtrPrimTy ty = applyTyCon stablePtrPrimTyCon [ty] +mkWeakPrimTy v = mkTyConApp weakPrimTyCon [v] \end{code} %************************************************************************ %* * -\subsection[TysPrim-foreign-objs]{The ``foreign object'' type} +\subsection[TysPrim-thread-ids]{The ``thread id'' type} %* * %************************************************************************ -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 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. -There are no primitive operations on @ForeignObj#@s (although equality -could possibly be added?) +Hence the programmer API for thread manipulation uses a weak pointer +to the thread id internally. \begin{code} -foreignObjPrimTy = applyTyCon foreignObjPrimTyCon [] -foreignObjPrimTyCon = pcPrimTyCon foreignObjPrimTyConKey SLIT("ForeignObj#") 0 ForeignObjRep +threadIdPrimTy = mkTyConTy threadIdPrimTyCon +threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep \end{code}