Use explicit language extensions & remove extension fields from base.cabal
[ghc.git] / libraries / base / Control / Concurrent / MVar.hs
1 {-# LANGUAGE CPP, NoImplicitPrelude #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : Control.Concurrent.MVar
6 -- Copyright : (c) The University of Glasgow 2001
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- Maintainer : libraries@haskell.org
10 -- Stability : experimental
11 -- Portability : non-portable (concurrency)
12 --
13 -- Synchronising variables
14 --
15 -----------------------------------------------------------------------------
16
17 module Control.Concurrent.MVar
18 (
19 -- * @MVar@s
20 MVar -- abstract
21 , newEmptyMVar -- :: IO (MVar a)
22 , newMVar -- :: a -> IO (MVar a)
23 , takeMVar -- :: MVar a -> IO a
24 , putMVar -- :: MVar a -> a -> IO ()
25 , readMVar -- :: MVar a -> IO a
26 , swapMVar -- :: MVar a -> a -> IO a
27 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
28 , tryPutMVar -- :: MVar a -> a -> IO Bool
29 , isEmptyMVar -- :: MVar a -> IO Bool
30 , withMVar -- :: MVar a -> (a -> IO b) -> IO b
31 , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO ()
32 , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b
33 #ifndef __HUGS__
34 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
35 #endif
36 ) where
37
38 #ifdef __HUGS__
39 import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
40 tryTakeMVar, tryPutMVar, isEmptyMVar,
41 )
42 #endif
43
44 #ifdef __GLASGOW_HASKELL__
45 import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
46 tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
47 )
48 #endif
49
50 #ifdef __GLASGOW_HASKELL__
51 import GHC.Base
52 #else
53 import Prelude
54 #endif
55
56 import Control.Exception.Base
57
58 {-|
59 This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
60 from the 'MVar', puts it back, and also returns it.
61 -}
62 readMVar :: MVar a -> IO a
63 readMVar m =
64 mask_ $ do
65 a <- takeMVar m
66 putMVar m a
67 return a
68
69 {-|
70 Take a value from an 'MVar', put a new value into the 'MVar' and
71 return the value taken. Note that there is a race condition whereby
72 another process can put something in the 'MVar' after the take
73 happens but before the put does.
74 -}
75 swapMVar :: MVar a -> a -> IO a
76 swapMVar mvar new =
77 mask_ $ do
78 old <- takeMVar mvar
79 putMVar mvar new
80 return old
81
82 {-|
83 'withMVar' is a safe wrapper for operating on the contents of an
84 'MVar'. This operation is exception-safe: it will replace the
85 original contents of the 'MVar' if an exception is raised (see
86 "Control.Exception").
87 -}
88 {-# INLINE withMVar #-}
89 -- inlining has been reported to have dramatic effects; see
90 -- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
91 withMVar :: MVar a -> (a -> IO b) -> IO b
92 withMVar m io =
93 mask $ \restore -> do
94 a <- takeMVar m
95 b <- restore (io a) `onException` putMVar m a
96 putMVar m a
97 return b
98
99 {-|
100 A safe wrapper for modifying the contents of an 'MVar'. Like 'withMVar',
101 'modifyMVar' will replace the original contents of the 'MVar' if an
102 exception is raised during the operation.
103 -}
104 {-# INLINE modifyMVar_ #-}
105 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
106 modifyMVar_ m io =
107 mask $ \restore -> do
108 a <- takeMVar m
109 a' <- restore (io a) `onException` putMVar m a
110 putMVar m a'
111
112 {-|
113 A slight variation on 'modifyMVar_' that allows a value to be
114 returned (@b@) in addition to the modified value of the 'MVar'.
115 -}
116 {-# INLINE modifyMVar #-}
117 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
118 modifyMVar m io =
119 mask $ \restore -> do
120 a <- takeMVar m
121 (a',b) <- restore (io a) `onException` putMVar m a
122 putMVar m a'
123 return b