functor FHEAP( type Item
               val < : Item * Item -> bool 
               ):QueueSig  =
struct
datatype 'a Tree = Lf | Nd of 'a Tree * 'a * 'a Tree
type Queue = Item Tree
type Item = Item

val empty = Lf
fun isEmpty Lf = true | isEmpty _ = false

fun ins (Lf, e) = Nd(Lf, e, Lf)
  | ins (Nd(lt, v, rt), e) =
     if e < v then Nd(rt, v, ins(lt, e))
              else Nd(rt, e, ins(lt, v))

exception Deq
fun del (Nd(Lf, v, Lf)) = (Lf, v)
  | del (Nd(lt, v, rt)) = 
     let val (rt', x) = del rt 
     in (Nd(rt', v, lt), x) end 

fun downheap (Nd(lt, _, rt)) x =
    case rt of Lf => Nd(Lf, x, Lf) (* lt is also a leaf *)
    | Nd(_, rv, _) =>
      (case lt of Lf  => if x < rv then Nd(Lf, rv, Nd(Lf, x, Lf))
                                   else Nd(Lf, x, rt)
       | Nd(_, lv, _) => if rv < lv then
                         if x < lv then Nd(downheap lt x, lv, rt)
                                   else Nd(lt, x, rt)
                         else (* lv <= rv *)
                         if x < rv then Nd(lt, rv, downheap rt x)
                                   else Nd(lt, x, rt))

fun deq Lf = raise Deq
  | deq (Nd(Lf, v, Lf)) = (Lf, v)
  | deq t = let val (t' as Nd(_, v, _), x) = del t
            in (downheap t' x, v) end

val enq = ins
end;