[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.git] / 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/core/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable
10 --
11 -- $Id: Chan.hs,v 1.2 2002/04/24 16:31:37 simonmar Exp $
12 --
13 -- Standard, unbounded channel abstraction.
14 --
15 -----------------------------------------------------------------------------
16
17 module Control.Concurrent.Chan
18 ( Chan -- abstract
19
20 -- creator
21 , newChan -- :: IO (Chan a)
22
23 -- operators
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
29 , isEmptyChan -- :: Chan a -> IO Bool
30
31 -- stream interface
32 , getChanContents -- :: Chan a -> IO [a]
33 , writeList2Chan -- :: Chan a -> [a] -> IO ()
34
35 ) where
36
37 import Prelude
38
39 import System.IO.Unsafe ( unsafeInterleaveIO )
40 import Control.Concurrent.MVar
41
42 -- A channel is represented by two @MVar@s keeping track of the two ends
43 -- of the channel contents,i.e., the read- and write ends. Empty @MVar@s
44 -- are used to handle consumers trying to read from an empty channel.
45
46 data Chan a
47 = Chan (MVar (Stream a))
48 (MVar (Stream a))
49
50 type Stream a = MVar (ChItem a)
51
52 data ChItem a = ChItem a (Stream a)
53
54 -- See the Concurrent Haskell paper for a diagram explaining the
55 -- how the different channel operations proceed.
56
57 -- @newChan@ sets up the read and write end of a channel by initialising
58 -- these two @MVar@s with an empty @MVar@.
59
60 newChan :: IO (Chan a)
61 newChan = do
62 hole <- newEmptyMVar
63 read <- newMVar hole
64 write <- newMVar hole
65 return (Chan read write)
66
67 -- To put an element on a channel, a new hole at the write end is created.
68 -- What was previously the empty @MVar@ at the back of the channel is then
69 -- filled in with a new stream element holding the entered value and the
70 -- new hole.
71
72 writeChan :: Chan a -> a -> IO ()
73 writeChan (Chan _read write) val = do
74 new_hole <- newEmptyMVar
75 modifyMVar_ write $ \old_hole -> do
76 putMVar old_hole (ChItem val new_hole)
77 return new_hole
78
79 readChan :: Chan a -> IO a
80 readChan (Chan read _write) = do
81 modifyMVar read $ \read_end -> do
82 (ChItem val new_read_end) <- readMVar read_end
83 -- Use readMVar here, not takeMVar,
84 -- else dupChan doesn't work
85 return (new_read_end, val)
86
87 dupChan :: Chan a -> IO (Chan a)
88 dupChan (Chan _read write) = do
89 hole <- readMVar write
90 new_read <- newMVar hole
91 return (Chan new_read write)
92
93 unGetChan :: Chan a -> a -> IO ()
94 unGetChan (Chan read _write) val = do
95 new_read_end <- newEmptyMVar
96 modifyMVar_ read $ \read_end -> do
97 putMVar new_read_end (ChItem val read_end)
98 return new_read_end
99
100 isEmptyChan :: Chan a -> IO Bool
101 isEmptyChan (Chan read write) = do
102 withMVar read $ \r -> do
103 w <- readMVar write
104 let eq = r == w
105 eq `seq` return eq
106
107 -- Operators for interfacing with functional streams.
108
109 getChanContents :: Chan a -> IO [a]
110 getChanContents ch
111 = unsafeInterleaveIO (do
112 x <- readChan ch
113 xs <- getChanContents ch
114 return (x:xs)
115 )
116
117 -------------
118 writeList2Chan :: Chan a -> [a] -> IO ()
119 writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)