exception Empty
exception Impossible_pattern of string

let impossible_pat x = raise (Impossible_pattern x)

module Elem =
struct
  let eq = (=)

  let lt = (<)

  let leq = (<=)
end

type priority = int

type 'a element = priority * 'a

type 'a tree = Node of int * 'a element * 'a tree list

type 'a queue = 'a tree list

exception Queue_is_empty


let empty() = []

let is_empty ts = ts = []

let rank (Node (r, _, _)) = r

let root (Node (_, x, _)) = x

let link (Node (r, x1, c1) as t1) (Node (_, x2, c2) as t2) =
  if Elem.leq x1 x2 then Node (r + 1, x1, t2 :: c1)
  else Node (r + 1, x2, t1 :: c2)

  let rec ins_tree t = function
    | [] -> [t]
    | t' :: ts' as ts ->
        if rank t < rank t' then t :: ts
        else ins_tree (link t t') ts'

  let insert ts p a = ins_tree (Node (0, (p, a), [])) ts

  let rec union ts1 ts2 = match ts1, ts2 with
    | _, [] -> ts1
    | [], _ -> ts2
    | t1 :: ts1', t2 :: ts2' ->
        if rank t1 < rank t2 then t1 :: union ts1' ts2
        else if rank t2 < rank t1 then t2 :: union ts1 ts2'
        else ins_tree (link t1 t2) (union ts1' ts2')

  let rec remove_min_tree = function
    | [] -> raise Empty
    | [t] -> t, []
    | t :: ts ->
        let t', ts' = remove_min_tree ts in
        if Elem.leq (root t) (root t') then (t, ts)
        else (t', t :: ts')

  let find_min ts = let (p, e) = root (fst (remove_min_tree ts)) in (p, e, ts)

  let delete_min ts =
    let (p, e, _) = find_min ts
    in
    let (Node (_, x, ts1), ts2) = remove_min_tree ts
    in
    let q = union (List.rev ts1) ts2
    in
      (p, e, q)