%
-% (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}
-#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,
+ tVarPrimTyCon, mkTVarPrimTy,
+ stablePtrPrimTyCon, mkStablePtrPrimTy,
+ stableNamePrimTyCon, mkStableNamePrimTy,
+ bcoPrimTyCon, bcoPrimTy,
+ weakPrimTyCon, mkWeakPrimTy,
+ threadIdPrimTyCon, threadIdPrimTy,
+
+ int32PrimTyCon, int32PrimTy,
+ word32PrimTyCon, word32PrimTy,
+
+ int64PrimTyCon, int64PrimTy,
+ word64PrimTyCon, word64PrimTy
+ ) where
-module TysPrim where
+#include "HsVersions.h"
-import Ubiq
+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}
-import Kind ( mkUnboxedTypeKind, mkBoxedTypeKind )
-import NameTypes ( mkPreludeCoreName, FullName )
-import PrelMods ( pRELUDE_BUILTIN )
-import PrimRep ( PrimRep(..) ) -- getPrimRepInfo uses PrimRep repn
-import TyCon ( mkPrimTyCon, mkDataTyCon,
- ConsVisible(..), NewOrData(..) )
-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
+ , 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.)}
\begin{code}
-- only used herein
-pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ([PrimRep] -> PrimRep) -> TyCon
-pcPrimTyCon key name arity{-UNUSED-} kind_fn{-UNUSED-}
- = mkPrimTyCon key full_name mkUnboxedTypeKind
+pcPrimTyCon :: Name -> ArgVrcs -> PrimRep -> TyCon
+pcPrimTyCon name arg_vrcs rep
+ = mkPrimTyCon name kind arity arg_vrcs rep
where
- full_name = mkPreludeCoreName pRELUDE_BUILTIN name
+ arity = length arg_vrcs
+ kind = mkArrowKinds (replicate arity liftedTypeKind) result_kind
+ result_kind = unliftedTypeKind -- all primitive types are unlifted
+
+pcPrimTyCon0 :: Name -> PrimRep -> TyCon
+pcPrimTyCon0 name rep
+ = mkPrimTyCon name result_kind 0 [] rep
+ where
+ result_kind = unliftedTypeKind -- all primitive types are unlifted
+
+charPrimTy = mkTyConTy charPrimTyCon
+charPrimTyCon = pcPrimTyCon0 charPrimTyConName WordRep
+
+intPrimTy = mkTyConTy intPrimTyCon
+intPrimTyCon = pcPrimTyCon0 intPrimTyConName IntRep
+
+int32PrimTy = mkTyConTy int32PrimTyCon
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep
+int64PrimTy = mkTyConTy int64PrimTyCon
+int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
-charPrimTy = applyTyCon charPrimTyCon []
-charPrimTyCon = pcPrimTyCon charPrimTyConKey SLIT("Char#") 0 (\ [] -> CharRep)
+wordPrimTy = mkTyConTy wordPrimTyCon
+wordPrimTyCon = pcPrimTyCon0 wordPrimTyConName WordRep
-intPrimTy = applyTyCon intPrimTyCon []
-intPrimTyCon = pcPrimTyCon intPrimTyConKey SLIT("Int#") 0 (\ [] -> IntRep)
+word32PrimTy = mkTyConTy word32PrimTyCon
+word32PrimTyCon = pcPrimTyCon0 word32PrimTyConName WordRep
-wordPrimTy = applyTyCon wordPrimTyCon []
-wordPrimTyCon = pcPrimTyCon wordPrimTyConKey SLIT("Word#") 0 (\ [] -> WordRep)
+word64PrimTy = mkTyConTy word64PrimTyCon
+word64PrimTyCon = pcPrimTyCon0 word64PrimTyConName Word64Rep
+
+addrPrimTy = mkTyConTy addrPrimTyCon
+addrPrimTyCon = pcPrimTyCon0 addrPrimTyConName AddrRep
+
+floatPrimTy = mkTyConTy floatPrimTyCon
+floatPrimTyCon = pcPrimTyCon0 floatPrimTyConName FloatRep
+
+doublePrimTy = mkTyConTy doublePrimTyCon
+doublePrimTyCon = pcPrimTyCon0 doublePrimTyConName DoubleRep
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsection[TysPrim-state]{The @State#@ type (and @_RealWorld@ types)}
+%* *
+%************************************************************************
-addrPrimTy = applyTyCon addrPrimTyCon []
-addrPrimTyCon = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 (\ [] -> AddrRep)
+State# is the primitive, unlifted type of states. It has one type parameter,
+thus
+ State# RealWorld
+or
+ State# s
-floatPrimTy = applyTyCon floatPrimTyCon []
-floatPrimTyCon = pcPrimTyCon floatPrimTyConKey SLIT("Float#") 0 (\ [] -> FloatRep)
+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.
-doublePrimTy = applyTyCon doublePrimTyCon []
-doublePrimTyCon = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 (\ [] -> DoubleRep)
+\begin{code}
+mkStatePrimTy ty = mkTyConApp statePrimTyCon [ty]
+statePrimTyCon = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
\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.)
+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}
-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)
+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-void]{The @Void#@ type}
+\subsection[TysPrim-arrays]{The primitive array types}
%* *
%************************************************************************
-Very similar to the @State#@ type.
\begin{code}
-voidPrimTy = applyTyCon voidPrimTyCon []
- where
- voidPrimTyCon = pcPrimTyCon voidPrimTyConKey SLIT("Void#") 0
- (\ [] -> VoidRep)
+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-state]{The @State#@ type (and @_RealWorld@ types)}
+\subsection[TysPrim-mut-var]{The mutable variable type}
%* *
%************************************************************************
\begin{code}
-mkStatePrimTy ty = applyTyCon statePrimTyCon [ty]
-statePrimTyCon = pcPrimTyCon statePrimTyConKey SLIT("State#") 1
- (\ [s_kind] -> VoidRep)
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConName vrcsZP PtrRep
+
+mkMutVarPrimTy s elt = mkTyConApp mutVarPrimTyCon [s, elt]
\end{code}
-@_RealWorld@ is deeply magical. It {\em is primitive}, but it
-{\em is not unboxed}.
+%************************************************************************
+%* *
+\subsection[TysPrim-synch-var]{The synchronizing variable type}
+%* *
+%************************************************************************
+
\begin{code}
-realWorldTy = applyTyCon realWorldTyCon []
-realWorldTyCon
- = mkDataTyCon realWorldTyConKey mkBoxedTypeKind full_name
- [{-no tyvars-}]
- [{-no context-}]
- [{-no data cons!-}] -- we tell you *nothing* about this guy
- [{-no derivings-}]
- ConsInvisible
- DataType
- where
- full_name = mkPreludeCoreName pRELUDE_BUILTIN SLIT("_RealWorld")
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConName vrcsZP PtrRep
-realWorldStatePrimTy = mkStatePrimTy realWorldTy
+mkMVarPrimTy s elt = mkTyConApp mVarPrimTyCon [s, elt]
\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}
+\subsection[TysPrim-stm-var]{The transactional variable type}
%* *
%************************************************************************
\begin{code}
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1
- (\ [elt_kind] -> ArrayRep)
+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep
-byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0
- (\ [] -> ByteArrayRep)
+mkTVarPrimTy s elt = mkTyConApp tVarPrimTyCon [s, elt]
+\end{code}
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2
- (\ [s_kind, elt_kind] -> ArrayRep)
+%************************************************************************
+%* *
+\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
+%* *
+%************************************************************************
-mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1
- (\ [s_kind] -> ByteArrayRep)
+\begin{code}
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep
-mkArrayPrimTy elt = applyTyCon arrayPrimTyCon [elt]
-byteArrayPrimTy = applyTyCon byteArrayPrimTyCon []
-mkMutableArrayPrimTy s elt = applyTyCon mutableArrayPrimTyCon [s, elt]
-mkMutableByteArrayPrimTy s = applyTyCon mutableByteArrayPrimTyCon [s]
+mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
\end{code}
%************************************************************************
%* *
-\subsection[TysPrim-synch-var]{The synchronizing variable type}
+\subsection[TysPrim-stable-names]{The stable-name type}
%* *
%************************************************************************
\begin{code}
-synchVarPrimTyCon = pcPrimTyCon synchVarPrimTyConKey SLIT("SynchVar#") 2
- (\ [s_kind, elt_kind] -> PtrRep)
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConName vrcsP PtrRep
-mkSynchVarPrimTy s elt = applyTyCon synchVarPrimTyCon [s, elt]
+mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
\end{code}
%************************************************************************
%* *
-\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
+\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}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1
- (\ [elt_kind] -> StablePtrRep)
+weakPrimTyCon = pcPrimTyCon weakPrimTyConName vrcsP PtrRep
-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.
-There are no primitive operations on @CHeapPtr#@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}
-mallocPtrPrimTyCon = pcPrimTyCon mallocPtrPrimTyConKey SLIT("MallocPtr#") 0
- (\ [] -> MallocPtrRep)
+threadIdPrimTy = mkTyConTy threadIdPrimTyCon
+threadIdPrimTyCon = pcPrimTyCon0 threadIdPrimTyConName PtrRep
\end{code}
projects / ghc-hetmet.git / blobdiff