infix sub;
functor BHEAP(type Item val <= : Item * Item -> bool):
    sig type Heap
	type Item
	val empty : int -> Heap
	val enq : Heap * Item -> unit
	val deq : Heap -> Item
	val isEmpty : Heap -> bool
    end
    =
struct
    open Array 
    fun swap a i j = let val t = a sub i
                     in update(a,i,a sub j); update(a,j,t) end

    exception Deq and FullHeap
    datatype Entry = Void | Some of Item
    type Item = Item
    type Heap = int ref * Entry Array.array
    infix <<=
    fun (Some x) <<= (Some y) = x <= y
      | _ <<= _               = true

    fun empty n = (ref 0,Array.array(n+1, Void))
    fun isEmpty (ref n,_) = n = 0

    fun parent i = i div 2 and left i = 2 * i and right i = 2 * i + 1

    fun upheap a 1 = ()
      | upheap a i = let val p = parent i in
                         if (a sub i) <<= (a sub p) then ()
                         else (swap a i p; upheap a p) end
                            
    fun downheap (n,a) i = 
        let val l = left i and r = right i
            val b = if l < n andalso (a sub i) <<= (a sub l) then l else i
            val c = if r < n andalso (a sub b) <<= (a sub r) then r else b
        in if c = i then () else (swap a i c; downheap (n,a) c) end
              
    fun enq((n,a), x) = if !n + 1 = length a then raise FullHeap
                     else (n := !n +1;
			   update(a,!n,Some x);
			   upheap a (!n))

    fun deq(n,a)= if !n < 1 then raise Deq else
                 let val Some v = a sub 1
                 in  update(a, 1, a sub (!n));
                     update(a, !n, Void);
                     downheap (!n,a) 1;
                     n := (!n - 1);
		     v end
end;