[project @ 1999-01-25 10:26:18 by sof]

[ghc-hetmet.git] / ghc / lib / concurrent / Channel.lhs

diff --git a/ghc/lib/concurrent/Channel.lhs b/ghc/lib/concurrent/Channel.lhs
index 6ae4ac8..fca29df 100644 (file)
--- a/ghc/lib/concurrent/Channel.lhs
+++ b/ghc/lib/concurrent/Channel.lhs
@@ -20,6 +20,8 @@ module Channel
        dupChan,         -- :: Chan a -> IO (Chan a)
        unGetChan,       -- :: Chan a -> a -> IO ()
 
+       isEmptyChan,     -- :: Chan a -> IO Bool
+
         {- stream interface -}
        getChanContents, -- :: Chan a -> IO [a]
        writeList2Chan   -- :: Chan a -> [a] -> IO ()
@@ -29,7 +31,7 @@ module Channel
 import Prelude
 import PrelConc
 import PrelST
-import PrelUnsafe ( unsafeInterleaveIO )
+import PrelIOBase ( unsafeInterleaveIO )
 \end{code}
 
 A channel is represented by two @MVar@s keeping track of the two ends
@@ -96,6 +98,14 @@ unGetChan (Chan read write) val = do
    putMVar new_read_end (ChItem val read_end)
    putMVar read new_read_end
 
+isEmptyChan :: Chan a -> IO Bool
+isEmptyChan (Chan read write) = do
+   r <- takeMVar read
+   w <- readMVar write
+   let eq = r == w
+   eq `seq` putMVar read r
+   return eq
+
 \end{code}
 
 Operators for interfacing with functional streams.
@@ -111,6 +121,6 @@ getChanContents ch
 
 -------------
 writeList2Chan :: Chan a -> [a] -> IO ()
-writeList2Chan ch ls = sequence (map (writeChan ch) ls)
+writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
 
 \end{code}