type sumbool = left
             | right
;;

type A == int;;

let inf_total x y =
  match lt_int x y with
    true -> left
  | false -> right
;;

type list = nil
          | cons of A * list
;;

type Tree = Tree_Leaf
          | Tree_Node of A * Tree * Tree
;;

let insert T =
  let rec F = function
    Tree_Leaf -> (fun a -> Tree_Node(a,Tree_Leaf,Tree_Leaf))
  | Tree_Node(a,t0,t1) ->
      (fun a0 -> match inf_total a a0 with
                   left -> Tree_Node(a,t1,(F t0 a0))
                 | right -> Tree_Node(a0,t1,(F t0 a)))
  in F T
;;

let list_to_heap l =
  let rec F = function
    nil -> Tree_Leaf
  | cons(a,l0) -> insert (F l0) a
  in F l
;;

let merge l1 =
  let rec F = function
    nil -> (fun l2 -> l2)
  | cons(a,l0) ->
      (fun l2 -> let rec F0 = function
                   nil -> cons(a,l0)
                 | cons(a0,l0) ->
                     (match inf_total a a0 with
                        left -> cons(a,(F l0 (cons(a0,l0))))
                      | right -> cons(a0,(F0 l0)))
                 in F0 l2)
  in F l1
;;

let heap_to_list T =
  let rec F = function
    Tree_Leaf -> nil
  | Tree_Node(a,t0,t1) -> cons(a,(merge (F t0) (F t1)))
  in F T
;;

let treesort l =
  heap_to_list (list_to_heap l)
;;

