Meldable Heap

heap.fs

module Heap =
    type tree<'T> = Node of 'T * tree<'T> * tree<'T>
                    | Leaf
    type t<'T> = { root : tree<'T>
                   cmp : 'T -> 'T -> bool
                }
    let create cmp =
        {root=Leaf; cmp=cmp}

    let rec meld cmp a b =
        match a, b with
        | Leaf, _ -> b
        | _, Leaf -> a
        | Node(av, al, ar), Node(bv, bl, br) ->            
            if cmp av bv then
                let br = meld cmp br a
                Node(bv, br, bl)
            else
                let ar = meld cmp ar b
                Node(av, ar, al)

    let push v h =
        let p = Node(v, Leaf, Leaf)
        let r = meld h.cmp h.root p
        {h with root=r}

    let empty h = 
        h.root = Leaf

    let top h =
        match h.root with
        | Leaf -> failwith "top"
        | Node(v, _, _) -> v

    let pop h =
        match h.root with
        | Leaf -> failwith "pop"
        | Node(_, rl, rr) ->
            let r = meld h.cmp rr rl
            {h with root=r}