[project @ 1999-05-18 15:03:54 by simonpj]
[ghc-hetmet.git] / ghc / compiler / prelude / TysPrim.lhs
index 17ee58e..694492e 100644 (file)
@@ -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,26 +7,88 @@ This module tracks the ``state interface'' document, ``GHC prelude:
 types and operations.''
 
 \begin{code}
-#include "HsVersions.h"
-
-module TysPrim where
+module TysPrim(
+       alphaTyVars, betaTyVars, 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,
+       stableNamePrimTyCon,            mkStableNamePrimTy,
+       weakPrimTyCon,                  mkWeakPrimTy,
+       foreignObjPrimTyCon,            foreignObjPrimTy,
+       threadIdPrimTyCon,              threadIdPrimTy,
+       
+       int64PrimTyCon,         int64PrimTy,
+       word64PrimTyCon,        word64PrimTy,
+
+       primRepTyCon,
+
+       pcPrimTyCon
+  ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
-import Kind            ( mkUnboxedTypeKind, mkBoxedTypeKind, mkTypeKind, mkArrowKind )
+import Var             ( TyVar, mkSysTyVar )
 import Name            ( mkWiredInTyConName )
-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 PrelMods                ( gHC__ )
+import PrimRep         ( PrimRep(..), isFollowableRep )
+import TyCon           ( mkPrimTyCon, TyCon, ArgVrcs )
+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..] ]
+
+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 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..] ]
+
+vrcPos,vrcZero :: (Bool,Bool)
+vrcPos  = (True,False)
+vrcZero = (False,False)
+
+vrcsP,vrcsZ,vrcsZP :: ArgVrcs
+vrcsP  = [vrcPos]
+vrcsZ  = [vrcZero]
+vrcsZP = [vrcZero,vrcPos]
 \end{code}
 
 %************************************************************************
@@ -37,54 +99,42 @@ alphaTys = mkTyVarTys alphaTyVars
 
 \begin{code}
 -- only used herein
-pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> PrimRep -> TyCon
-
-pcPrimTyCon key str arity primrep
+pcPrimTyCon :: Unique{-TyConKey-} -> FAST_STRING -> Int -> ArgVrcs -> PrimRep -> TyCon
+pcPrimTyCon key str arity arg_vrcs rep
   = the_tycon
   where
-    name      = mkWiredInTyConName key gHC__ str the_tycon
-    the_tycon = mkPrimTyCon name (mk_kind arity) primrep
-    mk_kind 0 = mkUnboxedTypeKind
-    mk_kind n = mkTypeKind `mkArrowKind` mk_kind (n-1)
+    name      = mkWiredInTyConName key pREL_GHC str the_tycon
+    the_tycon = mkPrimTyCon name kind arity arg_vrcs rep
+    kind      = mkArrowKinds (take arity (repeat boxedTypeKind)) 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
-
-doublePrimTy   = applyTyCon doublePrimTyCon []
-doublePrimTyCon        = pcPrimTyCon doublePrimTyConKey SLIT("Double#") 0 DoubleRep
-\end{code}
+addrPrimTy     = mkTyConTy addrPrimTyCon
+addrPrimTyCon  = pcPrimTyCon addrPrimTyConKey SLIT("Addr#") 0 [] 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 = 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-state]{The @State#@ type (and @_RealWorld@ types)}
@@ -101,116 +151,174 @@ 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 statePrimTyConKey SLIT("State#") 1 vrcsZ VoidRep
 \end{code}
 
 @_RealWorld@ is deeply magical.  It {\em is primitive}, but it
-{\em is not unboxed}.
+{\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         = applyTyCon realWorldTyCon []
-realWorldTyCon      = mk_no_constr_tycon realWorldTyConKey SLIT("RealWorld") 
-realWorldStatePrimTy = mkStatePrimTy realWorldTy
+realWorldTy         = mkTyConTy realWorldTyCon
+realWorldTyCon      = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PtrRep
+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 = mk_no_constr_tycon voidTyConKey SLIT("Void")
+arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 vrcsP ArrayRep
+
+byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 [] ByteArrayRep
+
+mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 
+                                    2 vrcsZP ArrayRep
+
+mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#")
+                                        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}
 
+%************************************************************************
+%*                                                                     *
+\subsection[TysPrim-mut-var]{The mutable variable type}
+%*                                                                     *
+%************************************************************************
+
 \begin{code}
-mk_no_constr_tycon key str
-  = the_tycon
-  where
-    name      = mkWiredInTyConName key gHC__ str the_tycon
-    the_tycon = mkDataTyCon name mkBoxedTypeKind 
-                       [{-no tyvars-}]
-                       [{-no context-}]
-                       [{-no data cons!-}] -- we tell you *nothing* about this guy
-                       [{-no derivings-}]
-                       DataType
+mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#")
+                              2 vrcsZP PtrRep
+
+mkMutVarPrimTy s elt       = mkTyConApp mutVarPrimTyCon [s, elt]
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[TysPrim-arrays]{The primitive array types}
+\subsection[TysPrim-synch-var]{The synchronizing variable type}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-arrayPrimTyCon = pcPrimTyCon arrayPrimTyConKey SLIT("Array#") 1 ArrayRep
+mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#")
+                            2 vrcsZP PtrRep
 
-byteArrayPrimTyCon = pcPrimTyCon byteArrayPrimTyConKey SLIT("ByteArray#") 0 ByteArrayRep
+mkMVarPrimTy s elt         = mkTyConApp mVarPrimTyCon [s, elt]
+\end{code}
 
-mutableArrayPrimTyCon = pcPrimTyCon mutableArrayPrimTyConKey SLIT("MutableArray#") 2 ArrayRep
+%************************************************************************
+%*                                                                     *
+\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
+%*                                                                     *
+%************************************************************************
 
-mutableByteArrayPrimTyCon = pcPrimTyCon mutableByteArrayPrimTyConKey SLIT("MutableByteArray#") 1 ByteArrayRep
+\begin{code}
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#")
+                                 1 vrcsP StablePtrRep
 
-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 PtrRep
+stableNamePrimTyCon = pcPrimTyCon stableNamePrimTyConKey SLIT("StableName#")
+                                  1 vrcsP StableNameRep
 
-mkSynchVarPrimTy s elt             = applyTyCon synchVarPrimTyCon [s, elt]
+mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty]
 \end{code}
 
 %************************************************************************
 %*                                                                     *
-\subsection[TysPrim-stable-ptrs]{The stable-pointer type}
+\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}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConKey SLIT("StablePtr#") 1 StablePtrRep
+weakPrimTyCon = pcPrimTyCon weakPrimTyConKey SLIT("Weak#") 1 vrcsP WeakPtrRep
 
-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.
+
+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 @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 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}