GHC/MVar.hs

   1 {-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
   2 {-# OPTIONS_HADDOCK hide #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.MVar
   6 -- Copyright   :  (c) The University of Glasgow 2008
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  cvs-ghc@haskell.org
  10 -- Stability   :  internal
  11 -- Portability :  non-portable (GHC Extensions)
  12 --
  13 -- The MVar type
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module GHC.MVar (
  18         -- * MVars
  19           MVar(..)
  20         , newMVar       -- :: a -> IO (MVar a)
  21         , newEmptyMVar  -- :: IO (MVar a)
  22         , takeMVar      -- :: MVar a -> IO a
  23         , putMVar       -- :: MVar a -> a -> IO ()
  24         , tryTakeMVar   -- :: MVar a -> IO (Maybe a)
  25         , tryPutMVar    -- :: MVar a -> a -> IO Bool
  26         , isEmptyMVar   -- :: MVar a -> IO Bool
  27         , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
  28
  29   ) where
  30
  31 import GHC.Base
  32 import GHC.IO()   -- instance Monad IO
  33 import Data.Maybe
  34
  35 data MVar a = MVar (MVar# RealWorld a)
  36 {- ^
  37 An 'MVar' (pronounced \"em-var\") is a synchronising variable, used
  38 for communication between concurrent threads.  It can be thought of
  39 as a a box, which may be empty or full.
  40 -}
  41
  42 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
  43 instance Eq (MVar a) where
  44         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
  45
  46 {-
  47 M-Vars are rendezvous points for concurrent threads.  They begin
  48 empty, and any attempt to read an empty M-Var blocks.  When an M-Var
  49 is written, a single blocked thread may be freed.  Reading an M-Var
  50 toggles its state from full back to empty.  Therefore, any value
  51 written to an M-Var may only be read once.  Multiple reads and writes
  52 are allowed, but there must be at least one read between any two
  53 writes.
  54 -}
  55
  56 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
  57
  58 -- |Create an 'MVar' which is initially empty.
  59 newEmptyMVar  :: IO (MVar a)
  60 newEmptyMVar = IO $ \ s# ->
  61     case newMVar# s# of
  62          (# s2#, svar# #) -> (# s2#, MVar svar# #)
  63
  64 -- |Create an 'MVar' which contains the supplied value.
  65 newMVar :: a -> IO (MVar a)
  66 newMVar value =
  67     newEmptyMVar        >>= \ mvar ->
  68     putMVar mvar value  >>
  69     return mvar
  70
  71 -- |Return the contents of the 'MVar'.  If the 'MVar' is currently
  72 -- empty, 'takeMVar' will wait until it is full.  After a 'takeMVar',
  73 -- the 'MVar' is left empty.
  74 --
  75 -- There are two further important properties of 'takeMVar':
  76 --
  77 --   * 'takeMVar' is single-wakeup.  That is, if there are multiple
  78 --     threads blocked in 'takeMVar', and the 'MVar' becomes full,
  79 --     only one thread will be woken up.  The runtime guarantees that
  80 --     the woken thread completes its 'takeMVar' operation.
  81 --
  82 --   * When multiple threads are blocked on an 'MVar', they are
  83 --     woken up in FIFO order.  This is useful for providing
  84 --     fairness properties of abstractions built using 'MVar's.
  85 --
  86 takeMVar :: MVar a -> IO a
  87 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
  88
  89 -- |Put a value into an 'MVar'.  If the 'MVar' is currently full,
  90 -- 'putMVar' will wait until it becomes empty.
  91 --
  92 -- There are two further important properties of 'putMVar':
  93 --
  94 --   * 'putMVar' is single-wakeup.  That is, if there are multiple
  95 --     threads blocked in 'putMVar', and the 'MVar' becomes empty,
  96 --     only one thread will be woken up.  The runtime guarantees that
  97 --     the woken thread completes its 'putMVar' operation.
  98 --
  99 --   * When multiple threads are blocked on an 'MVar', they are
 100 --     woken up in FIFO order.  This is useful for providing
 101 --     fairness properties of abstractions built using 'MVar's.
 102 --
 103 putMVar  :: MVar a -> a -> IO ()
 104 putMVar (MVar mvar#) x = IO $ \ s# ->
 105     case putMVar# mvar# x s# of
 106         s2# -> (# s2#, () #)
 107
 108 -- |A non-blocking version of 'takeMVar'.  The 'tryTakeMVar' function
 109 -- returns immediately, with 'Nothing' if the 'MVar' was empty, or
 110 -- @'Just' a@ if the 'MVar' was full with contents @a@.  After 'tryTakeMVar',
 111 -- the 'MVar' is left empty.
 112 tryTakeMVar :: MVar a -> IO (Maybe a)
 113 tryTakeMVar (MVar m) = IO $ \ s ->
 114     case tryTakeMVar# m s of
 115         (# s', 0#, _ #) -> (# s', Nothing #)      -- MVar is empty
 116         (# s', _,  a #) -> (# s', Just a  #)      -- MVar is full
 117
 118 -- |A non-blocking version of 'putMVar'.  The 'tryPutMVar' function
 119 -- attempts to put the value @a@ into the 'MVar', returning 'True' if
 120 -- it was successful, or 'False' otherwise.
 121 tryPutMVar  :: MVar a -> a -> IO Bool
 122 tryPutMVar (MVar mvar#) x = IO $ \ s# ->
 123     case tryPutMVar# mvar# x s# of
 124         (# s, 0# #) -> (# s, False #)
 125         (# s, _  #) -> (# s, True #)
 126
 127 -- |Check whether a given 'MVar' is empty.
 128 --
 129 -- Notice that the boolean value returned  is just a snapshot of
 130 -- the state of the MVar. By the time you get to react on its result,
 131 -- the MVar may have been filled (or emptied) - so be extremely
 132 -- careful when using this operation.   Use 'tryTakeMVar' instead if possible.
 133 isEmptyMVar :: MVar a -> IO Bool
 134 isEmptyMVar (MVar mv#) = IO $ \ s# ->
 135     case isEmptyMVar# mv# s# of
 136         (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
 137
 138 -- |Add a finalizer to an 'MVar' (GHC only).  See "Foreign.ForeignPtr" and
 139 -- "System.Mem.Weak" for more about finalizers.
 140 addMVarFinalizer :: MVar a -> IO () -> IO ()
 141 addMVarFinalizer (MVar m) finalizer =
 142   IO $ \s -> case mkWeak# m () finalizer s of { (# s1, _ #) -> (# s1, () #) }
 143