[commit: base] master: Implement tryAtomicReadMVar. (546f7e7)

[Edward Z. Yang]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : master

https://github.com/ghc/packages-base/commit/546f7e783dcf45a90d8cdc6ae1d95de17c0c55f5

>---------------------------------------------------------------

commit 546f7e783dcf45a90d8cdc6ae1d95de17c0c55f5
Author: Edward Z. Yang <ezyang at mit.edu>
Date:   Wed Jul 10 13:34:09 2013 -0700

    Implement tryAtomicReadMVar.
    
    Signed-off-by: Edward Z. Yang <ezyang at mit.edu>

>---------------------------------------------------------------

 Control/Concurrent/MVar.hs |    1 +
 GHC/MVar.hs                |   10 ++++++++++
 2 files changed, 11 insertions(+), 0 deletions(-)

diff --git a/Control/Concurrent/MVar.hs b/Control/Concurrent/MVar.hs
index 1bccc1e..62a9161 100644
--- a/Control/Concurrent/MVar.hs
+++ b/Control/Concurrent/MVar.hs
@@ -143,6 +143,7 @@ module Control.Concurrent.MVar
         , modifyMVarMasked
 #ifndef __HUGS__
         , atomicReadMVar
+        , tryAtomicReadMVar
         , mkWeakMVar
         , addMVarFinalizer
 #endif
diff --git a/GHC/MVar.hs b/GHC/MVar.hs
index 6a892db..5e819a2 100644
--- a/GHC/MVar.hs
+++ b/GHC/MVar.hs
@@ -27,6 +27,7 @@ module GHC.MVar (
         , putMVar
         , tryTakeMVar
         , tryPutMVar
+        , tryAtomicReadMVar
         , isEmptyMVar
         , addMVarFinalizer
     ) where
@@ -136,6 +137,15 @@ tryPutMVar (MVar mvar#) x = IO $ \ s# ->
         (# s, 0# #) -> (# s, False #)
         (# s, _  #) -> (# s, True #)
 
+-- |A non-blocking version of 'atomicReadMVar'.  The 'tryAtomicReadMVar' function
+-- returns immediately, with 'Nothing' if the 'MVar' was empty, or
+-- @'Just' a@ if the 'MVar' was full with contents @a at .
+tryAtomicReadMVar :: MVar a -> IO (Maybe a)
+tryAtomicReadMVar (MVar m) = IO $ \ s ->
+    case tryAtomicReadMVar# m s of
+        (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
+        (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
+
 -- |Check whether a given 'MVar' is empty.
 --
 -- Notice that the boolean value returned  is just a snapshot of