ghc/lib/prelude/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         putChan,         -- :: Chan a -> a -> IO ()
  19         getChan,         -- :: Chan a -> IO a
  20         dupChan,         -- :: Chan a -> IO (Chan a)
  21         unGetChan,       -- :: Chan a -> a -> IO ()
  22
  23          {- stream interface -}
  24         getChanContents, -- :: Chan a -> IO [a]
  25         putList2Chan     -- :: Chan a -> [a] -> IO ()
  26
  27        ) where
  28
  29 import PreludeGlaST
  30 import PreludePrimIO    ( newEmptyMVar, newMVar, putMVar,
  31                           readMVar, takeMVar, _MVar
  32                         )
  33 \end{code}
  34
  35 A channel is represented by two @MVar@s keeping track of the two ends
  36 of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
  37 are used to handle consumers trying to read from an empty channel.
  38
  39 \begin{code}
  40
  41 data Chan a
  42  = Chan (_MVar (Stream a))
  43         (_MVar (Stream a))
  44
  45 type Stream a = _MVar (ChItem a)
  46
  47 data ChItem a = ChItem a (Stream a)
  48
  49
  50 \end{code}
  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 \begin{code}
  59
  60 newChan :: IO (Chan a)
  61 newChan
  62  = newEmptyMVar      >>= \ hole ->
  63    newMVar hole      >>= \ read ->
  64    newMVar hole      >>= \ write ->
  65    return (Chan read write)
  66
  67 \end{code}
  68
  69 To put an element on a channel, a new hole at the write end is created.
  70 What was previously the empty @MVar@ at the back of the channel is then
  71 filled in with a new stream element holding the entered value and the
  72 new hole.
  73
  74 \begin{code}
  75
  76 putChan :: Chan a -> a -> IO ()
  77 putChan (Chan read write) val
  78  = newEmptyMVar             >>= \ new_hole ->
  79    takeMVar write           >>= \ old_hole ->
  80    putMVar write new_hole   >>
  81    putMVar old_hole (ChItem val new_hole) >>
  82    return ()
  83
  84 \end{code}
  85
  86 \begin{code}
  87
  88 getChan :: Chan a -> IO a
  89 getChan (Chan read write)
  90  = takeMVar read          >>= \ rend ->
  91    takeMVar rend          >>= \ (ChItem val new_rend) ->
  92    putMVar read new_rend  >>
  93    return val
  94
  95 \end{code}
  96
  97 \begin{code}
  98
  99 dupChan :: Chan a -> IO (Chan a)
 100 dupChan (Chan read write)
 101  = newEmptyMVar           >>= \ new_read ->
 102    readMVar write         >>= \ hole ->
 103    putMVar new_read hole  >>
 104    return (Chan new_read write)
 105
 106 unGetChan :: Chan a -> a -> IO ()
 107 unGetChan (Chan read write) val
 108  = newEmptyMVar                       >>= \ new_rend ->
 109    takeMVar read                      >>= \ rend ->
 110    putMVar new_rend (ChItem val rend) >>
 111    putMVar read new_rend              >>
 112    return ()
 113
 114 \end{code}
 115
 116 Operators for interfacing with functional streams.
 117
 118 \begin{code}
 119
 120 getChanContents :: Chan a -> IO [a]
 121 getChanContents ch =
 122  unsafeInterleavePrimIO (
 123   getChan ch                                   `thenPrimIO` \ ~(Right x) ->
 124   unsafeInterleavePrimIO (getChanContents ch)  `thenPrimIO` \ ~(Right xs) ->
 125   returnPrimIO  (Right (x:xs)))
 126
 127 putList2Chan :: Chan a -> [a] -> IO ()
 128 putList2Chan ch ls = sequence (map (putChan ch) ls)
 129
 130 \end{code}