{-# LANGUAGE CPP, StandaloneDeriving #-}

module Data.PQueue.Internals (
  MinQueue (..),
  BinomHeap,
  BinomForest(..),
  BinomTree(..),
  Succ(..),
  Zero(..),
  LEq,
  empty,
  null,
  size,
  getMin,
  minView,
  singleton,
  insert,
  union,
  mapMaybe,
  mapEither,
  mapMonotonic,
  foldrAsc,
  foldlAsc,
  insertMinQ,
--   mapU,
  foldrU,
  foldlU,
--   traverseU,
  keysQueue,
  seqSpine
  ) where

import Control.DeepSeq (NFData(rnf), deepseq)

import qualified Data.PQueue.Prio.Internals as Prio

#ifdef __GLASGOW_HASKELL__
import Data.Data
#endif

import Prelude hiding (null)

-- | A priority queue with elements of type @a@. Supports extracting the minimum element.
data MinQueue a = Empty | MinQueue {-# UNPACK #-} !Int a !(BinomHeap a)
#if __GLASGOW_HASKELL__>=707
  deriving Typeable
#else
#include "Typeable.h"
INSTANCE_TYPEABLE1(MinQueue,minQTC,"MinQueue")
#endif

#ifdef __GLASGOW_HASKELL__
instance (Ord a, Data a) => Data (MinQueue a) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MinQueue a -> c (MinQueue a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z MinQueue a
q = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
    Maybe (a, MinQueue a)
Nothing      -> MinQueue a -> c (MinQueue a)
forall g. g -> c g
z MinQueue a
forall a. MinQueue a
Empty
    Just (a
x, MinQueue a
q') -> (a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall g. g -> c g
z a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ c (a -> MinQueue a -> MinQueue a)
-> a -> c (MinQueue a -> MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x c (MinQueue a -> MinQueue a) -> MinQueue a -> c (MinQueue a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` MinQueue a
q'

  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (MinQueue a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> MinQueue a -> c (MinQueue a)
forall r. r -> c r
z MinQueue a
forall a. MinQueue a
Empty
    Int
2 -> c (MinQueue a -> MinQueue a) -> c (MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k (c (a -> MinQueue a -> MinQueue a) -> c (MinQueue a -> MinQueue a)
forall b r. Data b => c (b -> r) -> c r
k ((a -> MinQueue a -> MinQueue a)
-> c (a -> MinQueue a -> MinQueue a)
forall r. r -> c r
z a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMinQ))
    Int
_ -> [Char] -> c (MinQueue a)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (MinQueue a))
dataCast1 forall d. Data d => c (t d)
x = c (t a) -> Maybe (c (MinQueue a))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t a)
forall d. Data d => c (t d)
x

  toConstr :: MinQueue a -> Constr
toConstr MinQueue a
q
    | MinQueue a -> Bool
forall a. MinQueue a -> Bool
null MinQueue a
q = Constr
emptyConstr
    | Bool
otherwise = Constr
consConstr

  dataTypeOf :: MinQueue a -> DataType
dataTypeOf MinQueue a
_ = DataType
queueDataType

queueDataType :: DataType
queueDataType :: DataType
queueDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.PQueue.Min.MinQueue" [Constr
emptyConstr, Constr
consConstr]

emptyConstr, consConstr :: Constr
emptyConstr :: Constr
emptyConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
"empty" [] Fixity
Prefix
consConstr :: Constr
consConstr  = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
queueDataType [Char]
"<|" [] Fixity
Infix

#endif

type BinomHeap = BinomForest Zero

instance Ord a => Eq (MinQueue a) where
  MinQueue a
Empty == :: MinQueue a -> MinQueue a -> Bool
== MinQueue a
Empty = Bool
True
  MinQueue Int
n1 a
x1 BinomHeap a
q1 == MinQueue Int
n2 a
x2 BinomHeap a
q2 =
    Int
n1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n2 Bool -> Bool -> Bool
&& (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2)
  MinQueue a
_ == MinQueue a
_ = Bool
False

eqExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract :: (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2) =
  a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&&
  case (BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q1, BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q2) of
    (Just (a, BinomHeap a)
h1, Just (a, BinomHeap a)
h2) -> (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Bool
eqExtract (a, BinomHeap a)
h1 (a, BinomHeap a)
h2
    (Maybe (a, BinomHeap a)
Nothing, Maybe (a, BinomHeap a)
Nothing) -> Bool
True
    (Maybe (a, BinomHeap a), Maybe (a, BinomHeap a))
_ -> Bool
False

instance Ord a => Ord (MinQueue a) where
  MinQueue a
Empty compare :: MinQueue a -> MinQueue a -> Ordering
`compare` MinQueue a
Empty = Ordering
EQ
  MinQueue a
Empty `compare` MinQueue a
_ = Ordering
LT
  MinQueue a
_ `compare` MinQueue a
Empty = Ordering
GT
  MinQueue Int
_n1 a
x1 BinomHeap a
q1 `compare` MinQueue Int
_n2 a
x2 BinomHeap a
q2 = (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2)

cmpExtract :: Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract :: (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract (a
x1,BinomHeap a
q1) (a
x2,BinomHeap a
q2) =
  a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x1 a
x2 Ordering -> Ordering -> Ordering
forall a. Monoid a => a -> a -> a
`mappend`
  case (BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q1, BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
q2) of
    (Just (a, BinomHeap a)
h1, Just (a, BinomHeap a)
h2) -> (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
forall a. Ord a => (a, BinomHeap a) -> (a, BinomHeap a) -> Ordering
cmpExtract (a, BinomHeap a)
h1 (a, BinomHeap a)
h2
    (Maybe (a, BinomHeap a)
Nothing, Maybe (a, BinomHeap a)
Nothing) -> Ordering
EQ
    (Just (a, BinomHeap a)
_, Maybe (a, BinomHeap a)
Nothing) -> Ordering
GT
    (Maybe (a, BinomHeap a)
Nothing, Just (a, BinomHeap a)
_) -> Ordering
LT

    -- We compare their first elements, then their other elements up to the smaller queue's length,
    -- and then the longer queue wins.
    -- This is equivalent to @comparing toAscList@, except it fuses much more nicely.

-- We implement tree ranks in the type system with a nicely elegant approach, as follows.
-- The goal is to have the type system automatically guarantee that our binomial forest
-- has the correct binomial structure.
--
-- In the traditional set-theoretic construction of the natural numbers, we define
-- each number to be the set of numbers less than it, and Zero to be the empty set,
-- as follows:
--
-- 0 = {}  1 = {0}    2 = {0, 1}  3={0, 1, 2} ...
--
-- Binomial trees have a similar structure: a tree of rank @k@ has one child of each
-- rank less than @k@. Let's define the type @rk@ corresponding to rank @k@ to refer
-- to a collection of binomial trees of ranks @0..k-1@. Then we can say that
--
-- > data Succ rk a = Succ (BinomTree rk a) (rk a)
--
-- and this behaves exactly as the successor operator for ranks should behave. Furthermore,
-- we immediately obtain that
--
-- > data BinomTree rk a = BinomTree a (rk a)
--
-- which is nice and compact. With this construction, things work out extremely nicely:
--
-- > BinomTree (Succ (Succ (Succ Zero)))
--
-- is a type constructor that takes an element type and returns the type of binomial trees
-- of rank @3@.
data BinomForest rk a = Nil | Skip (BinomForest (Succ rk) a) |
  Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)

data BinomTree rk a = BinomTree a (rk a)

-- | If |rk| corresponds to rank @k@, then |'Succ' rk| corresponds to rank @k+1@.
data Succ rk a = Succ {-# UNPACK #-} !(BinomTree rk a) (rk a)

-- | Type corresponding to the Zero rank.
data Zero a = Zero

-- | Type alias for a comparison function.
type LEq a = a -> a -> Bool

-- basics

-- | /O(1)/. The empty priority queue.
empty :: MinQueue a
empty :: MinQueue a
empty = MinQueue a
forall a. MinQueue a
Empty

-- | /O(1)/. Is this the empty priority queue?
null :: MinQueue a -> Bool
null :: MinQueue a -> Bool
null MinQueue a
Empty = Bool
True
null MinQueue a
_     = Bool
False

-- | /O(1)/. The number of elements in the queue.
size :: MinQueue a -> Int
size :: MinQueue a -> Int
size MinQueue a
Empty            = Int
0
size (MinQueue Int
n a
_ BinomHeap a
_) = Int
n

-- | Returns the minimum element of the queue, if the queue is nonempty.
getMin :: MinQueue a -> Maybe a
getMin :: MinQueue a -> Maybe a
getMin (MinQueue Int
_ a
x BinomHeap a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
getMin MinQueue a
_                = Maybe a
forall a. Maybe a
Nothing

-- | Retrieves the minimum element of the queue, and the queue stripped of that element,
-- or 'Nothing' if passed an empty queue.
minView :: Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView :: MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
Empty = Maybe (a, MinQueue a)
forall a. Maybe a
Nothing
minView (MinQueue Int
n a
x BinomHeap a
ts) = (a, MinQueue a) -> Maybe (a, MinQueue a)
forall a. a -> Maybe a
Just (a
x, case BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts of
  Maybe (a, BinomHeap a)
Nothing        -> MinQueue a
forall a. MinQueue a
Empty
  Just (a
x', BinomHeap a
ts') -> Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
x' BinomHeap a
ts')

-- | /O(1)/. Construct a priority queue with a single element.
singleton :: a -> MinQueue a
singleton :: a -> MinQueue a
singleton a
x = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
1 a
x BinomHeap a
forall (rk :: * -> *) a. BinomForest rk a
Nil

-- | Amortized /O(1)/, worst-case /O(log n)/. Insert an element into the priority queue.
insert :: Ord a => a -> MinQueue a -> MinQueue a
insert :: a -> MinQueue a -> MinQueue a
insert = LEq a -> a -> MinQueue a -> MinQueue a
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
forall a. Ord a => a -> a -> Bool
(<=)

-- | Amortized /O(log (min(n,m)))/, worst-case /O(log (max (n,m)))/. Take the union of two priority queues.
union :: Ord a => MinQueue a -> MinQueue a -> MinQueue a
union :: MinQueue a -> MinQueue a -> MinQueue a
union = LEq a -> MinQueue a -> MinQueue a -> MinQueue a
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
forall a. Ord a => a -> a -> Bool
(<=)

-- | /O(n)/. Map elements and collect the 'Just' results.
mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe :: (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe a -> Maybe b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapMaybe a -> Maybe b
f (MinQueue Int
_ a
x BinomHeap a
ts) = MinQueue b -> (b -> MinQueue b) -> Maybe b -> MinQueue b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MinQueue b
q' (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
`insert` MinQueue b
q') (a -> Maybe b
f a
x)
  where
    q' :: MinQueue b
q' = (a -> Maybe b)
-> LEq b
-> (Zero a -> MinQueue b)
-> MinQueue b
-> BinomHeap a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
forall a. Ord a => a -> a -> Bool
(<=) (MinQueue b -> Zero a -> MinQueue b
forall a b. a -> b -> a
const MinQueue b
forall a. MinQueue a
Empty) MinQueue b
forall a. MinQueue a
Empty BinomHeap a
ts

-- | /O(n)/. Map elements and separate the 'Left' and 'Right' results.
mapEither :: (Ord b, Ord c) => (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither :: (a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither a -> Either b c
_ MinQueue a
Empty = (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty)
mapEither a -> Either b c
f (MinQueue Int
_ a
x BinomHeap a
ts) = case ((a -> Either b c)
-> LEq b
-> LEq c
-> (Zero a -> (MinQueue b, MinQueue c))
-> (MinQueue b, MinQueue c)
-> BinomHeap a
-> (MinQueue b, MinQueue c)
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f LEq b
forall a. Ord a => a -> a -> Bool
(<=) LEq c
forall a. Ord a => a -> a -> Bool
(<=) ((MinQueue b, MinQueue c) -> Zero a -> (MinQueue b, MinQueue c)
forall a b. a -> b -> a
const (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty)) (MinQueue b
forall a. MinQueue a
Empty, MinQueue c
forall a. MinQueue a
Empty) BinomHeap a
ts, a -> Either b c
f a
x) of
  ((MinQueue b
qL, MinQueue c
qR), Left b
b)  -> (b -> MinQueue b -> MinQueue b
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert b
b MinQueue b
qL, MinQueue c
qR)
  ((MinQueue b
qL, MinQueue c
qR), Right c
c) -> (MinQueue b
qL, c -> MinQueue c -> MinQueue c
forall a. Ord a => a -> MinQueue a -> MinQueue a
insert c
c MinQueue c
qR)

-- | /O(n)/. Assumes that the function it is given is monotonic, and applies this function to every element of the priority queue,
-- as in 'fmap'. If it is not, the result is undefined.
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic :: (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic = (a -> b) -> MinQueue a -> MinQueue b
forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapU

{-# INLINE foldrAsc #-}
-- | /O(n log n)/. Performs a right-fold on the elements of a priority queue in ascending order.
foldrAsc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc :: (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrAsc a -> b -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> b -> b
`f` (a -> b -> b)
-> b -> (BinomHeap a -> Maybe (a, BinomHeap a)) -> BinomHeap a -> b
forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold a -> b -> b
f b
z BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts

{-# INLINE foldrUnfold #-}
-- | Equivalent to @foldr f z (unfoldr suc s0)@.
foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold a -> c -> c
f c
z b -> Maybe (a, b)
suc b
s0 = b -> c
unf b
s0 where
  unf :: b -> c
unf b
s = case b -> Maybe (a, b)
suc b
s of
    Maybe (a, b)
Nothing      -> c
z
    Just (a
x, b
s') -> a
x a -> c -> c
`f` b -> c
unf b
s'

-- | /O(n log n)/. Performs a left-fold on the elements of a priority queue in ascending order.
foldlAsc :: Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc :: (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc b -> a -> b
_ b
z MinQueue a
Empty             = b
z
foldlAsc b -> a -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = (b -> a -> b)
-> b -> (BinomHeap a -> Maybe (a, BinomHeap a)) -> BinomHeap a -> b
forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold b -> a -> b
f (b
z b -> a -> b
`f` a
x) BinomHeap a -> Maybe (a, BinomHeap a)
forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts

{-# INLINE foldlUnfold #-}
-- | @foldlUnfold f z suc s0@ is equivalent to @foldl f z (unfoldr suc s0)@.
foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold :: (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold c -> a -> c
f c
z0 b -> Maybe (a, b)
suc b
s0 = c -> b -> c
unf c
z0 b
s0 where
  unf :: c -> b -> c
unf c
z b
s = case b -> Maybe (a, b)
suc b
s of
    Maybe (a, b)
Nothing      -> c
z
    Just (a
x, b
s') -> c -> b -> c
unf (c
z c -> a -> c
`f` a
x) b
s'

insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
_ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insert' LEq a
le a
x (MinQueue Int
n a
x' BinomHeap a
ts)
  | a
x LEq a
`le` a
x' = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (LEq a -> BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x') BinomHeap a
ts)
  | Bool
otherwise = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x' (LEq a -> BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x) BinomHeap a
ts)

{-# INLINE union' #-}
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' :: LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq a
_ MinQueue a
Empty MinQueue a
q = MinQueue a
q
union' LEq a
_ MinQueue a
q MinQueue a
Empty = MinQueue a
q
union' LEq a
le (MinQueue Int
n1 a
x1 BinomHeap a
f1) (MinQueue Int
n2 a
x2 BinomHeap a
f2)
  | a
x1 LEq a
`le` a
x2 = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x1 (LEq a
-> BinomTree Zero a -> BinomHeap a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x2) BinomHeap a
f1 BinomHeap a
f2)
  | Bool
otherwise  = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n2) a
x2 (LEq a
-> BinomTree Zero a -> BinomHeap a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x1) BinomHeap a
f1 BinomHeap a
f2)

-- | Takes a size and a binomial forest and produces a priority queue with a distinguished global root.
extractHeap :: Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap :: BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts = case LEq a -> BinomHeap a -> MExtract Zero a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
forall a. Ord a => a -> a -> Bool
(<=) BinomHeap a
ts of
  Yes (Extract a
x Zero a
_ BinomHeap a
ts') -> (a, BinomHeap a) -> Maybe (a, BinomHeap a)
forall a. a -> Maybe a
Just (a
x, BinomHeap a
ts')
  MExtract Zero a
_                     -> Maybe (a, BinomHeap a)
forall a. Maybe a
Nothing

-- | A specialized type intended to organize the return of extract-min queries
-- from a binomial forest. We walk all the way through the forest, and then
-- walk backwards. @Extract rk a@ is the result type of an extract-min
-- operation that has walked as far backwards of rank @rk@ -- that is, it
-- has visited every root of rank @>= rk@.
--
-- The interpretation of @Extract minKey children forest@ is
--
--   * @minKey@ is the key of the minimum root visited so far. It may have
--     any rank @>= rk@. We will denote the root corresponding to
--     @minKey@ as @minRoot@.
--
--   * @children@ is those children of @minRoot@ which have not yet been
--     merged with the rest of the forest. Specifically, these are
--     the children with rank @< rk@.
--
--   * @forest@ is an accumulating parameter that maintains the partial
--     reconstruction of the binomial forest without @minRoot@. It is
--     the union of all old roots with rank @>= rk@ (except @minRoot@),
--     with the set of all children of @minRoot@ with rank @>= rk@.
--     Note that @forest@ is lazy, so if we discover a smaller key
--     than @minKey@ later, we haven't wasted significant work.
data Extract rk a = Extract a (rk a) (BinomForest rk a)
data MExtract rk a = No | Yes {-# UNPACK #-} !(Extract rk a)

incrExtract :: Extract (Succ rk) a -> Extract rk a
incrExtract :: Extract (Succ rk) a -> Extract rk a
incrExtract (Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
  = a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
kChild BinomForest (Succ rk) a
ts)

incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' :: LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' LEq a
le BinomTree rk a
t (Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
  = a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (BinomTree rk a
t BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
kChild) BinomForest (Succ rk) a
ts))
  where
    cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le

-- | Walks backward from the biggest key in the forest, as far as rank @rk@.
-- Returns its progress. Each successive application of @extractBin@ takes
-- amortized /O(1)/ time, so applying it from the beginning takes /O(log n)/ time.
extractBin :: LEq a -> BinomForest rk a -> MExtract rk a
extractBin :: LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
_ BinomForest rk a
Nil = MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
extractBin LEq a
le (Skip BinomForest (Succ rk) a
f) = case LEq a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
le BinomForest (Succ rk) a
f of
  Yes Extract (Succ rk) a
ex -> Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (Extract (Succ rk) a -> Extract rk a
forall (rk :: * -> *) a. Extract (Succ rk) a -> Extract rk a
incrExtract Extract (Succ rk) a
ex)
  MExtract (Succ rk) a
No     -> MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
extractBin LEq a
le (Cons t :: BinomTree rk a
t@(BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f) = Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (Extract rk a -> MExtract rk a) -> Extract rk a -> MExtract rk a
forall a b. (a -> b) -> a -> b
$ case LEq a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
extractBin LEq a
le BinomForest (Succ rk) a
f of
  Yes ex :: Extract (Succ rk) a
ex@(Extract a
minKey Succ rk a
_ BinomForest (Succ rk) a
_)
    | a
minKey LEq a
`lt` a
x -> LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' LEq a
le BinomTree rk a
t Extract (Succ rk) a
ex
  MExtract (Succ rk) a
_                 -> a -> rk a -> BinomForest rk a -> Extract rk a
forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
x rk a
ts (BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip BinomForest (Succ rk) a
f)
  where a
a lt :: LEq a
`lt` a
b = Bool -> Bool
not (a
b LEq a
`le` a
a)

mapMaybeQueue :: (a -> Maybe b) -> LEq b -> (rk a -> MinQueue b) -> MinQueue b -> BinomForest rk a -> MinQueue b
mapMaybeQueue :: (a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le rk a -> MinQueue b
fCh MinQueue b
q0 BinomForest rk a
forest = MinQueue b
q0 MinQueue b -> MinQueue b -> MinQueue b
`seq` case BinomForest rk a
forest of
  BinomForest rk a
Nil    -> MinQueue b
q0
  Skip BinomForest (Succ rk) a
forest'  -> (a -> Maybe b)
-> LEq b
-> (Succ rk a -> MinQueue b)
-> MinQueue b
-> BinomForest (Succ rk) a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le Succ rk a -> MinQueue b
fCh' MinQueue b
q0 BinomForest (Succ rk) a
forest'
  Cons BinomTree rk a
t BinomForest (Succ rk) a
forest'  -> (a -> Maybe b)
-> LEq b
-> (Succ rk a -> MinQueue b)
-> MinQueue b
-> BinomForest (Succ rk) a
-> MinQueue b
forall a b (rk :: * -> *).
(a -> Maybe b)
-> LEq b
-> (rk a -> MinQueue b)
-> MinQueue b
-> BinomForest rk a
-> MinQueue b
mapMaybeQueue a -> Maybe b
f LEq b
le Succ rk a -> MinQueue b
fCh' (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
le (BinomTree rk a -> MinQueue b
mapMaybeT BinomTree rk a
t) MinQueue b
q0) BinomForest (Succ rk) a
forest'
  where fCh' :: Succ rk a -> MinQueue b
fCh' (Succ BinomTree rk a
t rk a
tss) = LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
le (BinomTree rk a -> MinQueue b
mapMaybeT BinomTree rk a
t) (rk a -> MinQueue b
fCh rk a
tss)
        mapMaybeT :: BinomTree rk a -> MinQueue b
mapMaybeT (BinomTree a
x0 rk a
ts) = MinQueue b -> (b -> MinQueue b) -> Maybe b -> MinQueue b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (rk a -> MinQueue b
fCh rk a
ts) (\b
x -> LEq b -> b -> MinQueue b -> MinQueue b
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq b
le b
x (rk a -> MinQueue b
fCh rk a
ts)) (a -> Maybe b
f a
x0)

type Partition a b = (MinQueue a, MinQueue b)

mapEitherQueue :: (a -> Either b c) -> LEq b -> LEq c -> (rk a -> Partition b c) -> Partition b c ->
  BinomForest rk a -> Partition b c
mapEitherQueue :: (a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC rk a -> Partition b c
fCh (MinQueue b
q00, MinQueue c
q10) BinomForest rk a
ts0 = MinQueue b
q00 MinQueue b -> Partition b c -> Partition b c
`seq` MinQueue c
q10 MinQueue c -> Partition b c -> Partition b c
`seq` case BinomForest rk a
ts0 of
  BinomForest rk a
Nil        -> (MinQueue b
q00, MinQueue c
q10)
  Skip BinomForest (Succ rk) a
ts'   -> (a -> Either b c)
-> LEq b
-> LEq c
-> (Succ rk a -> Partition b c)
-> Partition b c
-> BinomForest (Succ rk) a
-> Partition b c
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC Succ rk a -> Partition b c
fCh' (MinQueue b
q00, MinQueue c
q10) BinomForest (Succ rk) a
ts'
  Cons BinomTree rk a
t BinomForest (Succ rk) a
ts' -> (a -> Either b c)
-> LEq b
-> LEq c
-> (Succ rk a -> Partition b c)
-> Partition b c
-> BinomForest (Succ rk) a
-> Partition b c
forall a b c (rk :: * -> *).
(a -> Either b c)
-> LEq b
-> LEq c
-> (rk a -> Partition b c)
-> Partition b c
-> BinomForest rk a
-> Partition b c
mapEitherQueue a -> Either b c
f0 LEq b
leB LEq c
leC Succ rk a -> Partition b c
fCh' ((MinQueue b -> MinQueue b -> MinQueue b)
-> (MinQueue c -> MinQueue c -> MinQueue c)
-> Partition b c
-> Partition b c
-> Partition b c
forall t t a t t b.
(t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
leB) (LEq c -> MinQueue c -> MinQueue c -> MinQueue c
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq c
leC) (BinomTree rk a -> Partition b c
partitionT BinomTree rk a
t) (MinQueue b
q00, MinQueue c
q10)) BinomForest (Succ rk) a
ts'
  where  both :: (t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both t -> t -> a
f t -> t -> b
g (t
x1, t
x2) (t
y1, t
y2) = (t -> t -> a
f t
x1 t
y1, t -> t -> b
g t
x2 t
y2)
         fCh' :: Succ rk a -> Partition b c
fCh' (Succ BinomTree rk a
t rk a
tss) = (MinQueue b -> MinQueue b -> MinQueue b)
-> (MinQueue c -> MinQueue c -> MinQueue c)
-> Partition b c
-> Partition b c
-> Partition b c
forall t t a t t b.
(t -> t -> a) -> (t -> t -> b) -> (t, t) -> (t, t) -> (a, b)
both (LEq b -> MinQueue b -> MinQueue b -> MinQueue b
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq b
leB) (LEq c -> MinQueue c -> MinQueue c -> MinQueue c
forall a. LEq a -> MinQueue a -> MinQueue a -> MinQueue a
union' LEq c
leC) (BinomTree rk a -> Partition b c
partitionT BinomTree rk a
t) (rk a -> Partition b c
fCh rk a
tss)
         partitionT :: BinomTree rk a -> Partition b c
partitionT (BinomTree a
x rk a
ts) = case rk a -> Partition b c
fCh rk a
ts of
           (MinQueue b
q0, MinQueue c
q1) -> case a -> Either b c
f0 a
x of
             Left b
b  -> (LEq b -> b -> MinQueue b -> MinQueue b
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq b
leB b
b MinQueue b
q0, MinQueue c
q1)
             Right c
c  -> (MinQueue b
q0, LEq c -> c -> MinQueue c -> MinQueue c
forall a. LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq c
leC c
c MinQueue c
q1)

{-# INLINE tip #-}
-- | Constructs a binomial tree of rank 0.
tip :: a -> BinomTree Zero a
tip :: a -> BinomTree Zero a
tip a
x = a -> Zero a -> BinomTree Zero a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x Zero a
forall a. Zero a
Zero

insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ a
x MinQueue a
Empty = a -> MinQueue a
forall a. a -> MinQueue a
singleton a
x
insertMinQ a
x (MinQueue Int
n a
x' BinomHeap a
f) = Int -> a -> BinomHeap a -> MinQueue a
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) a
x (BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x') BinomHeap a
f)

-- | @insertMin t f@ assumes that the root of @t@ compares as less than
-- every other root in @f@, and merges accordingly.
insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin BinomTree rk a
t BinomForest rk a
Nil = BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
forall (rk :: * -> *) a. BinomForest rk a
Nil
insertMin BinomTree rk a
t (Skip BinomForest (Succ rk) a
f) = BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
insertMin (BinomTree a
x rk a
ts) (Cons BinomTree rk a
t' BinomForest (Succ rk) a
f) = BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree (Succ rk) a
-> BinomForest (Succ rk) a -> BinomForest (Succ rk) a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t' rk a
ts)) BinomForest (Succ rk) a
f)

-- | Given two binomial forests starting at rank @rk@, takes their union.
-- Each successive application of this function costs /O(1)/, so applying it
-- from the beginning costs /O(log n)/.
merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge :: LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest rk a
f1 BinomForest rk a
f2 = case (BinomForest rk a
f1, BinomForest rk a
f2) of
  (Skip BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2')    -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Skip BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2') -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t2 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t1 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2')
        -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (BinomTree rk a
t1 BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
t2) BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (BinomForest rk a
Nil, BinomForest rk a
_)                -> BinomForest rk a
f2
  (BinomForest rk a
_, BinomForest rk a
Nil)                -> BinomForest rk a
f1
  where  cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le

-- | Merges two binomial forests with another tree. If we are thinking of the trees
-- in the binomial forest as binary digits, this corresponds to a carry operation.
-- Each call to this function takes /O(1)/ time, so in total, it costs /O(log n)/.
carry :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry :: LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le BinomTree rk a
t0 BinomForest rk a
f1 BinomForest rk a
f2 = BinomTree rk a
t0 BinomTree rk a -> BinomForest rk a -> BinomForest rk a
`seq` case (BinomForest rk a
f1, BinomForest rk a
f2) of
  (Skip BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2')    -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 (LEq a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Skip BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2') -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t0 BinomTree rk a
t2 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2') -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t0 BinomTree rk a
t1 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (Cons BinomTree rk a
t1 BinomForest (Succ rk) a
f1', Cons BinomTree rk a
t2 BinomForest (Succ rk) a
f2')
        -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 (BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
t1 BinomTree rk a
t2 BinomForest (Succ rk) a
f1' BinomForest (Succ rk) a
f2')
  (BinomForest rk a
Nil, BinomForest rk a
_f2)              -> LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t0 BinomForest rk a
f2
  (BinomForest rk a
_f1, BinomForest rk a
Nil)              -> LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t0 BinomForest rk a
f1
  where  cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le
         mergeCarry :: BinomTree rk a
-> BinomTree rk a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
mergeCarry BinomTree rk a
tA BinomTree rk a
tB = LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a
-> BinomTree rk a
-> BinomForest rk a
-> BinomForest rk a
-> BinomForest rk a
carry LEq a
le (BinomTree rk a
tA BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
tB)

-- | Merges a binomial tree into a binomial forest. If we are thinking
-- of the trees in the binomial forest as binary digits, this corresponds
-- to adding a power of 2. This costs amortized /O(1)/ time.
incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr :: LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le BinomTree rk a
t BinomForest rk a
f0 = BinomTree rk a
t BinomTree rk a -> BinomForest rk a -> BinomForest rk a
`seq` case BinomForest rk a
f0 of
  BinomForest rk a
Nil  -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
forall (rk :: * -> *) a. BinomForest rk a
Nil
  Skip BinomForest (Succ rk) a
f     -> BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
  Cons BinomTree rk a
t' BinomForest (Succ rk) a
f' -> BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (LEq a
-> BinomTree (Succ rk) a
-> BinomForest (Succ rk) a
-> BinomForest (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr LEq a
le (BinomTree rk a
t BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *).
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`cat` BinomTree rk a
t') BinomForest (Succ rk) a
f')
  where  cat :: BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
cat = LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
forall a (rk :: * -> *).
LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le

-- | The carrying operation: takes two binomial heaps of the same rank @k@
-- and returns one of rank @k+1@. Takes /O(1)/ time.
joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin :: LEq a -> BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
joinBin LEq a
le t1 :: BinomTree rk a
t1@(BinomTree a
x1 rk a
ts1) t2 :: BinomTree rk a
t2@(BinomTree a
x2 rk a
ts2)
  | a
x1 LEq a
`le` a
x2 = a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x1 (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t2 rk a
ts1)
  | Bool
otherwise  = a -> Succ rk a -> BinomTree (Succ rk) a
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x2 (BinomTree rk a -> rk a -> Succ rk a
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t1 rk a
ts2)

instance Functor Zero where
  fmap :: (a -> b) -> Zero a -> Zero b
fmap a -> b
_ Zero a
_ = Zero b
forall a. Zero a
Zero

instance Functor rk => Functor (Succ rk) where
  fmap :: (a -> b) -> Succ rk a -> Succ rk b
fmap a -> b
f (Succ BinomTree rk a
t rk a
ts) = BinomTree rk b -> rk b -> Succ rk b
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ ((a -> b) -> BinomTree rk a -> BinomTree rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) ((a -> b) -> rk a -> rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f rk a
ts)

instance Functor rk => Functor (BinomTree rk) where
  fmap :: (a -> b) -> BinomTree rk a -> BinomTree rk b
fmap a -> b
f (BinomTree a
x rk a
ts) = b -> rk b -> BinomTree rk b
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree (a -> b
f a
x) ((a -> b) -> rk a -> rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f rk a
ts)

instance Functor rk => Functor (BinomForest rk) where
  fmap :: (a -> b) -> BinomForest rk a -> BinomForest rk b
fmap a -> b
_ BinomForest rk a
Nil = BinomForest rk b
forall (rk :: * -> *) a. BinomForest rk a
Nil
  fmap a -> b
f (Skip BinomForest (Succ rk) a
ts) = BinomForest (Succ rk) b -> BinomForest rk b
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip ((a -> b) -> BinomForest (Succ rk) a -> BinomForest (Succ rk) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomForest (Succ rk) a
ts)
  fmap a -> b
f (Cons BinomTree rk a
t BinomForest (Succ rk) a
ts) = BinomTree rk b -> BinomForest (Succ rk) b -> BinomForest rk b
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons ((a -> b) -> BinomTree rk a -> BinomTree rk b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) ((a -> b) -> BinomForest (Succ rk) a -> BinomForest (Succ rk) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomForest (Succ rk) a
ts)

instance Foldable Zero where
  foldr :: (a -> b -> b) -> b -> Zero a -> b
foldr a -> b -> b
_ b
z Zero a
_ = b
z
  foldl :: (b -> a -> b) -> b -> Zero a -> b
foldl b -> a -> b
_ b
z Zero a
_ = b
z

instance Foldable rk => Foldable (Succ rk) where
  foldr :: (a -> b -> b) -> b -> Succ rk a -> b
foldr a -> b -> b
f b
z (Succ BinomTree rk a
t rk a
ts) = (a -> b -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z rk a
ts) BinomTree rk a
t
  foldl :: (b -> a -> b) -> b -> Succ rk a -> b
foldl b -> a -> b
f b
z (Succ BinomTree rk a
t rk a
ts) = (b -> a -> b) -> b -> rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f ((b -> a -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomTree rk a
t) rk a
ts

instance Foldable rk => Foldable (BinomTree rk) where
  foldr :: (a -> b -> b) -> b -> BinomTree rk a -> b
foldr a -> b -> b
f b
z (BinomTree a
x rk a
ts) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z rk a
ts
  foldl :: (b -> a -> b) -> b -> BinomTree rk a -> b
foldl b -> a -> b
f b
z (BinomTree a
x rk a
ts) = (b -> a -> b) -> b -> rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b
z b -> a -> b
`f` a
x) rk a
ts

instance Foldable rk => Foldable (BinomForest rk) where
  foldr :: (a -> b -> b) -> b -> BinomForest rk a -> b
foldr a -> b -> b
_ b
z BinomForest rk a
Nil          = b
z
  foldr a -> b -> b
f b
z (Skip BinomForest (Succ rk) a
tss)   = (a -> b -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomForest (Succ rk) a
tss
  foldr a -> b -> b
f b
z (Cons BinomTree rk a
t BinomForest (Succ rk) a
tss) = (a -> b -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f ((a -> b -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomForest (Succ rk) a
tss) BinomTree rk a
t
  foldl :: (b -> a -> b) -> b -> BinomForest rk a -> b
foldl b -> a -> b
_ b
z BinomForest rk a
Nil          = b
z
  foldl b -> a -> b
f b
z (Skip BinomForest (Succ rk) a
tss)   = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomForest (Succ rk) a
tss
  foldl b -> a -> b
f b
z (Cons BinomTree rk a
t BinomForest (Succ rk) a
tss) = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f ((b -> a -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f b
z BinomTree rk a
t) BinomForest (Succ rk) a
tss

-- instance Traversable Zero where
--   traverse _ _ = pure Zero
--
-- instance Traversable rk => Traversable (Succ rk) where
--   traverse f (Succ t ts) = Succ <$> traverse f t <*> traverse f ts
--
-- instance Traversable rk => Traversable (BinomTree rk) where
--   traverse f (BinomTree x ts) = BinomTree <$> f x <*> traverse f ts
--
-- instance Traversable rk => Traversable (BinomForest rk) where
--   traverse _ Nil = pure Nil
--   traverse f (Skip tss) = Skip <$> traverse f tss
--   traverse f (Cons t tss) = Cons <$> traverse f t <*> traverse f tss

mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU :: (a -> b) -> MinQueue a -> MinQueue b
mapU a -> b
_ MinQueue a
Empty = MinQueue b
forall a. MinQueue a
Empty
mapU a -> b
f (MinQueue Int
n a
x BinomHeap a
ts) = Int -> b -> BinomHeap b -> MinQueue b
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
n (a -> b
f a
x) (a -> b
f (a -> b) -> BinomHeap a -> BinomHeap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinomHeap a
ts)

-- | /O(n)/. Unordered right fold on a priority queue.
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU a -> b -> b
_ b
z MinQueue a
Empty = b
z
foldrU a -> b -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> b -> b
`f` (a -> b -> b) -> b -> BinomHeap a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z BinomHeap a
ts

-- | /O(n)/. Unordered left fold on a priority queue.
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU b -> a -> b
_ b
z MinQueue a
Empty = b
z
foldlU b -> a -> b
f b
z (MinQueue Int
_ a
x BinomHeap a
ts) = (b -> a -> b) -> b -> BinomHeap a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl b -> a -> b
f (b
z b -> a -> b
`f` a
x) BinomHeap a
ts

-- traverseU :: Applicative f => (a -> f b) -> MinQueue a -> f (MinQueue b)
-- traverseU _ Empty = pure Empty
-- traverseU f (MinQueue n x ts) = MinQueue n <$> f x <*> traverse f ts

-- | Forces the spine of the priority queue.
seqSpine :: MinQueue a -> b -> b
seqSpine :: MinQueue a -> b -> b
seqSpine MinQueue a
Empty b
z = b
z
seqSpine (MinQueue Int
_ a
_ BinomHeap a
ts) b
z = BinomHeap a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomHeap a
ts b
z

seqSpineF :: BinomForest rk a -> b -> b
seqSpineF :: BinomForest rk a -> b -> b
seqSpineF BinomForest rk a
Nil b
z          = b
z
seqSpineF (Skip BinomForest (Succ rk) a
ts') b
z   = BinomForest (Succ rk) a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest (Succ rk) a
ts' b
z
seqSpineF (Cons BinomTree rk a
_ BinomForest (Succ rk) a
ts') b
z = BinomForest (Succ rk) a -> b -> b
forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest (Succ rk) a
ts' b
z

-- | Constructs a priority queue out of the keys of the specified 'Prio.MinPQueue'.
keysQueue :: Prio.MinPQueue k a -> MinQueue k
keysQueue :: MinPQueue k a -> MinQueue k
keysQueue MinPQueue k a
Prio.Empty = MinQueue k
forall a. MinQueue a
Empty
keysQueue (Prio.MinPQ Int
n k
k a
_ BinomHeap k a
ts) = Int -> k -> BinomHeap k -> MinQueue k
forall a. Int -> a -> BinomHeap a -> MinQueue a
MinQueue Int
n k
k ((Zero k a -> Zero k) -> BinomHeap k a -> BinomHeap k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF (Zero k -> Zero k a -> Zero k
forall a b. a -> b -> a
const Zero k
forall a. Zero a
Zero) BinomHeap k a
ts)

keysF :: (pRk k a -> rk k) -> Prio.BinomForest pRk k a -> BinomForest rk k
keysF :: (pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF pRk k a -> rk k
f BinomForest pRk k a
ts0 = case BinomForest pRk k a
ts0 of
  BinomForest pRk k a
Prio.Nil       -> BinomForest rk k
forall (rk :: * -> *) a. BinomForest rk a
Nil
  Prio.Skip BinomForest (Succ pRk) k a
ts'  -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
  Prio.Cons (Prio.BinomTree k
k a
_ pRk k a
ts) BinomForest (Succ pRk) k a
ts'
    -> BinomTree rk k -> BinomForest (Succ rk) k -> BinomForest rk k
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) ((Succ pRk k a -> Succ rk k)
-> BinomForest (Succ pRk) k a -> BinomForest (Succ rk) k
forall (pRk :: * -> * -> *) k a (rk :: * -> *).
(pRk k a -> rk k) -> BinomForest pRk k a -> BinomForest rk k
keysF Succ pRk k a -> Succ rk k
f' BinomForest (Succ pRk) k a
ts')
  where  f' :: Succ pRk k a -> Succ rk k
f' (Prio.Succ (Prio.BinomTree k
k a
_ pRk k a
ts) pRk k a
tss) = BinomTree rk k -> rk k -> Succ rk k
forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ (k -> rk k -> BinomTree rk k
forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree k
k (pRk k a -> rk k
f pRk k a
ts)) (pRk k a -> rk k
f pRk k a
tss)

class NFRank rk where
  rnfRk :: NFData a => rk a -> ()

instance NFRank Zero where
  rnfRk :: Zero a -> ()
rnfRk Zero a
_ = ()

instance NFRank rk => NFRank (Succ rk) where
  rnfRk :: Succ rk a -> ()
rnfRk (Succ BinomTree rk a
t rk a
ts) = BinomTree rk a
t BinomTree rk a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk a -> ()
forall (rk :: * -> *) a. (NFRank rk, NFData a) => rk a -> ()
rnfRk rk a
ts

instance (NFData a, NFRank rk) => NFData (BinomTree rk a) where
  rnf :: BinomTree rk a -> ()
rnf (BinomTree a
x rk a
ts) = a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` rk a -> ()
forall (rk :: * -> *) a. (NFRank rk, NFData a) => rk a -> ()
rnfRk rk a
ts

instance (NFData a, NFRank rk) => NFData (BinomForest rk a) where
  rnf :: BinomForest rk a -> ()
rnf BinomForest rk a
Nil         = ()
  rnf (Skip BinomForest (Succ rk) a
ts)   = BinomForest (Succ rk) a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) a
ts
  rnf (Cons BinomTree rk a
t BinomForest (Succ rk) a
ts) = BinomTree rk a
t BinomTree rk a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomForest (Succ rk) a -> ()
forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) a
ts

instance NFData a => NFData (MinQueue a) where
  rnf :: MinQueue a -> ()
rnf MinQueue a
Empty             = ()
  rnf (MinQueue Int
_ a
x BinomHeap a
ts) = a
x a -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` BinomHeap a -> ()
forall a. NFData a => a -> ()
rnf BinomHeap a
ts