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