(* Chris Okasaki
   School of Computer Science
   Carnegie Mellon University
   Pittsburgh, PA 15213
   cokasaki@cs.cmu.edu *)

functor BinomialQueue (E:ORDERED) : PRIORITY_QUEUE =
struct
  structure Elem = E

  type Rank = int
  datatype Tree = Node of Elem.T * Rank * Tree list
  type T = Tree list

  (* auxiliary functions *)
  fun root (Node (x,r,c)) = x
  fun rank (Node (x,r,c)) = r
  fun link (t1 as Node (x1,r1,c1), t2 as Node (x2,r2,c2)) = (* r1 = r2 *)
        if Elem.leq (x1,x2) then Node (x1,r1+1,t2 :: c1)
                            else Node (x2,r2+1,t1 :: c2)
  fun ins (t,[]) = [t]
    | ins (t,t' :: ts) =  (* rank t <= rank t' *)
        if rank t < rank t' then t :: t' :: ts else ins (link (t,t'), ts)

  val empty = []
  fun isEmpty ts = null ts

  fun insert (x, ts) = ins (Node (x,0,[]), ts)
  fun meld ([], ts) = ts
    | meld (ts, []) = ts
    | meld (t1 :: ts1,t2 :: ts2) =
        if      rank t1 < rank t2 then t1 :: meld (ts1, t2 :: ts2)
        else if rank t2 < rank t1 then t2 :: meld (t1 :: ts1, ts2)
        else ins (link (t1,t2), meld (ts1,ts2))

  exception EMPTY

  fun findMin [] = raise EMPTY
    | findMin [t] = root t
    | findMin (t :: ts) =
        let val x = root t
            val y = findMin ts
        in
            if Elem.leq (x,y) then x else y
        end
  fun deleteMin [] = raise EMPTY
    | deleteMin ts =
        let fun getMin [t] = (t, [])
              | getMin (t :: ts) =
                  let val (t', ts') = getMin ts
                  in
                      if Elem.leq (root t,root t') then (t, ts)
                                                   else (t', t :: ts')
                  end
            val (Node (x,r,c), ts) = getMin ts
	in meld (rev c, ts) end
end