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
  10 --
  11 -- Sample variables
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Control.Concurrent.SampleVar
  16        (
  17          SampleVar,         -- :: type _ =
  18
  19          newEmptySampleVar, -- :: IO (SampleVar a)
  20          newSampleVar,      -- :: a -> IO (SampleVar a)
  21          emptySampleVar,    -- :: SampleVar a -> IO ()
  22          readSampleVar,     -- :: SampleVar a -> IO a
  23          writeSampleVar     -- :: SampleVar a -> a -> IO ()
  24
  25        ) where
  26
  27 import Prelude
  28
  29 import Control.Concurrent.MVar
  30
  31 -- Sample variables are slightly different from a normal MVar:
  32 --
  33 --  * Reading an empty SampleVar causes the reader to block.
  34 --    (same as takeMVar on empty MVar)
  35 --
  36 --  * Reading a filled SampleVar empties it and returns value.
  37 --    (same as takeMVar)
  38 --
  39 --  * Writing to an empty SampleVar fills it with a value, and
  40 --    potentially, wakes up a blocked reader (same as for putMVar on
  41 --    empty MVar).
  42 --
  43 --  * Writing to a filled SampleVar overwrites the current value.
  44 --    (different from putMVar on full MVar.)
  45
  46 type SampleVar a
  47  = MVar (Int,           -- 1  == full
  48                         -- 0  == empty
  49                         -- <0 no of readers blocked
  50           MVar a)
  51
  52 -- Initally, a SampleVar is empty/unfilled.
  53
  54 newEmptySampleVar :: IO (SampleVar a)
  55 newEmptySampleVar = do
  56    v <- newEmptyMVar
  57    newMVar (0,v)
  58
  59 newSampleVar :: a -> IO (SampleVar a)
  60 newSampleVar a = do
  61    v <- newEmptyMVar
  62    putMVar v a
  63    newMVar (1,v)
  64
  65 emptySampleVar :: SampleVar a -> IO ()
  66 emptySampleVar v = do
  67    (readers, var) <- takeMVar v
  68    if readers >= 0 then
  69      putMVar v (0,var)
  70     else
  71      putMVar v (readers,var)
  72
  73 --
  74 -- filled => make empty and grab sample
  75 -- not filled => try to grab value, empty when read val.
  76 --
  77 readSampleVar :: SampleVar a -> IO a
  78 readSampleVar svar = do
  79    (readers,val) <- takeMVar svar
  80    putMVar svar (readers-1,val)
  81    takeMVar val
  82
  83 --
  84 -- filled => overwrite
  85 -- not filled => fill, write val
  86 --
  87 writeSampleVar :: SampleVar a -> a -> IO ()
  88 writeSampleVar svar v = do
  89    (readers,val) <- takeMVar svar
  90    case readers of
  91      1 ->
  92        swapMVar val v >>
  93        putMVar svar (1,val)
  94      _ ->
  95        putMVar val v >>
  96        putMVar svar (min 1 (readers+1), val)