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 -- * Example
  65 --
  66 -- Consider the following concurrent data structure, a skip channel.
  67 -- This is a channel for an intermittent source of high bandwidth
  68 -- information (for example, mouse movement events.)  Writing to the
  69 -- channel never blocks, and reading from the channel only returns the
  70 -- most recent value, or blocks if there are no new values.  Multiple
  71 -- readers are supported with a @dupSkipChan@ operation.
  72 --
  73 -- A skip channel is a pair of 'MVar's: the second 'MVar' is a semaphore
  74 -- for this particular reader: it is full if there is a value in the
  75 -- channel that this reader has not read yet, and empty otherwise.
  76 --
  77 -- @
  78 --     data SkipChan a = SkipChan (MVar (a, [MVar ()])) (MVar ())
  79 --
  80 --     newSkipChan :: IO (SkipChan a)
  81 --     newSkipChan = do
  82 --         sem <- newEmptyMVar
  83 --         main <- newMVar (undefined, [sem])
  84 --         return (SkipChan main sem)
  85 --
  86 --     putSkipChan :: SkipChan a -> a -> IO ()
  87 --     putSkipChan (SkipChan main _) v = do
  88 --         (_, sems) <- takeMVar main
  89 --         putMVar main (v, [])
  90 --         mapM_ (\sem -> putMVar sem ()) sems
  91 --
  92 --     getSkipChan :: SkipChan a -> IO a
  93 --     getSkipChan (SkipChan main sem) = do
  94 --         takeMVar sem
  95 --         (v, sems) <- takeMVar main
  96 --         putMVar main (v, sem:sems)
  97 --         return v
  98 --
  99 --     dupSkipChan :: SkipChan a -> IO (SkipChan a)
 100 --     dupSkipChan (SkipChan main _) = do
 101 --         sem <- newEmptyMVar
 102 --         (v, sems) <- takeMVar main
 103 --         putMVar main (v, sem:sems)
 104 --         return (SkipChan main sem)
 105 -- @
 106 --
 107 -- This example was adapted from the original Concurrent Haskell paper.
 108 -- For more examples of 'MVar's being used to build higher-level
 109 -- synchronization primitives, see 'Control.Concurrent.Chan' and
 110 -- 'Control.Concurrent.QSem'.
 111 --
 112 -----------------------------------------------------------------------------
 113
 114 module Control.Concurrent.MVar
 115         (
 116           -- * @MVar@s
 117           MVar          -- abstract
 118         , newEmptyMVar  -- :: IO (MVar a)
 119         , newMVar       -- :: a -> IO (MVar a)
 120         , takeMVar      -- :: MVar a -> IO a
 121         , putMVar       -- :: MVar a -> a -> IO ()
 122         , readMVar      -- :: MVar a -> IO a
 123         , swapMVar      -- :: MVar a -> a -> IO a
 124         , tryTakeMVar   -- :: MVar a -> IO (Maybe a)
 125         , tryPutMVar    -- :: MVar a -> a -> IO Bool
 126         , isEmptyMVar   -- :: MVar a -> IO Bool
 127         , withMVar      -- :: MVar a -> (a -> IO b) -> IO b
 128         , modifyMVar_   -- :: MVar a -> (a -> IO a) -> IO ()
 129         , modifyMVar    -- :: MVar a -> (a -> IO (a,b)) -> IO b
 130 #ifndef __HUGS__
 131         , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
 132 #endif
 133     ) where
 134
 135 #ifdef __HUGS__
 136 import Hugs.ConcBase ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
 137                   tryTakeMVar, tryPutMVar, isEmptyMVar,
 138                 )
 139 #endif
 140
 141 #ifdef __GLASGOW_HASKELL__
 142 import GHC.MVar ( MVar, newEmptyMVar, newMVar, takeMVar, putMVar,
 143                   tryTakeMVar, tryPutMVar, isEmptyMVar, addMVarFinalizer
 144                 )
 145 #endif
 146
 147 #ifdef __GLASGOW_HASKELL__
 148 import GHC.Base
 149 #else
 150 import Prelude
 151 #endif
 152
 153 import Control.Exception.Base
 154
 155 {-|
 156   This is a combination of 'takeMVar' and 'putMVar'; ie. it takes the value
 157   from the 'MVar', puts it back, and also returns it.  This function
 158   is atomic only if there are no other producers (i.e. threads calling
 159   'putMVar') for this 'MVar'.
 160 -}
 161 readMVar :: MVar a -> IO a
 162 readMVar m =
 163   mask_ $ do
 164     a <- takeMVar m
 165     putMVar m a
 166     return a
 167
 168 {-|
 169   Take a value from an 'MVar', put a new value into the 'MVar' and
 170   return the value taken. This function is atomic only if there are
 171   no other producers for this 'MVar'.
 172 -}
 173 swapMVar :: MVar a -> a -> IO a
 174 swapMVar mvar new =
 175   mask_ $ do
 176     old <- takeMVar mvar
 177     putMVar mvar new
 178     return old
 179
 180 {-|
 181   'withMVar' is an exception-safe wrapper for operating on the contents
 182   of an 'MVar'.  This operation is exception-safe: it will replace the
 183   original contents of the 'MVar' if an exception is raised (see
 184   "Control.Exception").  However, it is only atomic if there are no
 185   other producers for this 'MVar'.
 186 -}
 187 {-# INLINE withMVar #-}
 188 -- inlining has been reported to have dramatic effects; see
 189 -- http://www.haskell.org//pipermail/haskell/2006-May/017907.html
 190 withMVar :: MVar a -> (a -> IO b) -> IO b
 191 withMVar m io =
 192   mask $ \restore -> do
 193     a <- takeMVar m
 194     b <- restore (io a) `onException` putMVar m a
 195     putMVar m a
 196     return b
 197
 198 {-|
 199   An exception-safe wrapper for modifying the contents of an 'MVar'.
 200   Like 'withMVar', 'modifyMVar' will replace the original contents of
 201   the 'MVar' if an exception is raised during the operation.  This
 202   function is only atomic if there are no other producers for this
 203   'MVar'.
 204 -}
 205 {-# INLINE modifyMVar_ #-}
 206 modifyMVar_ :: MVar a -> (a -> IO a) -> IO ()
 207 modifyMVar_ m io =
 208   mask $ \restore -> do
 209     a  <- takeMVar m
 210     a' <- restore (io a) `onException` putMVar m a
 211     putMVar m a'
 212
 213 {-|
 214   A slight variation on 'modifyMVar_' that allows a value to be
 215   returned (@b@) in addition to the modified value of the 'MVar'.
 216 -}
 217 {-# INLINE modifyMVar #-}
 218 modifyMVar :: MVar a -> (a -> IO (a,b)) -> IO b
 219 modifyMVar m io =
 220   mask $ \restore -> do
 221     a      <- takeMVar m
 222     (a',b) <- restore (io a) `onException` putMVar m a
 223     putMVar m a'
 224     return b