1 -----------------------------------------------------------------------------
3 -- Module : Control.Concurrent.SampleVar
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/core/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
11 -- $Id: SampleVar.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
15 -----------------------------------------------------------------------------
17 module Control.Concurrent.SampleVar
19 SampleVar, -- :: type _ =
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 ()
31 import Control.Concurrent.MVar
33 -- Sample variables are slightly different from a normal MVar:
35 -- * Reading an empty SampleVar causes the reader to block.
36 -- (same as takeMVar on empty MVar)
38 -- * Reading a filled SampleVar empties it and returns value.
41 -- * Writing to an empty SampleVar fills it with a value, and
42 -- potentially, wakes up a blocked reader (same as for putMVar on
45 -- * Writing to a filled SampleVar overwrites the current value.
46 -- (different from putMVar on full MVar.)
49 = MVar (Int, -- 1 == full
51 -- <0 no of readers blocked
54 -- Initally, a SampleVar is empty/unfilled.
56 newEmptySampleVar :: IO (SampleVar a)
57 newEmptySampleVar = do
61 newSampleVar :: a -> IO (SampleVar a)
67 emptySampleVar :: SampleVar a -> IO ()
69 (readers, var) <- takeMVar v
73 putMVar v (readers,var)
76 -- filled => make empty and grab sample
77 -- not filled => try to grab value, empty when read val.
79 readSampleVar :: SampleVar a -> IO a
80 readSampleVar svar = do
81 (readers,val) <- takeMVar svar
82 putMVar svar (readers-1,val)
86 -- filled => overwrite
87 -- not filled => fill, write val
89 writeSampleVar :: SampleVar a -> a -> IO ()
90 writeSampleVar svar v = do
91 (readers,val) <- takeMVar svar
98 putMVar svar (min 1 (readers+1), val)