[project @ 2004-11-18 09:56:07 by tharris]

[ghc-hetmet.git] / ghc / compiler / prelude / TysPrim.lhs

diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 9ba2887..155fdf8 100644 (file)
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -28,6 +28,7 @@ module TysPrim(
        mutVarPrimTyCon,                mkMutVarPrimTy,
 
        mVarPrimTyCon,                  mkMVarPrimTy,   
+        tVarPrimTyCon,                  mkTVarPrimTy,
        stablePtrPrimTyCon,             mkStablePtrPrimTy,
        stableNamePrimTyCon,            mkStableNamePrimTy,
        bcoPrimTyCon,                   bcoPrimTy,
@@ -45,18 +46,19 @@ module TysPrim(
 #include "HsVersions.h"
 
 import Var             ( TyVar, mkTyVar )
-import Name            ( Name, mkInternalName )
-import OccName         ( mkVarOcc )
-import PrimRep         ( PrimRep(..) )
-import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon )
+import Name            ( Name, BuiltInSyntax(..), mkInternalName, mkWiredInName )
+import OccName         ( mkVarOcc, mkOccFS, tcName )
+import TyCon           ( TyCon, ArgVrcs, mkPrimTyCon, mkLiftedPrimTyCon,
+                         PrimRep(..) )
 import Type            ( mkTyConApp, mkTyConTy, mkTyVarTys, mkTyVarTy,
                          unliftedTypeKind, liftedTypeKind, openTypeKind, 
-                         Kind, mkArrowKinds
+                         Kind, mkArrowKinds,
+                         TyThing(..)
                        )
 import SrcLoc          ( noSrcLoc )
 import Unique          ( mkAlphaTyVarUnique )
 import PrelNames
-import FastString      ( mkFastString )
+import FastString      ( FastString, mkFastString )
 import Outputable
 
 import Char            ( ord, chr )
@@ -86,6 +88,7 @@ primTyCons
     , mutableArrayPrimTyCon
     , mutableByteArrayPrimTyCon
     , mVarPrimTyCon
+    , tVarPrimTyCon
     , mutVarPrimTyCon
     , realWorldTyCon
     , stablePtrPrimTyCon
@@ -96,8 +99,41 @@ primTyCons
     , word32PrimTyCon
     , word64PrimTyCon
     ]
-\end{code}
 
+mkPrimTc :: FastString -> Unique -> TyCon -> Name
+mkPrimTc fs uniq tycon
+  = mkWiredInName gHC_PRIM (mkOccFS 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
+foreignObjPrimTyConName       = mkPrimTc FSLIT("ForeignObj#") foreignObjPrimTyConKey foreignObjPrimTyCon
+bcoPrimTyConName             = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon
+weakPrimTyConName            = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon
+threadIdPrimTyConName                = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon
+\end{code}
 
 %************************************************************************
 %*                                                                     *
@@ -172,13 +208,13 @@ pcPrimTyCon0 name rep
     result_kind = unliftedTypeKind -- all primitive types are unlifted
 
 charPrimTy     = mkTyConTy charPrimTyCon
-charPrimTyCon  = pcPrimTyCon0 charPrimTyConName CharRep
+charPrimTyCon  = pcPrimTyCon0 charPrimTyConName WordRep
 
 intPrimTy      = mkTyConTy intPrimTyCon
 intPrimTyCon   = pcPrimTyCon0 intPrimTyConName IntRep
 
 int32PrimTy    = mkTyConTy int32PrimTyCon
-int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName Int32Rep
+int32PrimTyCon = pcPrimTyCon0 int32PrimTyConName IntRep
 
 int64PrimTy    = mkTyConTy int64PrimTyCon
 int64PrimTyCon = pcPrimTyCon0 int64PrimTyConName Int64Rep
@@ -187,7 +223,7 @@ wordPrimTy  = mkTyConTy wordPrimTyCon
 wordPrimTyCon  = pcPrimTyCon0 wordPrimTyConName WordRep
 
 word32PrimTy   = mkTyConTy word32PrimTyCon
-word32PrimTyCon        = pcPrimTyCon0 word32PrimTyConName Word32Rep
+word32PrimTyCon        = pcPrimTyCon0 word32PrimTyConName WordRep
 
 word64PrimTy   = mkTyConTy word64PrimTyCon
 word64PrimTyCon        = pcPrimTyCon0 word64PrimTyConName Word64Rep
@@ -224,7 +260,7 @@ statePrimTyCon       = pcPrimTyCon statePrimTyConName vrcsZ VoidRep
 \end{code}
 
 RealWorld is deeply magical.  It is *primitive*, but it is not
-*unlifted* (hence PtrRep).  We never manipulate values of type
+*unlifted* (hence ptrArg).  We never manipulate values of type
 RealWorld; it's only used in the type system, to parameterise State#.
 
 \begin{code}
@@ -281,12 +317,24 @@ mkMVarPrimTy s elt            = mkTyConApp mVarPrimTyCon [s, elt]
 
 %************************************************************************
 %*                                                                     *
+\subsection[TysPrim-stm-var]{The transactional variable type}
+%*                                                                     *
+%************************************************************************
+
+\begin{code}
+tVarPrimTyCon = pcPrimTyCon tVarPrimTyConName vrcsZP PtrRep
+
+mkTVarPrimTy s elt         = mkTyConApp tVarPrimTyCon [s, elt]
+\end{code}
+
+%************************************************************************
+%*                                                                     *
 \subsection[TysPrim-stable-ptrs]{The stable-pointer type}
 %*                                                                     *
 %************************************************************************
 
 \begin{code}
-stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP StablePtrRep
+stablePtrPrimTyCon = pcPrimTyCon stablePtrPrimTyConName vrcsP AddrRep
 
 mkStablePtrPrimTy ty = mkTyConApp stablePtrPrimTyCon [ty]
 \end{code}