Control/Concurrent/Chan.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Control.Concurrent.Chan
   4 -- Copyright   :  (c) The University of Glasgow 2001
   5 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   6 --
   7 -- Maintainer  :  libraries@haskell.org
   8 -- Stability   :  experimental
   9 -- Portability :  non-portable (concurrency)
  10 --
  11 -- Unbounded channels.
  12 --
  13 -----------------------------------------------------------------------------
  14
  15 module Control.Concurrent.Chan
  16   (
  17           -- * The 'Chan' type
  18         Chan,                   -- abstract
  19
  20           -- * Operations
  21         newChan,                -- :: IO (Chan a)
  22         writeChan,              -- :: Chan a -> a -> IO ()
  23         readChan,               -- :: Chan a -> IO a
  24         dupChan,                -- :: Chan a -> IO (Chan a)
  25         unGetChan,              -- :: Chan a -> a -> IO ()
  26         isEmptyChan,            -- :: Chan a -> IO Bool
  27
  28           -- * Stream interface
  29         getChanContents,        -- :: Chan a -> IO [a]
  30         writeList2Chan,         -- :: Chan a -> [a] -> IO ()
  31    ) where
  32
  33 import Prelude
  34
  35 import System.IO.Unsafe         ( unsafeInterleaveIO )
  36 import Control.Concurrent.MVar
  37 import Data.Typeable
  38
  39 #include "Typeable.h"
  40
  41 -- A channel is represented by two @MVar@s keeping track of the two ends
  42 -- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
  43 -- are used to handle consumers trying to read from an empty channel.
  44
  45 -- |'Chan' is an abstract type representing an unbounded FIFO channel.
  46 data Chan a
  47  = Chan (MVar (Stream a))
  48         (MVar (Stream a))
  49    deriving Eq
  50
  51 INSTANCE_TYPEABLE1(Chan,chanTc,"Chan")
  52
  53 type Stream a = MVar (ChItem a)
  54
  55 data ChItem a = ChItem a (Stream a)
  56
  57 -- See the Concurrent Haskell paper for a diagram explaining the
  58 -- how the different channel operations proceed.
  59
  60 -- @newChan@ sets up the read and write end of a channel by initialising
  61 -- these two @MVar@s with an empty @MVar@.
  62
  63 -- |Build and returns a new instance of 'Chan'.
  64 newChan :: IO (Chan a)
  65 newChan = do
  66    hole  <- newEmptyMVar
  67    readVar  <- newMVar hole
  68    writeVar <- newMVar hole
  69    return (Chan readVar writeVar)
  70
  71 -- To put an element on a channel, a new hole at the write end is created.
  72 -- What was previously the empty @MVar@ at the back of the channel is then
  73 -- filled in with a new stream element holding the entered value and the
  74 -- new hole.
  75
  76 -- |Write a value to a 'Chan'.
  77 writeChan :: Chan a -> a -> IO ()
  78 writeChan (Chan _ writeVar) val = do
  79   new_hole <- newEmptyMVar
  80   modifyMVar_ writeVar $ \old_hole -> do
  81     putMVar old_hole (ChItem val new_hole)
  82     return new_hole
  83
  84 -- |Read the next value from the 'Chan'.
  85 readChan :: Chan a -> IO a
  86 readChan (Chan readVar _) = do
  87   modifyMVar readVar $ \read_end -> do
  88     (ChItem val new_read_end) <- readMVar read_end
  89         -- Use readMVar here, not takeMVar,
  90         -- else dupChan doesn't work
  91     return (new_read_end, val)
  92
  93 -- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
  94 -- either channel from then on will be available from both.  Hence this creates
  95 -- a kind of broadcast channel, where data written by anyone is seen by
  96 -- everyone else.
  97 --
  98 -- (Note that a duplicated channel is not equal to its original.
  99 -- So: @fmap (c /=) $ dupChan c@ returns @True@ for all @c@.)
 100 dupChan :: Chan a -> IO (Chan a)
 101 dupChan (Chan _ writeVar) = do
 102    hole       <- readMVar writeVar
 103    newReadVar <- newMVar hole
 104    return (Chan newReadVar writeVar)
 105
 106 -- |Put a data item back onto a channel, where it will be the next item read.
 107 unGetChan :: Chan a -> a -> IO ()
 108 unGetChan (Chan readVar _) val = do
 109    new_read_end <- newEmptyMVar
 110    modifyMVar_ readVar $ \read_end -> do
 111      putMVar new_read_end (ChItem val read_end)
 112      return new_read_end
 113 {-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-}
 114
 115 -- |Returns 'True' if the supplied 'Chan' is empty.
 116 isEmptyChan :: Chan a -> IO Bool
 117 isEmptyChan (Chan readVar writeVar) = do
 118    withMVar readVar $ \r -> do
 119      w <- readMVar writeVar
 120      let eq = r == w
 121      eq `seq` return eq
 122 {-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-}
 123
 124 -- Operators for interfacing with functional streams.
 125
 126 -- |Return a lazy list representing the contents of the supplied
 127 -- 'Chan', much like 'System.IO.hGetContents'.
 128 getChanContents :: Chan a -> IO [a]
 129 getChanContents ch
 130   = unsafeInterleaveIO (do
 131         x  <- readChan ch
 132         xs <- getChanContents ch
 133         return (x:xs)
 134     )
 135
 136 -- |Write an entire list of items to a 'Chan'.
 137 writeList2Chan :: Chan a -> [a] -> IO ()
 138 writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)