home *** CD-ROM | disk | FTP | other *** search
/ PSION CD 2 / PsionCDVol2.iso / Programs / 876 / hugs.sis / Channel.lhs < prev    next >
Encoding:
Text File  |  2000-09-21  |  3.9 KB  |  160 lines
  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.     unReadChan,     -- :: Chan a -> a -> IO ()
  22.         isEmptyChan,     -- :: Chan a -> IO Bool    -- PRH
  23.  
  24.      {- stream interface -}
  25.     getChanContents, -- :: Chan a -> IO [a]
  26.     writeList2Chan     -- :: Chan a -> [a] -> IO ()
  27.  
  28.        ) where
  29.  
  30. import Prelude
  31. import IOExts( unsafeInterleaveIO )
  32. import ConcBase
  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 write 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. writeChan :: Chan a -> a -> IO ()
  77. writeChan (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.  
  85. readChan :: Chan a -> IO a
  86. readChan (Chan read write)
  87.  = takeMVar read      >>= \ rend ->
  88.    takeMVar rend          >>= \ (ChItem val new_rend) ->
  89.    putMVar read new_rend  >>
  90.    return val
  91.  
  92. isEmptyChan :: Chan a -> IO Bool
  93. isEmptyChan (Chan read write)
  94.  = takeMVar read      >>= \r ->
  95.    readMVar write     >>= \w ->
  96.    putMVar read r     >>
  97.    return (r == w)
  98.  
  99. {-
  100. -- PRH:
  101. isEmptyChan :: Chan a -> IO Bool
  102. isEmptyChan (Chan read write)
  103.  = readMVar read      >>= \ rend ->
  104.    isEmptyMVar rend   >>= \ yes  ->
  105.    return yes
  106. -}
  107.  
  108. -- or just:
  109. -- isEmptyChan (Chan read write)
  110. --  = readMVar read      >>=
  111. --    isEmptyMVar
  112.  
  113. dupChan :: Chan a -> IO (Chan a)
  114. dupChan (Chan read write)
  115.  = newEmptyMVar          >>= \ new_read ->
  116.    takeMVar write      >>= \ hole ->
  117.    putMVar new_read hole  >>
  118.    return (Chan new_read write)
  119.  
  120. unReadChan :: Chan a -> a -> IO ()
  121. unReadChan (Chan read write) val
  122.  = newEmptyMVar                  >>= \ new_rend ->
  123.    takeMVar read              >>= \ rend ->
  124.    putMVar new_rend (ChItem val rend) >> 
  125.    putMVar read new_rend              >>
  126.    return ()
  127.  
  128. \end{code}
  129.  
  130. Operators for interfacing with functional streams.
  131.  
  132. \begin{code}
  133.  
  134. getChanContents :: Chan a -> IO [a]
  135. -- Rewritten by ADR to use IO monad instead of PrimIO Monad
  136. getChanContents ch = unsafeInterleaveIO $ do
  137.          x  <- readChan ch
  138.          xs <- getChanContents ch
  139.          return (x:xs)
  140.  
  141. --ADR: my_2_IO :: PrimIO (Either IOError a) -> IO a -- simple; primIOToIO does too much!
  142. --ADR: my_2_IO m = IO m
  143. --ADR: 
  144. --ADR: readChan_prim         :: Chan a -> PrimIO (Either IOError  a)
  145. --ADR: readChanContents_prim :: Chan a -> PrimIO (Either IOError [a])
  146. --ADR: 
  147. --ADR: readChan_prim ch = ST $ \ s ->
  148. --ADR:        case (readChan ch) of { IO (ST read) ->
  149. --ADR:        read s }
  150. --ADR: 
  151. --ADR: readChanContents_prim ch = ST $ \ s ->
  152. --ADR:        case (readChanContents ch) of { IO (ST read) ->
  153. --ADR:        read s }
  154.  
  155. -------------
  156. writeList2Chan :: Chan a -> [a] -> IO ()
  157. writeList2Chan ch ls = sequence_ (map (writeChan ch) ls)
  158.  
  159. \end{code}
  160.