GHC/MVar.hs

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