%
-% (c) The AQUA Project, Glasgow University, 1994-1996
+% (c) The AQUA Project, Glasgow University, 1994-1998
%
\section[TysPrim]{Wired-in knowledge about primitive types}
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}
%************************************************************************
\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}
%************************************************************************
%* *
%* *
%************************************************************************
+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}
%************************************************************************
\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}
%************************************************************************
%************************************************************************
\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}
%************************************************************************
%************************************************************************
\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}
projects / ghc-hetmet.git / blobdiff