[project @ 2002-05-09 13:16:29 by simonmar]
[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/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- Sample variables
12 --
13 -----------------------------------------------------------------------------
14
15 module Control.Concurrent.SampleVar
16 (
17 SampleVar, -- :: type _ =
18
19 newEmptySampleVar, -- :: IO (SampleVar a)
20 newSampleVar, -- :: a -> IO (SampleVar a)
21 emptySampleVar, -- :: SampleVar a -> IO ()
22 readSampleVar, -- :: SampleVar a -> IO a
23 writeSampleVar -- :: SampleVar a -> a -> IO ()
24
25 ) where
26
27 import Prelude
28
29 import Control.Concurrent.MVar
30
31 -- Sample variables are slightly different from a normal MVar:
32 --
33 -- * Reading an empty SampleVar causes the reader to block.
34 -- (same as takeMVar on empty MVar)
35 --
36 -- * Reading a filled SampleVar empties it and returns value.
37 -- (same as takeMVar)
38 --
39 -- * Writing to an empty SampleVar fills it with a value, and
40 -- potentially, wakes up a blocked reader (same as for putMVar on
41 -- empty MVar).
42 --
43 -- * Writing to a filled SampleVar overwrites the current value.
44 -- (different from putMVar on full MVar.)
45
46 type SampleVar a
47 = MVar (Int, -- 1 == full
48 -- 0 == empty
49 -- <0 no of readers blocked
50 MVar a)
51
52 -- Initally, a SampleVar is empty/unfilled.
53
54 newEmptySampleVar :: IO (SampleVar a)
55 newEmptySampleVar = do
56 v <- newEmptyMVar
57 newMVar (0,v)
58
59 newSampleVar :: a -> IO (SampleVar a)
60 newSampleVar a = do
61 v <- newEmptyMVar
62 putMVar v a
63 newMVar (1,v)
64
65 emptySampleVar :: SampleVar a -> IO ()
66 emptySampleVar v = do
67 (readers, var) <- takeMVar v
68 if readers >= 0 then
69 putMVar v (0,var)
70 else
71 putMVar v (readers,var)
72
73 --
74 -- filled => make empty and grab sample
75 -- not filled => try to grab value, empty when read val.
76 --
77 readSampleVar :: SampleVar a -> IO a
78 readSampleVar svar = do
79 (readers,val) <- takeMVar svar
80 putMVar svar (readers-1,val)
81 takeMVar val
82
83 --
84 -- filled => overwrite
85 -- not filled => fill, write val
86 --
87 writeSampleVar :: SampleVar a -> a -> IO ()
88 writeSampleVar svar v = do
89 (readers,val) <- takeMVar svar
90 case readers of
91 1 ->
92 swapMVar val v >>
93 putMVar svar (1,val)
94 _ ->
95 putMVar val v >>
96 putMVar svar (min 1 (readers+1), val)