(* buffer.sml *)

(* CML buffers with fixed maximum lengths *)

structure Buffer :> BUFFER =
struct

open CML

type 'a buffer =
       {addCh  : 'a chan,  (* values sent to this channel will be added to
                              buffer *)
        delCh  : 'a chan}  (* values read from this channel will be deleted
                              from buffer *)

(* val server : 'a buffer * int -> 'b

   in a call server(buf, maxLen), we require that maxLen >= 1 *)

fun server({addCh, delCh}, maxLen) =
      let (* val serv : Fifo.fifo -> 'b

             in a call serv queue, we require that Fifo.length queue <=
             maxLen *)

          fun serv queue =
                select
                [(* handle additions *)
                 if Fifo.length queue < maxLen
                 then wrap(recvEvt addCh,
                           fn x => serv(Fifo.enqueue(queue, x)))
                 else never,

                 (* handle deletions *)
                 if Fifo.length queue > 0
                 then let val (queue, x) = Fifo.dequeue queue
                      in wrap(sendEvt(delCh, x),
                              fn () => serv queue)
                      end
                 else never]
      in serv Fifo.empty end

exception Size

fun make maxLen =
      if maxLen <= 0
      then raise Size
      else let val buf = {addCh  = channel(), delCh  = channel()}
           in spawn(fn () => server(buf, maxLen)); buf end

fun addEvt ({addCh, ...} : 'a buffer) x = sendEvt(addCh, x)

fun delEvt({delCh, ...} : 'a buffer) = recvEvt delCh

end;