ghc/lib/prelude/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          newSampleVar,     --:: IO (SampleVar a)
  25          emptySampleVar,   --:: SampleVar a -> IO ()
  26          readSample,       --:: SampleVar a -> IO a
  27          writeSample       --:: SampleVar a -> a -> IO ()
  28
  29        ) where
  30
  31 import PreludeGlaST
  32 import PreludePrimIO    ( newEmptyMVar, newMVar, putMVar,
  33                           readMVar, swapMVar, takeMVar, _MVar
  34                         )
  35 \end{code}
  36
  37 \begin{code}
  38
  39 type SampleVar a
  40  = _MVar (Int,          -- 1  == full
  41                         -- 0  == empty
  42                         -- <0 no of readers blocked
  43           _MVar a)
  44
  45 \end{code}
  46
  47 Initally, a @SampleVar@ is empty/unfilled.
  48
  49 \begin{code}
  50
  51 newSampleVar :: IO (SampleVar a)
  52 newSampleVar
  53  = newEmptyMVar          >>= \ val ->
  54    newMVar (0,val)
  55
  56 emptySampleVar :: SampleVar a -> IO ()
  57 emptySampleVar v
  58  = takeMVar v         >>= \ (readers,var) ->
  59    if readers >= 0 then
  60      putMVar v (0,var)
  61    else
  62      putMVar v (readers,var)
  63
  64 \end{code}
  65
  66
  67
  68 \begin{code}
  69
  70 --
  71 -- filled => make empty and grab sample
  72 -- not filled => try to grab value, empty when read val.
  73 --
  74 readSample :: SampleVar a -> IO a
  75 readSample svar
  76  = takeMVar svar                >>= \ (readers,val) ->
  77    putMVar svar (readers-1,val) >>
  78    takeMVar val
  79
  80 --
  81 -- filled => overwrite
  82 -- not filled => fill, write val
  83 --
  84 writeSample :: SampleVar a -> a -> IO ()
  85 writeSample svar v
  86  = takeMVar svar  >>= \ (readers, val) ->
  87    case readers of
  88      1 ->
  89        swapMVar val v       >>
  90        putMVar svar (1,val)
  91      _ ->
  92        putMVar val v >>
  93        putMVar svar (min 1 (readers+1), val)
  94
  95 \end{code}