SafeHaskell: Added SafeHaskell to base
[packages/base.git] / Control / Concurrent / MVar.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP, NoImplicitPrelude #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Control.Concurrent.MVar
7 -- Copyright : (c) The University of Glasgow 2001
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- Maintainer : libraries@haskell.org
11 -- Stability : experimental
12 -- Portability : non-portable (concurrency)
13 --
14 -- An @'MVar' t@ is mutable location that is either empty or contains a
15 -- value of type @t@. It has two fundamental operations: 'putMVar'
16 -- which fills an 'MVar' if it is empty and blocks otherwise, and
17 -- 'takeMVar' which empties an 'MVar' if it is full and blocks
18 -- otherwise. They can be used in multiple different ways:
19 --
20 -- 1. As synchronized mutable variables,
21 -- 2. As channels, with 'takeMVar' and 'putMVar' as receive and send, and
22 -- 3. As a binary semaphore @'MVar' ()@, with 'takeMVar' and 'putMVar' as
23 -- wait and signal.
24 --
25 -- They were introduced in the paper "Concurrent Haskell" by Simon
26 -- Peyton Jones, Andrew Gordon and Sigbjorn Finne, though some details
27 -- of their implementation have since then changed (in particular, a
28 -- put on a full MVar used to error, but now merely blocks.)
29 --
30 -- * Applicability
31 --
32 -- 'MVar's offer more flexibility than 'IORef's, but less flexibility
33 -- than 'STM'. They are appropriate for building synchronization
34 -- primitives and performing simple interthread communication; however
35 -- they are very simple and susceptible to race conditions, deadlocks or
36 -- uncaught exceptions. Do not use them if you need perform larger
37 -- atomic operations such as reading from multiple variables: use 'STM'
38 -- instead.
39 --
40 -- In particular, the "bigger" functions in this module ('readMVar',
41 -- 'swapMVar', 'withMVar', 'modifyMVar_' and 'modifyMVar') are simply
42 -- the composition of a 'takeMVar' followed by a 'putMVar' with
43 -- exception safety.
44 -- These only have atomicity guarantees if all other threads
45 -- perform a 'takeMVar' before a 'putMVar' as well; otherwise, they may
46 -- block.
47 --
48 -- * Fairness
49 --
50 -- No thread can be blocked indefinitely on an 'MVar' unless another
51 -- thread holds that 'MVar' indefinitely. One usual implementation of
52 -- this fairness guarantee is that threads blocked on an 'MVar' are
53 -- served in a first-in-first-out fashion, but this is not guaranteed
54 -- in the semantics.
55 --
56 -- * Gotchas
57 --
58 -- Like many other Haskell data structures, 'MVar's are lazy. This
59 -- means that if you place an expensive unevaluated thunk inside an
60 -- 'MVar', it will be evaluated by the thread that consumes it, not the
61 -- thread that produced it. Be sure to 'evaluate' values to be placed
62 -- in an 'MVar' to the appropriate normal form, or utilize a strict
63 -- MVar provided by the strict-concurrency package.
64 --
65 -- * Ordering
66 --
67 -- 'MVar' operations are always observed to take place in the order
68 -- they are written in the program, regardless of the memory model of
69 -- the underlying machine. This is in contrast to 'IORef' operations
70 -- which may appear out-of-order to another thread in some cases.
71 --
72 -- * Example
73 --
74 -- Consider the following concurrent data structure, a skip channel.
75 -- This is a channel for an intermittent source of high bandwidth
76 -- information (for example, mouse movement events.) Writing to the
77 -- channel never blocks, and reading from the channel only returns the
78 -- most recent value, or blocks if there are no new values. Multiple
79 -- readers are supported with a @dupSkipChan@ operation.
80 --
81 -- A skip channel is a pair of 'MVar's. The first 'MVar' contains the
82 -- current value, and a list of semaphores that need to be notified
83 -- when it changes. The second 'MVar' is a semaphore for this particular
84 -- reader: it is full if there is a value in the channel that this
85 -- reader has not read yet, and empty otherwise.
86 --
87 -- @
88 -- data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())
89 --
90 -- newSkipChan :: IO (SkipChan a)
91 -- newSkipChan = do
92 -- sem <- newEmptyMVar
93 -- main <- newMVar (undefined, [sem])
94 -- return (SkipChan main sem)
95 --
96 -- putSkipChan :: SkipChan a -> a -> IO ()
97 -- putSkipChan (SkipChan main _) v = do
98 -- (_, sems) <- takeMVar main
99 -- putMVar main (v, [])
100 -- mapM_ (\sem -> putMVar sem ()) sems
101 --
102 -- getSkipChan :: SkipChan a -> IO a
103 -- getSkipChan (SkipChan main sem) = do
104 -- takeMVar sem
105 -- (v, sems) <- takeMVar main
106 -- putMVar main (v, sem:sems)
107 -- return v
108 --
109 -- dupSkipChan :: SkipChan a -> IO (SkipChan a)
110 -- dupSkipChan (SkipChan main _) = do
111 -- sem <- newEmptyMVar
112 -- (v, sems) <- takeMVar main
113 -- putMVar main (v, sem:sems)
114 -- return (SkipChan main sem)
115 -- @
116 --
117 -- This example was adapted from the original Concurrent Haskell paper.
118 -- For more examples of 'MVar's being used to build higher-level
119 -- synchronization primitives, see 'Control.Concurrent.Chan' and
120 -- 'Control.Concurrent.QSem'.
121 --
122 -----------------------------------------------------------------------------
123
124 module Control.Concurrent.MVar
125 (
126 -- * @MVar@s
127 MVar -- abstract
128 , newEmptyMVar -- :: IO (MVar a)
129 , newMVar -- :: a -> IO (MVar a)
130 , takeMVar -- :: MVar a -> IO a
131 , putMVar -- :: MVar a -> a -> IO ()
132 , readMVar -- :: MVar a -> IO a
133 , swapMVar -- :: MVar a -> a -> IO a
134 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
135 , tryPutMVar -- :: MVar a -> a -> IO Bool
136 , isEmptyMVar -- :: MVar a -> IO Bool
137 , withMVar -- :: MVar a -> (a -> IO b) -> IO b
138 , modifyMVar_ -- :: MVar a -> (a -> IO a) -> IO ()
139 , modifyMVar -- :: MVar a -> (a -> IO (a,b)) -> IO b
140 #ifndef __HUGS__
141 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
142 #endif
143 ) where
144
145 #ifdef __HUGS__
146 import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
147 tryTakeMVar, tryPutMVar, isEmptyMVar,
148 )
149 #endif
150
151 #ifdef __GLASGOW_HASKELL__
152 import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
153 tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
154 )
155 #endif
156
157 #ifdef __GLASGOW_HASKELL__
158 import GHC.Base
159 #else
160 import Prelude
161 #endif
162
163 import Control.Exception.Base
164
165 {-|
166 This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
167 from the 'MVar', puts it back, and also returns it. This function
168 is atomic only if there are no other producers (i.e. threads calling
169 'putMVar') for this 'MVar'.
170 -}
171 readMVar :: MVar a -> IO a
172 readMVar m =
173 mask_ $ do
174 a <- takeMVar m
175 putMVar m a
176 return a
177
178 {-|
179 Take a value from an 'MVar', put a new value into the 'MVar' and
180 return the value taken. This function is atomic only if there are
181 no other producers for this 'MVar'.
182 -}
183 swapMVar :: MVar a -> a -> IO a
184 swapMVar mvar new =
185 mask_ $ do
186 old <- takeMVar mvar
187 putMVar mvar new
188 return old
189
190 {-|
191 'withMVar' is an exception-safe wrapper for operating on the contents
192 of an 'MVar'. This operation is exception-safe: it will replace the
193 original contents of the 'MVar' if an exception is raised (see
194 "Control.Exception"). However, it is only atomic if there are no
195 other producers for this 'MVar'.
196 -}
197 {-# INLINE withMVar #-}
198 -- inlining has been reported to have dramatic effects; see
199 -- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
200 withMVar :: MVar a -> (a -> IO b) -> IO b
201 withMVar m io =
202 mask $ \restore -> do
203 a <- takeMVar m
204 b <- restore (io a) `onException` putMVar m a
205 putMVar m a
206 return b
207
208 {-|
209 An exception-safe wrapper for modifying the contents of an 'MVar'.
210 Like 'withMVar', 'modifyMVar' will replace the original contents of
211 the 'MVar' if an exception is raised during the operation. This
212 function is only atomic if there are no other producers for this
213 'MVar'.
214 -}
215 {-# INLINE modifyMVar_ #-}
216 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
217 modifyMVar_ m io =
218 mask $ \restore -> do
219 a <- takeMVar m
220 a' <- restore (io a) `onException` putMVar m a
221 putMVar m a'
222
223 {-|
224 A slight variation on 'modifyMVar_' that allows a value to be
225 returned (@b@) in addition to the modified value of the 'MVar'.
226 -}
227 {-# INLINE modifyMVar #-}
228 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
229 modifyMVar m io =
230 mask $ \restore -> do
231 a <- takeMVar m
232 (a',b) <- restore (io a) `onException` putMVar m a
233 putMVar m a'
234 return b