(* This code is inspired by Chapter 3 of Chris Okasaki's book, "Purely
   Functional Data Structures". *)

(* A heap is either an empty heap [E] or a non-empty heap [T (r, x, h1, h2)]
   where [r] is the rank, [x] is an element, and [h1] and [h2] are sub-heaps. *)

type element =
  int

type heap =
| E
| T of int * element * heap * heap

type queue =
  heap

(* The rank of a (sub-)heap is the length of its right spine. The leftist
   invariant states that the rank of a left child is at least as large as
   the rank of its right sibling. *)

(* This implies that the length of each right spine is at most logarithmic.
   Indeed, one can prove (by induction) that [size h >= 2^(rank h) - 1]
   holds for every leftist heap [h]. (Exercise: do it!) *)

(* The rank of a heap can be determined in constant time (because we store it). *)

let rank h =
  match h with
  | E ->
      0
  | T (r, _, _, _) ->
      r

(* This smart constructor creates a new [T] node. The rank is computed on
   the fly, and the children are swapped if necessary, so as to maintain
   the leftist invariant. *)

let makeT x h1 h2 =
  let r1 = rank h1
  and r2 = rank h2 in
  if r1 >= r2 then
    T (r2 + 1, x, h1, h2)
  else
    T (r1 + 1, x, h2, h1)

(* Because we always use [makeT] when we build a new tree, we can be certain
   that our trees respect the leftist invariant. (Because the type [queue]
   is abstract, the user cannot build her own trees directly. She must go
   through us.) *)

(* Somewhat surprisingly, we can begin with [merge]. *)

let rec merge h1 h2 =
  match h1, h2 with
  | E, h
  | h, E ->
      h
  | T (_, x1, a1, b1), T (_, x2, a2, b2) ->
      if x1 <= x2 then
        (* Clearly [x1] must be at the root, so as to preserve the heap
           property.

           So, we wish to call [makeT x1 ? ?], where the two question marks
           stand for two as-yet-undetermined sub-heaps. We have three sub-heaps
           at hand, namely [a1], [b1], [h2]. It seems natural to perform one
           recursive call to [merge], after which we will have only two
           sub-heaps at hand, which we can use to fill the two question marks.
           The question is, which two of the three sub-heaps should we combine?

           As far as the heap property is concerned, all three combinations are
           permitted. As far the leftist invariant is concerned, all three
           combinations are permitted too, provided we use [makeT].

           The key insight is that the sum of the ranks of the arguments must
           decrease in the recursive call, so as to guarantee that [merge] has
           complexity [O(rank h1 + rank h2)], hence logarithmic complexity. This
           means that the sub-tree [a1], whose rank is not controlled, cannot be
           an argument to the recursive call. This leaves just one possibility.
           (Using [merge b1 h2] or [merge h2 b1] makes no fundamental
           difference.) *)
        makeT x1 a1 (merge b1 h2)
      else
        makeT x2 a2 (merge h1 b2)

let empty =
  E

let singleton x =
  T(1, x, E, E)
  (* makeT x empty empty *)

let insert x h =
  merge (singleton x) h

let extract h =
  match h with
  | E ->
      None
  | T (_, x, h1, h2) ->
      Some (x, merge h1 h2)