{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE DeriveFoldable    #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE UnboxedTuples     #-}
module Data.IntPSQ.Internal
    ( -- * Type
      Nat
    , Key
    , Mask
    , IntPSQ (..)

      -- * Query
    , null
    , size
    , member
    , lookup
    , findMin

      -- * Construction
    , empty
    , singleton

      -- * Insertion
    , insert

      -- * Delete/update
    , delete
    , deleteMin
    , alter
    , alterMin

      -- * Lists
    , fromList
    , toList
    , keys

      -- * Views
    , insertView
    , deleteView
    , minView
    , atMostView

      -- * Traversal
    , map
    , unsafeMapMonotonic
    , fold'

      -- * Unsafe manipulation
    , unsafeInsertNew
    , unsafeInsertIncreasePriority
    , unsafeInsertIncreasePriorityView
    , unsafeInsertWithIncreasePriority
    , unsafeInsertWithIncreasePriorityView
    , unsafeLookupIncreasePriority

      -- * Testing
    , valid
    , hasBadNils
    , hasDuplicateKeys
    , hasMinHeapProperty
    , validMask
    ) where

import           Control.Applicative ((<$>), (<*>))
import           Control.DeepSeq     (NFData (rnf))
import           Data.Bits
import           Data.BitUtil
import           Data.Foldable       (Foldable)
import           Data.List           (foldl')
import qualified Data.List           as List
import           Data.Maybe          (isJust)
import           Data.Traversable
import           Data.Word           (Word)
import           Prelude             hiding (filter, foldl, foldr, lookup, map,
                                      null)

-- TODO (SM): get rid of bang patterns

{-
-- Use macros to define strictness of functions.
-- STRICT_x_OF_y denotes an y-ary function strict in the x-th parameter.
-- We do not use BangPatterns, because they are not in any standard and we
-- want the compilers to be compiled by as many compilers as possible.
#define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
-}


------------------------------------------------------------------------------
-- Types
------------------------------------------------------------------------------

-- A "Nat" is a natural machine word (an unsigned Int)
type Nat = Word

type Key = Int

-- | We store masks as the index of the bit that determines the branching.
type Mask = Int

-- | A priority search queue with @Int@ keys and priorities of type @p@ and
-- values of type @v@. It is strict in keys, priorities and values.
data IntPSQ p v
    = Bin {-# UNPACK #-} !Key !p !v {-# UNPACK #-} !Mask !(IntPSQ p v) !(IntPSQ p v)
    | Tip {-# UNPACK #-} !Key !p !v
    | Nil
    deriving ((forall m. Monoid m => IntPSQ p m -> m)
-> (forall m a. Monoid m => (a -> m) -> IntPSQ p a -> m)
-> (forall m a. Monoid m => (a -> m) -> IntPSQ p a -> m)
-> (forall a b. (a -> b -> b) -> b -> IntPSQ p a -> b)
-> (forall a b. (a -> b -> b) -> b -> IntPSQ p a -> b)
-> (forall b a. (b -> a -> b) -> b -> IntPSQ p a -> b)
-> (forall b a. (b -> a -> b) -> b -> IntPSQ p a -> b)
-> (forall a. (a -> a -> a) -> IntPSQ p a -> a)
-> (forall a. (a -> a -> a) -> IntPSQ p a -> a)
-> (forall a. IntPSQ p a -> [a])
-> (forall a. IntPSQ p a -> Bool)
-> (forall a. IntPSQ p a -> Key)
-> (forall a. Eq a => a -> IntPSQ p a -> Bool)
-> (forall a. Ord a => IntPSQ p a -> a)
-> (forall a. Ord a => IntPSQ p a -> a)
-> (forall a. Num a => IntPSQ p a -> a)
-> (forall a. Num a => IntPSQ p a -> a)
-> Foldable (IntPSQ p)
forall a. Eq a => a -> IntPSQ p a -> Bool
forall a. Num a => IntPSQ p a -> a
forall a. Ord a => IntPSQ p a -> a
forall m. Monoid m => IntPSQ p m -> m
forall a. IntPSQ p a -> Bool
forall a. IntPSQ p a -> Key
forall a. IntPSQ p a -> [a]
forall a. (a -> a -> a) -> IntPSQ p a -> a
forall p a. Eq a => a -> IntPSQ p a -> Bool
forall p a. Num a => IntPSQ p a -> a
forall p a. Ord a => IntPSQ p a -> a
forall m a. Monoid m => (a -> m) -> IntPSQ p a -> m
forall p m. Monoid m => IntPSQ p m -> m
forall p a. IntPSQ p a -> Bool
forall p a. IntPSQ p a -> Key
forall p a. IntPSQ p a -> [a]
forall b a. (b -> a -> b) -> b -> IntPSQ p a -> b
forall a b. (a -> b -> b) -> b -> IntPSQ p a -> b
forall p a. (a -> a -> a) -> IntPSQ p a -> a
forall p m a. Monoid m => (a -> m) -> IntPSQ p a -> m
forall p b a. (b -> a -> b) -> b -> IntPSQ p a -> b
forall p a b. (a -> b -> b) -> b -> IntPSQ p a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Key)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall p m. Monoid m => IntPSQ p m -> m
fold :: forall m. Monoid m => IntPSQ p m -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> IntPSQ p a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> IntPSQ p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> IntPSQ p a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> IntPSQ p a -> m
$cfoldr :: forall p a b. (a -> b -> b) -> b -> IntPSQ p a -> b
foldr :: forall a b. (a -> b -> b) -> b -> IntPSQ p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> IntPSQ p a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IntPSQ p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> IntPSQ p a -> b
foldl :: forall b a. (b -> a -> b) -> b -> IntPSQ p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> IntPSQ p a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> IntPSQ p a -> b
$cfoldr1 :: forall p a. (a -> a -> a) -> IntPSQ p a -> a
foldr1 :: forall a. (a -> a -> a) -> IntPSQ p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> IntPSQ p a -> a
foldl1 :: forall a. (a -> a -> a) -> IntPSQ p a -> a
$ctoList :: forall p a. IntPSQ p a -> [a]
toList :: forall a. IntPSQ p a -> [a]
$cnull :: forall p a. IntPSQ p a -> Bool
null :: forall a. IntPSQ p a -> Bool
$clength :: forall p a. IntPSQ p a -> Key
length :: forall a. IntPSQ p a -> Key
$celem :: forall p a. Eq a => a -> IntPSQ p a -> Bool
elem :: forall a. Eq a => a -> IntPSQ p a -> Bool
$cmaximum :: forall p a. Ord a => IntPSQ p a -> a
maximum :: forall a. Ord a => IntPSQ p a -> a
$cminimum :: forall p a. Ord a => IntPSQ p a -> a
minimum :: forall a. Ord a => IntPSQ p a -> a
$csum :: forall p a. Num a => IntPSQ p a -> a
sum :: forall a. Num a => IntPSQ p a -> a
$cproduct :: forall p a. Num a => IntPSQ p a -> a
product :: forall a. Num a => IntPSQ p a -> a
Foldable, (forall a b. (a -> b) -> IntPSQ p a -> IntPSQ p b)
-> (forall a b. a -> IntPSQ p b -> IntPSQ p a)
-> Functor (IntPSQ p)
forall a b. a -> IntPSQ p b -> IntPSQ p a
forall a b. (a -> b) -> IntPSQ p a -> IntPSQ p b
forall p a b. a -> IntPSQ p b -> IntPSQ p a
forall p a b. (a -> b) -> IntPSQ p a -> IntPSQ p b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall p a b. (a -> b) -> IntPSQ p a -> IntPSQ p b
fmap :: forall a b. (a -> b) -> IntPSQ p a -> IntPSQ p b
$c<$ :: forall p a b. a -> IntPSQ p b -> IntPSQ p a
<$ :: forall a b. a -> IntPSQ p b -> IntPSQ p a
Functor, Key -> IntPSQ p v -> ShowS
[IntPSQ p v] -> ShowS
IntPSQ p v -> String
(Key -> IntPSQ p v -> ShowS)
-> (IntPSQ p v -> String)
-> ([IntPSQ p v] -> ShowS)
-> Show (IntPSQ p v)
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p v. (Show p, Show v) => Key -> IntPSQ p v -> ShowS
forall p v. (Show p, Show v) => [IntPSQ p v] -> ShowS
forall p v. (Show p, Show v) => IntPSQ p v -> String
$cshowsPrec :: forall p v. (Show p, Show v) => Key -> IntPSQ p v -> ShowS
showsPrec :: Key -> IntPSQ p v -> ShowS
$cshow :: forall p v. (Show p, Show v) => IntPSQ p v -> String
show :: IntPSQ p v -> String
$cshowList :: forall p v. (Show p, Show v) => [IntPSQ p v] -> ShowS
showList :: [IntPSQ p v] -> ShowS
Show, Functor (IntPSQ p)
Foldable (IntPSQ p)
(Functor (IntPSQ p), Foldable (IntPSQ p)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> IntPSQ p a -> f (IntPSQ p b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IntPSQ p (f a) -> f (IntPSQ p a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IntPSQ p a -> m (IntPSQ p b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IntPSQ p (m a) -> m (IntPSQ p a))
-> Traversable (IntPSQ p)
forall p. Functor (IntPSQ p)
forall p. Foldable (IntPSQ p)
forall p (m :: * -> *) a.
Monad m =>
IntPSQ p (m a) -> m (IntPSQ p a)
forall p (f :: * -> *) a.
Applicative f =>
IntPSQ p (f a) -> f (IntPSQ p a)
forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntPSQ p a -> f (IntPSQ p b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => IntPSQ p (m a) -> m (IntPSQ p a)
forall (f :: * -> *) a.
Applicative f =>
IntPSQ p (f a) -> f (IntPSQ p a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntPSQ p a -> f (IntPSQ p b)
$ctraverse :: forall p (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntPSQ p a -> f (IntPSQ p b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntPSQ p a -> f (IntPSQ p b)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
IntPSQ p (f a) -> f (IntPSQ p a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
IntPSQ p (f a) -> f (IntPSQ p a)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
IntPSQ p (m a) -> m (IntPSQ p a)
sequence :: forall (m :: * -> *) a. Monad m => IntPSQ p (m a) -> m (IntPSQ p a)
Traversable)

instance (NFData p, NFData v) => NFData (IntPSQ p v) where
    rnf :: IntPSQ p v -> ()
rnf (Bin Key
_k p
p v
v Key
_m IntPSQ p v
l IntPSQ p v
r) = p -> ()
forall a. NFData a => a -> ()
rnf p
p () -> () -> ()
forall a b. a -> b -> b
`seq` v -> ()
forall a. NFData a => a -> ()
rnf v
v () -> () -> ()
forall a b. a -> b -> b
`seq` IntPSQ p v -> ()
forall a. NFData a => a -> ()
rnf IntPSQ p v
l () -> () -> ()
forall a b. a -> b -> b
`seq` IntPSQ p v -> ()
forall a. NFData a => a -> ()
rnf IntPSQ p v
r
    rnf (Tip Key
_k p
p v
v)        = p -> ()
forall a. NFData a => a -> ()
rnf p
p () -> () -> ()
forall a b. a -> b -> b
`seq` v -> ()
forall a. NFData a => a -> ()
rnf v
v
    rnf IntPSQ p v
Nil                 = ()

instance (Ord p, Eq v) => Eq (IntPSQ p v) where
    IntPSQ p v
x == :: IntPSQ p v -> IntPSQ p v -> Bool
== IntPSQ p v
y = case (IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
minView IntPSQ p v
x, IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
minView IntPSQ p v
y) of
        (Maybe (Key, p, v, IntPSQ p v)
Nothing              , Maybe (Key, p, v, IntPSQ p v)
Nothing                ) -> Bool
True
        (Just (Key
xk, p
xp, v
xv, IntPSQ p v
x'), (Just (Key
yk, p
yp, v
yv, IntPSQ p v
y'))) ->
            Key
xk Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
yk Bool -> Bool -> Bool
&& p
xp p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
yp Bool -> Bool -> Bool
&& v
xv v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
yv Bool -> Bool -> Bool
&& IntPSQ p v
x' IntPSQ p v -> IntPSQ p v -> Bool
forall a. Eq a => a -> a -> Bool
== IntPSQ p v
y'
        (Just (Key, p, v, IntPSQ p v)
_               , Maybe (Key, p, v, IntPSQ p v)
Nothing                ) -> Bool
False
        (Maybe (Key, p, v, IntPSQ p v)
Nothing              , Just (Key, p, v, IntPSQ p v)
_                 ) -> Bool
False


-- bit twiddling
----------------

{-# INLINE natFromInt #-}
natFromInt :: Key -> Nat
natFromInt :: Key -> Nat
natFromInt = Key -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE intFromNat #-}
intFromNat :: Nat -> Key
intFromNat :: Nat -> Key
intFromNat = Nat -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE zero #-}
zero :: Key -> Mask -> Bool
zero :: Key -> Key -> Bool
zero Key
i Key
m
  = (Key -> Nat
natFromInt Key
i) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Key -> Nat
natFromInt Key
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0

{-# INLINE nomatch #-}
nomatch :: Key -> Key -> Mask -> Bool
nomatch :: Key -> Key -> Key -> Bool
nomatch Key
k1 Key
k2 Key
m =
    Key -> Nat
natFromInt Key
k1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
m' Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
/= Key -> Nat
natFromInt Key
k2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
m'
  where
    m' :: Nat
m' = Nat -> Nat
maskW (Key -> Nat
natFromInt Key
m)

{-# INLINE maskW #-}
maskW :: Nat -> Nat
maskW :: Nat -> Nat
maskW Nat
m = Nat -> Nat
forall a. Bits a => a -> a
complement (Nat
mNat -> Nat -> Nat
forall a. Num a => a -> a -> a
-Nat
1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
m

{-# INLINE branchMask #-}
branchMask :: Key -> Key -> Mask
branchMask :: Key -> Key -> Key
branchMask Key
k1 Key
k2 =
    Nat -> Key
intFromNat (Nat -> Nat
highestBitMask (Key -> Nat
natFromInt Key
k1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Key -> Nat
natFromInt Key
k2))


------------------------------------------------------------------------------
-- Query
------------------------------------------------------------------------------

-- | /O(1)/ True if the queue is empty.
null :: IntPSQ p v -> Bool
null :: forall p a. IntPSQ p a -> Bool
null IntPSQ p v
Nil = Bool
True
null IntPSQ p v
_   = Bool
False

-- | /O(n)/ The number of elements stored in the queue.
size :: IntPSQ p v -> Int
size :: forall p a. IntPSQ p a -> Key
size IntPSQ p v
Nil               = Key
0
size (Tip Key
_ p
_ v
_)       = Key
1
size (Bin Key
_ p
_ v
_ Key
_ IntPSQ p v
l IntPSQ p v
r) = Key
1 Key -> Key -> Key
forall a. Num a => a -> a -> a
+ IntPSQ p v -> Key
forall p a. IntPSQ p a -> Key
size IntPSQ p v
l Key -> Key -> Key
forall a. Num a => a -> a -> a
+ IntPSQ p v -> Key
forall p a. IntPSQ p a -> Key
size IntPSQ p v
r
-- TODO (SM): benchmark this against a tail-recursive variant

-- | /O(min(n,W))/ Check if a key is present in the the queue.
member :: Int -> IntPSQ p v -> Bool
member :: forall p v. Key -> IntPSQ p v -> Bool
member Key
k = Maybe (p, v) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (p, v) -> Bool)
-> (IntPSQ p v -> Maybe (p, v)) -> IntPSQ p v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> IntPSQ p v -> Maybe (p, v)
forall p v. Key -> IntPSQ p v -> Maybe (p, v)
lookup Key
k

-- | /O(min(n,W))/ The priority and value of a given key, or 'Nothing' if the
-- key is not bound.
lookup :: Int -> IntPSQ p v -> Maybe (p, v)
lookup :: forall p v. Key -> IntPSQ p v -> Maybe (p, v)
lookup Key
k = IntPSQ p v -> Maybe (p, v)
forall {a} {b}. IntPSQ a b -> Maybe (a, b)
go
  where
    go :: IntPSQ a b -> Maybe (a, b)
go IntPSQ a b
t = case IntPSQ a b
t of
        IntPSQ a b
Nil                -> Maybe (a, b)
forall a. Maybe a
Nothing

        Tip Key
k' a
p' b
x'
          | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'        -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
p', b
x')
          | Bool
otherwise      -> Maybe (a, b)
forall a. Maybe a
Nothing

        Bin Key
k' a
p' b
x' Key
m IntPSQ a b
l IntPSQ a b
r
          | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m -> Maybe (a, b)
forall a. Maybe a
Nothing
          | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'        -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
p', b
x')
          | Key -> Key -> Bool
zero Key
k Key
m       -> IntPSQ a b -> Maybe (a, b)
go IntPSQ a b
l
          | Bool
otherwise      -> IntPSQ a b -> Maybe (a, b)
go IntPSQ a b
r

-- | /O(1)/ The element with the lowest priority.
findMin :: Ord p => IntPSQ p v -> Maybe (Int, p, v)
findMin :: forall p v. Ord p => IntPSQ p v -> Maybe (Key, p, v)
findMin IntPSQ p v
t = case IntPSQ p v
t of
    IntPSQ p v
Nil             -> Maybe (Key, p, v)
forall a. Maybe a
Nothing
    Tip Key
k p
p v
x       -> (Key, p, v) -> Maybe (Key, p, v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x)
    Bin Key
k p
p v
x Key
_ IntPSQ p v
_ IntPSQ p v
_ -> (Key, p, v) -> Maybe (Key, p, v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x)


------------------------------------------------------------------------------
--- Construction
------------------------------------------------------------------------------

-- | /O(1)/ The empty queue.
empty :: IntPSQ p v
empty :: forall p v. IntPSQ p v
empty = IntPSQ p v
forall p v. IntPSQ p v
Nil

-- | /O(1)/ Build a queue with one element.
singleton :: Ord p => Int -> p -> v -> IntPSQ p v
singleton :: forall p v. Ord p => Key -> p -> v -> IntPSQ p v
singleton = Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip


------------------------------------------------------------------------------
-- Insertion
------------------------------------------------------------------------------

-- | /O(min(n,W))/ Insert a new key, priority and value into the queue. If the key
-- is already present in the queue, the associated priority and value are
-- replaced with the supplied priority and value.
insert :: Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
insert :: forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
insert Key
k p
p v
x IntPSQ p v
t0 = Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p v
x (Key -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v
delete Key
k IntPSQ p v
t0)

-- | Internal function to insert a key that is *not* present in the priority
-- queue.
{-# INLINABLE unsafeInsertNew #-}
unsafeInsertNew :: Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew :: forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p v
x = IntPSQ p v -> IntPSQ p v
go
  where
    go :: IntPSQ p v -> IntPSQ p v
go IntPSQ p v
t = case IntPSQ p v
t of
      IntPSQ p v
Nil       -> Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x

      Tip Key
k' p
p' v
x'
        | (p
p, Key
k) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Key
k') -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k  p
p  v
x  Key
k' IntPSQ p v
t           IntPSQ p v
forall p v. IntPSQ p v
Nil
        | Bool
otherwise         -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k  (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil

      Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
        | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m ->
            if (p
p, Key
k) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Key
k')
              then Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k  p
p  v
x  Key
k' IntPSQ p v
t           IntPSQ p v
forall p v. IntPSQ p v
Nil
              else Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k  (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r)

        | Bool
otherwise ->
            if (p
p, Key
k) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Key
k')
              then
                if Key -> Key -> Bool
zero Key
k' Key
m
                  then Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k  p
p  v
x  Key
m (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k' p
p' v
x' IntPSQ p v
l) IntPSQ p v
r
                  else Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k  p
p  v
x  Key
m IntPSQ p v
l (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k' p
p' v
x' IntPSQ p v
r)
              else
                if Key -> Key -> Bool
zero Key
k Key
m
                  then Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k  p
p  v
x  IntPSQ p v
l) IntPSQ p v
r
                  else Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k  p
p  v
x  IntPSQ p v
r)

-- | Link
link :: Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link :: forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k p
p v
x Key
k' IntPSQ p v
k't IntPSQ p v
otherTree
  | Key -> Key -> Bool
zero Key
m Key
k' = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k p
p v
x Key
m IntPSQ p v
k't       IntPSQ p v
otherTree
  | Bool
otherwise = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k p
p v
x Key
m IntPSQ p v
otherTree IntPSQ p v
k't
  where
    m :: Key
m = Key -> Key -> Key
branchMask Key
k Key
k'


------------------------------------------------------------------------------
-- Delete/Alter
------------------------------------------------------------------------------

-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. When
-- the key is not a member of the queue, the original queue is returned.
{-# INLINABLE delete #-}
delete :: Ord p => Int -> IntPSQ p v -> IntPSQ p v
delete :: forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v
delete Key
k = IntPSQ p v -> IntPSQ p v
forall {p} {v}. Ord p => IntPSQ p v -> IntPSQ p v
go
  where
    go :: IntPSQ p v -> IntPSQ p v
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil           -> IntPSQ p v
forall p v. IntPSQ p v
Nil

        Tip Key
k' p
_ v
_
          | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> IntPSQ p v
forall p v. IntPSQ p v
Nil
          | Bool
otherwise -> IntPSQ p v
t

        Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
          | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m -> IntPSQ p v
t
          | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'        -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r
          | Key -> Key -> Bool
zero Key
k Key
m       -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin Key
k' p
p' v
x' Key
m (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
l) IntPSQ p v
r
          | Bool
otherwise      -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin Key
k' p
p' v
x' Key
m IntPSQ p v
l      (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
r)

-- | /O(min(n,W))/ Delete the binding with the least priority, and return the
-- rest of the queue stripped of that binding. In case the queue is empty, the
-- empty queue is returned again.
{-# INLINE deleteMin #-}
deleteMin :: Ord p => IntPSQ p v -> IntPSQ p v
deleteMin :: forall {p} {v}. Ord p => IntPSQ p v -> IntPSQ p v
deleteMin IntPSQ p v
t = case IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
minView IntPSQ p v
t of
    Maybe (Key, p, v, IntPSQ p v)
Nothing            -> IntPSQ p v
t
    Just (Key
_, p
_, v
_, IntPSQ p v
t') -> IntPSQ p v
t'

-- | /O(min(n,W))/ The expression @alter f k queue@ alters the value @x@ at @k@,
-- or absence thereof. 'alter' can be used to insert, delete, or update a value
-- in a queue. It also allows you to calculate an additional value @b@.
{-# INLINE alter #-}
alter
    :: Ord p
    => (Maybe (p, v) -> (b, Maybe (p, v)))
    -> Int
    -> IntPSQ p v
    -> (b, IntPSQ p v)
alter :: forall p v b.
Ord p =>
(Maybe (p, v) -> (b, Maybe (p, v)))
-> Key -> IntPSQ p v -> (b, IntPSQ p v)
alter Maybe (p, v) -> (b, Maybe (p, v))
f = \Key
k IntPSQ p v
t0 ->
    let (IntPSQ p v
t, Maybe (p, v)
mbX) = case Key -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
forall p v. Ord p => Key -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView Key
k IntPSQ p v
t0 of
                            Maybe (p, v, IntPSQ p v)
Nothing          -> (IntPSQ p v
t0, Maybe (p, v)
forall a. Maybe a
Nothing)
                            Just (p
p, v
v, IntPSQ p v
t0') -> (IntPSQ p v
t0', (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p, v
v))
    in case Maybe (p, v) -> (b, Maybe (p, v))
f Maybe (p, v)
mbX of
          (b
b, Maybe (p, v)
mbX') ->
            (b
b, IntPSQ p v -> ((p, v) -> IntPSQ p v) -> Maybe (p, v) -> IntPSQ p v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntPSQ p v
t (\(p
p, v
v) -> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p v
v IntPSQ p v
t) Maybe (p, v)
mbX')

-- | /O(min(n,W))/ A variant of 'alter' which works on the element with the
-- minimum priority. Unlike 'alter', this variant also allows you to change the
-- key of the element.
{-# INLINE alterMin #-}
alterMin :: Ord p
         => (Maybe (Int, p, v) -> (b, Maybe (Int, p, v)))
         -> IntPSQ p v
         -> (b, IntPSQ p v)
alterMin :: forall p v b.
Ord p =>
(Maybe (Key, p, v) -> (b, Maybe (Key, p, v)))
-> IntPSQ p v -> (b, IntPSQ p v)
alterMin Maybe (Key, p, v) -> (b, Maybe (Key, p, v))
f IntPSQ p v
t = case IntPSQ p v
t of
    IntPSQ p v
Nil             -> case Maybe (Key, p, v) -> (b, Maybe (Key, p, v))
f Maybe (Key, p, v)
forall a. Maybe a
Nothing of
                         (b
b, Maybe (Key, p, v)
Nothing)           -> (b
b, IntPSQ p v
forall p v. IntPSQ p v
Nil)
                         (b
b, Just (Key
k', p
p', v
x')) -> (b
b, Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k' p
p' v
x')

    Tip Key
k p
p v
x       -> case Maybe (Key, p, v) -> (b, Maybe (Key, p, v))
f ((Key, p, v) -> Maybe (Key, p, v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x)) of
                         (b
b, Maybe (Key, p, v)
Nothing)           -> (b
b, IntPSQ p v
forall p v. IntPSQ p v
Nil)
                         (b
b, Just (Key
k', p
p', v
x')) -> (b
b, Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k' p
p' v
x')

    Bin Key
k p
p v
x Key
m IntPSQ p v
l IntPSQ p v
r -> case Maybe (Key, p, v) -> (b, Maybe (Key, p, v))
f ((Key, p, v) -> Maybe (Key, p, v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x)) of
                         (b
b, Maybe (Key, p, v)
Nothing)           -> (b
b, Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r)
                         (b
b, Just (Key
k', p
p', v
x'))
                           | Key
k  Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
/= Key
k'  -> (b
b, Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
insert Key
k' p
p' v
x' (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r))
                           | p
p' p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
p   -> (b
b, Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r)
                           | Bool
otherwise -> (b
b, Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p' v
x' (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r))

-- | Smart constructor for a 'Bin' node.
{-# INLINE bin #-}
bin :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin :: forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin Key
k p
p v
x Key
_ IntPSQ p v
Nil IntPSQ p v
Nil = Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x
bin Key
k p
p v
x Key
m IntPSQ p v
l   IntPSQ p v
r   = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k p
p v
x Key
m IntPSQ p v
l IntPSQ p v
r


------------------------------------------------------------------------------
-- Lists
------------------------------------------------------------------------------

-- | /O(n*min(n,W))/ Build a queue from a list of (key, priority, value) tuples.
-- If the list contains more than one priority and value for the same key, the
-- last priority and value for the key is retained.
{-# INLINABLE fromList #-}
fromList :: Ord p => [(Int, p, v)] -> IntPSQ p v
fromList :: forall p v. Ord p => [(Key, p, v)] -> IntPSQ p v
fromList = (IntPSQ p v -> (Key, p, v) -> IntPSQ p v)
-> IntPSQ p v -> [(Key, p, v)] -> IntPSQ p v
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\IntPSQ p v
im (Key
k, p
p, v
x) -> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
insert Key
k p
p v
x IntPSQ p v
im) IntPSQ p v
forall p v. IntPSQ p v
empty

-- | /O(n)/ Convert a queue to a list of (key, priority, value) tuples. The
-- order of the list is not specified.
toList :: IntPSQ p v -> [(Int, p, v)]
toList :: forall p v. IntPSQ p v -> [(Key, p, v)]
toList =
    [(Key, p, v)] -> IntPSQ p v -> [(Key, p, v)]
forall {b} {c}. [(Key, b, c)] -> IntPSQ b c -> [(Key, b, c)]
go []
  where
    go :: [(Key, b, c)] -> IntPSQ b c -> [(Key, b, c)]
go [(Key, b, c)]
acc IntPSQ b c
Nil                   = [(Key, b, c)]
acc
    go [(Key, b, c)]
acc (Tip Key
k' b
p' c
x')        = (Key
k', b
p', c
x') (Key, b, c) -> [(Key, b, c)] -> [(Key, b, c)]
forall a. a -> [a] -> [a]
: [(Key, b, c)]
acc
    go [(Key, b, c)]
acc (Bin Key
k' b
p' c
x' Key
_m IntPSQ b c
l IntPSQ b c
r) = (Key
k', b
p', c
x') (Key, b, c) -> [(Key, b, c)] -> [(Key, b, c)]
forall a. a -> [a] -> [a]
: [(Key, b, c)] -> IntPSQ b c -> [(Key, b, c)]
go ([(Key, b, c)] -> IntPSQ b c -> [(Key, b, c)]
go [(Key, b, c)]
acc IntPSQ b c
r) IntPSQ b c
l

-- | /O(n)/ Obtain the list of present keys in the queue.
keys :: IntPSQ p v -> [Int]
keys :: forall p v. IntPSQ p v -> [Key]
keys IntPSQ p v
t = [Key
k | (Key
k, p
_, v
_) <- IntPSQ p v -> [(Key, p, v)]
forall p v. IntPSQ p v -> [(Key, p, v)]
toList IntPSQ p v
t]
-- TODO (jaspervdj): More efficient implementations possible


------------------------------------------------------------------------------
-- Views
------------------------------------------------------------------------------

-- | /O(min(n,W))/ Insert a new key, priority and value into the queue. If the key
-- is already present in the queue, then the evicted priority and value can be
-- found the first element of the returned tuple.
insertView :: Ord p => Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
insertView :: forall p v.
Ord p =>
Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
insertView Key
k p
p v
x IntPSQ p v
t0 = case Key -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
forall p v. Ord p => Key -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView Key
k IntPSQ p v
t0 of
    Maybe (p, v, IntPSQ p v)
Nothing          -> (Maybe (p, v)
forall a. Maybe a
Nothing,       Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p v
x IntPSQ p v
t0)
    Just (p
p', v
v', IntPSQ p v
t) -> ((p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
v'), Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
p v
x IntPSQ p v
t)

-- | /O(min(n,W))/ Delete a key and its priority and value from the queue. If
-- the key was present, the associated priority and value are returned in
-- addition to the updated queue.
{-# INLINABLE deleteView #-}
deleteView :: Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView :: forall p v. Ord p => Key -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView Key
k IntPSQ p v
t0 =
    case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
forall {p} {v}.
Ord p =>
IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
delFrom IntPSQ p v
t0 of
      (# IntPSQ p v
_, Maybe (p, v)
Nothing     #) -> Maybe (p, v, IntPSQ p v)
forall a. Maybe a
Nothing
      (# IntPSQ p v
t, Just (p
p, v
x) #) -> (p, v, IntPSQ p v) -> Maybe (p, v, IntPSQ p v)
forall a. a -> Maybe a
Just (p
p, v
x, IntPSQ p v
t)
  where
    delFrom :: IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
delFrom IntPSQ p v
t = case IntPSQ p v
t of
      IntPSQ p v
Nil -> (# IntPSQ p v
forall p v. IntPSQ p v
Nil, Maybe (p, v)
forall a. Maybe a
Nothing #)

      Tip Key
k' p
p' v
x'
        | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> (# IntPSQ p v
forall p v. IntPSQ p v
Nil, (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)
        | Bool
otherwise -> (# IntPSQ p v
t,   Maybe (p, v)
forall a. Maybe a
Nothing       #)

      Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
        | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m -> (# IntPSQ p v
t, Maybe (p, v)
forall a. Maybe a
Nothing #)
        | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r
                       in  IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)

        | Key -> Key -> Bool
zero Key
k Key
m  -> case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
delFrom IntPSQ p v
l of
                         (# IntPSQ p v
l', Maybe (p, v)
mbPX #) -> let t' :: IntPSQ p v
t' = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin Key
k' p
p' v
x' Key
m IntPSQ p v
l' IntPSQ p v
r
                                           in  IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', Maybe (p, v)
mbPX #)

        | Bool
otherwise -> case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
delFrom IntPSQ p v
r of
                         (# IntPSQ p v
r', Maybe (p, v)
mbPX #) -> let t' :: IntPSQ p v
t' = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
bin Key
k' p
p' v
x' Key
m IntPSQ p v
l  IntPSQ p v
r'
                                           in  IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', Maybe (p, v)
mbPX #)

-- | /O(min(n,W))/ Retrieve the binding with the least priority, and the
-- rest of the queue stripped of that binding.
{-# INLINE minView #-}
minView :: Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView :: forall p v. Ord p => IntPSQ p v -> Maybe (Key, p, v, IntPSQ p v)
minView IntPSQ p v
t = case IntPSQ p v
t of
    IntPSQ p v
Nil             -> Maybe (Key, p, v, IntPSQ p v)
forall a. Maybe a
Nothing
    Tip Key
k p
p v
x       -> (Key, p, v, IntPSQ p v) -> Maybe (Key, p, v, IntPSQ p v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x, IntPSQ p v
forall p v. IntPSQ p v
Nil)
    Bin Key
k p
p v
x Key
m IntPSQ p v
l IntPSQ p v
r -> (Key, p, v, IntPSQ p v) -> Maybe (Key, p, v, IntPSQ p v)
forall a. a -> Maybe a
Just (Key
k, p
p, v
x, Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r)

-- | Return a list of elements ordered by key whose priorities are at most @pt@,
-- and the rest of the queue stripped of these elements.  The returned list of
-- elements can be in any order: no guarantees there.
{-# INLINABLE atMostView #-}
atMostView :: Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
atMostView :: forall p v. Ord p => p -> IntPSQ p v -> ([(Key, p, v)], IntPSQ p v)
atMostView p
pt IntPSQ p v
t0 = [(Key, p, v)] -> IntPSQ p v -> ([(Key, p, v)], IntPSQ p v)
forall {c}.
[(Key, p, c)] -> IntPSQ p c -> ([(Key, p, c)], IntPSQ p c)
go [] IntPSQ p v
t0
  where
    go :: [(Key, p, c)] -> IntPSQ p c -> ([(Key, p, c)], IntPSQ p c)
go [(Key, p, c)]
acc IntPSQ p c
t = case IntPSQ p c
t of
        IntPSQ p c
Nil             -> ([(Key, p, c)]
acc, IntPSQ p c
t)
        Tip Key
k p
p c
x
            | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt    -> ([(Key, p, c)]
acc, IntPSQ p c
t)
            | Bool
otherwise -> ((Key
k, p
p, c
x) (Key, p, c) -> [(Key, p, c)] -> [(Key, p, c)]
forall a. a -> [a] -> [a]
: [(Key, p, c)]
acc, IntPSQ p c
forall p v. IntPSQ p v
Nil)

        Bin Key
k p
p c
x Key
m IntPSQ p c
l IntPSQ p c
r
            | p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt    -> ([(Key, p, c)]
acc, IntPSQ p c
t)
            | Bool
otherwise ->
                let ([(Key, p, c)]
acc',  IntPSQ p c
l') = [(Key, p, c)] -> IntPSQ p c -> ([(Key, p, c)], IntPSQ p c)
go [(Key, p, c)]
acc  IntPSQ p c
l
                    ([(Key, p, c)]
acc'', IntPSQ p c
r') = [(Key, p, c)] -> IntPSQ p c -> ([(Key, p, c)], IntPSQ p c)
go [(Key, p, c)]
acc' IntPSQ p c
r
                in  ((Key
k, p
p, c
x) (Key, p, c) -> [(Key, p, c)] -> [(Key, p, c)]
forall a. a -> [a] -> [a]
: [(Key, p, c)]
acc'', Key -> IntPSQ p c -> IntPSQ p c -> IntPSQ p c
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p c
l' IntPSQ p c
r')


------------------------------------------------------------------------------
-- Traversal
------------------------------------------------------------------------------

-- | /O(n)/ Modify every value in the queue.
{-# INLINABLE map #-}
map :: (Int -> p -> v -> w) -> IntPSQ p v -> IntPSQ p w
map :: forall p v w. (Key -> p -> v -> w) -> IntPSQ p v -> IntPSQ p w
map Key -> p -> v -> w
f =
    IntPSQ p v -> IntPSQ p w
go
  where
    go :: IntPSQ p v -> IntPSQ p w
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil             -> IntPSQ p w
forall p v. IntPSQ p v
Nil
        Tip Key
k p
p v
x       -> Key -> p -> w -> IntPSQ p w
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p (Key -> p -> v -> w
f Key
k p
p v
x)
        Bin Key
k p
p v
x Key
m IntPSQ p v
l IntPSQ p v
r -> Key -> p -> w -> Key -> IntPSQ p w -> IntPSQ p w -> IntPSQ p w
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k p
p (Key -> p -> v -> w
f Key
k p
p v
x) Key
m (IntPSQ p v -> IntPSQ p w
go IntPSQ p v
l) (IntPSQ p v -> IntPSQ p w
go IntPSQ p v
r)

-- | /O(n)/ Maps a function over the values and priorities of the queue.
-- The function @f@ must be monotonic with respect to the priorities. I.e. if
-- @x < y@, then @fst (f k x v) < fst (f k y v)@.
-- /The precondition is not checked./ If @f@ is not monotonic, then the result
-- will be invalid.
{-# INLINABLE unsafeMapMonotonic #-}
unsafeMapMonotonic :: (Key -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
unsafeMapMonotonic :: forall p v q w.
(Key -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
unsafeMapMonotonic Key -> p -> v -> (q, w)
f = IntPSQ p v -> IntPSQ q w
go
  where
    go :: IntPSQ p v -> IntPSQ q w
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil             -> IntPSQ q w
forall p v. IntPSQ p v
Nil
        Tip Key
k p
p v
x       -> let (q
p', w
x') = Key -> p -> v -> (q, w)
f Key
k p
p v
x
                           in  Key -> q -> w -> IntPSQ q w
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k q
p' w
x'

        Bin Key
k p
p v
x Key
m IntPSQ p v
l IntPSQ p v
r -> let (q
p', w
x') = Key -> p -> v -> (q, w)
f Key
k p
p v
x
                           in  Key -> q -> w -> Key -> IntPSQ q w -> IntPSQ q w -> IntPSQ q w
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k q
p' w
x' Key
m (IntPSQ p v -> IntPSQ q w
go IntPSQ p v
l) (IntPSQ p v -> IntPSQ q w
go IntPSQ p v
r)

-- | /O(n)/ Strict fold over every key, priority and value in the queue. The order
-- in which the fold is performed is not specified.
{-# INLINABLE fold' #-}
fold' :: (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
fold' :: forall p v a. (Key -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
fold' Key -> p -> v -> a -> a
f = a -> IntPSQ p v -> a
go
  where
    go :: a -> IntPSQ p v -> a
go !a
acc IntPSQ p v
Nil                   = a
acc
    go !a
acc (Tip Key
k' p
p' v
x')        = Key -> p -> v -> a -> a
f Key
k' p
p' v
x' a
acc
    go !a
acc (Bin Key
k' p
p' v
x' Key
_m IntPSQ p v
l IntPSQ p v
r) =
        let !acc1 :: a
acc1 = Key -> p -> v -> a -> a
f Key
k' p
p' v
x' a
acc
            !acc2 :: a
acc2 = a -> IntPSQ p v -> a
go a
acc1 IntPSQ p v
l
            !acc3 :: a
acc3 = a -> IntPSQ p v -> a
go a
acc2 IntPSQ p v
r
        in a
acc3


-- | Internal function that merges two *disjoint* 'IntPSQ's that share the
-- same prefix mask.
{-# INLINABLE merge #-}
merge :: Ord p => Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge :: forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r = case IntPSQ p v
l of
    IntPSQ p v
Nil -> IntPSQ p v
r

    Tip Key
lk p
lp v
lx ->
      case IntPSQ p v
r of
        IntPSQ p v
Nil                     -> IntPSQ p v
l
        Tip Key
rk p
rp v
rx
          | (p
lp, Key
lk) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Key
rk) -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
lk p
lp v
lx Key
m IntPSQ p v
forall p v. IntPSQ p v
Nil IntPSQ p v
r
          | Bool
otherwise           -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
rk p
rp v
rx Key
m IntPSQ p v
l   IntPSQ p v
forall p v. IntPSQ p v
Nil
        Bin Key
rk p
rp v
rx Key
rm IntPSQ p v
rl IntPSQ p v
rr
          | (p
lp, Key
lk) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Key
rk) -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
lk p
lp v
lx Key
m IntPSQ p v
forall p v. IntPSQ p v
Nil IntPSQ p v
r
          | Bool
otherwise           -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
rk p
rp v
rx Key
m IntPSQ p v
l   (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
rm IntPSQ p v
rl IntPSQ p v
rr)

    Bin Key
lk p
lp v
lx Key
lm IntPSQ p v
ll IntPSQ p v
lr ->
      case IntPSQ p v
r of
        IntPSQ p v
Nil                     -> IntPSQ p v
l
        Tip Key
rk p
rp v
rx
          | (p
lp, Key
lk) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Key
rk) -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
lk p
lp v
lx Key
m (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
lm IntPSQ p v
ll IntPSQ p v
lr) IntPSQ p v
r
          | Bool
otherwise           -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
rk p
rp v
rx Key
m IntPSQ p v
l                IntPSQ p v
forall p v. IntPSQ p v
Nil
        Bin Key
rk p
rp v
rx Key
rm IntPSQ p v
rl IntPSQ p v
rr
          | (p
lp, Key
lk) (p, Key) -> (p, Key) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Key
rk) -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
lk p
lp v
lx Key
m (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
lm IntPSQ p v
ll IntPSQ p v
lr) IntPSQ p v
r
          | Bool
otherwise           -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
rk p
rp v
rx Key
m IntPSQ p v
l                (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
rm IntPSQ p v
rl IntPSQ p v
rr)


------------------------------------------------------------------------------
-- Improved insert performance for special cases
------------------------------------------------------------------------------

-- | Internal function to insert a key with priority larger than the
-- maximal priority in the heap. This is always the case when using the PSQ
-- as the basis to implement a LRU cache, which associates a
-- access-tick-number with every element.
{-# INLINE unsafeInsertIncreasePriority #-}
unsafeInsertIncreasePriority
    :: Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertIncreasePriority :: forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertIncreasePriority =
    (p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority (\p
newP v
newX p
_ v
_ -> (p
newP, v
newX))

{-# INLINE unsafeInsertIncreasePriorityView #-}
unsafeInsertIncreasePriorityView
    :: Ord p => Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertIncreasePriorityView :: forall p v.
Ord p =>
Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertIncreasePriorityView =
    (p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertWithIncreasePriorityView (\p
newP v
newX p
_ v
_ -> (p
newP, v
newX))

-- | This name is not chosen well anymore. This function:
--
-- - Either inserts a value at a new key with a prio higher than the max of the
--   entire PSQ.
-- - Or, overrides the value at the key with a prio strictly higher than the
--   original prio at that key (but not necessarily the max of the entire PSQ).
{-# INLINABLE unsafeInsertWithIncreasePriority #-}
unsafeInsertWithIncreasePriority
    :: Ord p
    => (p -> v -> p -> v -> (p, v))
    -> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority :: forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority p -> v -> p -> v -> (p, v)
f Key
k p
p v
x IntPSQ p v
t0 =
    -- TODO (jaspervdj): Maybe help inliner a bit here, check core.
    IntPSQ p v -> IntPSQ p v
go IntPSQ p v
t0
  where
    go :: IntPSQ p v -> IntPSQ p v
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil -> Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x

        Tip Key
k' p
p' v
x'
            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of (!p
fp, !v
fx) -> Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
fp v
fx
            | Bool
otherwise -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k  (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil

        Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
            | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) (Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r)
            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'        -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
                (!p
fp, !v
fx)
                    | Key -> Key -> Bool
zero Key
k Key
m  -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
l) IntPSQ p v
r
                    | Bool
otherwise -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
r)
            | Key -> Key -> Bool
zero Key
k Key
m       -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
l) IntPSQ p v
r
            | Bool
otherwise      -> Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l      (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
r)

{-# INLINABLE unsafeInsertWithIncreasePriorityView #-}
unsafeInsertWithIncreasePriorityView
    :: Ord p
    => (p -> v -> p -> v -> (p, v))
    -> Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertWithIncreasePriorityView :: forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertWithIncreasePriorityView p -> v -> p -> v -> (p, v)
f Key
k p
p v
x IntPSQ p v
t0 =
    -- TODO (jaspervdj): Maybe help inliner a bit here, check core.
    case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
t0 of
        (# IntPSQ p v
t, Maybe (p, v)
mbPX #) -> (Maybe (p, v)
mbPX, IntPSQ p v
t)
  where
    go :: IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil -> (# Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x, Maybe (p, v)
forall a. Maybe a
Nothing #)

        Tip Key
k' p
p' v
x'
            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
                (!p
fp, !v
fx) -> (# Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
fp v
fx, (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)
            | Bool
otherwise -> (# Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k  (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil, Maybe (p, v)
forall a. Maybe a
Nothing #)

        Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
            | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m ->
                let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l IntPSQ p v
r
                in IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq`
                    let t'' :: IntPSQ p v
t'' = Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Key
k' p
p' v
x' Key
k (Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
p v
x) IntPSQ p v
t'
                    in IntPSQ p v
t'' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t'', Maybe (p, v)
forall a. Maybe a
Nothing #)

            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k' -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
                (!p
fp, !v
fx)
                    | Key -> Key -> Bool
zero Key
k Key
m  ->
                        let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
l) IntPSQ p v
r
                        in IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)
                    | Bool
otherwise ->
                        let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
r)
                        in IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)

            | Key -> Key -> Bool
zero Key
k Key
m -> case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
l of
                (# IntPSQ p v
l', Maybe (p, v)
mbPX #) -> IntPSQ p v
l' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l' IntPSQ p v
r, Maybe (p, v)
mbPX #)

            | Bool
otherwise -> case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
r of
                (# IntPSQ p v
r', Maybe (p, v)
mbPX #) -> IntPSQ p v
r' IntPSQ p v
-> (# IntPSQ p v, Maybe (p, v) #) -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. a -> b -> b
`seq` (# Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r', Maybe (p, v)
mbPX #)

-- | This can NOT be used to delete elements.
{-# INLINABLE unsafeLookupIncreasePriority #-}
unsafeLookupIncreasePriority
    :: Ord p
    => (p -> v -> (Maybe b, p, v))
    -> Key
    -> IntPSQ p v
    -> (Maybe b, IntPSQ p v)
unsafeLookupIncreasePriority :: forall p v b.
Ord p =>
(p -> v -> (Maybe b, p, v))
-> Key -> IntPSQ p v -> (Maybe b, IntPSQ p v)
unsafeLookupIncreasePriority p -> v -> (Maybe b, p, v)
f Key
k IntPSQ p v
t0 =
    -- TODO (jaspervdj): Maybe help inliner a bit here, check core.
    case IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
t0 of
        (# IntPSQ p v
t, Maybe b
mbB #) -> (Maybe b
mbB, IntPSQ p v
t)
  where
    go :: IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
t = case IntPSQ p v
t of
        IntPSQ p v
Nil -> (# IntPSQ p v
forall p v. IntPSQ p v
Nil, Maybe b
forall a. Maybe a
Nothing #)

        Tip Key
k' p
p' v
x'
            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k'   -> case p -> v -> (Maybe b, p, v)
f p
p' v
x' of
                (!Maybe b
fb, !p
fp, !v
fx) -> (# Key -> p -> v -> IntPSQ p v
forall p v. Key -> p -> v -> IntPSQ p v
Tip Key
k p
fp v
fx, Maybe b
fb #)
            | Bool
otherwise -> (# IntPSQ p v
t, Maybe b
forall a. Maybe a
Nothing #)

        Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r
            | Key -> Key -> Key -> Bool
nomatch Key
k Key
k' Key
m -> (# IntPSQ p v
t, Maybe b
forall a. Maybe a
Nothing #)

            | Key
k Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k' -> case p -> v -> (Maybe b, p, v)
f p
p' v
x' of
                (!Maybe b
fb, !p
fp, !v
fx)
                    | Key -> Key -> Bool
zero Key
k Key
m  ->
                        let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
l) IntPSQ p v
r
                        in IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe b #) -> (# IntPSQ p v, Maybe b #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', Maybe b
fb #)
                    | Bool
otherwise ->
                        let t' :: IntPSQ p v
t' = Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Key
m IntPSQ p v
l (Key -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Key
k p
fp v
fx IntPSQ p v
r)
                        in IntPSQ p v
t' IntPSQ p v
-> (# IntPSQ p v, Maybe b #) -> (# IntPSQ p v, Maybe b #)
forall a b. a -> b -> b
`seq` (# IntPSQ p v
t', Maybe b
fb #)

            | Key -> Key -> Bool
zero Key
k Key
m -> case IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
l of
                (# IntPSQ p v
l', Maybe b
mbB #) -> IntPSQ p v
l' IntPSQ p v
-> (# IntPSQ p v, Maybe b #) -> (# IntPSQ p v, Maybe b #)
forall a b. a -> b -> b
`seq` (# Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l' IntPSQ p v
r, Maybe b
mbB #)

            | Bool
otherwise -> case IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
r of
                (# IntPSQ p v
r', Maybe b
mbB #) -> IntPSQ p v
r' IntPSQ p v
-> (# IntPSQ p v, Maybe b #) -> (# IntPSQ p v, Maybe b #)
forall a b. a -> b -> b
`seq` (# Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Key
k' p
p' v
x' Key
m IntPSQ p v
l IntPSQ p v
r', Maybe b
mbB #)


------------------------------------------------------------------------------
-- Validity checks for the datastructure invariants
------------------------------------------------------------------------------

-- | /O(n^2)/ Internal function to check if the 'IntPSQ' is valid, i.e. if all
-- invariants hold. This should always be the case.
valid :: Ord p => IntPSQ p v -> Bool
valid :: forall p v. Ord p => IntPSQ p v -> Bool
valid IntPSQ p v
psq =
    Bool -> Bool
not (IntPSQ p v -> Bool
forall p a. IntPSQ p a -> Bool
hasBadNils IntPSQ p v
psq) Bool -> Bool -> Bool
&&
    Bool -> Bool
not (IntPSQ p v -> Bool
forall p a. IntPSQ p a -> Bool
hasDuplicateKeys IntPSQ p v
psq) Bool -> Bool -> Bool
&&
    IntPSQ p v -> Bool
forall p v. Ord p => IntPSQ p v -> Bool
hasMinHeapProperty IntPSQ p v
psq Bool -> Bool -> Bool
&&
    IntPSQ p v -> Bool
forall p a. IntPSQ p a -> Bool
validMask IntPSQ p v
psq

hasBadNils :: IntPSQ p v -> Bool
hasBadNils :: forall p a. IntPSQ p a -> Bool
hasBadNils IntPSQ p v
psq = case IntPSQ p v
psq of
    IntPSQ p v
Nil                 -> Bool
False
    Tip Key
_ p
_ v
_           -> Bool
False
    Bin Key
_ p
_ v
_ Key
_ IntPSQ p v
Nil IntPSQ p v
Nil -> Bool
True
    Bin Key
_ p
_ v
_ Key
_ IntPSQ p v
l IntPSQ p v
r     -> IntPSQ p v -> Bool
forall p a. IntPSQ p a -> Bool
hasBadNils IntPSQ p v
l Bool -> Bool -> Bool
|| IntPSQ p v -> Bool
forall p a. IntPSQ p a -> Bool
hasBadNils IntPSQ p v
r

hasDuplicateKeys :: IntPSQ p v -> Bool
hasDuplicateKeys :: forall p a. IntPSQ p a -> Bool
hasDuplicateKeys IntPSQ p v
psq =
    ([Key] -> Bool) -> [[Key]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Key -> Key -> Bool
forall a. Ord a => a -> a -> Bool
> Key
1) (Key -> Bool) -> ([Key] -> Key) -> [Key] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> Key
forall a. [a] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length) ([Key] -> [[Key]]
forall a. Eq a => [a] -> [[a]]
List.group ([Key] -> [[Key]]) -> ([Key] -> [Key]) -> [Key] -> [[Key]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Key] -> [Key]
forall a. Ord a => [a] -> [a]
List.sort ([Key] -> [[Key]]) -> [Key] -> [[Key]]
forall a b. (a -> b) -> a -> b
$ [Key] -> IntPSQ p v -> [Key]
forall p v. [Key] -> IntPSQ p v -> [Key]
collectKeys [] IntPSQ p v
psq)
  where
    collectKeys :: [Int] -> IntPSQ p v -> [Int]
    collectKeys :: forall p v. [Key] -> IntPSQ p v -> [Key]
collectKeys [Key]
ks IntPSQ p v
Nil = [Key]
ks
    collectKeys [Key]
ks (Tip Key
k p
_ v
_) = Key
k Key -> [Key] -> [Key]
forall a. a -> [a] -> [a]
: [Key]
ks
    collectKeys [Key]
ks (Bin Key
k p
_ v
_ Key
_ IntPSQ p v
l IntPSQ p v
r) =
        let ks' :: [Key]
ks' = [Key] -> IntPSQ p v -> [Key]
forall p v. [Key] -> IntPSQ p v -> [Key]
collectKeys (Key
k Key -> [Key] -> [Key]
forall a. a -> [a] -> [a]
: [Key]
ks) IntPSQ p v
l
        in [Key] -> IntPSQ p v -> [Key]
forall p v. [Key] -> IntPSQ p v -> [Key]
collectKeys [Key]
ks' IntPSQ p v
r

hasMinHeapProperty :: Ord p => IntPSQ p v -> Bool
hasMinHeapProperty :: forall p v. Ord p => IntPSQ p v -> Bool
hasMinHeapProperty IntPSQ p v
psq = case IntPSQ p v
psq of
    IntPSQ p v
Nil             -> Bool
True
    Tip Key
_ p
_ v
_       -> Bool
True
    Bin Key
_ p
p v
_ Key
_ IntPSQ p v
l IntPSQ p v
r -> p -> IntPSQ p v -> Bool
forall p v. Ord p => p -> IntPSQ p v -> Bool
go p
p IntPSQ p v
l Bool -> Bool -> Bool
&& p -> IntPSQ p v -> Bool
forall p v. Ord p => p -> IntPSQ p v -> Bool
go p
p IntPSQ p v
r
  where
    go :: Ord p => p -> IntPSQ p v -> Bool
    go :: forall p v. Ord p => p -> IntPSQ p v -> Bool
go p
_ IntPSQ p v
Nil = Bool
True
    go p
parentPrio (Tip Key
_ p
prio v
_) = p
parentPrio p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
prio
    go p
parentPrio (Bin Key
_ p
prio v
_  Key
_ IntPSQ p v
l IntPSQ p v
r) =
        p
parentPrio p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
prio Bool -> Bool -> Bool
&& p -> IntPSQ p v -> Bool
forall p v. Ord p => p -> IntPSQ p v -> Bool
go p
prio IntPSQ p v
l Bool -> Bool -> Bool
&& p -> IntPSQ p v -> Bool
forall p v. Ord p => p -> IntPSQ p v -> Bool
go p
prio IntPSQ p v
r

data Side = L | R

validMask :: IntPSQ p v -> Bool
validMask :: forall p a. IntPSQ p a -> Bool
validMask IntPSQ p v
Nil = Bool
True
validMask (Tip Key
_ p
_ v
_) = Bool
True
validMask (Bin Key
_ p
_ v
_ Key
m IntPSQ p v
left IntPSQ p v
right ) =
    Key -> IntPSQ p v -> IntPSQ p v -> Bool
forall p v. Key -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk Key
m IntPSQ p v
left IntPSQ p v
right Bool -> Bool -> Bool
&& Key -> Side -> IntPSQ p v -> Bool
forall p v. Key -> Side -> IntPSQ p v -> Bool
go Key
m Side
L IntPSQ p v
left Bool -> Bool -> Bool
&& Key -> Side -> IntPSQ p v -> Bool
forall p v. Key -> Side -> IntPSQ p v -> Bool
go Key
m Side
R IntPSQ p v
right
  where
    go :: Mask -> Side -> IntPSQ p v -> Bool
    go :: forall p v. Key -> Side -> IntPSQ p v -> Bool
go Key
parentMask Side
side IntPSQ p v
psq = case IntPSQ p v
psq of
        IntPSQ p v
Nil -> Bool
True
        Tip Key
k p
_ v
_ -> Key -> Side -> Key -> Bool
forall {a}. (Bits a, Num a) => a -> Side -> a -> Bool
checkMaskAndSideMatchKey Key
parentMask Side
side Key
k
        Bin Key
k p
_ v
_ Key
mask IntPSQ p v
l IntPSQ p v
r ->
            Key -> Side -> Key -> Bool
forall {a}. (Bits a, Num a) => a -> Side -> a -> Bool
checkMaskAndSideMatchKey Key
parentMask Side
side Key
k Bool -> Bool -> Bool
&&
            Key -> IntPSQ p v -> IntPSQ p v -> Bool
forall p v. Key -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk Key
mask IntPSQ p v
l IntPSQ p v
r Bool -> Bool -> Bool
&&
            Key -> Side -> IntPSQ p v -> Bool
forall p v. Key -> Side -> IntPSQ p v -> Bool
go Key
mask Side
L IntPSQ p v
l Bool -> Bool -> Bool
&&
            Key -> Side -> IntPSQ p v -> Bool
forall p v. Key -> Side -> IntPSQ p v -> Bool
go Key
mask Side
R IntPSQ p v
r

    checkMaskAndSideMatchKey :: a -> Side -> a -> Bool
checkMaskAndSideMatchKey a
parentMask Side
side a
key =
        case Side
side of
            Side
L -> a
parentMask a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0
            Side
R -> a
parentMask a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
key a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
parentMask

    maskOk :: Mask -> IntPSQ p v -> IntPSQ p v -> Bool
    maskOk :: forall p v. Key -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk Key
mask IntPSQ p v
l IntPSQ p v
r = case Key -> Key -> Key
forall a. Bits a => a -> a -> a
xor (Key -> Key -> Key) -> Maybe Key -> Maybe (Key -> Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntPSQ p v -> Maybe Key
forall {p} {v}. IntPSQ p v -> Maybe Key
childKey IntPSQ p v
l Maybe (Key -> Key) -> Maybe Key -> Maybe Key
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntPSQ p v -> Maybe Key
forall {p} {v}. IntPSQ p v -> Maybe Key
childKey IntPSQ p v
r of
        Maybe Key
Nothing -> Bool
True
        Just Key
xoredKeys ->
            Key -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
mask Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat -> Nat
highestBitMask (Key -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Key
xoredKeys)

    childKey :: IntPSQ p v -> Maybe Key
childKey IntPSQ p v
Nil               = Maybe Key
forall a. Maybe a
Nothing
    childKey (Tip Key
k p
_ v
_)       = Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k
    childKey (Bin Key
k p
_ v
_ Key
_ IntPSQ p v
_ IntPSQ p v
_) = Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k