{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE StandaloneDeriving #-}

module BinomialQueue.Internals (
  MinQueue (..),
  BinomHeap,
  BinomForest(..),
  BinomTree(..),
  Extract(..),
  MExtract(..),
  Succ(..),
  Zero(..),
  empty,
  extractHeap,
  null,
  size,
  getMin,
  minView,
  singleton,
  insert,
  insertEager,
  union,
  unionPlusOne,
  mapMaybe,
  mapEither,
  mapMonotonic,
  foldrAsc,
  foldlAsc,
  foldrDesc,
  foldrUnfold,
  foldlUnfold,
  insertMinQ,
  insertMinQ',
  insertMaxQ',
  toAscList,
  toDescList,
  toListU,
  fromList,
  mapU,
  fromAscList,
  foldMapU,
  foldrU,
  foldlU,
  foldlU',
  seqSpine,
  unions
  ) where

import Control.DeepSeq (NFData(rnf), deepseq)
import Data.Foldable (foldl')
import Data.Function (on)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..), stimesMonoid)
#endif

import Data.PQueue.Internals.Foldable
#ifdef __GLASGOW_HASKELL__
import Data.Data
import Text.Read (Lexeme(Ident), lexP, parens, prec,
  readPrec, readListPrec, readListPrecDefault)
import GHC.Exts (build)
#endif

import Prelude hiding (null)

#ifndef __GLASGOW_HASKELL__
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build f = f (:) []
#endif

-- | A priority queue with elements of type @a@. Getting the
-- size or retrieving the minimum element takes \(O(\log n)\) time.
newtype MinQueue a = MinQueue (BinomHeap a)

#ifdef __GLASGOW_HASKELL__
instance (Ord a, Data a) => Data (MinQueue a) where
  gfoldl :: forall (c :: * -> *).
(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 forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
q of
    Maybe (a, MinQueue a)
Nothing      -> forall g. g -> c g
z forall a. MinQueue a
empty
    Just (a
x, MinQueue a
q') -> forall g. g -> c g
z forall a. Ord a => a -> MinQueue a -> MinQueue a
insert forall d b. Data d => c (d -> b) -> d -> c b
`f` a
x forall d b. Data d => c (d -> b) -> d -> c b
`f` MinQueue a
q'

  gunfold :: forall (c :: * -> *).
(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 -> forall r. r -> c r
z forall a. MinQueue a
empty
    Int
2 -> forall b r. Data b => c (b -> r) -> c r
k (forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. a -> MinQueue a -> MinQueue a
insertMinQ))
    Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

  dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (MinQueue a))
dataCast1 forall d. Data d => c (t d)
x = 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 forall d. Data d => c (t d)
x

  toConstr :: MinQueue a -> Constr
toConstr MinQueue a
q
    | 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 -> MinQueue a -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView

instance Ord a => Ord (MinQueue a) where
  compare :: MinQueue a -> MinQueue a -> Ordering
compare = forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView
    -- 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@.
--
-- The Skip constructor must be lazy to obtain the desired amortized bounds.
-- The forest field of the Cons constructor /could/ be made strict, but that
-- would be worse for heavily persistent use. According to our benchmarks, it
-- doesn't make a significant or consistent difference even in non-persistent
-- code (heap sort and k-way merge).
--
-- Debit invariant:
--
-- The next-pointer of a Skip node is allowed 1 debit. No other debits are
-- allowed in the structure.
data BinomForest rk a
   = Nil
   | Skip (BinomForest (Succ rk) a)
   | Cons {-# UNPACK #-} !(BinomTree rk a) (BinomForest (Succ rk) a)

-- The BinomTree and Succ constructors are entirely strict, primarily because
-- that makes it easier to make sure everything is as strict as it should
-- be. The downside is that this slows down `mapMonotonic`. If that's important,
-- we can do all the forcing manually; it will be a pain.

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

-- basics

-- | \(O(1)\). The empty priority queue.
empty :: MinQueue a
empty :: forall a. MinQueue a
empty = forall a. BinomHeap a -> MinQueue a
MinQueue forall (rk :: * -> *) a. BinomForest rk a
Nil

-- | \(O(1)\). Is this the empty priority queue?
null :: MinQueue a -> Bool
null :: forall a. MinQueue a -> Bool
null (MinQueue BinomForest Zero a
Nil) = Bool
True
null MinQueue a
_ = Bool
False

-- | \(O(\log n)\). The number of elements in the queue.
size :: MinQueue a -> Int
size :: forall a. MinQueue a -> Int
size (MinQueue BinomHeap a
hp) = forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go Int
0 Int
1 BinomHeap a
hp
  where
    go :: Int -> Int -> BinomForest rk a -> Int
    go :: forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go Int
acc Int
rk BinomForest rk a
Nil = Int
rk seq :: forall a b. a -> b -> b
`seq` Int
acc
    go Int
acc Int
rk (Skip BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go Int
acc (Int
2 forall a. Num a => a -> a -> a
* Int
rk) BinomForest (Succ rk) a
f
    go Int
acc Int
rk (Cons BinomTree rk a
_t BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go (Int
acc forall a. Num a => a -> a -> a
+ Int
rk) (Int
2 forall a. Num a => a -> a -> a
* Int
rk) BinomForest (Succ rk) a
f

-- | \(O(\log n)\). Returns the minimum element of the queue, if the queue is nonempty.
getMin :: Ord a => MinQueue a -> Maybe a
-- TODO: Write this directly to avoid rebuilding the heap.
getMin :: forall a. Ord a => MinQueue a -> Maybe a
getMin MinQueue a
xs = case forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
xs of
  Just (a
a, MinQueue a
_) -> forall a. a -> Maybe a
Just a
a
  Maybe (a, MinQueue a)
Nothing -> 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 :: forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView (MinQueue BinomHeap a
ts) = case forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
extractBin BinomHeap a
ts of
  MExtract Zero a
No -> forall a. Maybe a
Nothing
  Yes (Extract a
x ~Zero a
Zero BinomHeap a
ts') -> forall a. a -> Maybe a
Just (a
x, forall a. BinomHeap a -> MinQueue a
MinQueue BinomHeap a
ts')

-- | \(O(1)\). Construct a priority queue with a single element.
singleton :: a -> MinQueue a
singleton :: forall a. a -> MinQueue a
singleton a
x = forall a. BinomHeap a -> MinQueue a
MinQueue (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (forall a. a -> BinomTree Zero a
tip a
x) 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 :: forall a. Ord a => a -> MinQueue a -> MinQueue a
insert a
x (MinQueue BinomHeap a
ts) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr (forall a. a -> BinomTree Zero a
tip a
x) BinomHeap a
ts)

-- | \(O(\log n)\), but a fast \(O(1)\) average when inserting repeatedly in
-- an empty queue or at least around \(O(\log n)\) times into a nonempty one.
-- Insert an element into the priority queue. This is good for 'fromList'-like
-- operations.
insertEager :: Ord a => a -> MinQueue a -> MinQueue a
insertEager :: forall a. Ord a => a -> MinQueue a -> MinQueue a
insertEager a
x (MinQueue BinomHeap a
ts) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr' (forall a. a -> BinomTree Zero a
tip a
x) BinomHeap a
ts)
{-# INLINE insertEager #-}

-- | 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 :: forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union (MinQueue BinomHeap a
f1) (MinQueue BinomHeap a
f2) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge BinomHeap a
f1 BinomHeap a
f2)

-- | Takes the union of a list of priority queues. Equivalent to @'foldl'' 'union' 'empty'@.
unions :: Ord a => [MinQueue a] -> MinQueue a
unions :: forall a. Ord a => [MinQueue a] -> MinQueue a
unions = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union forall a. MinQueue a
empty

-- | \(O(n)\). Map elements and collect the 'Just' results.
mapMaybe :: Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe :: forall b a. Ord b => (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe a -> Maybe b
f = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. (b -> a -> b) -> b -> MinQueue a -> b
foldlU' forall a. MinQueue a
empty forall a b. (a -> b) -> a -> b
$ \MinQueue b
q a
a ->
  case a -> Maybe b
f a
a of
    Maybe b
Nothing -> MinQueue b
q
    Just b
b -> forall a. Ord a => a -> MinQueue a -> MinQueue a
insertEager b
b MinQueue b
q
-- This seems to be needed for specialization.
{-# INLINABLE mapMaybe #-}

-- | \(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 :: forall b c a.
(Ord b, Ord c) =>
(a -> Either b c) -> MinQueue a -> (MinQueue b, MinQueue c)
mapEither a -> Either b c
f = forall a b. Partition a b -> (MinQueue a, MinQueue b)
fromPartition forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall b a. (b -> a -> b) -> b -> MinQueue a -> b
foldlU'
    (\(Partition MinQueue b
ls MinQueue c
rs) a
a ->
        case a -> Either b c
f a
a of
          Left b
b -> forall a b. MinQueue a -> MinQueue b -> Partition a b
Partition (forall a. Ord a => a -> MinQueue a -> MinQueue a
insertEager b
b MinQueue b
ls) MinQueue c
rs
          Right c
b -> forall a b. MinQueue a -> MinQueue b -> Partition a b
Partition MinQueue b
ls (forall a. Ord a => a -> MinQueue a -> MinQueue a
insertEager c
b MinQueue c
rs))
    (forall a b. MinQueue a -> MinQueue b -> Partition a b
Partition forall a. MinQueue a
empty forall a. MinQueue a
empty)
-- This seems to be needed for specialization.
{-# INLINABLE mapEither #-}

-- | \(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 :: forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapMonotonic = forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapU

{-# INLINABLE [0] 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 :: forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc a -> b -> b
f b
z (MinQueue BinomHeap a
ts) = forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold a -> b -> b
f b
z forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts

-- | \(O(n \log n)\). Performs a right fold on the elements of a priority queue in descending order.
-- @foldrDesc f z q == foldlAsc (flip f) z q@.
foldrDesc :: Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc :: forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc = forall a b. Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip
{-# INLINE [0] foldrDesc #-}

{-# INLINE foldrUnfold #-}
-- | Equivalent to @foldr f z (unfoldr suc s0)@.
foldrUnfold :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold :: forall a c b. (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 :: forall a b. Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc b -> a -> b
f b
z (MinQueue BinomHeap a
ts) = forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold b -> a -> b
f b
z 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 :: forall c a b. (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'

{-# INLINABLE [1] toAscList #-}
-- | \(O(n \log n)\). Extracts the elements of the priority queue in ascending order.
toAscList :: Ord a => MinQueue a -> [a]
toAscList :: forall a. Ord a => MinQueue a -> [a]
toAscList MinQueue a
queue = forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc (:) [] MinQueue a
queue

{-# INLINABLE toAscListApp #-}
toAscListApp :: Ord a => MinQueue a -> [a] -> [a]
toAscListApp :: forall a. Ord a => MinQueue a -> [a] -> [a]
toAscListApp (MinQueue BinomHeap a
ts) [a]
app = forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold (:) [a]
app forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts

{-# INLINABLE [1] toDescList #-}
-- | \(O(n \log n)\). Extracts the elements of the priority queue in descending order.
toDescList :: Ord a => MinQueue a -> [a]
toDescList :: forall a. Ord a => MinQueue a -> [a]
toDescList MinQueue a
queue = forall a b. Ord a => (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc (:) [] MinQueue a
queue

{-# INLINABLE toDescListApp #-}
toDescListApp :: Ord a => MinQueue a -> [a] -> [a]
toDescListApp :: forall a. Ord a => MinQueue a -> [a] -> [a]
toDescListApp (MinQueue BinomHeap a
ts) [a]
app = forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [a]
app forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts

{-# RULES
"toAscList" [~1] forall q. toAscList q = build (\c nil -> foldrAsc c nil q)
"toDescList" [~1] forall q. toDescList q = build (\c nil -> foldrDesc c nil q)
"ascList" [1] forall q add. foldrAsc (:) add q = toAscListApp q add
"descList" [1] forall q add. foldrDesc (:) add q = toDescListApp q add
 #-}

{-# INLINE fromAscList #-}
-- | \(O(n)\). Constructs a priority queue from an ascending list. /Warning/: Does not check the precondition.
--
-- Performance note: Code using this function in a performance-sensitive context
-- with an argument that is a "good producer" for list fusion should be compiled
-- with @-fspec-constr@ or @-O2@. For example, @fromAscList . map f@ needs one
-- of these options for best results.
fromAscList :: [a] -> MinQueue a
-- We apply an explicit argument to get foldl' to inline.
fromAscList :: forall a. [a] -> MinQueue a
fromAscList [a]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> MinQueue a -> MinQueue a
insertMaxQ') forall a. MinQueue a
empty [a]
xs

-- | 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 :: forall a. Ord a => BinomHeap a -> Maybe (a, BinomHeap a)
extractHeap BinomHeap a
ts = case forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
extractBin BinomHeap a
ts of
  MExtract Zero a
No                        -> forall a. Maybe a
Nothing
  Yes (Extract a
x ~Zero a
Zero BinomHeap a
ts') -> forall a. a -> Maybe a
Just (a
x, BinomHeap a
ts')

-- | 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@.
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 :: forall (rk :: * -> *) a. Extract (Succ rk) a -> Extract rk a
incrExtract (Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
  = forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
kChild BinomForest (Succ rk) a
ts)

-- Note: We used to apply Skip lazily here, and to use the lazy incr, for fear
-- that the potential cascade of carries would be more expensive than leaving
-- those carries suspended and letting subsequent operations force them.
-- However, our benchmarks indicated that doing these strictly was
-- faster. Note that even if we chose to go back to incr (rather than incr'),
-- it's even more clearly worse to apply Skip lazily— forcing the result of
-- incr in this context doesn't cause a cascade, because the child of any Cons
-- will come from an Extract, and therefore be in WHNF already.
incrExtract' :: Ord a => BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' :: forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' BinomTree rk a
t (Extract a
minKey (Succ BinomTree rk a
kChild rk a
kChildren) BinomForest (Succ rk) a
ts)
  = forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
minKey rk a
kChildren (forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr' (BinomTree rk a
t forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`joinBin` BinomTree rk a
kChild) BinomForest (Succ rk) a
ts)

-- | 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 :: Ord a => BinomForest rk a -> MExtract rk a
extractBin :: forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
extractBin = forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
start
  where
    start :: Ord a => BinomForest rk a -> MExtract rk a
    start :: forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
start BinomForest rk a
Nil = forall (rk :: * -> *) a. MExtract rk a
No
    start (Skip BinomForest (Succ rk) a
f) = case forall a (rk :: * -> *). Ord a => BinomForest rk a -> MExtract rk a
start BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No     -> forall (rk :: * -> *) a. MExtract rk a
No
      Yes Extract (Succ rk) a
ex -> forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (forall (rk :: * -> *) a. Extract (Succ rk) a -> Extract rk a
incrExtract Extract (Succ rk) a
ex)
    start (Cons t :: BinomTree rk a
t@(BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes forall a b. (a -> b) -> a -> b
$ case forall a (rk :: * -> *).
Ord a =>
a -> BinomForest rk a -> MExtract rk a
go a
x BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No -> forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
x rk a
ts (forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
skip BinomForest (Succ rk) a
f)
      Yes Extract (Succ rk) a
ex -> forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' BinomTree rk a
t Extract (Succ rk) a
ex

    go :: Ord a => a -> BinomForest rk a -> MExtract rk a
    go :: forall a (rk :: * -> *).
Ord a =>
a -> BinomForest rk a -> MExtract rk a
go a
_min_above BinomForest rk a
Nil = a
_min_above seq :: forall a b. a -> b -> b
`seq` forall (rk :: * -> *) a. MExtract rk a
No
    go a
min_above (Skip BinomForest (Succ rk) a
f) = case forall a (rk :: * -> *).
Ord a =>
a -> BinomForest rk a -> MExtract rk a
go a
min_above BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No -> forall (rk :: * -> *) a. MExtract rk a
No
      Yes Extract (Succ rk) a
ex -> forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (forall (rk :: * -> *) a. Extract (Succ rk) a -> Extract rk a
incrExtract Extract (Succ rk) a
ex)
    go a
min_above (Cons t :: BinomTree rk a
t@(BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f)
      | a
min_above forall a. Ord a => a -> a -> Bool
<= a
x = case forall a (rk :: * -> *).
Ord a =>
a -> BinomForest rk a -> MExtract rk a
go a
min_above BinomForest (Succ rk) a
f of
          MExtract (Succ rk) a
No -> forall (rk :: * -> *) a. MExtract rk a
No
          Yes Extract (Succ rk) a
ex -> forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' BinomTree rk a
t Extract (Succ rk) a
ex)
      | Bool
otherwise = case forall a (rk :: * -> *).
Ord a =>
a -> BinomForest rk a -> MExtract rk a
go a
x BinomForest (Succ rk) a
f of
          MExtract (Succ rk) a
No -> forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (forall (rk :: * -> *) a.
a -> rk a -> BinomForest rk a -> Extract rk a
Extract a
x rk a
ts (forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
skip BinomForest (Succ rk) a
f))
          Yes Extract (Succ rk) a
ex -> forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> Extract (Succ rk) a -> Extract rk a
incrExtract' BinomTree rk a
t Extract (Succ rk) a
ex)

-- | When the heap size is a power of two and we extract from it, we have
-- to shrink the spine by one. This function takes care of that.
skip :: BinomForest (Succ rk) a -> BinomForest rk a
skip :: forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
skip BinomForest (Succ rk) a
Nil = forall (rk :: * -> *) a. BinomForest rk a
Nil
skip BinomForest (Succ rk) a
f = forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip BinomForest (Succ rk) a
f
{-# INLINE skip #-}

data Partition a b = Partition !(MinQueue a) !(MinQueue b)
fromPartition :: Partition a b -> (MinQueue a, MinQueue b)
fromPartition :: forall a b. Partition a b -> (MinQueue a, MinQueue b)
fromPartition (Partition MinQueue a
p MinQueue b
q) = (MinQueue a
p, MinQueue b
q)

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

insertMinQ :: a -> MinQueue a -> MinQueue a
insertMinQ :: forall a. a -> MinQueue a -> MinQueue a
insertMinQ a
x (MinQueue BinomHeap a
f) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (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
-- or equal to every other root in @f@, and merges accordingly.
insertMin :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin :: forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin BinomTree rk a
t BinomForest rk a
Nil = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t forall (rk :: * -> *) a. BinomForest rk a
Nil
insertMin BinomTree rk a
t (Skip BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
-- See Note [Force on cascade]
insertMin (BinomTree a
x rk a
ts) (Cons BinomTree rk a
t' BinomForest (Succ rk) a
f) = BinomForest (Succ rk) a
f seq :: forall a b. a -> b -> b
`seq` forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin (forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x (forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t' rk a
ts)) BinomForest (Succ rk) a
f)

-- | @insertMinQ' x h@ assumes that @x@ compares as less
-- than or equal to every element of @h@.
insertMinQ' :: a -> MinQueue a -> MinQueue a
insertMinQ' :: forall a. a -> MinQueue a -> MinQueue a
insertMinQ' a
x (MinQueue BinomHeap a
f) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin' (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. It eagerly evaluates
-- the modified portion of the structure.
insertMin' :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin' :: forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin' BinomTree rk a
t BinomForest rk a
Nil = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t forall (rk :: * -> *) a. BinomForest rk a
Nil
insertMin' BinomTree rk a
t (Skip BinomForest (Succ rk) a
f) = 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) = forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMin' (forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x (forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t' rk a
ts)) BinomForest (Succ rk) a
f

-- | @insertMaxQ' x h@ assumes that @x@ compares as greater
-- than or equal to every element of @h@. It also assumes,
-- and preserves, an extra invariant. See 'insertMax'' for details.
-- tldr: this function can be used safely to build a queue from an
-- ascending list/array/whatever, but that's about it.
insertMaxQ' :: a -> MinQueue a -> MinQueue a
insertMaxQ' :: forall a. a -> MinQueue a -> MinQueue a
insertMaxQ' a
x (MinQueue BinomHeap a
f) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' (forall a. a -> BinomTree Zero a
tip a
x) BinomHeap a
f)

-- | @insertMax' t f@ assumes that the root of @t@ compares as greater
-- than or equal to every root in @f@, and further assumes that the roots
-- in @f@ occur in descending order. It produces a forest whose roots are
-- again in descending order. Note: the whole modified portion of the spine
-- is forced.
insertMax' :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' :: forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' BinomTree rk a
t BinomForest rk a
Nil = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t forall (rk :: * -> *) a. BinomForest rk a
Nil
insertMax' BinomTree rk a
t (Skip BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t BinomForest (Succ rk) a
f
insertMax' BinomTree rk a
t (Cons (BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f) = forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' (forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree a
x (forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ BinomTree rk a
t rk a
ts)) BinomForest (Succ rk) a
f

{-# INLINABLE fromList #-}
-- | \(O(n)\). Constructs a priority queue from an unordered list.
fromList :: Ord a => [a] -> MinQueue a
fromList :: forall a. Ord a => [a] -> MinQueue a
fromList [a]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> MinQueue a -> MinQueue a
insertEager) forall a. MinQueue a
empty [a]
xs

-- | 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 :: Ord a => BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge :: forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge 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')    -> forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge 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') -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t2 forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge 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') -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t1 forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge 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')
        -> forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomTree rk a
-> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry (BinomTree rk a
t1 forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`joinBin` 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

-- | Take the union of two queues and toss in an extra element.
unionPlusOne :: Ord a => a -> MinQueue a -> MinQueue a -> MinQueue a
unionPlusOne :: forall a. Ord a => a -> MinQueue a -> MinQueue a -> MinQueue a
unionPlusOne a
a (MinQueue BinomHeap a
xs) (MinQueue BinomHeap a
ys) = forall a. BinomHeap a -> MinQueue a
MinQueue (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a
-> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry (forall a. a -> BinomTree Zero a
tip a
a) BinomHeap a
xs BinomHeap a
ys)

-- | 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 :: Ord a => BinomTree rk a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry :: forall a (rk :: * -> *).
Ord a =>
BinomTree rk a
-> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry BinomTree rk a
t0 BinomForest rk a
f1 BinomForest rk a
f2 = BinomTree rk a
t0 seq :: forall a b. a -> b -> b
`seq` case (BinomForest rk a
f1, BinomForest rk a
f2) of
  (Skip BinomForest (Succ rk) a
f1', Skip BinomForest (Succ rk) a
f2')    -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge 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') -> forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall {a} {rk :: * -> *}.
Ord a =>
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') -> forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall {a} {rk :: * -> *}.
Ord a =>
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')
        -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t0 forall a b. (a -> b) -> a -> b
$! forall {a} {rk :: * -> *}.
Ord a =>
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'
  -- Why do these use incr and not incr'? We want the merge to take amortized
  -- O(log(min(|f1|, |f2|))) time. If we performed this final increment
  -- eagerly, that would degrade to O(log(max(|f1|, |f2|))) time.
  (BinomForest rk a
Nil, BinomForest rk a
_f2)              -> forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr BinomTree rk a
t0 BinomForest rk a
f2
  (BinomForest rk a
_f1, BinomForest rk a
Nil)              -> forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr BinomTree rk a
t0 BinomForest rk a
f1
  where
    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 = forall a (rk :: * -> *).
Ord a =>
BinomTree rk a
-> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
carry (BinomTree rk a
tA forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`joinBin` 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 :: Ord a => BinomTree rk a -> BinomForest rk a -> BinomForest rk a
-- See Note [Amortization]
incr :: forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr BinomTree rk a
t BinomForest rk a
f0 = BinomTree rk a
t seq :: forall a b. a -> b -> b
`seq` case BinomForest rk a
f0 of
  BinomForest rk a
Nil  -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t forall (rk :: * -> *) a. BinomForest rk a
Nil
  Skip BinomForest (Succ rk) a
f     -> 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
f' seq :: forall a b. a -> b -> b
`seq` forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr (BinomTree rk a
t forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`joinBin` BinomTree rk a
t') BinomForest (Succ rk) a
f')
      -- See Note [Force on cascade]

      -- Question: should we force t `cat` t' here? We're allowed to;
      -- it's not obviously good or obviously bad.

-- Note [Amortization]
--
-- In the Skip case, we perform O(1) unshared work and pay a
-- debit. In the Cons case, there are no debits on f', so we can force it for
-- free. We perform O(1) unshared work, and by induction suspend O(1) amortized
-- work. Another way to look at this: We have a string of Conses followed by
-- a Skip or Nil. We change all the Conses to Skips, and change the Skip to
-- a Cons or the Nil to a Cons Nil. Processing each Cons takes O(1) time, which
-- we account for by placing debits below the new Skips. Note: this increment
-- pattern is exactly the same as the one for Hinze-Paterson 2–3 finger trees,
-- and the amortization argument works just the same.

-- Note [Force on cascade]
--
-- As Hinze and Patterson noticed in a similar structure, whenever we cascade
-- past a Cons on insertion, we should force its child. If we don't, then
-- multiple insertions in a row will form a chain of thunks just under the root
-- of the structure, which degrades the worst-case bound for deletion from
-- logarithmic to linear and leads to poor real-world performance.

-- | A version of 'incr' that constructs the spine eagerly. This is
-- intended for implementing @fromList@.
incr' :: Ord a => BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr' :: forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr' BinomTree rk a
t BinomForest rk a
f0 = BinomTree rk a
t seq :: forall a b. a -> b -> b
`seq` case BinomForest rk a
f0 of
  BinomForest rk a
Nil  -> forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons BinomTree rk a
t forall (rk :: * -> *) a. BinomForest rk a
Nil
  Skip BinomForest (Succ rk) a
f     -> 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' -> forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> b
$! forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
incr' (BinomTree rk a
t forall a (rk :: * -> *).
Ord a =>
BinomTree rk a -> BinomTree rk a -> BinomTree (Succ rk) a
`joinBin` BinomTree rk a
t') BinomForest (Succ rk) a
f'

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


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

instance Functor rk => Functor (Succ rk) where
  fmap :: forall a b. (a -> b) -> Succ rk a -> Succ rk b
fmap a -> b
f (Succ BinomTree rk a
t rk a
ts) = forall (rk :: * -> *) a. BinomTree rk a -> rk a -> Succ rk a
Succ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) (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 :: forall a b. (a -> b) -> BinomTree rk a -> BinomTree rk b
fmap a -> b
f (BinomTree a
x rk a
ts) = forall (rk :: * -> *) a. a -> rk a -> BinomTree rk a
BinomTree (a -> b
f a
x) (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 :: forall a b. (a -> b) -> BinomForest rk a -> BinomForest rk b
fmap a -> b
_ BinomForest rk a
Nil = forall (rk :: * -> *) a. BinomForest rk a
Nil
  fmap a -> b
f (Skip BinomForest (Succ rk) a
ts) = forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip forall a b. (a -> b) -> a -> 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) = forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomTree rk a
t) forall a b. (a -> b) -> a -> b
$! forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f BinomForest (Succ rk) a
ts

instance Foldr Zero where
  foldr_ :: forall a b. (a -> b -> b) -> b -> Zero a -> b
foldr_ a -> b -> b
_ b
z ~Zero a
Zero = b
z

instance Foldl Zero where
  foldl_ :: forall b a. (b -> a -> b) -> b -> Zero a -> b
foldl_ b -> a -> b
_ b
z ~Zero a
Zero = b
z

instance Foldl' Zero where
  foldl'_ :: forall b a. (b -> a -> b) -> b -> Zero a -> b
foldl'_ b -> a -> b
_ b
z ~Zero a
Zero = b
z

instance FoldMap Zero where
  foldMap_ :: forall m a. Monoid m => (a -> m) -> Zero a -> m
foldMap_ a -> m
_ ~Zero a
Zero = forall a. Monoid a => a
mempty

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

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

instance Foldl' rk => Foldl' (Succ rk) where
  foldl'_ :: forall b a. (b -> a -> b) -> b -> Succ rk a -> b
foldl'_ b -> a -> b
f !b
z (Succ BinomTree rk a
t rk a
ts) = forall (t :: * -> *) b a.
Foldl' t =>
(b -> a -> b) -> b -> t a -> b
foldl'_ b -> a -> b
f (forall (t :: * -> *) b a.
Foldl' t =>
(b -> a -> b) -> b -> t a -> b
foldl'_ b -> a -> b
f b
z BinomTree rk a
t) rk a
ts

instance FoldMap rk => FoldMap (Succ rk) where
  foldMap_ :: forall m a. Monoid m => (a -> m) -> Succ rk a -> m
foldMap_ a -> m
f (Succ BinomTree rk a
t rk a
ts) = forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomTree rk a
t forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f rk a
ts

instance Foldr rk => Foldr (BinomTree rk) where
  foldr_ :: forall a b. (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` forall (t :: * -> *) a b. Foldr t => (a -> b -> b) -> b -> t a -> b
foldr_ a -> b -> b
f b
z rk a
ts

instance Foldl rk => Foldl (BinomTree rk) where
  foldl_ :: forall b a. (b -> a -> b) -> b -> BinomTree rk a -> b
foldl_ b -> a -> b
f b
z (BinomTree a
x rk a
ts) = forall (t :: * -> *) b a. Foldl 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 Foldl' rk => Foldl' (BinomTree rk) where
  foldl'_ :: forall b a. (b -> a -> b) -> b -> BinomTree rk a -> b
foldl'_ b -> a -> b
f !b
z (BinomTree a
x rk a
ts) = forall (t :: * -> *) b a.
Foldl' 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 FoldMap rk => FoldMap (BinomTree rk) where
  foldMap_ :: forall m a. Monoid m => (a -> m) -> BinomTree rk a -> m
foldMap_ a -> m
f (BinomTree a
x rk a
ts) = a -> m
f a
x forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f rk a
ts

instance Foldr rk => Foldr (BinomForest rk) where
  foldr_ :: forall a b. (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)   = forall (t :: * -> *) a b. Foldr 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) = forall (t :: * -> *) a b. Foldr t => (a -> b -> b) -> b -> t a -> b
foldr_ a -> b -> b
f (forall (t :: * -> *) a b. Foldr t => (a -> b -> b) -> b -> t a -> b
foldr_ a -> b -> b
f b
z BinomForest (Succ rk) a
tss) BinomTree rk a
t

instance Foldl rk => Foldl (BinomForest rk) where
  foldl_ :: forall b a. (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)   = forall (t :: * -> *) b a. Foldl 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) = forall (t :: * -> *) b a. Foldl t => (b -> a -> b) -> b -> t a -> b
foldl_ b -> a -> b
f (forall (t :: * -> *) b a. Foldl 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 Foldl' rk => Foldl' (BinomForest rk) where
  foldl'_ :: forall b a. (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)   = forall (t :: * -> *) b a.
Foldl' 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) = forall (t :: * -> *) b a.
Foldl' t =>
(b -> a -> b) -> b -> t a -> b
foldl'_ b -> a -> b
f (forall (t :: * -> *) b a.
Foldl' 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 FoldMap rk => FoldMap (BinomForest rk) where
  foldMap_ :: forall m a. Monoid m => (a -> m) -> BinomForest rk a -> m
foldMap_ a -> m
_ BinomForest rk a
Nil = forall a. Monoid a => a
mempty
  foldMap_ a -> m
f (Skip BinomForest (Succ rk) a
tss)   = forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomForest (Succ rk) a
tss
  foldMap_ a -> m
f (Cons BinomTree rk a
t BinomForest (Succ rk) a
tss) = forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomTree rk a
t forall a. Monoid a => a -> a -> a
`mappend` forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomForest (Succ rk) a
tss

{-
instance Foldable Zero where
  foldr _ z ~Zero = z
  foldl _ z ~Zero = z

instance Foldable rk => Foldable (Succ rk) where
  foldr f z (Succ t ts) = foldr f (foldr f z ts) t
  foldl f z (Succ t ts) = foldl f (foldl f z t) ts

instance Foldable rk => Foldable (BinomTree rk) where
  foldr f z (BinomTree x ts) = x `f` foldr f z ts
  foldl f z (BinomTree x ts) = foldl f (z `f` x) ts

instance Foldable rk => Foldable (BinomForest rk) where
  foldr _ z Nil          = z
  foldr f z (Skip tss)   = foldr f z tss
  foldr f z (Cons t tss) = foldr f (foldr f z tss) t
  foldl _ z Nil          = z
  foldl f z (Skip tss)   = foldl f z tss
  foldl f z (Cons t tss) = foldl f (foldl f z t) 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 :: forall a b. (a -> b) -> MinQueue a -> MinQueue b
mapU a -> b
f (MinQueue BinomHeap a
ts) = forall a. BinomHeap a -> MinQueue a
MinQueue (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinomHeap a
ts)

{-# NOINLINE [0] foldrU #-}
-- | \(O(n)\). Unordered right fold on a priority queue.
foldrU :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU :: forall a b. (a -> b -> b) -> b -> MinQueue a -> b
foldrU a -> b -> b
f b
z (MinQueue BinomHeap a
ts) = forall (t :: * -> *) a b. Foldr 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. This is rarely
-- what you want; 'foldrU' and 'foldlU'' are more likely to perform
-- well.
foldlU :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU :: forall b a. (b -> a -> b) -> b -> MinQueue a -> b
foldlU b -> a -> b
f b
z (MinQueue BinomHeap a
ts) = forall (t :: * -> *) b a. Foldl t => (b -> a -> b) -> b -> t a -> b
foldl_ b -> a -> b
f b
z BinomHeap a
ts

-- | \(O(n)\). Unordered strict left fold on a priority queue.
--
-- @since 1.4.2
foldlU' :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU' :: forall b a. (b -> a -> b) -> b -> MinQueue a -> b
foldlU' b -> a -> b
f b
z (MinQueue BinomHeap a
ts) = forall (t :: * -> *) b a.
Foldl' t =>
(b -> a -> b) -> b -> t a -> b
foldl'_ b -> a -> b
f b
z BinomHeap a
ts

-- | \(O(n)\). Unordered monoidal fold on a priority queue.
--
-- @since 1.4.2
foldMapU :: Monoid m => (a -> m) -> MinQueue a -> m
foldMapU :: forall m a. Monoid m => (a -> m) -> MinQueue a -> m
foldMapU a -> m
f (MinQueue BinomHeap a
ts) = forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomHeap a
ts

{-# NOINLINE toListU #-}
-- | \(O(n)\). Returns the elements of the queue, in no particular order.
toListU :: MinQueue a -> [a]
toListU :: forall a. MinQueue a -> [a]
toListU MinQueue a
q = forall a b. (a -> b -> b) -> b -> MinQueue a -> b
foldrU (:) [] MinQueue a
q

{-# NOINLINE toListUApp #-}
toListUApp :: MinQueue a -> [a] -> [a]
toListUApp :: forall a. MinQueue a -> [a] -> [a]
toListUApp (MinQueue BinomHeap a
ts) [a]
app = forall (t :: * -> *) a b. Foldr t => (a -> b -> b) -> b -> t a -> b
foldr_ (:) [a]
app BinomHeap a
ts

{-# RULES
"toListU/build" [~1] forall q. toListU q = build (\c n -> foldrU c n q)
"toListU" [1] forall q app. foldrU (:) app q = toListUApp q app
  #-}

-- 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

-- | \(O(\log n)\). @seqSpine q r@ forces the spine of @q@ and returns @r@.
--
-- Note: The spine of a 'MinQueue' is stored somewhat lazily. Most operations
-- take great care to prevent chains of thunks from accumulating along the
-- spine to the detriment of performance. However, @mapU@ can leave expensive
-- thunks in the structure and repeated applications of that function can
-- create thunk chains.
seqSpine :: MinQueue a -> b -> b
seqSpine :: forall a b. MinQueue a -> b -> b
seqSpine (MinQueue BinomHeap a
ts) b
z = forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomHeap a
ts b
z

seqSpineF :: BinomForest rk a -> b -> b
seqSpineF :: forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest rk a
Nil b
z          = b
z
seqSpineF (Skip BinomForest (Succ rk) a
ts') b
z   = 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 = forall (rk :: * -> *) a b. BinomForest rk a -> b -> b
seqSpineF BinomForest (Succ rk) a
ts' b
z

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

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

instance NFRank rk => NFRank (Succ rk) where
  rnfRk :: forall a. NFData a => Succ rk a -> ()
rnfRk (Succ BinomTree rk a
t rk a
ts) = BinomTree rk a
t forall a b. NFData a => a -> b -> b
`deepseq` 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 forall a b. NFData a => a -> b -> b
`deepseq` 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)   = 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 forall a b. NFData a => a -> b -> b
`deepseq` forall a. NFData a => a -> ()
rnf BinomForest (Succ rk) a
ts

instance NFData a => NFData (MinQueue a) where
  rnf :: MinQueue a -> ()
rnf (MinQueue BinomHeap a
ts) = forall a. NFData a => a -> ()
rnf BinomHeap a
ts

instance (Ord a, Show a) => Show (MinQueue a) where
  showsPrec :: Int -> MinQueue a -> ShowS
showsPrec Int
p MinQueue a
xs = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromAscList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall a. Ord a => MinQueue a -> [a]
toAscList MinQueue a
xs)

instance Read a => Read (MinQueue a) where
#ifdef __GLASGOW_HASKELL__
  readPrec :: ReadPrec (MinQueue a)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromAscList" <- ReadPrec Lexeme
lexP
    [a]
xs <- forall a. Read a => ReadPrec a
readPrec
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [a] -> MinQueue a
fromAscList [a]
xs)

  readListPrec :: ReadPrec [MinQueue a]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
  readsPrec p = readParen (p > 10) $ \r -> do
    ("fromAscList",s) <- lex r
    (xs,t) <- reads s
    return (fromAscList xs,t)
#endif

#if MIN_VERSION_base(4,9,0)
instance Ord a => Semigroup (MinQueue a) where
  <> :: MinQueue a -> MinQueue a -> MinQueue a
(<>) = forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union
  stimes :: forall b. Integral b => b -> MinQueue a -> MinQueue a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
  {-# INLINABLE stimes #-}
#endif

instance Ord a => Monoid (MinQueue a) where
  mempty :: MinQueue a
mempty = forall a. MinQueue a
empty
#if !MIN_VERSION_base(4,11,0)
  mappend = union
#endif
  mconcat :: [MinQueue a] -> MinQueue a
mconcat = forall a. Ord a => [MinQueue a] -> MinQueue a
unions