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

module BinomialQueue.Internals (
  MinQueue (..),
  BinomHeap,
  BinomForest(..),
  BinomTree(..),
  Extract(..),
  MExtract(..),
  Succ(..),
  Zero(..),
  LEq,
  empty,
  extractHeap,
  null,
  size,
  getMin,
  minView,
  singleton,
  insert,
  insert',
  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 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. Ord a => a -> MinQueue a -> MinQueue a
insert 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 -> MinQueue a -> Bool
(==) = Maybe (a, MinQueue a) -> Maybe (a, MinQueue a) -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe (a, MinQueue a) -> Maybe (a, MinQueue a) -> Bool)
-> (MinQueue a -> Maybe (a, MinQueue a))
-> MinQueue a
-> MinQueue a
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MinQueue a -> Maybe (a, MinQueue a)
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 = Maybe (a, MinQueue a) -> Maybe (a, MinQueue a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Maybe (a, MinQueue a) -> Maybe (a, MinQueue a) -> Ordering)
-> (MinQueue a -> Maybe (a, MinQueue a))
-> MinQueue a
-> MinQueue a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` MinQueue a -> Maybe (a, MinQueue a)
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 and not obviously better
-- otherwise.
--
-- 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

-- | 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 = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue BinomHeap a
forall (rk :: * -> *) a. BinomForest rk a
Nil

-- | \(O(1)\). Is this the empty priority queue?
null :: MinQueue a -> Bool
null :: 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 :: MinQueue a -> Int
size (MinQueue BinomHeap a
hp) = Int -> Int -> BinomHeap a -> Int
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 :: Int -> Int -> BinomForest rk a -> Int
go Int
acc Int
rk BinomForest rk a
Nil = Int
rk Int -> Int -> Int
`seq` Int
acc
    go Int
acc Int
rk (Skip BinomForest (Succ rk) a
f) = Int -> Int -> BinomForest (Succ rk) a -> Int
forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go Int
acc (Int
2 Int -> Int -> Int
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) = Int -> Int -> BinomForest (Succ rk) a -> Int
forall (rk :: * -> *) a. Int -> Int -> BinomForest rk a -> Int
go (Int
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rk) (Int
2 Int -> Int -> Int
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 :: MinQueue a -> Maybe a
getMin MinQueue a
xs = case MinQueue a -> Maybe (a, MinQueue a)
forall a. Ord a => MinQueue a -> Maybe (a, MinQueue a)
minView MinQueue a
xs of
  Just (a
a, MinQueue a
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
  Maybe (a, MinQueue a)
Nothing -> 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 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
  MExtract Zero a
No -> Maybe (a, MinQueue a)
forall a. Maybe a
Nothing
  Yes (Extract a
x ~Zero a
Zero BinomHeap a
ts') -> (a, MinQueue a) -> Maybe (a, MinQueue a)
forall a. a -> Maybe a
Just (a
x, BinomHeap a -> MinQueue a
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 :: a -> MinQueue a
singleton a
x = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (BinomTree Zero a -> BinomForest (Succ Zero) a -> BinomHeap a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest (Succ rk) a -> BinomForest rk a
Cons (a -> BinomTree Zero a
forall a. a -> BinomTree Zero a
tip a
x) BinomForest (Succ Zero) 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
(<=)

-- | Takes the union of a list of priority queues. Equivalent to @'foldl'' 'union' 'empty'@.
unions :: Ord a => [MinQueue a] -> MinQueue a
unions :: [MinQueue a] -> MinQueue a
unions = (MinQueue a -> MinQueue a -> MinQueue a)
-> MinQueue a -> [MinQueue a] -> MinQueue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' MinQueue a -> MinQueue a -> MinQueue a
forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union MinQueue a
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 :: (a -> Maybe b) -> MinQueue a -> MinQueue b
mapMaybe a -> Maybe b
f (MinQueue BinomHeap a
ts) = (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
f (MinQueue BinomHeap a
ts) = (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

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

{-# 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 :: (a -> b -> b) -> b -> MinQueue a -> b
foldrAsc a -> b -> b
f b
z (MinQueue BinomHeap a
ts) = (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

-- | \(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 :: (a -> b -> b) -> b -> MinQueue a -> b
foldrDesc = (b -> a -> b) -> b -> MinQueue a -> b
forall a b. Ord a => (b -> a -> b) -> b -> MinQueue a -> b
foldlAsc ((b -> a -> b) -> b -> MinQueue a -> b)
-> ((a -> b -> b) -> b -> a -> b)
-> (a -> b -> b)
-> b
-> MinQueue a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> a -> b
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 :: (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
f b
z (MinQueue 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 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'

{-# INLINABLE [1] toAscList #-}
-- | \(O(n \log n)\). Extracts the elements of the priority queue in ascending order.
toAscList :: Ord a => MinQueue a -> [a]
toAscList :: MinQueue a -> [a]
toAscList MinQueue a
queue = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
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 :: MinQueue a -> [a] -> [a]
toAscListApp (MinQueue BinomHeap a
ts) [a]
app = (a -> [a] -> [a])
-> [a]
-> (BinomHeap a -> Maybe (a, BinomHeap a))
-> BinomHeap a
-> [a]
forall a c b. (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldrUnfold (:) [a]
app BinomHeap a -> Maybe (a, BinomHeap a)
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 :: MinQueue a -> [a]
toDescList MinQueue a
queue = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
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 :: MinQueue a -> [a] -> [a]
toDescListApp (MinQueue BinomHeap a
ts) [a]
app = ([a] -> a -> [a])
-> [a]
-> (BinomHeap a -> Maybe (a, BinomHeap a))
-> BinomHeap a
-> [a]
forall c a b. (c -> a -> c) -> c -> (b -> Maybe (a, b)) -> b -> c
foldlUnfold ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [a]
app BinomHeap a -> Maybe (a, BinomHeap a)
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 :: [a] -> MinQueue a
fromAscList [a]
xs = (MinQueue a -> a -> MinQueue a) -> MinQueue a -> [a] -> MinQueue a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> MinQueue a -> MinQueue a) -> MinQueue a -> a -> MinQueue a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> MinQueue a -> MinQueue a
forall a. a -> MinQueue a -> MinQueue a
insertMaxQ') MinQueue a
forall a. MinQueue a
empty [a]
xs

insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' :: LEq a -> a -> MinQueue a -> MinQueue a
insert' LEq a
le a
x (MinQueue BinomHeap a
ts)
  = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (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
le (MinQueue BinomHeap a
f1) (MinQueue BinomHeap a
f2) = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (LEq a -> BinomHeap a -> BinomHeap a -> BinomHeap a
forall a (rk :: * -> *).
LEq a -> BinomForest rk a -> BinomForest rk a -> BinomForest rk a
merge LEq a
le 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
  MExtract Zero a
No                        -> Maybe (a, BinomHeap a)
forall a. Maybe a
Nothing
  Yes (Extract a
x ~Zero a
Zero BinomHeap a
ts') -> (a, BinomHeap a) -> Maybe (a, BinomHeap a)
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 :: 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$ 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
le0 = LEq a -> BinomForest rk a -> MExtract rk a
forall a (rk :: * -> *). LEq a -> BinomForest rk a -> MExtract rk a
start LEq a
le0
  where
    start :: LEq a -> BinomForest rk a -> MExtract rk a
    start :: LEq a -> BinomForest rk a -> MExtract rk a
start LEq a
_le BinomForest rk a
Nil = MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
    start 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
start LEq a
le BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No     -> MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
      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)
    start 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 -> a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *).
LEq a -> a -> BinomForest rk a -> MExtract rk a
go LEq a
le a
x BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No -> 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)
      Yes Extract (Succ rk) a
ex -> 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

    go :: LEq a -> a -> BinomForest rk a -> MExtract rk a
    go :: LEq a -> a -> BinomForest rk a -> MExtract rk a
go LEq a
_le a
_min_above BinomForest rk a
Nil = a
_min_above a -> MExtract rk a -> MExtract rk a
`seq` MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
    go LEq a
le a
min_above (Skip BinomForest (Succ rk) a
f) = case LEq a -> a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *).
LEq a -> a -> BinomForest rk a -> MExtract rk a
go LEq a
le a
min_above BinomForest (Succ rk) a
f of
      MExtract (Succ rk) a
No -> MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
      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)
    go LEq a
le a
min_above (Cons t :: BinomTree rk a
t@(BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f)
      | a
min_above LEq a
`le` a
x = case LEq a -> a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *).
LEq a -> a -> BinomForest rk a -> MExtract rk a
go LEq a
le a
min_above BinomForest (Succ rk) a
f of
          MExtract (Succ rk) a
No -> MExtract rk a
forall (rk :: * -> *) a. MExtract rk a
No
          Yes Extract (Succ rk) a
ex -> Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (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)
      | Bool
otherwise = case LEq a -> a -> BinomForest (Succ rk) a -> MExtract (Succ rk) a
forall a (rk :: * -> *).
LEq a -> a -> BinomForest rk a -> MExtract rk a
go LEq a
le a
x BinomForest (Succ rk) a
f of
          MExtract (Succ rk) a
No -> Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (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))
          Yes Extract (Succ rk) a
ex -> Extract rk a -> MExtract rk a
forall (rk :: * -> *) a. Extract rk a -> MExtract rk a
Yes (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)

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 BinomHeap a
f) = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (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
-- or equal to 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
-- 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 BinomForest (Succ rk) a -> BinomForest rk a -> BinomForest rk a
`seq` 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)

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

-- | @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' :: a -> MinQueue a -> MinQueue a
insertMaxQ' a
x (MinQueue BinomHeap a
f) = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (BinomTree Zero a -> BinomHeap a -> BinomHeap a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' (a -> BinomTree Zero a
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' :: BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' 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
insertMax' 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
insertMax' BinomTree rk a
t (Cons (BinomTree a
x rk a
ts) BinomForest (Succ rk) a
f) = BinomForest (Succ rk) a -> BinomForest rk a
forall (rk :: * -> *) a.
BinomForest (Succ rk) a -> BinomForest rk a
Skip (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! BinomTree (Succ rk) a
-> BinomForest (Succ rk) a -> BinomForest (Succ rk) a
forall (rk :: * -> *) a.
BinomTree rk a -> BinomForest rk a -> BinomForest rk a
insertMax' (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

{-# INLINABLE fromList #-}
-- | \(O(n)\). Constructs a priority queue from an unordered list.
fromList :: Ord a => [a] -> MinQueue a
fromList :: [a] -> MinQueue a
fromList [a]
xs = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (LEq a -> [a] -> BinomHeap a
forall a. LEq a -> [a] -> BinomHeap a
fromListHeap LEq a
forall a. Ord a => a -> a -> Bool
(<=) [a]
xs)

{-# INLINE fromListHeap #-}
fromListHeap :: LEq a -> [a] -> BinomHeap a
fromListHeap :: LEq a -> [a] -> BinomHeap a
fromListHeap LEq a
le [a]
xs = (BinomHeap a -> a -> BinomHeap a)
-> BinomHeap a -> [a] -> BinomHeap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' BinomHeap a -> a -> BinomHeap a
go BinomHeap a
forall (rk :: * -> *) a. BinomForest rk a
Nil [a]
xs
  where
    go :: BinomHeap a -> a -> BinomHeap a
go BinomHeap a
fr 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
fr

-- | 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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

-- | Take the union of two queues and toss in an extra element.
unionPlusOne :: LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
unionPlusOne :: LEq a -> a -> MinQueue a -> MinQueue a -> MinQueue a
unionPlusOne LEq a
le a
a (MinQueue BinomHeap a
xs) (MinQueue BinomHeap a
ys) = BinomHeap a -> MinQueue a
forall a. BinomHeap a -> MinQueue a
MinQueue (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
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 :: 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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'
  -- 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)              -> 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
-- See Note [Amortization]
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
f' BinomForest (Succ rk) a -> BinomForest rk a -> BinomForest rk a
`seq` 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')
      -- 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.
    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

-- 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' :: 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 (BinomForest (Succ rk) a -> BinomForest rk a)
-> BinomForest (Succ rk) a -> BinomForest rk a
forall a b. (a -> b) -> a -> b
$! 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 Foldr Zero where
  foldr_ :: (a -> b -> b) -> b -> Zero a -> b
foldr_ a -> b -> b
_ b
z ~Zero a
Zero = b
z

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

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

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

instance Foldr rk => Foldr (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. Foldr t => (a -> b -> b) -> b -> t a -> b
foldr_ a -> b -> b
f ((a -> b -> b) -> b -> rk a -> b
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_ :: (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. Foldl 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. 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'_ :: (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.
Foldl' 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.
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_ :: (a -> m) -> Succ rk a -> m
foldMap_ a -> m
f (Succ BinomTree rk a
t rk a
ts) = (a -> m) -> BinomTree rk a -> m
forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomTree rk a
t m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> rk a -> m
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_ :: (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. 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_ :: (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. 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'_ :: (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.
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_ :: (a -> m) -> BinomTree rk a -> m
foldMap_ a -> m
f (BinomTree a
x rk a
ts) = a -> m
f a
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> rk a -> m
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_ :: (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. 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) = (a -> b -> b) -> b -> BinomTree rk a -> b
forall (t :: * -> *) a b. Foldr 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. 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_ :: (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. 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) = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a. Foldl 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. 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'_ :: (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.
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) = (b -> a -> b) -> b -> BinomForest (Succ rk) a -> b
forall (t :: * -> *) b a.
Foldl' 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.
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_ :: (a -> m) -> BinomForest rk a -> m
foldMap_ a -> m
_ BinomForest rk a
Nil = m
forall a. Monoid a => a
mempty
  foldMap_ a -> m
f (Skip BinomForest (Succ rk) a
tss)   = (a -> m) -> BinomForest (Succ rk) a -> m
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) = (a -> m) -> BinomTree rk a -> m
forall (t :: * -> *) m a.
(FoldMap t, Monoid m) =>
(a -> m) -> t a -> m
foldMap_ a -> m
f BinomTree rk a
t m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` (a -> m) -> BinomForest (Succ rk) a -> m
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 :: (a -> b) -> MinQueue a -> MinQueue b
mapU a -> b
f (MinQueue BinomHeap a
ts) = BinomHeap b -> MinQueue b
forall a. BinomHeap a -> MinQueue a
MinQueue (a -> b
f (a -> b) -> BinomHeap a -> BinomHeap b
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 :: (a -> b -> b) -> b -> MinQueue a -> b
foldrU a -> b -> b
f b
z (MinQueue BinomHeap a
ts) = (a -> b -> b) -> b -> BinomHeap a -> b
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 :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU b -> a -> b
f b
z (MinQueue BinomHeap a
ts) = (b -> a -> b) -> b -> BinomHeap a -> b
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' :: (b -> a -> b) -> b -> MinQueue a -> b
foldlU' b -> a -> b
f b
z (MinQueue BinomHeap a
ts) = (b -> a -> b) -> b -> BinomHeap a -> b
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 :: (a -> m) -> MinQueue a -> m
foldMapU a -> m
f (MinQueue BinomHeap a
ts) = (a -> m) -> BinomHeap a -> m
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 :: MinQueue a -> [a]
toListU MinQueue a
q = (a -> [a] -> [a]) -> [a] -> MinQueue a -> [a]
forall a b. (a -> b -> b) -> b -> MinQueue a -> b
foldrU (:) [] MinQueue a
q

{-# NOINLINE toListUApp #-}
toListUApp :: MinQueue a -> [a] -> [a]
toListUApp :: MinQueue a -> [a] -> [a]
toListUApp (MinQueue BinomHeap a
ts) [a]
app = (a -> [a] -> [a]) -> [a] -> BinomHeap a -> [a]
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 :: MinQueue a -> b -> b
seqSpine (MinQueue 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

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 BinomHeap a
ts) = BinomHeap a -> ()
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    [Char] -> ShowS
showString [Char]
"fromAscList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> ShowS
forall a. Show a => a -> ShowS
shows (MinQueue a -> [a]
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 = ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (MinQueue a) -> ReadPrec (MinQueue a))
-> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (MinQueue a) -> ReadPrec (MinQueue a))
-> ReadPrec (MinQueue a) -> ReadPrec (MinQueue a)
forall a b. (a -> b) -> a -> b
$ do
    Ident [Char]
"fromAscList" <- ReadPrec Lexeme
lexP
    [a]
xs <- ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec
    MinQueue a -> ReadPrec (MinQueue a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> MinQueue a
forall a. [a] -> MinQueue a
fromAscList [a]
xs)

  readListPrec :: ReadPrec [MinQueue a]
readListPrec = ReadPrec [MinQueue a]
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
(<>) = MinQueue a -> MinQueue a -> MinQueue a
forall a. Ord a => MinQueue a -> MinQueue a -> MinQueue a
union
  stimes :: b -> MinQueue a -> MinQueue a
stimes = b -> MinQueue a -> MinQueue a
forall b a. (Integral b, Monoid a) => b -> a -> a
stimesMonoid
#endif

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