diff options
Diffstat (limited to 'ghc/compiler')
| -rw-r--r-- | ghc/compiler/codeGen/CgPrimOp.hs | 1 | ||||
| -rw-r--r-- | ghc/compiler/prelude/PrelNames.lhs | 1 | ||||
| -rw-r--r-- | ghc/compiler/prelude/TysPrim.lhs | 15 | ||||
| -rw-r--r-- | ghc/compiler/prelude/primops.txt.pp | 62 |
4 files changed, 78 insertions, 1 deletions
diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs index 65ad0cc724..5c01903c8c 100644 --- a/ghc/compiler/codeGen/CgPrimOp.hs +++ b/ghc/compiler/codeGen/CgPrimOp.hs @@ -486,6 +486,7 @@ translateOp SameMutVarOp = Just mo_wordEq translateOp SameMVarOp = Just mo_wordEq translateOp SameMutableArrayOp = Just mo_wordEq translateOp SameMutableByteArrayOp = Just mo_wordEq +translateOp SameTVarOp = Just mo_wordEq translateOp EqForeignObj = Just mo_wordEq translateOp EqStablePtrOp = Just mo_wordEq diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index 893fed28a0..f534abe659 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -789,6 +789,7 @@ threadIdPrimTyConKey = mkPreludeTyConUnique 72 bcoPrimTyConKey = mkPreludeTyConUnique 73 ptrTyConKey = mkPreludeTyConUnique 74 funPtrTyConKey = mkPreludeTyConUnique 75 +tVarPrimTyConKey = mkPreludeTyConUnique 76 -- Generic Type Constructors crossTyConKey = mkPreludeTyConUnique 79 diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index 0cc59d98f7..155fdf8238 100644 --- 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, @@ -87,6 +88,7 @@ primTyCons , mutableArrayPrimTyCon , mutableByteArrayPrimTyCon , mVarPrimTyCon + , tVarPrimTyCon , mutVarPrimTyCon , realWorldTyCon , stablePtrPrimTyCon @@ -124,6 +126,7 @@ mutableArrayPrimTyConName = mkPrimTc FSLIT("MutableArray#") mutableArrayPrim 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 @@ -314,6 +317,18 @@ 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} %* * %************************************************************************ diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index 4d7d4d9198..04a7885e0c 100644 --- a/ghc/compiler/prelude/primops.txt.pp +++ b/ghc/compiler/prelude/primops.txt.pp @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $Id: primops.txt.pp,v 1.30 2003/10/01 10:57:39 wolfgang Exp $ +-- $Id: primops.txt.pp,v 1.31 2004/11/18 09:56:15 tharris Exp $ -- -- Primitive Operations -- @@ -1334,6 +1334,66 @@ primop UnblockAsyncExceptionsOp "unblockAsyncExceptions#" GenPrimOp out_of_line = True ------------------------------------------------------------------------ +section "STM-accessible Mutable Variables" +------------------------------------------------------------------------ + +primop AtomicallyOp "atomically#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> State# RealWorld -> (# State# RealWorld, a #) + with + out_of_line = True + has_side_effects = True + +primop RetryOp "retry#" GenPrimOp + State# RealWorld -> (# State# RealWorld, a #) + with + out_of_line = True + has_side_effects = True + +primop CatchRetryOp "catchRetry#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> (State# RealWorld -> (# State# RealWorld, a #) ) + -> (State# RealWorld -> (# State# RealWorld, a #) ) + with + out_of_line = True + has_side_effects = True + +primop CatchSTMOp "catchSTM#" GenPrimOp + (State# RealWorld -> (# State# RealWorld, a #) ) + -> (b -> State# RealWorld -> (# State# RealWorld, a #) ) + -> (State# RealWorld -> (# State# RealWorld, a #) ) + with + out_of_line = True + has_side_effects = True + +primop NewTVarOp "newTVar#" GenPrimOp + a + -> State# s -> (# State# s, TVar# s a #) + {Create a new Tar\# holding a specified initial value.} + with + out_of_line = True + +primop ReadTVarOp "readTVar#" GenPrimOp + TVar# s a + -> State# s -> (# State# s, a #) + {Read contents of TVar\#. Result is not yet evaluated.} + with + out_of_line = True + +primop WriteTVarOp "writeTVar#" GenPrimOp + TVar# s a + -> a + -> State# s -> State# s + {Write contents of TVar\#.} + with + out_of_line = True + has_side_effects = True + +primop SameTVarOp "sameTVar#" GenPrimOp + TVar# s a -> TVar# s a -> Bool + + +------------------------------------------------------------------------ section "Synchronized Mutable Variables" {Operations on MVar\#s, which are shared mutable variables ({\it not} the same as MutVar\#s!). (Note: in a non-concurrent implementation, |