Repository : ssh://[email protected]/stm On branch : master Link : http://git.haskell.org/?p=packages/stm.git;a=commit;h=7dddeef8380258049e88680b666d38c91091e8f4
>--------------------------------------------------------------- commit 7dddeef8380258049e88680b666d38c91091e8f4 Author: Austin Seipp <[email protected]> Date: Fri Sep 6 19:28:54 2013 -0500 Implement isFullTBQueue This was proposed on the libraries@ mailing list by Merijn with no objections. Authored-by: Merijn Verstraaten <[email protected]> Signed-off-by: Austin Seipp <[email protected]> >--------------------------------------------------------------- 7dddeef8380258049e88680b666d38c91091e8f4 Control/Concurrent/STM/TBQueue.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Control/Concurrent/STM/TBQueue.hs b/Control/Concurrent/STM/TBQueue.hs index 82b46b3..028fd57 100644 --- a/Control/Concurrent/STM/TBQueue.hs +++ b/Control/Concurrent/STM/TBQueue.hs @@ -38,6 +38,7 @@ module Control.Concurrent.STM.TBQueue ( writeTBQueue, unGetTBQueue, isEmptyTBQueue, + isFullTBQueue, ) where import Data.Typeable @@ -177,3 +178,15 @@ isEmptyTBQueue (TBQueue _rsize read _wsize write) = do case ys of [] -> return True _ -> return False + +-- |Returns 'True' if the supplied 'TBQueue' is full. +isFullTBQueue :: TBQueue a -> STM Bool +isFullTBQueue (TBQueue rsize _read wsize _write) = do + w <- readTVar wsize + if (w > 0) + then return False + else do + r <- readTVar rsize + if (r > 0) + then return False + else return True _______________________________________________ ghc-commits mailing list [email protected] http://www.haskell.org/mailman/listinfo/ghc-commits
