projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Don't try to make haddock links to the mtl package as we don't depend on it
[ghc-base.git]
/
Control
/
Concurrent
/
QSem.hs
diff --git
a/Control/Concurrent/QSem.hs
b/Control/Concurrent/QSem.hs
index
2cc9f55
..
5a512d8
100644
(file)
--- a/
Control/Concurrent/QSem.hs
+++ b/
Control/Concurrent/QSem.hs
@@
-1,21
+1,20
@@
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
---
+-- |
-- Module : Control.Concurrent.QSem
-- Copyright : (c) The University of Glasgow 2001
-- Module : Control.Concurrent.QSem
-- Copyright : (c) The University of Glasgow 2001
--- License : BSD-style (see the file libraries/core/LICENSE)
+-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
--- Portability : non-portable
---
--- $Id: QSem.hs,v 1.2 2001/07/04 11:30:52 simonmar Exp $
+-- Portability : non-portable (concurrency)
--
--
--- General semaphores
+-- Simple quantity semaphores.
--
-----------------------------------------------------------------------------
module Control.Concurrent.QSem
--
-----------------------------------------------------------------------------
module Control.Concurrent.QSem
- ( QSem, -- abstract
+ ( -- * Simple Quantity Semaphores
+ QSem, -- abstract
newQSem, -- :: Int -> IO QSem
waitQSem, -- :: QSem -> IO ()
signalQSem -- :: QSem -> IO ()
newQSem, -- :: Int -> IO QSem
waitQSem, -- :: QSem -> IO ()
signalQSem -- :: QSem -> IO ()
@@
-23,6
+22,9
@@
module Control.Concurrent.QSem
import Prelude
import Control.Concurrent.MVar
import Prelude
import Control.Concurrent.MVar
+import Data.Typeable
+
+#include "Typeable.h"
-- General semaphores are also implemented readily in terms of shared
-- @MVar@s, only have to catch the case when the semaphore is tried
-- General semaphores are also implemented readily in terms of shared
-- @MVar@s, only have to catch the case when the semaphore is tried
@@
-31,13
+33,19
@@
import Control.Concurrent.MVar
-- representing threads currently waiting. The counter is a shared
-- variable, ensuring the mutual exclusion on its access.
-- representing threads currently waiting. The counter is a shared
-- variable, ensuring the mutual exclusion on its access.
+-- |A 'QSem' is a simple quantity semaphore, in which the available
+-- \"quantity\" is always dealt with in units of one.
newtype QSem = QSem (MVar (Int, [MVar ()]))
newtype QSem = QSem (MVar (Int, [MVar ()]))
+INSTANCE_TYPEABLE0(QSem,qSemTc,"QSem")
+
+-- |Build a new 'QSem'
newQSem :: Int -> IO QSem
newQSem init = do
sem <- newMVar (init,[])
return (QSem sem)
newQSem :: Int -> IO QSem
newQSem init = do
sem <- newMVar (init,[])
return (QSem sem)
+-- |Wait for a unit to become available
waitQSem :: QSem -> IO ()
waitQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem -- gain ex. access
waitQSem :: QSem -> IO ()
waitQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem -- gain ex. access
@@
-57,6
+65,7
@@
waitQSem (QSem sem) = do
putMVar sem (0, blocked++[block])
takeMVar block
putMVar sem (0, blocked++[block])
takeMVar block
+-- |Signal that a unit of the 'QSem' is available
signalQSem :: QSem -> IO ()
signalQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem
signalQSem :: QSem -> IO ()
signalQSem (QSem sem) = do
(avail,blocked) <- takeMVar sem