X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FConcurrent%2FChan.hs;h=dfc46c38cbb3e77342291e2b6b6d1a4fcafb04ac;hb=3efe74f3acd0dff20d078b6e8416664193b219d4;hp=29423e1d84ab38cc81bc2f3af9bd25bb498598f1;hpb=7f1f4e7a695c402ddd3a1dc2cc7114e649a78ebc;p=ghc-base.git diff --git a/Control/Concurrent/Chan.hs b/Control/Concurrent/Chan.hs index 29423e1..dfc46c3 100644 --- a/Control/Concurrent/Chan.hs +++ b/Control/Concurrent/Chan.hs @@ -1,52 +1,54 @@ ----------------------------------------------------------------------------- --- +-- | -- Module : Control.Concurrent.Chan -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental --- Portability : non-portable --- --- $Id: Chan.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $ +-- Portability : non-portable (concurrency) -- --- Standard, unbounded channel abstraction. +-- Unbounded channels. -- ----------------------------------------------------------------------------- module Control.Concurrent.Chan - ( Chan -- abstract - - -- creator - , newChan -- :: IO (Chan a) - - -- operators - , writeChan -- :: Chan a -> a -> IO () - , readChan -- :: Chan a -> IO a - , dupChan -- :: Chan a -> IO (Chan a) - , unGetChan -- :: Chan a -> a -> IO () - - , isEmptyChan -- :: Chan a -> IO Bool - - -- stream interface - , getChanContents -- :: Chan a -> IO [a] - , writeList2Chan -- :: Chan a -> [a] -> IO () - - ) where + ( + -- * The 'Chan' type + Chan, -- abstract + + -- * Operations + newChan, -- :: IO (Chan a) + writeChan, -- :: Chan a -> a -> IO () + readChan, -- :: Chan a -> IO a + dupChan, -- :: Chan a -> IO (Chan a) + unGetChan, -- :: Chan a -> a -> IO () + isEmptyChan, -- :: Chan a -> IO Bool + + -- * Stream interface + getChanContents, -- :: Chan a -> IO [a] + writeList2Chan, -- :: Chan a -> [a] -> IO () + ) where import Prelude -import System.IO.Unsafe ( unsafeInterleaveIO ) +import System.IO.Unsafe ( unsafeInterleaveIO ) import Control.Concurrent.MVar +import Data.Typeable + +#include "Typeable.h" -- 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 = Chan (MVar (Stream a)) (MVar (Stream a)) +INSTANCE_TYPEABLE1(Chan,chanTc,"Chan") + type Stream a = MVar (ChItem a) data ChItem a = ChItem a (Stream a) @@ -57,63 +59,76 @@ data ChItem a = ChItem a (Stream a) -- @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 - read <- newMVar hole - write <- newMVar hole - return (Chan read write) + 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 _read write) val = do +writeChan (Chan _ writeVar) val = do new_hole <- newEmptyMVar - modifyMVar_ write $ \old_hole -> do + modifyMVar_ writeVar $ \old_hole -> do putMVar old_hole (ChItem val new_hole) return new_hole +-- |Read the next value from the 'Chan'. readChan :: Chan a -> IO a -readChan (Chan read _write) = do - modifyMVar read $ \read_end -> do +readChan (Chan readVar _) = do + modifyMVar readVar $ \read_end -> do (ChItem val new_read_end) <- readMVar read_end - -- Use readMVar here, not takeMVar, - -- else dupChan doesn't work + -- Use readMVar here, not takeMVar, + -- else dupChan doesn't work return (new_read_end, val) +-- |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. dupChan :: Chan a -> IO (Chan a) -dupChan (Chan _read write) = do - hole <- readMVar write - new_read <- newMVar hole - return (Chan new_read write) +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 read _write) val = do +unGetChan (Chan readVar _) val = do new_read_end <- newEmptyMVar - modifyMVar_ read $ \read_end -> do + modifyMVar_ readVar $ \read_end -> do putMVar new_read_end (ChItem val read_end) return new_read_end +{-# DEPRECATED unGetChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-} +-- |Returns 'True' if the supplied 'Chan' is empty. isEmptyChan :: Chan a -> IO Bool -isEmptyChan (Chan read write) = do - withMVar read $ \r -> do - w <- readMVar write +isEmptyChan (Chan readVar writeVar) = do + withMVar readVar $ \r -> do + w <- readMVar writeVar let eq = r == w eq `seq` return eq +{-# DEPRECATED isEmptyChan "if you need this operation, use Control.Concurrent.STM.TChan instead. See http://hackage.haskell.org/trac/ghc/ticket/4154 for details" #-} -- 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) + 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)