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
  50 INSTANCE_TYPEABLE1(Chan,chanTc,"Chan")
  51
  52 type Stream a = MVar (ChItem a)
  53
  54 data ChItem a = ChItem a (Stream a)
  55
  56 -- See the Concurrent Haskell paper for a diagram explaining the
  57 -- how the different channel operations proceed.
  58
  59 -- @newChan@ sets up the read and write end of a channel by initialising
  60 -- these two @MVar@s with an empty @MVar@.
  61
  62 -- |Build and returns a new instance of 'Chan'.
  63 newChan :: IO (Chan a)
  64 newChan = do
  65    hole  <- newEmptyMVar
  66    readVar  <- newMVar hole
  67    writeVar <- newMVar hole
  68    return (Chan readVar writeVar)
  69
  70 -- To put an element on a channel, a new hole at the write end is created.
  71 -- What was previously the empty @MVar@ at the back of the channel is then
  72 -- filled in with a new stream element holding the entered value and the
  73 -- new hole.
  74
  75 -- |Write a value to a 'Chan'.
  76 writeChan :: Chan a -> a -> IO ()
  77 writeChan (Chan _ writeVar) val = do
  78   new_hole <- newEmptyMVar
  79   modifyMVar_ writeVar $ \old_hole -> do
  80     putMVar old_hole (ChItem val new_hole)
  81     return new_hole
  82
  83 -- |Read the next value from the 'Chan'.
  84 readChan :: Chan a -> IO a
  85 readChan (Chan readVar _) = do
  86   modifyMVar readVar $ \read_end -> do
  87     (ChItem val new_read_end) <- readMVar read_end
  88         -- Use readMVar here, not takeMVar,
  89         -- else dupChan doesn't work
  90     return (new_read_end, val)
  91
  92 -- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
  93 -- either channel from then on will be available from both.  Hence this creates
  94 -- a kind of broadcast channel, where data written by anyone is seen by
  95 -- everyone else.
  96 dupChan :: Chan a -> IO (Chan a)
  97 dupChan (Chan _ writeVar) = do
  98    hole       <- readMVar writeVar
  99    newReadVar <- newMVar hole
 100    return (Chan newReadVar writeVar)
 101
 102 -- |Put a data item back onto a channel, where it will be the next item read.
 103 unGetChan :: Chan a -> a -> IO ()
 104 unGetChan (Chan readVar _) val = do
 105    new_read_end <- newEmptyMVar
 106    modifyMVar_ readVar $ \read_end -> do
 107      putMVar new_read_end (ChItem val read_end)
 108      return new_read_end
 109 {-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-}
 110
 111 -- |Returns 'True' if the supplied 'Chan' is empty.
 112 isEmptyChan :: Chan a -> IO Bool
 113 isEmptyChan (Chan readVar writeVar) = do
 114    withMVar readVar $ \r -> do
 115      w <- readMVar writeVar
 116      let eq = r == w
 117      eq `seq` return eq
 118 {-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-}
 119
 120 -- Operators for interfacing with functional streams.
 121
 122 -- |Return a lazy list representing the contents of the supplied
 123 -- 'Chan', much like 'System.IO.hGetContents'.
 124 getChanContents :: Chan a -> IO [a]
 125 getChanContents ch
 126   = unsafeInterleaveIO (do
 127         x  <- readChan ch
 128         xs <- getChanContents ch
 129         return (x:xs)
 130     )
 131
 132 -- |Write an entire list of items to a 'Chan'.
 133 writeList2Chan :: Chan a -> [a] -> IO ()
 134 writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)