Remove Control.Parallel*, now in package parallel
[packages/random.git] / Control / Concurrent / QSem.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Control.Concurrent.QSem
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 (concurrency)
10 --
11 -- Simple quantity semaphores.
12 --
13 -----------------------------------------------------------------------------
14
15 module Control.Concurrent.QSem
16 ( -- * Simple Quantity Semaphores
17 QSem, -- abstract
18 newQSem, -- :: Int -> IO QSem
19 waitQSem, -- :: QSem -> IO ()
20 signalQSem -- :: QSem -> IO ()
21 ) where
22
23 import Prelude
24 import Control.Concurrent.MVar
25 import Data.Typeable
26
27 #include "Typeable.h"
28
29 -- General semaphores are also implemented readily in terms of shared
30 -- @MVar@s, only have to catch the case when the semaphore is tried
31 -- waited on when it is empty (==0). Implement this in the same way as
32 -- shared variables are implemented - maintaining a list of @MVar@s
33 -- representing threads currently waiting. The counter is a shared
34 -- variable, ensuring the mutual exclusion on its access.
35
36 -- |A 'QSem' is a simple quantity semaphore, in which the available
37 -- \"quantity\" is always dealt with in units of one.
38 newtype QSem = QSem (MVar (Int, [MVar ()]))
39
40 INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")
41
42 -- |Build a new 'QSem'
43 newQSem :: Int -> IO QSem
44 newQSem init = do
45 sem <- newMVar (init,[])
46 return (QSem sem)
47
48 -- |Wait for a unit to become available
49 waitQSem :: QSem -> IO ()
50 waitQSem (QSem sem) = do
51 (avail,blocked) <- takeMVar sem -- gain ex. access
52 if avail > 0 then
53 putMVar sem (avail-1,[])
54 else do
55 block <- newEmptyMVar
56 {-
57 Stuff the reader at the back of the queue,
58 so as to preserve waiting order. A signalling
59 process then only have to pick the MVar at the
60 front of the blocked list.
61
62 The version of waitQSem given in the paper could
63 lead to starvation.
64 -}
65 putMVar sem (0, blocked++[block])
66 takeMVar block
67
68 -- |Signal that a unit of the 'QSem' is available
69 signalQSem :: QSem -> IO ()
70 signalQSem (QSem sem) = do
71 (avail,blocked) <- takeMVar sem
72 case blocked of
73 [] -> putMVar sem (avail+1,[])
74
75 (block:blocked') -> do
76 putMVar sem (0,blocked')
77 putMVar block ()