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