e3d334108bf3db0975397e23cceef715d10e551c
[packages/base.git] / 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.1 2001/06/28 14:15:02 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)