From: sof <unknown>
Date: Mon, 25 Jan 1999 10:26:18 +0000 (+0000)
Subject: [project @ 1999-01-25 10:26:18 by sof]
X-Git-Tag: Approximately_9120_patches~6696
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=dce7bd6af20658a7fb262c83b06e9196d70d8c1a;p=ghc-hetmet.git

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

diff --git a/ghc/lib/concurrent/Channel.lhs b/ghc/lib/concurrent/Channel.lhs
index f9293c5..fca29df 100644
--- 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 ()
@@ -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.