[project @ 2002-07-16 16:08:58 by ross]
[packages/old-locale.git] / Control / Concurrent / MVar.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Control.Concurrent.MVar
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (concurrency)
10 --
11 -- Synchronising variables
12 --
13 -----------------------------------------------------------------------------
14
15 module Control.Concurrent.MVar
16 (
17 -- * @MVar@s
18 MVar -- abstract
19 , newEmptyMVar -- :: IO (MVar a)
20 , newMVar -- :: a -> IO (MVar a)
21 , takeMVar -- :: MVar a -> IO a
22 , putMVar -- :: MVar a -> a -> IO ()
23 , readMVar -- :: MVar a -> IO a
24 , swapMVar -- :: MVar a -> a -> IO a
25 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
26 , tryPutMVar -- :: MVar a -> a -> IO Bool
27 , isEmptyMVar -- :: MVar a -> IO Bool
28 , withMVar -- :: MVar a -> (a -> IO b) -> IO b
29 , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO ()
30 , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b
31 #ifndef __HUGS__
32 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
33 #endif
34 ) where
35
36 #ifdef __HUGS__
37 import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
38 tryTakeMVar, tryPutMVar, isEmptyMVar,
39 readMVar, swapMVar,
40 )
41 #endif
42
43 #ifdef __GLASGOW_HASKELL__
44 import GHC.Conc ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
45 tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
46 )
47 #endif
48
49 import Prelude
50 import Control.Exception as Exception
51
52 #ifdef __HUGS__
53 -- This is as close as Hugs gets to providing throw
54 throw :: Exception -> IO a
55 throw = throwIO
56 #endif
57
58 #ifdef __GLASGOW_HASKELL__
59 {-|
60 This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
61 from the 'MVar', puts it back, and also returns it.
62 -}
63 readMVar :: MVar a -> IO a
64 readMVar m =
65 block $ do
66 a <- takeMVar m
67 putMVar m a
68 return a
69
70 -- |Swap the contents of an 'MVar' for a new value.
71 swapMVar :: MVar a -> a -> IO a
72 swapMVar mvar new = modifyMVar mvar (\old -> return (new,old))
73 #endif
74
75 {-|
76 'withMVar' is a safe wrapper for operating on the contents of an
77 'MVar'. This operation is exception-safe: it will replace the
78 original contents of the 'MVar' if an exception is raised (see
79 "Control.Exception").
80 -}
81 withMVar :: MVar a -> (a -> IO b) -> IO b
82 withMVar m io =
83 block $ do
84 a <- takeMVar m
85 b <- Exception.catch (unblock (io a))
86 (\e -> do putMVar m a; throw e)
87 putMVar m a
88 return b
89
90 {-|
91 A safe wrapper for modifying the contents of an 'MVar'. Like 'withMVar',
92 'modifyMVar' will replace the original contents of the 'MVar' if an
93 exception is raised during the operation.
94 -}
95 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
96 modifyMVar_ m io =
97 block $ do
98 a <- takeMVar m
99 a' <- Exception.catch (unblock (io a))
100 (\e -> do putMVar m a; throw e)
101 putMVar m a'
102
103 {-|
104 A slight variation on 'modifyMVar_' that allows a value to be
105 returned (@b@) in addition to the modified value of the 'MVar'.
106 -}
107 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
108 modifyMVar m io =
109 block $ do
110 a <- takeMVar m
111 (a',b) <- Exception.catch (unblock (io a))
112 (\e -> do putMVar m a; throw e)
113 putMVar m a'
114 return b