signature PRIORITY_QUEUE =
sig
  exception Size 
  type item
  type t
  val empty: t
  val null: t -> bool
  val insert: item -> t -> t 
  val min: t -> item
  val delmin: t -> t 
end ;

structure Heap: PRIORITY_QUEUE =
struct
  exception Size ;

  type item = real ;

  abstype 'a tree = O | V of 'a * 'a tree * 'a tree with 

  type t = item tree ; 

  val empty = O ;

  fun null O = true
    | null _ = false ;

  fun insert (w:item) O
      = V( w , O , O )
    | insert w ( V( v , l , r ) )
      = if w <= v then V( w , insert v r , l )
        else V( v , insert w r , l ) ;

  fun min( V(v,_,_) ) = v
    | min O = raise Size ;

  local
    exception Impossible ;

    fun leftrem( V( v , O , O ) ) = ( v, O )
      | leftrem( V( v , l , r ) )
          = let 
              val (w,t) = leftrem l
              in 
                ( w , V(v,r,t) ) 
            end 
      | leftrem _ = raise Impossible ;

    fun siftdown( w:item , O , O ) = V( w , O , O )
      | siftdown( w , t as V(v,O,O) , O )
          = if w <= v then V( w , t , O )
            else V( v , V(w,O,O) , O )
      | siftdown( w , l as V(u,ll,lr) , r as V(v,rl,rr) )
          = if w <= u andalso w <= v then V(w,l,r)
            else if u <= v then V( u , siftdown(w,ll,lr) ,r)
                 else V( v , l , siftdown(w,rl,rr) )
      | siftdown _ = raise Impossible ;
  in 
    fun delmin O = raise Size
      | delmin( V(v,O,_) ) = O
      | delmin( V(v,l,r) )
          = let 
              val (w,t) = leftrem l
            in
              siftdown( w , r , t )
            end
  end ;
  
  end ;
end ;

val myheap =
  foldl (fn(v,h) => Heap.insert v h) Heap.empty 
  [real 5,real 8,real 3, real 1,real 2,real 7,real 4,real 6,real 9,real 0] ;

fun heapTOlist h
  = if Heap.null h then [] 
    else (Heap.min h) :: heapTOlist(Heap.delmin h) ;

heapTOlist myheap ;

val sort = 
  heapTOlist o foldl (fn(v,h) => Heap.insert v h) Heap.empty ;