ghc/lib/concurrent/SampleVar.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section[SampleVar]{Sample variables}
   5
   6 Sample variables are slightly different from a normal @MVar@:
   7
   8 \begin{itemize}
   9 \item Reading an empty @SampleVar@ causes the reader to block.
  10     (same as @takeMVar@ on empty @MVar@)
  11 \item Reading a filled @SampleVar@ empties it and returns value.
  12     (same as @takeMVar@)
  13 \item Writing to an empty @SampleVar@ fills it with a value, and
  14 potentially, wakes up a blocked reader  (same as for @putMVar@ on empty @MVar@).
  15 \item Writing to a filled @SampleVar@ overwrites the current value.
  16  (different from @putMVar@ on full @MVar@.)
  17 \end{itemize}
  18
  19 \begin{code}
  20 module SampleVar
  21        (
  22          SampleVar,         --:: type _ =
  23
  24          newEmptySampleVar, --:: IO (SampleVar a)
  25          newSampleVar,      --:: a -> IO (SampleVar a)
  26          emptySampleVar,    --:: SampleVar a -> IO ()
  27          readSampleVar,     --:: SampleVar a -> IO a
  28          writeSampleVar     --:: SampleVar a -> a -> IO ()
  29
  30        ) where
  31
  32 import PrelConc
  33
  34
  35 type SampleVar a
  36  = MVar (Int,           -- 1  == full
  37                         -- 0  == empty
  38                         -- <0 no of readers blocked
  39           MVar a)
  40
  41 -- Initally, a @SampleVar@ is empty/unfilled.
  42
  43 newEmptySampleVar :: IO (SampleVar a)
  44 newEmptySampleVar = do
  45    v <- newEmptyMVar
  46    newMVar (0,v)
  47
  48 newSampleVar :: a -> IO (SampleVar a)
  49 newSampleVar a = do
  50    v <- newEmptyMVar
  51    putMVar v a
  52    newMVar (1,v)
  53
  54 emptySampleVar :: SampleVar a -> IO ()
  55 emptySampleVar v = do
  56    (readers, var) <- takeMVar v
  57    if readers >= 0 then
  58      putMVar v (0,var)
  59     else
  60      putMVar v (readers,var)
  61
  62 --
  63 -- filled => make empty and grab sample
  64 -- not filled => try to grab value, empty when read val.
  65 --
  66 readSampleVar :: SampleVar a -> IO a
  67 readSampleVar svar = do
  68    (readers,val) <- takeMVar svar
  69    putMVar svar (readers-1,val)
  70    takeMVar val
  71
  72 --
  73 -- filled => overwrite
  74 -- not filled => fill, write val
  75 --
  76 writeSampleVar :: SampleVar a -> a -> IO ()
  77 writeSampleVar svar v = do
  78    (readers,val) <- takeMVar svar
  79    case readers of
  80      1 ->
  81        swapMVar val v >>
  82        putMVar svar (1,val)
  83      _ ->
  84        putMVar val v >>
  85        putMVar svar (min 1 (readers+1), val)
  86 \end{code}