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/core/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable
  10 --
  11 -- $Id: SampleVar.hs,v 1.2 2002/04/24 16:31:37 simonmar Exp $
  12 --
  13 -- Sample variables
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module Control.Concurrent.SampleVar
  18        (
  19          SampleVar,         -- :: type _ =
  20
  21          newEmptySampleVar, -- :: IO (SampleVar a)
  22          newSampleVar,      -- :: a -> IO (SampleVar a)
  23          emptySampleVar,    -- :: SampleVar a -> IO ()
  24          readSampleVar,     -- :: SampleVar a -> IO a
  25          writeSampleVar     -- :: SampleVar a -> a -> IO ()
  26
  27        ) where
  28
  29 import Prelude
  30
  31 import Control.Concurrent.MVar
  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 -- Initally, a SampleVar is empty/unfilled.
  55
  56 newEmptySampleVar :: IO (SampleVar a)
  57 newEmptySampleVar = do
  58    v <- newEmptyMVar
  59    newMVar (0,v)
  60
  61 newSampleVar :: a -> IO (SampleVar a)
  62 newSampleVar a = do
  63    v <- newEmptyMVar
  64    putMVar v a
  65    newMVar (1,v)
  66
  67 emptySampleVar :: SampleVar a -> IO ()
  68 emptySampleVar v = do
  69    (readers, var) <- takeMVar v
  70    if readers >= 0 then
  71      putMVar v (0,var)
  72     else
  73      putMVar v (readers,var)
  74
  75 --
  76 -- filled => make empty and grab sample
  77 -- not filled => try to grab value, empty when read val.
  78 --
  79 readSampleVar :: SampleVar a -> IO a
  80 readSampleVar svar = do
  81    (readers,val) <- takeMVar svar
  82    putMVar svar (readers-1,val)
  83    takeMVar val
  84
  85 --
  86 -- filled => overwrite
  87 -- not filled => fill, write val
  88 --
  89 writeSampleVar :: SampleVar a -> a -> IO ()
  90 writeSampleVar svar v = do
  91    (readers,val) <- takeMVar svar
  92    case readers of
  93      1 ->
  94        swapMVar val v >>
  95        putMVar svar (1,val)
  96      _ ->
  97        putMVar val v >>
  98        putMVar svar (min 1 (readers+1), val)