{-# LANGUAGE BangPatterns #-}{-# OPTIONS_HADDOCK not-home #-}-- |---- = WARNING---- This module is considered __internal__.---- The Package Versioning Policy __does not apply__.---- The contents of this module may change __in any way whatsoever__-- and __without any warning__ between minor versions of this package.---- Authors importing this module are expected to track development-- closely.---- = Description---- This module provides the various sorting implementations for-- "Data.Sequence". Further notes are available in the file sorting.md-- (in this directory).moduleData.Sequence.Internal.Sorting(-- * Sort Functionssort ,sortBy ,sortOn ,unstableSort ,unstableSortBy ,unstableSortOn ,-- * Heaps-- $heapsQueue (..),QList (..),IndexedQueue (..),IQList (..),TaggedQueue (..),TQList (..),IndexedTaggedQueue (..),ITQList (..),-- * Merges-- $mergesmergeQ ,mergeIQ ,mergeTQ ,mergeITQ ,-- * popMin-- $popMinpopMinQ ,popMinIQ ,popMinTQ ,popMinITQ ,-- * Building-- $buildingbuildQ ,buildIQ ,buildTQ ,buildITQ ,-- * Special folds-- $foldsfoldToMaybeTree ,foldToMaybeWithIndexTree )whereimportData.Sequence.Internal (Elem (..),Seq (..),Node (..),Digit (..),Sized (..),FingerTree (..),replicateA ,foldDigit ,foldNode ,foldWithIndexDigit ,foldWithIndexNode )importUtils.Containers.Internal.State (State (..),execState )-- | \( O(n \log n) \). 'sort' sorts the specified 'Seq' by the natural-- ordering of its elements. The sort is stable, meaning the order of equal-- elements is preserved. If stability is not-- required, 'unstableSort' can be slightly faster.---- @since 0.3.0sort ::Orda =>Seq a ->Seq a sort :: forall a. Ord a => Seq a -> Seq a
sort =(a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare-- | \( O(n \log n) \). 'sortBy' sorts the specified 'Seq' according to the-- specified comparator. The sort is stable, meaning the order of equal-- elements is preserved. If stability is not required,-- 'unstableSortBy' can be slightly faster.---- @since 0.3.0sortBy ::(a ->a ->Ordering)->Seq a ->Seq a sortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
sortBy a -> a -> Ordering
cmp (Seq FingerTree (Elem a)
xs )=Seq a
-> (IndexedQueue a -> Seq a) -> Maybe (IndexedQueue a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT )(State (IndexedQueue a) (Seq a) -> IndexedQueue a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (IndexedQueue a) a -> State (IndexedQueue a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs )((IndexedQueue a -> (IndexedQueue a, a)) -> State (IndexedQueue a) a
forall s a. (s -> (s, a)) -> State s a
State ((a -> a -> Ordering) -> IndexedQueue a -> (IndexedQueue a, a)
forall e.
(e -> e -> Ordering) -> IndexedQueue e -> (IndexedQueue e, e)
popMinIQ a -> a -> Ordering
cmp ))))((a -> a -> Ordering)
-> (Int -> Elem a -> IndexedQueue a)
-> Int
-> FingerTree (Elem a)
-> Maybe (IndexedQueue a)
forall b y.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
buildIQ a -> a -> Ordering
cmp (\Int
s (Elem a
x )->Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
s a
x IQList a
forall e. IQList e
IQNil )Int
0FingerTree (Elem a)
xs )-- | \( O(n \log n) \). 'sortOn' sorts the specified 'Seq' by comparing-- the results of a key function applied to each element. The sort is stable,-- meaning the order of equal elements is preserved. @'sortOn' f@ is-- equivalent to @'sortBy' ('compare' ``Data.Function.on`` f)@, but has the-- performance advantage of only evaluating @f@ once for each element in the-- input 'Seq'.---- An example of using 'sortOn' might be to sort a 'Seq' of strings-- according to their length:---- > sortOn length (fromList ["alligator", "monkey", "zebra"]) == fromList ["zebra", "monkey", "alligator"]---- If, instead, 'sortBy' had been used, 'length' would be evaluated on-- every comparison, giving \( O(n \log n) \) evaluations, rather than-- \( O(n) \).---- If @f@ is very cheap (for example a record selector, or 'fst'),-- @'sortBy' ('compare' ``Data.Function.on`` f)@ will be faster than-- @'sortOn' f@.---- @since 0.5.11sortOn ::Ordb =>(a ->b )->Seq a ->Seq a sortOn :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
sortOn a -> b
f (Seq FingerTree (Elem a)
xs )=Seq a
-> (IndexedTaggedQueue b a -> Seq a)
-> Maybe (IndexedTaggedQueue b a)
-> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT )(State (IndexedTaggedQueue b a) (Seq a)
-> IndexedTaggedQueue b a -> Seq a
forall s a. State s a -> s -> a
execState (Int
-> State (IndexedTaggedQueue b a) a
-> State (IndexedTaggedQueue b a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs )((IndexedTaggedQueue b a -> (IndexedTaggedQueue b a, a))
-> State (IndexedTaggedQueue b a) a
forall s a. (s -> (s, a)) -> State s a
State ((b -> b -> Ordering)
-> IndexedTaggedQueue b a -> (IndexedTaggedQueue b a, a)
forall e b.
(e -> e -> Ordering)
-> IndexedTaggedQueue e b -> (IndexedTaggedQueue e b, b)
popMinITQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare))))((b -> b -> Ordering)
-> (Int -> Elem a -> IndexedTaggedQueue b a)
-> Int
-> FingerTree (Elem a)
-> Maybe (IndexedTaggedQueue b a)
forall b y c.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
buildITQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare(\Int
s (Elem a
x )->Int -> b -> a -> ITQList b a -> IndexedTaggedQueue b a
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
s (a -> b
f a
x )a
x ITQList b a
forall e a. ITQList e a
ITQNil )Int
0FingerTree (Elem a)
xs )-- | \( O(n \log n) \). 'unstableSort' sorts the specified 'Seq' by-- the natural ordering of its elements, but the sort is not stable.-- This algorithm is frequently faster and uses less memory than 'sort'.-- Notes on the implementation and choice of heap are available in-- the file sorting.md (in this directory).---- @since 0.3.0unstableSort ::Orda =>Seq a ->Seq a unstableSort :: forall a. Ord a => Seq a -> Seq a
unstableSort =(a -> a -> Ordering) -> Seq a -> Seq a
forall a. (a -> a -> Ordering) -> Seq a -> Seq a
unstableSortBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare-- | \( O(n \log n) \). A generalization of 'unstableSort', 'unstableSortBy'-- takes an arbitrary comparator and sorts the specified sequence.-- The sort is not stable. This algorithm is frequently faster and-- uses less memory than 'sortBy'.---- @since 0.3.0unstableSortBy ::(a ->a ->Ordering)->Seq a ->Seq a unstableSortBy :: forall a. (a -> a -> Ordering) -> Seq a -> Seq a
unstableSortBy a -> a -> Ordering
cmp (Seq FingerTree (Elem a)
xs )=Seq a -> (Queue a -> Seq a) -> Maybe (Queue a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT )(State (Queue a) (Seq a) -> Queue a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (Queue a) a -> State (Queue a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs )((Queue a -> (Queue a, a)) -> State (Queue a) a
forall s a. (s -> (s, a)) -> State s a
State ((a -> a -> Ordering) -> Queue a -> (Queue a, a)
forall e. (e -> e -> Ordering) -> Queue e -> (Queue e, e)
popMinQ a -> a -> Ordering
cmp ))))((a -> a -> Ordering)
-> (Elem a -> Queue a) -> FingerTree (Elem a) -> Maybe (Queue a)
forall b a.
(b -> b -> Ordering)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
buildQ a -> a -> Ordering
cmp (\(Elem a
x )->a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x QList a
forall e. QList e
Nil )FingerTree (Elem a)
xs )-- | \( O(n \log n) \). 'unstableSortOn' sorts the specified 'Seq' by-- comparing the results of a key function applied to each element.-- @'unstableSortOn' f@ is equivalent to @'unstableSortBy' ('compare' ``Data.Function.on`` f)@,-- but has the performance advantage of only evaluating @f@ once for each-- element in the input 'Seq'.---- An example of using 'unstableSortOn' might be to sort a 'Seq' of strings-- according to their length:---- > unstableSortOn length (fromList ["alligator", "monkey", "zebra"]) == fromList ["zebra", "monkey", "alligator"]---- If, instead, 'unstableSortBy' had been used, 'length' would be evaluated on-- every comparison, giving \( O(n \log n) \) evaluations, rather than-- \( O(n) \).---- If @f@ is very cheap (for example a record selector, or 'fst'),-- @'unstableSortBy' ('compare' ``Data.Function.on`` f)@ will be faster than-- @'unstableSortOn' f@.---- @since 0.5.11unstableSortOn ::Ordb =>(a ->b )->Seq a ->Seq a unstableSortOn :: forall b a. Ord b => (a -> b) -> Seq a -> Seq a
unstableSortOn a -> b
f (Seq FingerTree (Elem a)
xs )=Seq a
-> (TaggedQueue b a -> Seq a) -> Maybe (TaggedQueue b a) -> Seq a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(FingerTree (Elem a) -> Seq a
forall a. FingerTree (Elem a) -> Seq a
Seq FingerTree (Elem a)
forall a. FingerTree a
EmptyT )(State (TaggedQueue b a) (Seq a) -> TaggedQueue b a -> Seq a
forall s a. State s a -> s -> a
execState (Int -> State (TaggedQueue b a) a -> State (TaggedQueue b a) (Seq a)
forall (f :: * -> *) a. Applicative f => Int -> f a -> f (Seq a)
replicateA (FingerTree (Elem a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Elem a)
xs )((TaggedQueue b a -> (TaggedQueue b a, a))
-> State (TaggedQueue b a) a
forall s a. (s -> (s, a)) -> State s a
State ((b -> b -> Ordering) -> TaggedQueue b a -> (TaggedQueue b a, a)
forall a b.
(a -> a -> Ordering) -> TaggedQueue a b -> (TaggedQueue a b, b)
popMinTQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare))))((b -> b -> Ordering)
-> (Elem a -> TaggedQueue b a)
-> FingerTree (Elem a)
-> Maybe (TaggedQueue b a)
forall b a c.
(b -> b -> Ordering)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
buildTQ b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare(\(Elem a
x )->b -> a -> TQList b a -> TaggedQueue b a
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ (a -> b
f a
x )a
x TQList b a
forall a b. TQList a b
TQNil )FingerTree (Elem a)
xs )-------------------------------------------------------------------------- $heaps---- The following are definitions for various specialized pairing heaps.---- All of the heaps are defined to be non-empty, which speeds up the-- merge functions.-------------------------------------------------------------------------- | A simple pairing heap.dataQueue e =Q !e (QList e )dataQList e =Nil |QCons {-# UNPACK#-}!(Queue e )(QList e )-- | A pairing heap tagged with the original position of elements,-- to allow for stable sorting.dataIndexedQueue e =IQ {-# UNPACK#-}!Int!e (IQList e )dataIQList e =IQNil |IQCons {-# UNPACK#-}!(IndexedQueue e )(IQList e )-- | A pairing heap tagged with some key for sorting elements, for use-- in 'unstableSortOn'.dataTaggedQueue a b =TQ !a b (TQList a b )dataTQList a b =TQNil |TQCons {-# UNPACK#-}!(TaggedQueue a b )(TQList a b )-- | A pairing heap tagged with both a key and the original position-- of its elements, for use in 'sortOn'.dataIndexedTaggedQueue e a =ITQ {-# UNPACK#-}!Int!e a (ITQList e a )dataITQList e a =ITQNil |ITQCons {-# UNPACK#-}!(IndexedTaggedQueue e a )(ITQList e a )infixr8`ITQCons` ,`TQCons` ,`QCons` ,`IQCons` -------------------------------------------------------------------------- $merges---- The following are definitions for "merge" for each of the heaps-- above. Each takes a comparison function which is used to order the-- elements.-------------------------------------------------------------------------- | 'mergeQ' merges two 'Queue's.mergeQ ::(a ->a ->Ordering)->Queue a ->Queue a ->Queue a mergeQ :: forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ a -> a -> Ordering
cmp q1 :: Queue a
q1 @(Q a
x1 QList a
ts1 )q2 :: Queue a
q2 @(Q a
x2 QList a
ts2 )|a -> a -> Ordering
cmp a
x1 a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==Ordering
GT=a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x2 (Queue a
q1 Queue a -> QList a -> QList a
forall e. Queue e -> QList e -> QList e
`QCons` QList a
ts2 )|Bool
otherwise=a -> QList a -> Queue a
forall e. e -> QList e -> Queue e
Q a
x1 (Queue a
q2 Queue a -> QList a -> QList a
forall e. Queue e -> QList e -> QList e
`QCons` QList a
ts1 )-- | 'mergeTQ' merges two 'TaggedQueue's, based on the tag value.mergeTQ ::(a ->a ->Ordering)->TaggedQueue a b ->TaggedQueue a b ->TaggedQueue a b mergeTQ :: forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ a -> a -> Ordering
cmp q1 :: TaggedQueue a b
q1 @(TQ a
x1 b
y1 TQList a b
ts1 )q2 :: TaggedQueue a b
q2 @(TQ a
x2 b
y2 TQList a b
ts2 )|a -> a -> Ordering
cmp a
x1 a
x2 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
==Ordering
GT=a -> b -> TQList a b -> TaggedQueue a b
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ a
x2 b
y2 (TaggedQueue a b
q1 TaggedQueue a b -> TQList a b -> TQList a b
forall a b. TaggedQueue a b -> TQList a b -> TQList a b
`TQCons` TQList a b
ts2 )|Bool
otherwise=a -> b -> TQList a b -> TaggedQueue a b
forall a b. a -> b -> TQList a b -> TaggedQueue a b
TQ a
x1 b
y1 (TaggedQueue a b
q2 TaggedQueue a b -> TQList a b -> TQList a b
forall a b. TaggedQueue a b -> TQList a b -> TQList a b
`TQCons` TQList a b
ts1 )-- | 'mergeIQ' merges two 'IndexedQueue's, taking into account the-- original position of the elements.mergeIQ ::(a ->a ->Ordering)->IndexedQueue a ->IndexedQueue a ->IndexedQueue a mergeIQ :: forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ a -> a -> Ordering
cmp q1 :: IndexedQueue a
q1 @(IQ Int
i1 a
x1 IQList a
ts1 )q2 :: IndexedQueue a
q2 @(IQ Int
i2 a
x2 IQList a
ts2 )=casea -> a -> Ordering
cmp a
x1 a
x2 ofOrdering
LT->Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i1 a
x1 (IndexedQueue a
q2 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts1 )Ordering
EQ|Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i2 ->Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i1 a
x1 (IndexedQueue a
q2 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts1 )Ordering
_->Int -> a -> IQList a -> IndexedQueue a
forall e. Int -> e -> IQList e -> IndexedQueue e
IQ Int
i2 a
x2 (IndexedQueue a
q1 IndexedQueue a -> IQList a -> IQList a
forall e. IndexedQueue e -> IQList e -> IQList e
`IQCons` IQList a
ts2 )-- | 'mergeITQ' merges two 'IndexedTaggedQueue's, based on the tag-- value, taking into account the original position of the elements.mergeITQ ::(a ->a ->Ordering)->IndexedTaggedQueue a b ->IndexedTaggedQueue a b ->IndexedTaggedQueue a b mergeITQ :: forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ a -> a -> Ordering
cmp q1 :: IndexedTaggedQueue a b
q1 @(ITQ Int
i1 a
x1 b
y1 ITQList a b
ts1 )q2 :: IndexedTaggedQueue a b
q2 @(ITQ Int
i2 a
x2 b
y2 ITQList a b
ts2 )=casea -> a -> Ordering
cmp a
x1 a
x2 ofOrdering
LT->Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i1 a
x1 b
y1 (IndexedTaggedQueue a b
q2 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts1 )Ordering
EQ|Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
i2 ->Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i1 a
x1 b
y1 (IndexedTaggedQueue a b
q2 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts1 )Ordering
_->Int -> a -> b -> ITQList a b -> IndexedTaggedQueue a b
forall e a. Int -> e -> a -> ITQList e a -> IndexedTaggedQueue e a
ITQ Int
i2 a
x2 b
y2 (IndexedTaggedQueue a b
q1 IndexedTaggedQueue a b -> ITQList a b -> ITQList a b
forall e a. IndexedTaggedQueue e a -> ITQList e a -> ITQList e a
`ITQCons` ITQList a b
ts2 )-------------------------------------------------------------------------- $popMin---- The following are definitions for @popMin@, a function which-- constructs a stateful action which pops the smallest element from the-- queue, where "smallest" is according to the supplied comparison-- function.---- All of the functions fail on an empty queue.---- Each of these functions is structured something like this:---- @popMinQ cmp (Q x ts) = (mergeQs ts, x)@---- The reason the call to @mergeQs@ is lazy is that it will be bottom-- for the last element in the queue, preventing us from evaluating the-- fully sorted sequence.-------------------------------------------------------------------------- | Pop the smallest element from the queue, using the supplied-- comparator.popMinQ ::(e ->e ->Ordering)->Queue e ->(Queue e ,e )popMinQ :: forall e. (e -> e -> Ordering) -> Queue e -> (Queue e, e)
popMinQ e -> e -> Ordering
cmp (Q e
x QList e
xs )=(QList e -> Queue e
mergeQs QList e
xs ,e
x )wheremergeQs :: QList e -> Queue e
mergeQs (Queue e
t `QCons` QList e
Nil )=Queue e
t mergeQs (Queue e
t1 `QCons` Queue e
t2 `QCons` QList e
Nil )=Queue e
t1 Queue e -> Queue e -> Queue e
<+> Queue e
t2 mergeQs (Queue e
t1 `QCons` Queue e
t2 `QCons` QList e
ts )=(Queue e
t1 Queue e -> Queue e -> Queue e
<+> Queue e
t2 )Queue e -> Queue e -> Queue e
<+> QList e -> Queue e
mergeQs QList e
ts mergeQs QList e
Nil =[Char] -> Queue e
forall a. HasCallStack => [Char] -> a
error[Char]
"popMinQ: tried to pop from empty queue"<+> :: Queue e -> Queue e -> Queue e
(<+>) =(e -> e -> Ordering) -> Queue e -> Queue e -> Queue e
forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ e -> e -> Ordering
cmp -- | Pop the smallest element from the queue, using the supplied-- comparator, deferring to the item's original position when the-- comparator returns 'EQ'.popMinIQ ::(e ->e ->Ordering)->IndexedQueue e ->(IndexedQueue e ,e )popMinIQ :: forall e.
(e -> e -> Ordering) -> IndexedQueue e -> (IndexedQueue e, e)
popMinIQ e -> e -> Ordering
cmp (IQ Int
_e
x IQList e
xs )=(IQList e -> IndexedQueue e
mergeQs IQList e
xs ,e
x )wheremergeQs :: IQList e -> IndexedQueue e
mergeQs (IndexedQueue e
t `IQCons` IQList e
IQNil )=IndexedQueue e
t mergeQs (IndexedQueue e
t1 `IQCons` IndexedQueue e
t2 `IQCons` IQList e
IQNil )=IndexedQueue e
t1 IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IndexedQueue e
t2 mergeQs (IndexedQueue e
t1 `IQCons` IndexedQueue e
t2 `IQCons` IQList e
ts )=(IndexedQueue e
t1 IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IndexedQueue e
t2 )IndexedQueue e -> IndexedQueue e -> IndexedQueue e
<+> IQList e -> IndexedQueue e
mergeQs IQList e
ts mergeQs IQList e
IQNil =[Char] -> IndexedQueue e
forall a. HasCallStack => [Char] -> a
error[Char]
"popMinQ: tried to pop from empty queue"<+> :: IndexedQueue e -> IndexedQueue e -> IndexedQueue e
(<+>) =(e -> e -> Ordering)
-> IndexedQueue e -> IndexedQueue e -> IndexedQueue e
forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ e -> e -> Ordering
cmp -- | Pop the smallest element from the queue, using the supplied-- comparator on the tag.popMinTQ ::(a ->a ->Ordering)->TaggedQueue a b ->(TaggedQueue a b ,b )popMinTQ :: forall a b.
(a -> a -> Ordering) -> TaggedQueue a b -> (TaggedQueue a b, b)
popMinTQ a -> a -> Ordering
cmp (TQ a
_b
x TQList a b
xs )=(TQList a b -> TaggedQueue a b
forall {b}. TQList a b -> TaggedQueue a b
mergeQs TQList a b
xs ,b
x )wheremergeQs :: TQList a b -> TaggedQueue a b
mergeQs (TaggedQueue a b
t `TQCons` TQList a b
TQNil )=TaggedQueue a b
t mergeQs (TaggedQueue a b
t1 `TQCons` TaggedQueue a b
t2 `TQCons` TQList a b
TQNil )=TaggedQueue a b
t1 TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TaggedQueue a b
t2 mergeQs (TaggedQueue a b
t1 `TQCons` TaggedQueue a b
t2 `TQCons` TQList a b
ts )=(TaggedQueue a b
t1 TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TaggedQueue a b
t2 )TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall {b}. TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
<+> TQList a b -> TaggedQueue a b
mergeQs TQList a b
ts mergeQs TQList a b
TQNil =[Char] -> TaggedQueue a b
forall a. HasCallStack => [Char] -> a
error[Char]
"popMinQ: tried to pop from empty queue"<+> :: TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
(<+>) =(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ a -> a -> Ordering
cmp -- | Pop the smallest element from the queue, using the supplied-- comparator on the tag, deferring to the item's original position-- when the comparator returns 'EQ'.popMinITQ ::(e ->e ->Ordering)->IndexedTaggedQueue e b ->(IndexedTaggedQueue e b ,b )popMinITQ :: forall e b.
(e -> e -> Ordering)
-> IndexedTaggedQueue e b -> (IndexedTaggedQueue e b, b)
popMinITQ e -> e -> Ordering
cmp (ITQ Int
_e
_b
x ITQList e b
xs )=(ITQList e b -> IndexedTaggedQueue e b
forall {a}. ITQList e a -> IndexedTaggedQueue e a
mergeQs ITQList e b
xs ,b
x )wheremergeQs :: ITQList e a -> IndexedTaggedQueue e a
mergeQs (IndexedTaggedQueue e a
t `ITQCons` ITQList e a
ITQNil )=IndexedTaggedQueue e a
t mergeQs (IndexedTaggedQueue e a
t1 `ITQCons` IndexedTaggedQueue e a
t2 `ITQCons` ITQList e a
ITQNil )=IndexedTaggedQueue e a
t1 IndexedTaggedQueue e a
-> IndexedTaggedQueue e a -> IndexedTaggedQueue e a
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> IndexedTaggedQueue e a
t2 mergeQs (IndexedTaggedQueue e a
t1 `ITQCons` IndexedTaggedQueue e a
t2 `ITQCons` ITQList e a
ts )=(IndexedTaggedQueue e a
t1 IndexedTaggedQueue e a
-> IndexedTaggedQueue e a -> IndexedTaggedQueue e a
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> IndexedTaggedQueue e a
t2 )IndexedTaggedQueue e a
-> IndexedTaggedQueue e a -> IndexedTaggedQueue e a
forall {b}.
IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
<+> ITQList e a -> IndexedTaggedQueue e a
mergeQs ITQList e a
ts mergeQs ITQList e a
ITQNil =[Char] -> IndexedTaggedQueue e a
forall a. HasCallStack => [Char] -> a
error[Char]
"popMinQ: tried to pop from empty queue"<+> :: IndexedTaggedQueue e b
-> IndexedTaggedQueue e b -> IndexedTaggedQueue e b
(<+>) =(e -> e -> Ordering)
-> IndexedTaggedQueue e b
-> IndexedTaggedQueue e b
-> IndexedTaggedQueue e b
forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ e -> e -> Ordering
cmp -------------------------------------------------------------------------- $building---- The following are definitions for functions to build queues, given a-- comparison function.------------------------------------------------------------------------buildQ ::(b ->b ->Ordering)->(a ->Queue b )->FingerTree a ->Maybe(Queue b )buildQ :: forall b a.
(b -> b -> Ordering)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
buildQ b -> b -> Ordering
cmp =(Queue b -> Queue b -> Queue b)
-> (a -> Queue b) -> FingerTree a -> Maybe (Queue b)
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree ((b -> b -> Ordering) -> Queue b -> Queue b -> Queue b
forall a. (a -> a -> Ordering) -> Queue a -> Queue a -> Queue a
mergeQ b -> b -> Ordering
cmp )buildIQ ::(b ->b ->Ordering)->(Int->Elem y ->IndexedQueue b )->Int->FingerTree (Elem y )->Maybe(IndexedQueue b )buildIQ :: forall b y.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
buildIQ b -> b -> Ordering
cmp =(IndexedQueue b -> IndexedQueue b -> IndexedQueue b)
-> (Int -> Elem y -> IndexedQueue b)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedQueue b)
forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree ((b -> b -> Ordering)
-> IndexedQueue b -> IndexedQueue b -> IndexedQueue b
forall a.
(a -> a -> Ordering)
-> IndexedQueue a -> IndexedQueue a -> IndexedQueue a
mergeIQ b -> b -> Ordering
cmp )buildTQ ::(b ->b ->Ordering)->(a ->TaggedQueue b c )->FingerTree a ->Maybe(TaggedQueue b c )buildTQ :: forall b a c.
(b -> b -> Ordering)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
buildTQ b -> b -> Ordering
cmp =(TaggedQueue b c -> TaggedQueue b c -> TaggedQueue b c)
-> (a -> TaggedQueue b c)
-> FingerTree a
-> Maybe (TaggedQueue b c)
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree ((b -> b -> Ordering)
-> TaggedQueue b c -> TaggedQueue b c -> TaggedQueue b c
forall a b.
(a -> a -> Ordering)
-> TaggedQueue a b -> TaggedQueue a b -> TaggedQueue a b
mergeTQ b -> b -> Ordering
cmp )buildITQ ::(b ->b ->Ordering)->(Int->Elem y ->IndexedTaggedQueue b c )->Int->FingerTree (Elem y )->Maybe(IndexedTaggedQueue b c )buildITQ :: forall b y c.
(b -> b -> Ordering)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
buildITQ b -> b -> Ordering
cmp =(IndexedTaggedQueue b c
 -> IndexedTaggedQueue b c -> IndexedTaggedQueue b c)
-> (Int -> Elem y -> IndexedTaggedQueue b c)
-> Int
-> FingerTree (Elem y)
-> Maybe (IndexedTaggedQueue b c)
forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree ((b -> b -> Ordering)
-> IndexedTaggedQueue b c
-> IndexedTaggedQueue b c
-> IndexedTaggedQueue b c
forall a b.
(a -> a -> Ordering)
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
-> IndexedTaggedQueue a b
mergeITQ b -> b -> Ordering
cmp )-------------------------------------------------------------------------- $folds---- A big part of what makes the heaps fast is that they're non empty,-- so the merge function can avoid an extra case match. To take-- advantage of this, though, we need specialized versions of 'foldMap'-- and 'Data.Sequence.foldMapWithIndex', which can alternate between-- calling the faster semigroup-like merge when folding over non empty-- structures (like 'Node' and 'Digit'), and the-- 'Data.Semirgroup.Option'-like mappend, when folding over structures-- which can be empty (like 'FingerTree').-------------------------------------------------------------------------- | A 'foldMap'-like function, specialized to the-- 'Data.Semigroup.Option' monoid, which takes advantage of the-- internal structure of 'Seq' to avoid wrapping in 'Maybe' at certain-- points.foldToMaybeTree ::(b ->b ->b )->(a ->b )->FingerTree a ->Maybeb foldToMaybeTree :: forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree b -> b -> b
_a -> b
_FingerTree a
EmptyT =Maybe b
forall a. Maybe a
NothingfoldToMaybeTree b -> b -> b
_a -> b
f (Single a
xs )=b -> Maybe b
forall a. a -> Maybe a
Just(a -> b
f a
xs )foldToMaybeTree b -> b -> b
(<+>) a -> b
f (Deep Int
_Digit a
pr FingerTree (Node a)
m Digit a
sf )=b -> Maybe b
forall a. a -> Maybe a
Just(b -> (b -> b) -> Maybe b -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(b
pr' b -> b -> b
<+> b
sf' )((b
pr' b -> b -> b
<+> b
sf' )b -> b -> b
<+> )Maybe b
m' )wherepr' :: b
pr' =(b -> b -> b) -> (a -> b) -> Digit a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
(<+>) a -> b
f Digit a
pr sf' :: b
sf' =(b -> b -> b) -> (a -> b) -> Digit a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Digit a -> b
foldDigit b -> b -> b
(<+>) a -> b
f Digit a
sf m' :: Maybe b
m' =(b -> b -> b) -> (Node a -> b) -> FingerTree (Node a) -> Maybe b
forall b a. (b -> b -> b) -> (a -> b) -> FingerTree a -> Maybe b
foldToMaybeTree b -> b -> b
(<+>) ((b -> b -> b) -> (a -> b) -> Node a -> b
forall b a. (b -> b -> b) -> (a -> b) -> Node a -> b
foldNode b -> b -> b
(<+>) a -> b
f )FingerTree (Node a)
m -- | A 'Data.Sequence.foldMapWithIndex'-like function, specialized to the-- 'Data.Semigroup.Option' monoid, which takes advantage of the-- internal structure of 'Seq' to avoid wrapping in 'Maybe' at certain-- points.foldToMaybeWithIndexTree ::(b ->b ->b )->(Int->Elem y ->b )->Int->FingerTree (Elem y )->Maybeb foldToMaybeWithIndexTree :: forall b y.
(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
foldToMaybeWithIndexTree =(b -> b -> b)
-> (Int -> Elem y -> b) -> Int -> FingerTree (Elem y) -> Maybe b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree' where{-# SPECIALISEfoldToMaybeWithIndexTree' ::(b ->b ->b )->(Int->Elem y ->b )->Int->FingerTree (Elem y )->Maybeb #-}{-# SPECIALISEfoldToMaybeWithIndexTree' ::(b ->b ->b )->(Int->Node y ->b )->Int->FingerTree (Node y )->Maybeb #-}foldToMaybeWithIndexTree' ::Sized a =>(b ->b ->b )->(Int->a ->b )->Int->FingerTree a ->Maybeb foldToMaybeWithIndexTree' :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree' b -> b -> b
_Int -> a -> b
_!Int
_s FingerTree a
EmptyT =Maybe b
forall a. Maybe a
NothingfoldToMaybeWithIndexTree' b -> b -> b
_Int -> a -> b
f Int
s (Single a
xs )=b -> Maybe b
forall a. a -> Maybe a
Just(Int -> a -> b
f Int
s a
xs )foldToMaybeWithIndexTree' b -> b -> b
(<+>) Int -> a -> b
f Int
s (Deep Int
_Digit a
pr FingerTree (Node a)
m Digit a
sf )=b -> Maybe b
forall a. a -> Maybe a
Just(b -> (b -> b) -> Maybe b -> b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe(b
pr' b -> b -> b
<+> b
sf' )((b
pr' b -> b -> b
<+> b
sf' )b -> b -> b
<+> )Maybe b
m' )wherepr' :: b
pr' =(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit b -> b -> b
(<+>) Int -> a -> b
f Int
s Digit a
pr sf' :: b
sf' =(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit b -> b -> b
(<+>) Int -> a -> b
f Int
sPsprm Digit a
sf m' :: Maybe b
m' =(b -> b -> b)
-> (Int -> Node a -> b) -> Int -> FingerTree (Node a) -> Maybe b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> FingerTree a -> Maybe b
foldToMaybeWithIndexTree' b -> b -> b
(<+>) ((b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
node b -> b -> b
(<+>) Int -> a -> b
f )Int
sPspr FingerTree (Node a)
m !sPspr :: Int
sPspr =Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+Digit a -> Int
forall a. Sized a => a -> Int
size Digit a
pr !sPsprm :: Int
sPsprm =Int
sPspr Int -> Int -> Int
forall a. Num a => a -> a -> a
+FingerTree (Node a) -> Int
forall a. Sized a => a -> Int
size FingerTree (Node a)
m {-# SPECIALISEdigit ::(b ->b ->b )->(Int->Elem y ->b )->Int->Digit (Elem y )->b #-}{-# SPECIALISEdigit ::(b ->b ->b )->(Int->Node y ->b )->Int->Digit (Node y )->b #-}digit ::Sized a =>(b ->b ->b )->(Int->a ->b )->Int->Digit a ->b digit :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
digit =(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Digit a -> b
foldWithIndexDigit {-# SPECIALISEnode ::(b ->b ->b )->(Int->Elem y ->b )->Int->Node (Elem y )->b #-}{-# SPECIALISEnode ::(b ->b ->b )->(Int->Node y ->b )->Int->Node (Node y )->b #-}node ::Sized a =>(b ->b ->b )->(Int->a ->b )->Int->Node a ->b node :: forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
node =(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
forall a b.
Sized a =>
(b -> b -> b) -> (Int -> a -> b) -> Int -> Node a -> b
foldWithIndexNode {-# INLINEfoldToMaybeWithIndexTree #-}