Weight-biased leftist heap (exercise 3.3 of Purely Functional Data Structures)

wbl_heap.sml

functor WBLHeap(Element : ORDERED) : HEAP =
    struct
        structure Elem = Element

        datatype Heap = E
                      | T of int * Elem.T * Heap * Heap

        val empty = E
        
        fun isEmpty E = true
          | isEmpty _ = false

        fun weight E               = 0
          | weight (T(w, _, _, _)) = w

        fun singleton x = T(1, x, E, E)

        fun merge (E, h) = h
          | merge (h, E) = h
          | merge (h1 as T(w1, x, a1, b1), h2 as T(w2, y, a2, b2)) =
              if Elem.leq(x, y) then
                  if weight a1 >= weight b1 + w2 then
                      T(w1 + w2, x, a1, merge(b1, h2))
                  else
                      T(w1 + w2, x, merge(b1, h2), a1)
              else
                  if weight a2 >= w1 + weight b2 then
                      T(w1 + w2, y, a2, merge(h1, b2))
                  else
                      T(w1 + w2, y, merge(h1, b2), a2)

        fun insert (x, h) = merge(singleton x, h)

        fun findMin E               = raise Empty
          | findMin (T(_, x, _, _)) = x

        fun deleteMin E               = raise Empty
          | deleteMin (T(_, _, a, b)) = merge(a, b)

        fun pairwiseMerge []           = []
          | pairwiseMerge [h]          = [h]
          | pairwiseMerge (h1::h2::hs) = merge(h1, h2)::pairwiseMerge hs

        fun bottomUpMerge []  = E
          | bottomUpMerge [h] = h
          | bottomUpMerge hs  = bottomUpMerge(pairwiseMerge hs)

        fun fromList xs = bottomUpMerge(map singleton xs)
    end