Chan.hs 5.59 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
{-# LANGUAGE CPP #-}
3
{-# LANGUAGE StandaloneDeriving #-}
4

Ian Lynagh's avatar
Ian Lynagh committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Concurrent.Chan
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
-- 
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (concurrency)
--
-- Unbounded channels.
--
-----------------------------------------------------------------------------

module Control.Concurrent.Chan
  ( 
          -- * The 'Chan' type
        Chan,                   -- abstract

          -- * Operations
25 26 27 28 29 30
        newChan,
        writeChan,
        readChan,
        dupChan,
        unGetChan,
        isEmptyChan,
Ian Lynagh's avatar
Ian Lynagh committed
31 32

          -- * Stream interface
33 34
        getChanContents,
        writeList2Chan,
Ian Lynagh's avatar
Ian Lynagh committed
35 36 37 38
   ) where

import System.IO.Unsafe         ( unsafeInterleaveIO )
import Control.Concurrent.MVar
39
import Control.Exception (mask_)
Ian Lynagh's avatar
Ian Lynagh committed
40

41 42
#define _UPK_(x) {-# UNPACK #-} !(x)

Ian Lynagh's avatar
Ian Lynagh committed
43 44 45 46 47 48
-- A channel is represented by two @MVar@s keeping track of the two ends
-- of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
-- are used to handle consumers trying to read from an empty channel.

-- |'Chan' is an abstract type representing an unbounded FIFO channel.
data Chan a
49 50
 = Chan _UPK_(MVar (Stream a))
        _UPK_(MVar (Stream a)) -- Invariant: the Stream a is always an empty MVar
51
   deriving (Eq)
Ian Lynagh's avatar
Ian Lynagh committed
52 53 54

type Stream a = MVar (ChItem a)

55 56 57 58
data ChItem a = ChItem a _UPK_(Stream a)
  -- benchmarks show that unboxing the MVar here is worthwhile, because
  -- although it leads to higher allocation, the channel data takes up
  -- less space and is therefore quicker to GC.
Ian Lynagh's avatar
Ian Lynagh committed
59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82

-- See the Concurrent Haskell paper for a diagram explaining the
-- how the different channel operations proceed.

-- @newChan@ sets up the read and write end of a channel by initialising
-- these two @MVar@s with an empty @MVar@.

-- |Build and returns a new instance of 'Chan'.
newChan :: IO (Chan a)
newChan = do
   hole  <- newEmptyMVar
   readVar  <- newMVar hole
   writeVar <- newMVar hole
   return (Chan readVar writeVar)

-- To put an element on a channel, a new hole at the write end is created.
-- What was previously the empty @MVar@ at the back of the channel is then
-- filled in with a new stream element holding the entered value and the
-- new hole.

-- |Write a value to a 'Chan'.
writeChan :: Chan a -> a -> IO ()
writeChan (Chan _ writeVar) val = do
  new_hole <- newEmptyMVar
83 84
  mask_ $ do
    old_hole <- takeMVar writeVar
Ian Lynagh's avatar
Ian Lynagh committed
85
    putMVar old_hole (ChItem val new_hole)
86 87 88 89 90 91 92 93 94 95 96
    putMVar writeVar new_hole

-- The reason we don't simply do this:
--
--    modifyMVar_ writeVar $ \old_hole -> do
--      putMVar old_hole (ChItem val new_hole)
--      return new_hole
--
-- is because if an asynchronous exception is received after the 'putMVar'
-- completes and before modifyMVar_ installs the new value, it will set the
-- Chan's write end to a filled hole.
Ian Lynagh's avatar
Ian Lynagh committed
97 98 99 100

-- |Read the next value from the 'Chan'.
readChan :: Chan a -> IO a
readChan (Chan readVar _) = do
101
  modifyMVarMasked readVar $ \read_end -> do -- Note [modifyMVarMasked]
Ian Lynagh's avatar
Ian Lynagh committed
102 103 104 105 106
    (ChItem val new_read_end) <- readMVar read_end
        -- Use readMVar here, not takeMVar,
        -- else dupChan doesn't work
    return (new_read_end, val)

107 108 109 110 111 112 113 114 115
-- Note [modifyMVarMasked]
-- This prevents a theoretical deadlock if an asynchronous exception
-- happens during the readMVar while the MVar is empty.  In that case
-- the read_end MVar will be left empty, and subsequent readers will
-- deadlock.  Using modifyMVarMasked prevents this.  The deadlock can
-- be reproduced, but only by expanding readMVar and inserting an
-- artificial yield between its takeMVar and putMVar operations.


Ian Lynagh's avatar
Ian Lynagh committed
116 117 118 119
-- |Duplicate a 'Chan': the duplicate channel begins empty, but data written to
-- either channel from then on will be available from both.  Hence this creates
-- a kind of broadcast channel, where data written by anyone is seen by
-- everyone else.
basvandijk's avatar
basvandijk committed
120 121 122
--
-- (Note that a duplicated channel is not equal to its original.
-- So: @fmap (c /=) $ dupChan c@ returns @True@ for all @c@.)
Ian Lynagh's avatar
Ian Lynagh committed
123 124 125 126 127 128 129 130 131 132 133 134 135
dupChan :: Chan a -> IO (Chan a)
dupChan (Chan _ writeVar) = do
   hole       <- readMVar writeVar
   newReadVar <- newMVar hole
   return (Chan newReadVar writeVar)

-- |Put a data item back onto a channel, where it will be the next item read.
unGetChan :: Chan a -> a -> IO ()
unGetChan (Chan readVar _) val = do
   new_read_end <- newEmptyMVar
   modifyMVar_ readVar $ \read_end -> do
     putMVar new_read_end (ChItem val read_end)
     return new_read_end
136
{-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
Ian Lynagh's avatar
Ian Lynagh committed
137 138 139 140 141 142 143 144

-- |Returns 'True' if the supplied 'Chan' is empty.
isEmptyChan :: Chan a -> IO Bool
isEmptyChan (Chan readVar writeVar) = do
   withMVar readVar $ \r -> do
     w <- readMVar writeVar
     let eq = r == w
     eq `seq` return eq
145
{-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead.  See <http://ghc.haskell.org/trac/ghc/ticket/4154> for details" #-} -- deprecated in 7.0
Ian Lynagh's avatar
Ian Lynagh committed
146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161

-- Operators for interfacing with functional streams.

-- |Return a lazy list representing the contents of the supplied
-- 'Chan', much like 'System.IO.hGetContents'.
getChanContents :: Chan a -> IO [a]
getChanContents ch
  = unsafeInterleaveIO (do
        x  <- readChan ch
        xs <- getChanContents ch
        return (x:xs)
    )

-- |Write an entire list of items to a 'Chan'.
writeList2Chan :: Chan a -> [a] -> IO ()
writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)