1 -----------------------------------------------------------------------------
3 -- Module : Control.Concurrent.MVar
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- MVars: Synchronising variables
13 -----------------------------------------------------------------------------
15 module Control.Concurrent.MVar
17 , newEmptyMVar -- :: IO (MVar a)
18 , newMVar -- :: a -> IO (MVar a)
19 , takeMVar -- :: MVar a -> IO a
20 , putMVar -- :: MVar a -> a -> IO ()
21 , readMVar -- :: MVar a -> IO a
22 , swapMVar -- :: MVar a -> a -> IO a
23 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
24 , tryPutMVar -- :: MVar a -> a -> IO Bool
25 , isEmptyMVar -- :: MVar a -> IO Bool
26 , withMVar -- :: MVar a -> (a -> IO b) -> IO b
27 , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO ()
28 , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b
29 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
33 import ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
34 tryTakeMVar, tryPutMVar, isEmptyMVar,
37 import Prelude hiding( catch )
40 #ifdef __GLASGOW_HASKELL__
41 import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
42 tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
46 import Control.Exception as Exception
49 -- This is as close as Hugs gets to providing throw
50 throw :: Exception -> IO a
54 #ifdef __GLASGOW_HASKELL__
55 readMVar :: MVar a -> IO a
62 swapMVar :: MVar a -> a -> IO a
63 swapMVar mvar new = modifyMVar mvar (\old -> return (new,old))
66 -- put back the same value, return something
67 withMVar :: MVar a -> (a -> IO b) -> IO b
71 b <- Exception.catch (unblock (io a))
72 (\e -> do putMVar m a; throw e)
76 -- put back a new value, return ()
77 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
81 a' <- Exception.catch (unblock (io a))
82 (\e -> do putMVar m a; throw e)
85 -- put back a new value, return something
86 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
90 (a',b) <- Exception.catch (unblock (io a))
91 (\e -> do putMVar m a; throw e)