type 'a btree = Leaf | Node of int * 'a * 'a btree * 'a btree 

let min_weg = function
  Leaf -> 0
| Node(c,_,_,_) -> c

let rec insert x = function
  Leaf             -> Node(1,x,Leaf,Leaf)
| Node(_,x',t1,t2) -> 
    let (s,ns) = if x > x' then (x',x) else (x,x') in
	let (t1,t2) = if min_weg t1 <= min_weg t2 then
			  (insert s t1, t2) 
			else (t1, insert s t2) in
    Node(1 + min (min_weg t1) (min_weg t2), ns, t1, t2)
   
exception Empty

let rec repair t1 t2 =
  match (t1,t2) with
    (Leaf,t) | (t,Leaf) -> t
  | (Node(_,x1,t1',t1''), Node(_,x2,t2',t2'')) -> 
      let (x,t1,t2) = if x1 > x2 then 
			  (x1, repair t1' t1'', t2) 
			else (x2, t1, repair t2' t2'') in
      Node(1 + min (min_weg t1) (min_weg t2), x, t1, t2)

let remove = function
  Leaf            -> raise Empty
| Node(_,x,t1,t2) -> (x,repair t1 t2)

open List

let rec build_list acc = function
    Leaf -> acc
  | heap ->
      let (x,heap) = remove heap in
  	  build_list (x::acc) heap
  
let build_list l = build_list [] l  

let heapsort l = 
  build_list (fold_left (fun heap x -> insert x heap) Leaf l)