Haddock hacks to fix whitespace consistency

[ghc-base.git] / Control / Concurrent / QSemN.hs

diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs
index 8e95903..991b0d5 100644 (file)
--- a/Control/Concurrent/QSemN.hs
+++ b/Control/Concurrent/QSemN.hs
@@ -14,26 +14,34 @@
 -----------------------------------------------------------------------------
 
 module Control.Concurrent.QSemN
-       (  -- * General Quantity Semaphores
-         QSemN,        -- abstract
-         newQSemN,     -- :: Int   -> IO QSemN
-         waitQSemN,    -- :: QSemN -> Int -> IO ()
-         signalQSemN   -- :: QSemN -> Int -> IO ()
+        (  -- * General Quantity Semaphores
+          QSemN,        -- abstract
+          newQSemN,     -- :: Int   -> IO QSemN
+          waitQSemN,    -- :: QSemN -> Int -> IO ()
+          signalQSemN   -- :: QSemN -> Int -> IO ()
       ) where
 
 import Prelude
 
 import Control.Concurrent.MVar
+import Data.Typeable
+
+#include "Typeable.h"
 
 -- |A 'QSemN' is a quantity semaphore, in which the available
 -- \"quantity\" may be signalled or waited for in arbitrary amounts.
 newtype QSemN = QSemN (MVar (Int,[(Int,MVar ())]))
 
+INSTANCE_TYPEABLE0(QSemN,qSemNTc,"QSemN")
+
 -- |Build a new 'QSemN' with a supplied initial quantity.
-newQSemN :: Int -> IO QSemN 
-newQSemN init = do
-   sem <- newMVar (init,[])
-   return (QSemN sem)
+--  The initial quantity must be at least 0.
+newQSemN :: Int -> IO QSemN
+newQSemN initial =
+    if initial < 0
+    then fail "newQSemN: Initial quantity must be non-negative"
+    else do sem <- newMVar (initial, [])
+            return (QSemN sem)
 
 -- |Wait for the specified quantity to become available
 waitQSemN :: QSemN -> Int -> IO ()
@@ -42,7 +50,7 @@ waitQSemN (QSemN sem) sz = do
   if (avail - sz) >= 0 then
        -- discharging 'sz' still leaves the semaphore
        -- in an 'unblocked' state.
-     putMVar sem (avail-sz,[])
+     putMVar sem (avail-sz,blocked)
    else do
      block <- newEmptyMVar
      putMVar sem (avail, blocked++[(sz,block)])
@@ -58,8 +66,8 @@ signalQSemN (QSemN sem) n = do
    free avail []    = return (avail,[])
    free avail ((req,block):blocked)
      | avail >= req = do
-       putMVar block ()
-       free (avail-req) blocked
+        putMVar block ()
+        free (avail-req) blocked
      | otherwise    = do
-       (avail',blocked') <- free avail blocked
+        (avail',blocked') <- free avail blocked
         return (avail',(req,block):blocked')