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 -}
  12         Chan,
  13
  14         newChan,        -- :: IO (Chan a)
  15         putChan,        -- :: Chan a -> a -> IO ()
  16         getChan,        -- :: Chan a -> IO a
  17         dupChan,        -- :: Chan a -> IO (Chan a)
  18         unGetChan,      -- :: Chan a -> a -> IO ()
  19         getChanContents -- :: Chan a -> IO [a]
  20
  21        ) where
  22
  23 import PreludeGlaST
  24 import PreludePrimIO    ( newEmptyMVar, newMVar, putMVar,
  25                           readMVar, takeMVar, _MVar
  26                         )
  27 \end{code}
  28
  29 A channel is represented by two @MVar@s keeping track of the two ends
  30 of the channel contents,i.e.,  the read- and write ends. Empty @MVar@s
  31 are used to handle consumers trying to read from an empty channel.
  32
  33 \begin{code}
  34
  35 data Chan a
  36  = Chan (_MVar (Stream a))
  37         (_MVar (Stream a))
  38
  39 type Stream a = _MVar (ChItem a)
  40
  41 data ChItem a = ChItem a (Stream a)
  42
  43
  44 \end{code}
  45
  46 See the Concurrent Haskell paper for a diagram explaining the
  47 how the different channel operations proceed.
  48
  49 @newChan@ sets up the read and write end of a channel by initialising
  50 these two @MVar@s with an empty @MVar@.
  51
  52 \begin{code}
  53
  54 newChan :: IO (Chan a)
  55 newChan
  56  = newEmptyMVar      >>= \ hole ->
  57    newMVar hole      >>= \ read ->
  58    newMVar hole      >>= \ write ->
  59    return (Chan read write)
  60
  61 \end{code}
  62
  63 To put an element on a channel, a new hole at the write end is created.
  64 What was previously the empty @MVar@ at the back of the channel is then
  65 filled in with a new stream element holding the entered value and the
  66 new hole.
  67
  68 \begin{code}
  69
  70 putChan :: Chan a -> a -> IO ()
  71 putChan (Chan read write) val
  72  = newEmptyMVar             >>= \ new_hole ->
  73    takeMVar write           >>= \ old_hole ->
  74    putMVar write new_hole   >>
  75    putMVar old_hole (ChItem val new_hole) >>
  76    return ()
  77
  78 \end{code}
  79
  80 \begin{code}
  81
  82 getChan :: Chan a -> IO a
  83 getChan (Chan read write)
  84  = takeMVar read          >>= \ rend ->
  85    takeMVar rend          >>= \ (ChItem val new_rend) ->
  86    putMVar read new_rend  >>
  87    return val
  88
  89 \end{code}
  90
  91 \begin{code}
  92
  93 dupChan :: Chan a -> IO (Chan a)
  94 dupChan (Chan read write)
  95  = newEmptyMVar           >>= \ new_read ->
  96    readMVar write         >>= \ hole ->
  97    putMVar new_read hole  >>
  98    return (Chan new_read write)
  99
 100 unGetChan :: Chan a -> a -> IO ()
 101 unGetChan (Chan read write) val
 102  = newEmptyMVar                       >>= \ new_rend ->
 103    takeMVar read                      >>= \ rend ->
 104    putMVar new_rend (ChItem val rend) >>
 105    putMVar read new_rend              >>
 106    return ()
 107
 108 \end{code}
 109
 110 \begin{code}
 111
 112 getChanContents :: Chan a -> IO [a]
 113 getChanContents ch
 114  = unsafeInterleavePrimIO (
 115       getChan ch)         `thenPrimIO` \ ~(Right x) ->
 116    unsafeInterleavePrimIO (
 117       getChanContents ch) `thenPrimIO` \ ~(Right xs) ->
 118    return (x:xs)
 119
 120 \end{code}