ghc/lib/concurrent/Channel.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1995
   3 %
   4 \section[Channel]{Unbounded Channels}
   5
   6 Standard, unbounded channel abstraction.
   7
   8 \begin{code}
   9 module Channel
  10        (
  11          {- abstract type defined -}
  12         Chan,
  13
  14          {- creator -}
  15         newChan,         -- :: IO (Chan a)
  16
  17          {- operators -}
  18         writeChan,       -- :: Chan a -> a -> IO ()
  19         readChan,        -- :: Chan a -> IO a
  20         dupChan,         -- :: Chan a -> IO (Chan a)
  21         unGetChan,       -- :: Chan a -> a -> IO ()
  22
  23          {- stream interface -}
  24         readChanContents, -- :: Chan a -> IO [a]
  25         putList2Chan     -- :: Chan a -> [a] -> IO ()
  26
  27        ) where
  28
  29 import Prelude
  30 import IOBase   ( IO(..), ioToST, stToIO )              -- Suspicious!
  31 import ConcBase
  32 import STBase
  33 import Unsafe ( unsafeInterleaveIO )
  34 \end{code}
  35
  36 A channel is represented by two @MVar@s keeping track of the two ends
  37 of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
  38 are used to handle consumers trying to read from an empty channel.
  39
  40 \begin{code}
  41
  42 data Chan a
  43  = Chan (MVar (Stream a))
  44         (MVar (Stream a))
  45
  46 type Stream a = MVar (ChItem a)
  47
  48 data ChItem a = ChItem a (Stream a)
  49
  50
  51 \end{code}
  52
  53 See the Concurrent Haskell paper for a diagram explaining the
  54 how the different channel operations proceed.
  55
  56 @newChan@ sets up the read and write end of a channel by initialising
  57 these two @MVar@s with an empty @MVar@.
  58
  59 \begin{code}
  60
  61 newChan :: IO (Chan a)
  62 newChan
  63  = newEmptyMVar      >>= \ hole ->
  64    newMVar hole      >>= \ read ->
  65    newMVar hole      >>= \ write ->
  66    return (Chan read write)
  67
  68 \end{code}
  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 \begin{code}
  76
  77 writeChan :: Chan a -> a -> IO ()
  78 writeChan (Chan read write) val
  79  = newEmptyMVar             >>= \ new_hole ->
  80    takeMVar write           >>= \ old_hole ->
  81    putMVar write new_hole   >>
  82    putMVar old_hole (ChItem val new_hole) >>
  83    return ()
  84
  85
  86 readChan :: Chan a -> IO a
  87 readChan (Chan read write)
  88  = takeMVar read          >>= \ rend ->
  89    takeMVar rend          >>= \ (ChItem val new_rend) ->
  90    putMVar read new_rend  >>
  91    return val
  92
  93
  94 dupChan :: Chan a -> IO (Chan a)
  95 dupChan (Chan read write)
  96  = newEmptyMVar           >>= \ new_read ->
  97    readMVar write         >>= \ hole ->
  98    putMVar new_read hole  >>
  99    return (Chan new_read write)
 100
 101 unGetChan :: Chan a -> a -> IO ()
 102 unGetChan (Chan read write) val
 103  = newEmptyMVar                       >>= \ new_rend ->
 104    takeMVar read                      >>= \ rend ->
 105    putMVar new_rend (ChItem val rend) >>
 106    putMVar read new_rend              >>
 107    return ()
 108
 109 \end{code}
 110
 111 Operators for interfacing with functional streams.
 112
 113 \begin{code}
 114
 115 readChanContents :: Chan a -> IO [a]
 116 readChanContents ch
 117   = unsafeInterleaveIO (do
 118         x <- readChan ch
 119         xs <- readChanContents ch
 120         return (x:xs)
 121     )
 122
 123 -------------
 124 putList2Chan :: Chan a -> [a] -> IO ()
 125 putList2Chan ch ls = sequence (map (writeChan ch) ls)
 126
 127 \end{code}