home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / sml_nj / cml-098.lha / cml-0.9.8 / library / buffer.sml next >
Encoding:
Text File  |  1991-06-16  |  1.9 KB  |  57 lines
  1. (* buffer.sml
  2.  *
  3.  * COPYRIGHT (c) 1990 by John H. Reppy.  See COPYRIGHT file for details.
  4.  *
  5.  * This is an implementation unbounded buffered channels.  Send operations never
  6.  * block, but accept/receive operations may.
  7.  * Caveat: since the buffer is unbounded it is possible for the buffer to consume
  8.  * excessive amounts of space, if the number of send operations greatly exceeds
  9.  * the number of accepts over some time period.
  10.  *)
  11.  
  12. signature BUFFER_CHAN =
  13.   sig
  14.     structure CML : CONCUR_ML
  15.     type 'a buffer_chan
  16.     val buffer : unit -> '1a buffer_chan
  17.     val bufferIn : '1a CML.chan -> '1a buffer_chan
  18.     val bufferOut : '1a CML.chan -> '1a buffer_chan
  19.     val bufferSend : ('a buffer_chan * 'a) -> unit
  20.     val bufferAccept : 'a buffer_chan -> 'a
  21.     val bufferReceive : 'a buffer_chan -> 'a CML.event
  22.   end (* BUFFER_CHAN *)
  23.  
  24. functor BufferChan (CML : CONCUR_ML) : BUFFER_CHAN =
  25.   struct
  26.     structure CML = CML
  27.  
  28.     open CML
  29.  
  30.     datatype 'a buffer_chan = BC of {inch : 'a chan, outch : 'a chan}
  31.  
  32.     local
  33. (** We need the ('a chan) type constraint here because of a SML/NJ compiler bug *)
  34.       fun mkBuffer (inCh, outCh : 'a chan) = let
  35.         val inEvt = receive inCh
  36.         fun loop ([], []) = loop([accept inCh], [])
  37.           | loop (front as (x::r), rear) = select [
  38.             wrap (inEvt, fn y => loop(front, y::rear)),
  39.             wrap (transmit(outCh, x), fn () => loop(r, rear))
  40.           ]
  41.           | loop ([], rear) = loop(List.rev rear, [])
  42.         in
  43.           spawn (fn () => loop([], []));
  44.           BC{inch=inCh, outch=outCh}
  45.         end
  46.     in
  47.     fun buffer () = mkBuffer(channel(), channel())
  48.     fun bufferIn inCh = mkBuffer(inCh, channel())
  49.     fun bufferOut outCh = mkBuffer(channel(), outCh)
  50.     end (* local *)
  51.  
  52.     fun bufferSend (BC{inch, ...}, x) = send(inch, x)
  53.     fun bufferAccept (BC{outch, ...}) = accept outch
  54.     fun bufferReceive (BC{outch, ...}) = receive outch
  55.  
  56.   end (* functor BufferChan *)
  57.