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