Repository : ssh://darcs.haskell.org//srv/darcs/packages/stm

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b2f8a18078bd9bdd8d468dc88181ad06b5d090fa

>---------------------------------------------------------------

commit b2f8a18078bd9bdd8d468dc88181ad06b5d090fa
Author: Joey Adams <[email protected]>
Date:   Fri Mar 2 21:10:51 2012 -0500

    Add newBroadcastTChan and newBroadcastTChanIO

>---------------------------------------------------------------

 Control/Concurrent/STM/TChan.hs |   36 ++++++++++++++++++++++++++++++++++++
 1 files changed, 36 insertions(+), 0 deletions(-)

diff --git a/Control/Concurrent/STM/TChan.hs b/Control/Concurrent/STM/TChan.hs
index 3a9df05..eece85c 100644
--- a/Control/Concurrent/STM/TChan.hs
+++ b/Control/Concurrent/STM/TChan.hs
@@ -26,6 +26,8 @@ module Control.Concurrent.STM.TChan (
        TChan,
        newTChan,
        newTChanIO,
+       newBroadcastTChan,
+       newBroadcastTChanIO,
        readTChan,
        tryReadTChan,
        peekTChan,
@@ -72,6 +74,40 @@ newTChanIO = do
   write <- newTVarIO hole
   return (TChan read write)
 
+-- | Create a write-only 'TChan'.  More precisely, 'readTChan' will 'retry'
+-- even after items have been written to the channel.  The only way to read
+-- a broadcast channel is to duplicate it with 'dupTChan'.
+--
+-- Consider a server that broadcasts messages to clients:
+--
+-- >serve :: TChan Message -> Client -> IO loop
+-- >serve broadcastChan client = do
+-- >    myChan <- dupTChan broadcastChan
+-- >    forever $ do
+-- >        message <- readTChan myChan
+-- >        send client message
+--
+-- The problem with using 'newTChan' to create the broadcast channel is that if
+-- it is only written to and never read, items will pile up in memory.  By
+-- using 'newBroadcastTChan' to create the broadcast channel, items can be
+-- garbage collected after clients have seen them.
+newBroadcastTChan :: STM (TChan a)
+newBroadcastTChan = do
+    dummy_hole <- newTVar TNil
+    write_hole <- newTVar TNil
+    read <- newTVar dummy_hole
+    write <- newTVar write_hole
+    return (TChan read write)
+
+-- | @IO@ version of 'newBroadcastTChan'.
+newBroadcastTChanIO :: IO (TChan a)
+newBroadcastTChanIO = do
+    dummy_hole <- newTVarIO TNil
+    write_hole <- newTVarIO TNil
+    read <- newTVarIO dummy_hole
+    write <- newTVarIO write_hole
+    return (TChan read write)
+
 -- |Write a value to a 'TChan'.
 writeTChan :: TChan a -> a -> STM ()
 writeTChan (TChan _read write) a = do



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to