(* * * * * * * * * * *
 *    LEFT TREES     *
 * * * * * * * * * * *)

type priority = int

  type 'a queue =
    | Empty
    | Node of priority * 'a * 'a queue * 'a queue * int
        (* priority, left son, right son, interval 
           to the nearest leaf (the most right one) *)

  let empty() = Empty

  let is_empty = function Empty -> true | _ -> false

  let interval = function Empty -> 0 | Node (_,_,_,_,i) -> i

  exception Unproper_use_of_queue

  let rec insert queue prio elt =
    match queue with
      | Empty -> Node(prio, elt, Empty, Empty, 1)
      | Node(p, e, left, right, _) ->
          if prio <= p then
            let new_right =
              insert right p e
            in
              match left, new_right with
                | Node (_,_,_,_, i), Node (_,_,_,_, j) ->
                    if i > j then Node(prio, elt, left, new_right, j + 1)
                    else Node (prio, elt, new_right, left, i + 1)
                | Empty, _ ->
                    Node (prio, elt, new_right, left, 1)
                | _, Empty -> raise Unproper_use_of_queue
          else
            let new_right =
              insert right prio elt
            in
              match left, new_right with
                | Node (_,_,_,_, i), Node (_,_,_,_, j) ->
                    if i > j then Node(p, e, left, new_right, j + 1)
                    else Node (p, e, new_right, left, i + 1)
                | Empty, _ ->
                    Node (p, e, new_right, left, 1)
                | _, Empty -> raise Unproper_use_of_queue

  exception Queue_is_empty

  let rec union q1 q2 =
    match q1, q2 with
      | Empty, _  -> q2
      | _, Empty  -> q1
      | Node(p1, e1, ql1, qr1, i1),
          Node (p2, e2, ql2, qr2, i2)  ->
          if p1 > p2 then
            let new_left = q1
            in
            let new_i1 = interval new_left
            and new_right = union qr2 ql2
            in
            let new_i2 = interval new_right
            in
              if new_i1 < new_i2 then
                (* watch it - rotation *)
                Node (p2, e2, new_left, new_right, i1)
              else
                Node (p2, e2, new_right, new_left, i2)
          else
            let new_left = q2
            in
            let new_i1 = interval new_left
            and new_right = union ql1 qr1
            in
            let new_i2 = interval new_right
            in
              if new_i1 < new_i2 then
                (* watch it - rotation *)
                Node (p1, e1, new_left, new_right, i1)
              else
                Node (p1, e1, new_right, new_left, i2)

  let rec remove_top = function
      Empty -> raise Queue_is_empty
    | Node (_, _,q1, q2, _) -> union q1 q2

  let delete_min = function
      Empty -> raise Queue_is_empty
    | Node(prio, elt, _, _, _) as queue ->
        (prio, elt, remove_top queue)

  let find_min = function
      Empty -> raise Queue_is_empty
    | Node(prio, elt, _, _, _) as queue -> (prio, elt, queue)