functor FTEventQueue (val h: real) =
struct

    structure TEventPriority = 
    struct
       type priority     = int
       fun compare (x,y) = Int.compare (y,x)
       type item         = int * RTensor.tensor list
       val priority : item -> int = #1
    end


    structure PQ = LeftPriorityQFn (TEventPriority)

    (* Given a delay (positive real number), compute the priority given a time step *)
    fun delayPriority (delay) = Real.round (Real./ (delay, h))

    val empty = PQ.empty

    fun addEvent ((delay, elem), pq) =
        let
            val prio = delayPriority delay
        in
            PQ.insert ((prio, elem), pq)
        end


    fun nextEvent (f, dflt, pq) =
        case PQ.next pq of
            NONE => (dflt, pq)
          | SOME ((prio, v), pq') => 
            (f (prio, v), pq')


    fun nextEvent' (p, f, dflt, pq) =
        case PQ.next pq of
            NONE => (dflt, pq)
          | SOME ((prio, v), pq') => 
            (if p (prio, v) 
             then (f (prio, v), pq')
             else (dflt, pq))

    fun nextUntil (t, f, pq) =
        let
            val prio = delayPriority t
            val _ = print ("nextUntil: prio = " ^ (Int.toString prio) ^ "\n")
                                           

            fun recur (lst, pq) =
                let 
                    val (e, pq') = nextEvent' ((fn (prio',_) => prio' <= prio),
                                               (fn (prio,v) => SOME (prio,v)),
                                               NONE,
                                               pq)
                in
                    case e of
                        SOME x => recur (x::lst, pq')
                      | NONE => (f lst, pq')
                end
        in
            recur ([], pq)
        end

end


functor TEventQueue (structure P : PRIORITY
                     type value 
                     val value : P.item -> value) =
struct

    structure PQ = LeftPriorityQFn (P)

    type priority = P.priority
    type value = value
                                   
    val empty   = PQ.empty

    val numItems    = PQ.numItems

    val isEmpty = PQ.isEmpty

    val merge   = PQ.merge

    fun addEvent (item, pq) =
        PQ.insert (item, pq)

    fun nextEvent (f, dflt, pq) =
        case PQ.next pq of
            NONE => (dflt, pq)
          | SOME (v, pq') => 
            (f (P.priority v, value v), pq')


    fun nextEvent' (p, f, dflt, pq) =
        case PQ.next pq of
            NONE => (dflt, pq)
          | SOME (v, pq') => 
            (if p (P.priority v, value v) 
             then (f (P.priority v, value v), pq')
             else (dflt, pq))


    fun nextUntil (f, t, pq) =
        let
            val prio = t

            fun recur (lst, pq) =
                let 
                    val (e, pq') = nextEvent' 
                                       ((fn (p,v) => case P.compare (p, prio) of 
                                                         LESS => true
                                                       | EQUAL => true
                                                       | GREATER => false),
                                               (fn (item) => SOME item),
                                               NONE,
                                               pq)
                in
                    case e of
                        SOME x => recur (x::lst, pq')
                      | NONE => (f lst, pq')
                end
        in
            recur ([], pq)
        end


    fun app f pq =
        case PQ.next pq of
            NONE => ()
          | SOME (item, pq') => 
            (f (P.priority item, value item); 
             app f pq')


    fun foldl f pq init =
        case PQ.next pq of
            NONE => init
          | SOME (item, pq') => 
            foldl f pq' (f (P.priority item, value item, init))

end