pairing.hs

data Pairing a = Empty | Node a [Pairing a]

singleton :: Ord a => a -> Pairing a
singleton x = Node x []

union :: Ord a => Pairing a -> Pairing a -> Pairing a
union Empty h2 = h2
union h1 Empty = h1
union t1@(Pairing h1 subs1) t2@(Pairing h2 subs)
    | h1 < h2 = Pairing h1 t2:subs1
    | otherwise = Pairing h2 t1:subs2

insert :: Ord a => a -> Pairing a -> Pairing a
insert x heap = union (singleton x) heap

extractMin :: Ord a => Pairing a -> Maybe (a, Pairing a)
extractMin Empty = Nothing
extractMin (Pairing x subs) = Just (x, pairing subs)

pairing [] = Empty
pairing [h1] = h1
pairing h1:h2:tail = pairing (union h1 h2):tail