Control/Concurrent/SampleVar.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Concurrent.SampleVar
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable (concurrency)
  10 --
  11 -- Sample variables
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Control.Concurrent.SampleVar
  16        (
  17          -- * Sample Variables
  18          SampleVar,         -- :: type _ =
  19
  20          newEmptySampleVar, -- :: IO (SampleVar a)
  21          newSampleVar,      -- :: a -> IO (SampleVar a)
  22          emptySampleVar,    -- :: SampleVar a -> IO ()
  23          readSampleVar,     -- :: SampleVar a -> IO a
  24          writeSampleVar     -- :: SampleVar a -> a -> IO ()
  25
  26        ) where
  27
  28 import Prelude
  29
  30 import Control.Concurrent.MVar
  31
  32 -- |
  33 -- Sample variables are slightly different from a normal 'MVar':
  34 --
  35 --  * Reading an empty 'SampleVar' causes the reader to block.
  36 --    (same as 'takeMVar' on empty 'MVar')
  37 --
  38 --  * Reading a filled 'SampleVar' empties it and returns value.
  39 --    (same as 'takeMVar')
  40 --
  41 --  * Writing to an empty 'SampleVar' fills it with a value, and
  42 --    potentially, wakes up a blocked reader (same as for 'putMVar' on
  43 --    empty 'MVar').
  44 --
  45 --  * Writing to a filled 'SampleVar' overwrites the current value.
  46 --    (different from 'putMVar' on full 'MVar'.)
  47
  48 type SampleVar a
  49  = MVar (Int,           -- 1  == full
  50                         -- 0  == empty
  51                         -- <0 no of readers blocked
  52           MVar a)
  53
  54 -- |Build a new, empty, 'SampleVar'
  55 newEmptySampleVar :: IO (SampleVar a)
  56 newEmptySampleVar = do
  57    v <- newEmptyMVar
  58    newMVar (0,v)
  59
  60 -- |Build a 'SampleVar' with an initial value.
  61 newSampleVar :: a -> IO (SampleVar a)
  62 newSampleVar a = do
  63    v <- newEmptyMVar
  64    putMVar v a
  65    newMVar (1,v)
  66
  67 -- |If the SampleVar is full, leave it empty.  Otherwise, do nothing.
  68 emptySampleVar :: SampleVar a -> IO ()
  69 emptySampleVar v = do
  70    (readers, var) <- takeMVar v
  71    if readers >= 0 then
  72      putMVar v (0,var)
  73     else
  74      putMVar v (readers,var)
  75
  76 -- |Wait for a value to become available, then take it and return.
  77 readSampleVar :: SampleVar a -> IO a
  78 readSampleVar svar = do
  79 --
  80 -- filled => make empty and grab sample
  81 -- not filled => try to grab value, empty when read val.
  82 --
  83    (readers,val) <- takeMVar svar
  84    putMVar svar (readers-1,val)
  85    takeMVar val
  86
  87 -- |Write a value into the 'SampleVar', overwriting any previous value that
  88 -- was there.
  89 writeSampleVar :: SampleVar a -> a -> IO ()
  90 writeSampleVar svar v = do
  91 --
  92 -- filled => overwrite
  93 -- not filled => fill, write val
  94 --
  95    (readers,val) <- takeMVar svar
  96    case readers of
  97      1 ->
  98        swapMVar val v >>
  99        putMVar svar (1,val)
 100      _ ->
 101        putMVar val v >>
 102        putMVar svar (min 1 (readers+1), val)