bounded-tchan (empty) → 0.1

raw patch · 4 files changed

+135/−0 lines, 4 filesdep +basedep +stmsetup-changed

Dependencies added: base, stm

Files

• Control/Concurrent/STM/BTChan.hs +81/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• bounded-tchan.cabal +22/−0

@@ -0,0 +1,81 @@+{-# LANGUAGE BangPatterns #-}+module Control.Concurrent.STM.BTChan+        ( BTChan+        , newBTChan+        , newBTChanIO+        , writeBTChan+        , readBTChan+	, isEmptyBTChan+	, sizeOfBTChan+	, setMaxOfBTChan+	, maxOfBTChan+        ) where++import Control.Concurrent.STM+import Control.Monad (when)++-- |A 'BTChan' is a bounded 'TChan' - a FIFO channel using 'TChan' and+-- a transactional variable to limit the number of elements on the channel.+data BTChan a = BTChan {-# UNPACK #-} !Int (TChan a) (TVar  Int)++-- |An IO version of 'newBTChanIO'.  This should be useful with unsafePerformIO+-- in the same manner as 'newTVarIO' and 'newTChanIO' are used.+newBTChanIO :: Int -> IO (BTChan a)+newBTChanIO m = do+    szTV <- newTVarIO 0+    c    <- newTChanIO+    return (BTChan m c szTV)++-- | `newBTChan m` make a new bounded TChan of max size `m`.+newBTChan :: Int -> STM (BTChan a)+newBTChan m = do+        szTV <- newTVar 0+        c    <- newTChan+        return (BTChan m c szTV)++-- |Writes the value to the 'BTChan' or blocks if the channel is full.+writeBTChan :: BTChan a -> a -> STM ()+writeBTChan (BTChan mx c szTV) x = do+        sz <- readTVar szTV+	when (sz >= mx) retry+        writeTVar szTV (sz + 1) >> writeTChan c x++-- |Reads the next value from the 'BTChan'+readBTChan :: BTChan a -> STM a+readBTChan (BTChan _ c szTV) = do+        x <- readTChan c+        sz <- readTVar szTV+        let !sz' = sz - 1+        writeTVar szTV sz'+        return x++-- Put an element on the front of the queue so it will be the next item read.+unGetBTChan :: BTChan a -> a -> STM ()+unGetBTChan (BTChan m c sTV) a = do+	s <- readTVar sTV+	when (s >= m) retry+	let !s' = s+1+	writeTVar sTV s'+	unGetTChan c a++-- |Returns 'True' if the supplied 'TChan' is empty.+isEmptyBTChan :: BTChan a -> STM Bool+isEmptyBTChan (BTChan _ c _) = isEmptyTChan c++-- |Get the current number of elements in the 'BTChan'.+sizeOfBTChan :: BTChan a -> STM Int+sizeOfBTChan (BTChan _ _ sTV) = readTVar sTV++-- |@c2 = setMaxOfBTChan c1 mx@ Using the same underlying 'TChan',+-- set a new maximum number of messages, @mx@.  If the current size+-- is greater than @mx@ then no messages are dropped, but writes +-- will block till the size goes lower than @mx@.  Using @c2@ and+-- @c1@ concurrently is possible, but @c2@ writes will block at the new+-- maximum while writes to @c1@ will block at the new, making it biased+-- against whichever writer has the channel with the smaller bound.+setMaxOfBTChan :: BTChan a -> Int -> BTChan a+setMaxOfBTChan (BTChan _ c s) m = BTChan m c s++-- |Get the bound of the `BTChan`.+maxOfBTChan :: BTChan a -> Int+maxOfBTChan (BTChan m _ _) = m

@@ -0,0 +1,30 @@+Copyright (c)2011, Thomas M. DuBuisson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Thomas M. DuBuisson nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,22 @@+Name:                bounded-tchan+Version:             0.1+Synopsis:            Bounded Transactional channels (queues)+Description:         Bounded TChan's, or BTChan's, are a transactional queue with a limit to the number of elements (further calls to @writeBTChan@ or @unGetBTChan@ call STM retry).++License:             BSD3+License-file:        LICENSE+Author:              Thomas M. DuBuisson+Maintainer:          thomas.dubuisson@gmail.com+Copyright:           Thomas M. DuBuisson (2011)+Category:            Concurrency+Build-type:          Simple+Extra-source-files:  +Cabal-version:       >=1.2+++Library+  Exposed-modules:     Control.Concurrent.STM.BTChan+  Build-depends:       base >=3 && <= 5, stm+  Other-modules:       +  Build-tools:         +