(* filter-evt.sml *)

(* Copyright (C) 2006 Alley Stoughton

   This file is part of crypto, a cryptogram encoder/decoder.  See the
   file COPYING.txt for copying and usage restrictions *)

(* event filtering and buffering *)

structure FilterEvt :> FILTER_EVT =
struct

open CML

fun filterEvt (f : 'a -> bool) (ev : 'a event) =
      let val valCh : 'a chan     = channel()
          val flushCh : unit chan = channel()  

          (* val loop : 'a Fifo.fifo -> 'b *)

          fun loop que =
                select
                [wrap(ev,
                      fn x =>
                           if f x
                           then loop(Fifo.enqueue(que, x))
                           else loop que),

                 if Fifo.length que > 0
                 then let val (que, x) = Fifo.dequeue que
                      in wrap(sendEvt(valCh, x),
                              fn () => loop que)
                      end
                 else never,

                 wrap(recvEvt flushCh,
                      fn () => loop Fifo.empty)]
      in spawn(fn () => loop Fifo.empty);
         (recvEvt valCh, sendEvt(flushCh, ()))
      end

end;