(* acct.sml *)

(* bank accounts with non-negative integer balances *)

structure Acct :> ACCT =
struct

open CML

(* requests

   Inc n is an incrementation request: increment an account's balance by n

   Dec(n, approveEv) is a decrementation request: decrement an
   account's balance by n; the server synchronizes on approveEv when
   it is ready to approve the request; if this synchronization yields
   true, this means that the client who made the request learned that
   the request was approved; if it yields false, this means that the
   client was no longer interested in the request being approved *)

datatype req = Inc of int
             | Dec of int * bool event

(* a bank account is a request channel *)

type acct = req chan

(* decrementation request queue *)

type dec_queue = (int * bool event)Fifo.fifo

(* val server : req chan * int * dec_queue -> 'a *)

fun server(ch, bal, que) =
      if case Fifo.peek que of
              NONE       => false
            | SOME(n, _) => n <= bal
      then let val (que, (n, approveEv)) = Fifo.dequeue que
           in if sync approveEv
              then server(ch, bal - n, que)
              else server(ch, bal, que)
           end
      else case recv ch of
              Inc n   => server(ch, bal + n, que)
            | Dec dec => server(ch, bal, Fifo.enqueue(que, dec))

(* val make : unit -> acct *)

fun make() =
      let val ch = channel() : req chan
      in spawn(fn () => server(ch, 0, Fifo.empty)); ch end

exception NonPositive

(* val incEvt : acct * int -> unit event *)

fun incEvt(ch, n) =
      if n <= 0
      then raise NonPositive
      else sendEvt(ch, Inc n)

(* val decEvt : acct * int -> unit event *)

fun decEvt(ch, n) =
      if n <= 0
      then raise NonPositive
      else withNack
           (fn nackEvt =>
                 let val replyCh : unit chan    = channel()
                     val approveEv : bool event =
                           choose[wrap(sendEvt(replyCh, ()),
                                       fn () => true),
                                  wrap(nackEvt,
                                       fn () => false)]
                 in spawn(fn () => send(ch, Dec(n, approveEv)));
                    recvEvt replyCh
                 end)

end;