Control/Concurrent/Chan.hs

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