{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.IntPSQ.Internal
(
Nat
, Key
, Mask
, IntPSQ (..)
, null
, size
, member
, lookup
, findMin
, empty
, singleton
, insert
, delete
, deleteMin
, alter
, alterMin
, fromList
, toList
, keys
, insertView
, deleteView
, minView
, atMostView
, map
, unsafeMapMonotonic
, fold'
, unsafeInsertNew
, unsafeInsertIncreasePriority
, unsafeInsertIncreasePriorityView
, unsafeInsertWithIncreasePriority
, unsafeInsertWithIncreasePriorityView
, unsafeLookupIncreasePriority
, 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)
type Nat = Word
type Key = Int
type Mask = Int
data IntPSQ p v
= Bin {-# UNPACK #-} !Key !p !v {-# UNPACK #-} !Mask !(IntPSQ p v) !(IntPSQ p v)
| Tip {-# UNPACK #-} !Key !p !v
| Nil
deriving (IntPSQ p a -> Bool
(a -> m) -> IntPSQ p a -> m
(a -> b -> b) -> b -> IntPSQ p a -> b
(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 -> Int)
-> (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 -> Int
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 -> Int
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 -> Int)
-> (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
product :: IntPSQ p a -> a
$cproduct :: forall p a. Num a => IntPSQ p a -> a
sum :: IntPSQ p a -> a
$csum :: forall p a. Num a => IntPSQ p a -> a
minimum :: IntPSQ p a -> a
$cminimum :: forall p a. Ord a => IntPSQ p a -> a
maximum :: IntPSQ p a -> a
$cmaximum :: forall p a. Ord a => IntPSQ p a -> a
elem :: a -> IntPSQ p a -> Bool
$celem :: forall p a. Eq a => a -> IntPSQ p a -> Bool
length :: IntPSQ p a -> Int
$clength :: forall p a. IntPSQ p a -> Int
null :: IntPSQ p a -> Bool
$cnull :: forall p a. IntPSQ p a -> Bool
toList :: IntPSQ p a -> [a]
$ctoList :: forall p a. IntPSQ p a -> [a]
foldl1 :: (a -> a -> a) -> IntPSQ p a -> a
$cfoldl1 :: forall p a. (a -> a -> a) -> IntPSQ p a -> a
foldr1 :: (a -> a -> a) -> IntPSQ p a -> a
$cfoldr1 :: forall p a. (a -> a -> a) -> IntPSQ p a -> a
foldl' :: (b -> a -> b) -> b -> IntPSQ p a -> b
$cfoldl' :: forall p b a. (b -> a -> b) -> b -> IntPSQ p a -> b
foldl :: (b -> a -> b) -> b -> IntPSQ p a -> b
$cfoldl :: forall p b a. (b -> a -> b) -> b -> IntPSQ p a -> b
foldr' :: (a -> b -> b) -> b -> IntPSQ p a -> b
$cfoldr' :: forall p a b. (a -> b -> b) -> b -> IntPSQ p a -> b
foldr :: (a -> b -> b) -> b -> IntPSQ p a -> b
$cfoldr :: forall p a b. (a -> b -> b) -> b -> IntPSQ p a -> b
foldMap' :: (a -> m) -> IntPSQ p a -> m
$cfoldMap' :: forall p m a. Monoid m => (a -> m) -> IntPSQ p a -> m
foldMap :: (a -> m) -> IntPSQ p a -> m
$cfoldMap :: forall p m a. Monoid m => (a -> m) -> IntPSQ p a -> m
fold :: IntPSQ p m -> m
$cfold :: forall p m. Monoid m => IntPSQ p m -> m
Foldable, a -> IntPSQ p b -> IntPSQ p a
(a -> b) -> IntPSQ p a -> IntPSQ p b
(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
<$ :: a -> IntPSQ p b -> IntPSQ p a
$c<$ :: forall p a b. a -> IntPSQ p b -> IntPSQ p a
fmap :: (a -> b) -> IntPSQ p a -> IntPSQ p b
$cfmap :: forall p a b. (a -> b) -> IntPSQ p a -> IntPSQ p b
Functor, Int -> IntPSQ p v -> ShowS
[IntPSQ p v] -> ShowS
IntPSQ p v -> String
(Int -> IntPSQ p v -> ShowS)
-> (IntPSQ p v -> String)
-> ([IntPSQ p v] -> ShowS)
-> Show (IntPSQ p v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p v. (Show p, Show v) => Int -> 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
showList :: [IntPSQ p v] -> ShowS
$cshowList :: forall p v. (Show p, Show v) => [IntPSQ p v] -> ShowS
show :: IntPSQ p v -> String
$cshow :: forall p v. (Show p, Show v) => IntPSQ p v -> String
showsPrec :: Int -> IntPSQ p v -> ShowS
$cshowsPrec :: forall p v. (Show p, Show v) => Int -> 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)
(a -> f b) -> IntPSQ p a -> f (IntPSQ p b)
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)
sequence :: IntPSQ p (m a) -> m (IntPSQ p a)
$csequence :: forall p (m :: * -> *) a.
Monad m =>
IntPSQ p (m a) -> m (IntPSQ p a)
mapM :: (a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
$cmapM :: forall p (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IntPSQ p a -> m (IntPSQ p b)
sequenceA :: IntPSQ p (f a) -> f (IntPSQ p a)
$csequenceA :: forall p (f :: * -> *) a.
Applicative f =>
IntPSQ p (f a) -> f (IntPSQ p a)
traverse :: (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)
$cp2Traversable :: forall p. Foldable (IntPSQ p)
$cp1Traversable :: forall p. Functor (IntPSQ p)
Traversable)
instance (NFData p, NFData v) => NFData (IntPSQ p v) where
rnf :: IntPSQ p v -> ()
rnf (Bin _k :: Int
_k p :: p
p v :: v
v _m :: Int
_m l :: IntPSQ p v
l r :: 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 _k :: Int
_k p :: p
p v :: 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 Nil = ()
instance (Ord p, Eq v) => Eq (IntPSQ p v) where
x :: IntPSQ p v
x == :: IntPSQ p v -> IntPSQ p v -> Bool
== y :: IntPSQ p v
y = case (IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView IntPSQ p v
x, IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView IntPSQ p v
y) of
(Nothing , Nothing ) -> Bool
True
(Just (xk :: Int
xk, xp :: p
xp, xv :: v
xv, x' :: IntPSQ p v
x'), (Just (yk :: Int
yk, yp :: p
yp, yv :: v
yv, y' :: IntPSQ p v
y'))) ->
Int
xk Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 _ , Nothing ) -> Bool
False
(Nothing , Just _ ) -> Bool
False
{-# INLINE natFromInt #-}
natFromInt :: Key -> Nat
natFromInt :: Int -> Nat
natFromInt = Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intFromNat #-}
intFromNat :: Nat -> Key
intFromNat :: Nat -> Int
intFromNat = Nat -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE zero #-}
zero :: Key -> Mask -> Bool
zero :: Int -> Int -> Bool
zero i :: Int
i m :: Int
m
= (Int -> Nat
natFromInt Int
i) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Int -> Nat
natFromInt Int
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== 0
{-# INLINE nomatch #-}
nomatch :: Key -> Key -> Mask -> Bool
nomatch :: Int -> Int -> Int -> Bool
nomatch k1 :: Int
k1 k2 :: Int
k2 m :: Int
m =
Int -> Nat
natFromInt Int
k1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
m' Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Nat
natFromInt Int
k2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
m'
where
m' :: Nat
m' = Nat -> Nat
maskW (Int -> Nat
natFromInt Int
m)
{-# INLINE maskW #-}
maskW :: Nat -> Nat
maskW :: Nat -> Nat
maskW m :: Nat
m = Nat -> Nat
forall a. Bits a => a -> a
complement (Nat
mNat -> Nat -> Nat
forall a. Num a => a -> a -> a
-1) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
m
{-# INLINE branchMask #-}
branchMask :: Key -> Key -> Mask
branchMask :: Int -> Int -> Int
branchMask k1 :: Int
k1 k2 :: Int
k2 =
Nat -> Int
intFromNat (Nat -> Nat
highestBitMask (Int -> Nat
natFromInt Int
k1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Int -> Nat
natFromInt Int
k2))
null :: IntPSQ p v -> Bool
null :: IntPSQ p v -> Bool
null Nil = Bool
True
null _ = Bool
False
size :: IntPSQ p v -> Int
size :: IntPSQ p v -> Int
size Nil = 0
size (Tip _ _ _) = 1
size (Bin _ _ _ _ l :: IntPSQ p v
l r :: IntPSQ p v
r) = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IntPSQ p v -> Int
forall p a. IntPSQ p a -> Int
size IntPSQ p v
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ IntPSQ p v -> Int
forall p a. IntPSQ p a -> Int
size IntPSQ p v
r
member :: Int -> IntPSQ p v -> Bool
member :: Int -> IntPSQ p v -> Bool
member k :: Int
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
. Int -> IntPSQ p v -> Maybe (p, v)
forall p v. Int -> IntPSQ p v -> Maybe (p, v)
lookup Int
k
lookup :: Int -> IntPSQ p v -> Maybe (p, v)
lookup :: Int -> IntPSQ p v -> Maybe (p, v)
lookup k :: Int
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 t :: IntPSQ a b
t = case IntPSQ a b
t of
Nil -> Maybe (a, b)
forall a. Maybe a
Nothing
Tip k' :: Int
k' p' :: a
p' x' :: b
x'
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
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 k' :: Int
k' p' :: a
p' x' :: b
x' m :: Int
m l :: IntPSQ a b
l r :: IntPSQ a b
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m -> Maybe (a, b)
forall a. Maybe a
Nothing
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
p', b
x')
| Int -> Int -> Bool
zero Int
k Int
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
findMin :: Ord p => IntPSQ p v -> Maybe (Int, p, v)
findMin :: IntPSQ p v -> Maybe (Int, p, v)
findMin t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> Maybe (Int, p, v)
forall a. Maybe a
Nothing
Tip k :: Int
k p :: p
p x :: v
x -> (Int, p, v) -> Maybe (Int, p, v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x)
Bin k :: Int
k p :: p
p x :: v
x _ _ _ -> (Int, p, v) -> Maybe (Int, p, v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x)
empty :: IntPSQ p v
empty :: IntPSQ p v
empty = IntPSQ p v
forall p v. IntPSQ p v
Nil
singleton :: Ord p => Int -> p -> v -> IntPSQ p v
singleton :: Int -> p -> v -> IntPSQ p v
singleton = Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip
insert :: Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
insert :: Int -> p -> v -> IntPSQ p v -> IntPSQ p v
insert k :: Int
k p :: p
p x :: v
x t0 :: IntPSQ p v
t0 = Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
x (Int -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v
delete Int
k IntPSQ p v
t0)
{-# INLINABLE unsafeInsertNew #-}
unsafeInsertNew :: Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew :: Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew k :: Int
k p :: p
p x :: v
x = IntPSQ p v -> IntPSQ p v
go
where
go :: IntPSQ p v -> IntPSQ p v
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x
Tip k' :: Int
k' p' :: p
p' x' :: v
x'
| (p
p, Int
k) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Int
k') -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k p
p v
x Int
k' IntPSQ p v
t IntPSQ p v
forall p v. IntPSQ p v
Nil
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil
Bin k' :: Int
k' p' :: p
p' x' :: v
x' m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m ->
if (p
p, Int
k) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Int
k')
then Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k p
p v
x Int
k' IntPSQ p v
t IntPSQ p v
forall p v. IntPSQ p v
Nil
else Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x) (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r)
| Bool
otherwise ->
if (p
p, Int
k) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
p', Int
k')
then
if Int -> Int -> Bool
zero Int
k' Int
m
then Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k' p
p' v
x' IntPSQ p v
l) IntPSQ p v
r
else Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
l (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k' p
p' v
x' IntPSQ p v
r)
else
if Int -> Int -> Bool
zero Int
k Int
m
then Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
m (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
x IntPSQ p v
l) IntPSQ p v
r
else Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
m IntPSQ p v
l (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
x IntPSQ p v
r)
link :: Key -> p -> v -> Key -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link :: Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link k :: Int
k p :: p
p x :: v
x k' :: Int
k' k't :: IntPSQ p v
k't otherTree :: IntPSQ p v
otherTree
| Int -> Int -> Bool
zero Int
m Int
k' = Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
k't IntPSQ p v
otherTree
| Bool
otherwise = Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
otherTree IntPSQ p v
k't
where
m :: Int
m = Int -> Int -> Int
branchMask Int
k Int
k'
{-# INLINABLE delete #-}
delete :: Ord p => Int -> IntPSQ p v -> IntPSQ p v
delete :: Int -> IntPSQ p v -> IntPSQ p v
delete k :: Int
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 t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> IntPSQ p v
forall p v. IntPSQ p v
Nil
Tip k' :: Int
k' _ _
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> IntPSQ p v
forall p v. IntPSQ p v
Nil
| Bool
otherwise -> IntPSQ p v
t
Bin k' :: Int
k' p' :: p
p' x' :: v
x' m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m -> IntPSQ p v
t
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r
| Int -> Int -> Bool
zero Int
k Int
m -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkL Int
k' p
p' v
x' Int
m (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
l) IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkR Int
k' p
p' v
x' Int
m IntPSQ p v
l (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
r)
{-# INLINE deleteMin #-}
deleteMin :: Ord p => IntPSQ p v -> IntPSQ p v
deleteMin :: IntPSQ p v -> IntPSQ p v
deleteMin t :: IntPSQ p v
t = case IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
forall p v. Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView IntPSQ p v
t of
Nothing -> IntPSQ p v
t
Just (_, _, _, t' :: IntPSQ p v
t') -> IntPSQ p v
t'
{-# INLINE alter #-}
alter
:: Ord p
=> (Maybe (p, v) -> (b, Maybe (p, v)))
-> Int
-> IntPSQ p v
-> (b, IntPSQ p v)
alter :: (Maybe (p, v) -> (b, Maybe (p, v)))
-> Int -> IntPSQ p v -> (b, IntPSQ p v)
alter f :: Maybe (p, v) -> (b, Maybe (p, v))
f = \k :: Int
k t0 :: IntPSQ p v
t0 ->
let (t :: IntPSQ p v
t, mbX :: Maybe (p, v)
mbX) = case Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
forall p v. Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView Int
k IntPSQ p v
t0 of
Nothing -> (IntPSQ p v
t0, Maybe (p, v)
forall a. Maybe a
Nothing)
Just (p :: p
p, v :: v
v, t0' :: 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
b, mbX' :: 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
p, v :: v
v) -> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
v IntPSQ p v
t) Maybe (p, v)
mbX')
{-# INLINE alterMin #-}
alterMin :: Ord p
=> (Maybe (Int, p, v) -> (b, Maybe (Int, p, v)))
-> IntPSQ p v
-> (b, IntPSQ p v)
alterMin :: (Maybe (Int, p, v) -> (b, Maybe (Int, p, v)))
-> IntPSQ p v -> (b, IntPSQ p v)
alterMin f :: Maybe (Int, p, v) -> (b, Maybe (Int, p, v))
f t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> case Maybe (Int, p, v) -> (b, Maybe (Int, p, v))
f Maybe (Int, p, v)
forall a. Maybe a
Nothing of
(b :: b
b, Nothing) -> (b
b, IntPSQ p v
forall p v. IntPSQ p v
Nil)
(b :: b
b, Just (k' :: Int
k', p' :: p
p', x' :: v
x')) -> (b
b, Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k' p
p' v
x')
Tip k :: Int
k p :: p
p x :: v
x -> case Maybe (Int, p, v) -> (b, Maybe (Int, p, v))
f ((Int, p, v) -> Maybe (Int, p, v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x)) of
(b :: b
b, Nothing) -> (b
b, IntPSQ p v
forall p v. IntPSQ p v
Nil)
(b :: b
b, Just (k' :: Int
k', p' :: p
p', x' :: v
x')) -> (b
b, Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k' p
p' v
x')
Bin k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r -> case Maybe (Int, p, v) -> (b, Maybe (Int, p, v))
f ((Int, p, v) -> Maybe (Int, p, v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x)) of
(b :: b
b, Nothing) -> (b
b, Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r)
(b :: b
b, Just (k' :: Int
k', p' :: p
p', x' :: v
x'))
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
k' -> (b
b, Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
insert Int
k' p
p' v
x' (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
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, Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p' v
x' Int
m IntPSQ p v
l IntPSQ p v
r)
| Bool
otherwise -> (b
b, Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p' v
x' (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r))
{-# INLINE binShrinkL #-}
binShrinkL :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkL :: Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkL k :: Int
k p :: p
p x :: v
x m :: Int
m Nil r :: IntPSQ p v
r = case IntPSQ p v
r of Nil -> Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x; _ -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
forall p v. IntPSQ p v
Nil IntPSQ p v
r
binShrinkL k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r = Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
l IntPSQ p v
r
{-# INLINE binShrinkR #-}
binShrinkR :: Key -> p -> v -> Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkR :: Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkR k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l Nil = case IntPSQ p v
l of Nil -> Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x; _ -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
l IntPSQ p v
forall p v. IntPSQ p v
Nil
binShrinkR k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r = Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p v
x Int
m IntPSQ p v
l IntPSQ p v
r
{-# INLINABLE fromList #-}
fromList :: Ord p => [(Int, p, v)] -> IntPSQ p v
fromList :: [(Int, p, v)] -> IntPSQ p v
fromList = (IntPSQ p v -> (Int, p, v) -> IntPSQ p v)
-> IntPSQ p v -> [(Int, p, v)] -> IntPSQ p v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\im :: IntPSQ p v
im (k :: Int
k, p :: p
p, x :: v
x) -> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
insert Int
k p
p v
x IntPSQ p v
im) IntPSQ p v
forall p v. IntPSQ p v
empty
toList :: IntPSQ p v -> [(Int, p, v)]
toList :: IntPSQ p v -> [(Int, p, v)]
toList =
[(Int, p, v)] -> IntPSQ p v -> [(Int, p, v)]
forall b c. [(Int, b, c)] -> IntPSQ b c -> [(Int, b, c)]
go []
where
go :: [(Int, b, c)] -> IntPSQ b c -> [(Int, b, c)]
go acc :: [(Int, b, c)]
acc Nil = [(Int, b, c)]
acc
go acc :: [(Int, b, c)]
acc (Tip k' :: Int
k' p' :: b
p' x' :: c
x') = (Int
k', b
p', c
x') (Int, b, c) -> [(Int, b, c)] -> [(Int, b, c)]
forall a. a -> [a] -> [a]
: [(Int, b, c)]
acc
go acc :: [(Int, b, c)]
acc (Bin k' :: Int
k' p' :: b
p' x' :: c
x' _m :: Int
_m l :: IntPSQ b c
l r :: IntPSQ b c
r) = (Int
k', b
p', c
x') (Int, b, c) -> [(Int, b, c)] -> [(Int, b, c)]
forall a. a -> [a] -> [a]
: [(Int, b, c)] -> IntPSQ b c -> [(Int, b, c)]
go ([(Int, b, c)] -> IntPSQ b c -> [(Int, b, c)]
go [(Int, b, c)]
acc IntPSQ b c
r) IntPSQ b c
l
keys :: IntPSQ p v -> [Int]
keys :: IntPSQ p v -> [Int]
keys t :: IntPSQ p v
t = [Int
k | (k :: Int
k, _, _) <- IntPSQ p v -> [(Int, p, v)]
forall p v. IntPSQ p v -> [(Int, p, v)]
toList IntPSQ p v
t]
insertView :: Ord p => Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
insertView :: Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
insertView k :: Int
k p :: p
p x :: v
x t0 :: IntPSQ p v
t0 = case Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
forall p v. Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView Int
k IntPSQ p v
t0 of
Nothing -> (Maybe (p, v)
forall a. Maybe a
Nothing, Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
x IntPSQ p v
t0)
Just (p' :: p
p', v' :: v
v', t :: IntPSQ p v
t) -> ((p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
v'), Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
p v
x IntPSQ p v
t)
{-# INLINABLE deleteView #-}
deleteView :: Ord p => Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView :: Int -> IntPSQ p v -> Maybe (p, v, IntPSQ p v)
deleteView k :: Int
k t0 :: IntPSQ p v
t0 =
case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
forall a b. Ord a => IntPSQ a b -> (# IntPSQ a b, Maybe (a, b) #)
delFrom IntPSQ p v
t0 of
(# _, Nothing #) -> Maybe (p, v, IntPSQ p v)
forall a. Maybe a
Nothing
(# t :: IntPSQ p v
t, Just (p :: p
p, x :: 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 a b -> (# IntPSQ a b, Maybe (a, b) #)
delFrom t :: IntPSQ a b
t = case IntPSQ a b
t of
Nil -> (# IntPSQ a b
forall p v. IntPSQ p v
Nil, Maybe (a, b)
forall a. Maybe a
Nothing #)
Tip k' :: Int
k' p' :: a
p' x' :: b
x'
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> (# IntPSQ a b
forall p v. IntPSQ p v
Nil, (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
p', b
x') #)
| Bool
otherwise -> (# IntPSQ a b
t, Maybe (a, b)
forall a. Maybe a
Nothing #)
Bin k' :: Int
k' p' :: a
p' x' :: b
x' m :: Int
m l :: IntPSQ a b
l r :: IntPSQ a b
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m -> (# IntPSQ a b
t, Maybe (a, b)
forall a. Maybe a
Nothing #)
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> let t' :: IntPSQ a b
t' = Int -> IntPSQ a b -> IntPSQ a b -> IntPSQ a b
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ a b
l IntPSQ a b
r
in IntPSQ a b
t' IntPSQ a b
-> (# IntPSQ a b, Maybe (a, b) #) -> (# IntPSQ a b, Maybe (a, b) #)
forall a b. a -> b -> b
`seq` (# IntPSQ a b
t', (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
p', b
x') #)
| Int -> Int -> Bool
zero Int
k Int
m -> case IntPSQ a b -> (# IntPSQ a b, Maybe (a, b) #)
delFrom IntPSQ a b
l of
(# l' :: IntPSQ a b
l', mbPX :: Maybe (a, b)
mbPX #) -> let t' :: IntPSQ a b
t' = Int -> a -> b -> Int -> IntPSQ a b -> IntPSQ a b -> IntPSQ a b
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkL Int
k' a
p' b
x' Int
m IntPSQ a b
l' IntPSQ a b
r
in IntPSQ a b
t' IntPSQ a b
-> (# IntPSQ a b, Maybe (a, b) #) -> (# IntPSQ a b, Maybe (a, b) #)
forall a b. a -> b -> b
`seq` (# IntPSQ a b
t', Maybe (a, b)
mbPX #)
| Bool
otherwise -> case IntPSQ a b -> (# IntPSQ a b, Maybe (a, b) #)
delFrom IntPSQ a b
r of
(# r' :: IntPSQ a b
r', mbPX :: Maybe (a, b)
mbPX #) -> let t' :: IntPSQ a b
t' = Int -> a -> b -> Int -> IntPSQ a b -> IntPSQ a b -> IntPSQ a b
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
binShrinkR Int
k' a
p' b
x' Int
m IntPSQ a b
l IntPSQ a b
r'
in IntPSQ a b
t' IntPSQ a b
-> (# IntPSQ a b, Maybe (a, b) #) -> (# IntPSQ a b, Maybe (a, b) #)
forall a b. a -> b -> b
`seq` (# IntPSQ a b
t', Maybe (a, b)
mbPX #)
{-# INLINE minView #-}
minView :: Ord p => IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView :: IntPSQ p v -> Maybe (Int, p, v, IntPSQ p v)
minView t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> Maybe (Int, p, v, IntPSQ p v)
forall a. Maybe a
Nothing
Tip k :: Int
k p :: p
p x :: v
x -> (Int, p, v, IntPSQ p v) -> Maybe (Int, p, v, IntPSQ p v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x, IntPSQ p v
forall p v. IntPSQ p v
Nil)
Bin k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r -> (Int, p, v, IntPSQ p v) -> Maybe (Int, p, v, IntPSQ p v)
forall a. a -> Maybe a
Just (Int
k, p
p, v
x, Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r)
{-# INLINABLE atMostView #-}
atMostView :: Ord p => p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
atMostView :: p -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
atMostView pt :: p
pt t0 :: IntPSQ p v
t0 = [(Int, p, v)] -> IntPSQ p v -> ([(Int, p, v)], IntPSQ p v)
forall c.
[(Int, p, c)] -> IntPSQ p c -> ([(Int, p, c)], IntPSQ p c)
go [] IntPSQ p v
t0
where
go :: [(Int, p, c)] -> IntPSQ p c -> ([(Int, p, c)], IntPSQ p c)
go acc :: [(Int, p, c)]
acc t :: IntPSQ p c
t = case IntPSQ p c
t of
Nil -> ([(Int, p, c)]
acc, IntPSQ p c
t)
Tip k :: Int
k p :: p
p x :: c
x
| p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt -> ([(Int, p, c)]
acc, IntPSQ p c
t)
| Bool
otherwise -> ((Int
k, p
p, c
x) (Int, p, c) -> [(Int, p, c)] -> [(Int, p, c)]
forall a. a -> [a] -> [a]
: [(Int, p, c)]
acc, IntPSQ p c
forall p v. IntPSQ p v
Nil)
Bin k :: Int
k p :: p
p x :: c
x m :: Int
m l :: IntPSQ p c
l r :: IntPSQ p c
r
| p
p p -> p -> Bool
forall a. Ord a => a -> a -> Bool
> p
pt -> ([(Int, p, c)]
acc, IntPSQ p c
t)
| Bool
otherwise ->
let (acc' :: [(Int, p, c)]
acc', l' :: IntPSQ p c
l') = [(Int, p, c)] -> IntPSQ p c -> ([(Int, p, c)], IntPSQ p c)
go [(Int, p, c)]
acc IntPSQ p c
l
(acc'' :: [(Int, p, c)]
acc'', r' :: IntPSQ p c
r') = [(Int, p, c)] -> IntPSQ p c -> ([(Int, p, c)], IntPSQ p c)
go [(Int, p, c)]
acc' IntPSQ p c
r
in ((Int
k, p
p, c
x) (Int, p, c) -> [(Int, p, c)] -> [(Int, p, c)]
forall a. a -> [a] -> [a]
: [(Int, p, c)]
acc'', Int -> IntPSQ p c -> IntPSQ p c -> IntPSQ p c
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p c
l' IntPSQ p c
r')
{-# INLINABLE map #-}
map :: (Int -> p -> v -> w) -> IntPSQ p v -> IntPSQ p w
map :: (Int -> p -> v -> w) -> IntPSQ p v -> IntPSQ p w
map f :: Int -> p -> v -> w
f =
IntPSQ p v -> IntPSQ p w
go
where
go :: IntPSQ p v -> IntPSQ p w
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> IntPSQ p w
forall p v. IntPSQ p v
Nil
Tip k :: Int
k p :: p
p x :: v
x -> Int -> p -> w -> IntPSQ p w
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p (Int -> p -> v -> w
f Int
k p
p v
x)
Bin k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r -> Int -> p -> w -> Int -> IntPSQ p w -> IntPSQ p w -> IntPSQ p w
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k p
p (Int -> p -> v -> w
f Int
k p
p v
x) Int
m (IntPSQ p v -> IntPSQ p w
go IntPSQ p v
l) (IntPSQ p v -> IntPSQ p w
go IntPSQ p v
r)
{-# INLINABLE unsafeMapMonotonic #-}
unsafeMapMonotonic :: (Key -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
unsafeMapMonotonic :: (Int -> p -> v -> (q, w)) -> IntPSQ p v -> IntPSQ q w
unsafeMapMonotonic f :: Int -> p -> v -> (q, w)
f = IntPSQ p v -> IntPSQ q w
go
where
go :: IntPSQ p v -> IntPSQ q w
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> IntPSQ q w
forall p v. IntPSQ p v
Nil
Tip k :: Int
k p :: p
p x :: v
x -> let (p' :: q
p', x' :: w
x') = Int -> p -> v -> (q, w)
f Int
k p
p v
x
in Int -> q -> w -> IntPSQ q w
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k q
p' w
x'
Bin k :: Int
k p :: p
p x :: v
x m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r -> let (p' :: q
p', x' :: w
x') = Int -> p -> v -> (q, w)
f Int
k p
p v
x
in Int -> q -> w -> Int -> IntPSQ q w -> IntPSQ q w -> IntPSQ q w
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k q
p' w
x' Int
m (IntPSQ p v -> IntPSQ q w
go IntPSQ p v
l) (IntPSQ p v -> IntPSQ q w
go IntPSQ p v
r)
{-# INLINABLE fold' #-}
fold' :: (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
fold' :: (Int -> p -> v -> a -> a) -> a -> IntPSQ p v -> a
fold' f :: Int -> p -> v -> a -> a
f = a -> IntPSQ p v -> a
go
where
go :: a -> IntPSQ p v -> a
go !a
acc Nil = a
acc
go !a
acc (Tip k' :: Int
k' p' :: p
p' x' :: v
x') = Int -> p -> v -> a -> a
f Int
k' p
p' v
x' a
acc
go !a
acc (Bin k' :: Int
k' p' :: p
p' x' :: v
x' _m :: Int
_m l :: IntPSQ p v
l r :: IntPSQ p v
r) =
let !acc1 :: a
acc1 = Int -> p -> v -> a -> a
f Int
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
{-# INLINABLE merge #-}
merge :: Ord p => Mask -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge :: Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r = case IntPSQ p v
l of
Nil -> IntPSQ p v
r
Tip lk :: Int
lk lp :: p
lp lx :: v
lx ->
case IntPSQ p v
r of
Nil -> IntPSQ p v
l
Tip rk :: Int
rk rp :: p
rp rx :: v
rx
| (p
lp, Int
lk) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Int
rk) -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
lk p
lp v
lx Int
m IntPSQ p v
forall p v. IntPSQ p v
Nil IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
rk p
rp v
rx Int
m IntPSQ p v
l IntPSQ p v
forall p v. IntPSQ p v
Nil
Bin rk :: Int
rk rp :: p
rp rx :: v
rx rm :: Int
rm rl :: IntPSQ p v
rl rr :: IntPSQ p v
rr
| (p
lp, Int
lk) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Int
rk) -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
lk p
lp v
lx Int
m IntPSQ p v
forall p v. IntPSQ p v
Nil IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
rk p
rp v
rx Int
m IntPSQ p v
l (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
rm IntPSQ p v
rl IntPSQ p v
rr)
Bin lk :: Int
lk lp :: p
lp lx :: v
lx lm :: Int
lm ll :: IntPSQ p v
ll lr :: IntPSQ p v
lr ->
case IntPSQ p v
r of
Nil -> IntPSQ p v
l
Tip rk :: Int
rk rp :: p
rp rx :: v
rx
| (p
lp, Int
lk) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Int
rk) -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
lk p
lp v
lx Int
m (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
lm IntPSQ p v
ll IntPSQ p v
lr) IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
rk p
rp v
rx Int
m IntPSQ p v
l IntPSQ p v
forall p v. IntPSQ p v
Nil
Bin rk :: Int
rk rp :: p
rp rx :: v
rx rm :: Int
rm rl :: IntPSQ p v
rl rr :: IntPSQ p v
rr
| (p
lp, Int
lk) (p, Int) -> (p, Int) -> Bool
forall a. Ord a => a -> a -> Bool
< (p
rp, Int
rk) -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
lk p
lp v
lx Int
m (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
lm IntPSQ p v
ll IntPSQ p v
lr) IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
rk p
rp v
rx Int
m IntPSQ p v
l (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
rm IntPSQ p v
rl IntPSQ p v
rr)
{-# INLINE unsafeInsertIncreasePriority #-}
unsafeInsertIncreasePriority
:: Ord p => Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertIncreasePriority :: Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertIncreasePriority =
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority (\newP :: p
newP newX :: v
newX _ _ -> (p
newP, v
newX))
{-# INLINE unsafeInsertIncreasePriorityView #-}
unsafeInsertIncreasePriorityView
:: Ord p => Key -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertIncreasePriorityView :: Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertIncreasePriorityView =
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
forall p v.
Ord p =>
(p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertWithIncreasePriorityView (\newP :: p
newP newX :: v
newX _ _ -> (p
newP, v
newX))
{-# INLINABLE unsafeInsertWithIncreasePriority #-}
unsafeInsertWithIncreasePriority
:: Ord p
=> (p -> v -> p -> v -> (p, v))
-> Key -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority :: (p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertWithIncreasePriority f :: p -> v -> p -> v -> (p, v)
f k :: Int
k p :: p
p x :: v
x t0 :: IntPSQ p v
t0 =
IntPSQ p v -> IntPSQ p v
go IntPSQ p v
t0
where
go :: IntPSQ p v -> IntPSQ p v
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x
Tip k' :: Int
k' p' :: p
p' x' :: v
x'
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of (!p
fp, !v
fx) -> Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
fp v
fx
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil
Bin k' :: Int
k' p' :: p
p' x' :: v
x' m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x) (Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l IntPSQ p v
r)
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
(!p
fp, !v
fx)
| Int -> Int -> Bool
zero Int
k Int
m -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
fp v
fx IntPSQ p v
l) IntPSQ p v
r
| Bool
otherwise -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
k p
fp v
fx IntPSQ p v
r)
| Int -> Int -> Bool
zero Int
k Int
m -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
m (IntPSQ p v -> IntPSQ p v
go IntPSQ p v
l) IntPSQ p v
r
| Bool
otherwise -> Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
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 :: (p -> v -> p -> v -> (p, v))
-> Int -> p -> v -> IntPSQ p v -> (Maybe (p, v), IntPSQ p v)
unsafeInsertWithIncreasePriorityView f :: p -> v -> p -> v -> (p, v)
f k :: Int
k p :: p
p x :: v
x t0 :: IntPSQ p v
t0 =
case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
t0 of
(# t :: IntPSQ p v
t, mbPX :: Maybe (p, v)
mbPX #) -> (Maybe (p, v)
mbPX, IntPSQ p v
t)
where
go :: IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> (# Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x, Maybe (p, v)
forall a. Maybe a
Nothing #)
Tip k' :: Int
k' p' :: p
p' x' :: v
x'
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
(!p
fp, !v
fx) -> (# Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
fp v
fx, (p, v) -> Maybe (p, v)
forall a. a -> Maybe a
Just (p
p', v
x') #)
| Bool
otherwise -> (# Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
p v
x) IntPSQ p v
forall p v. IntPSQ p v
Nil, Maybe (p, v)
forall a. Maybe a
Nothing #)
Bin k' :: Int
k' p' :: p
p' x' :: v
x' m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m ->
let t' :: IntPSQ p v
t' = Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
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'' = Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
link Int
k' p
p' v
x' Int
k (Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
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 #)
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> p -> v -> (p, v)
f p
p v
x p
p' v
x' of
(!p
fp, !v
fx)
| Int -> Int -> Bool
zero Int
k Int
m ->
let t' :: IntPSQ p v
t' = Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
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' = Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
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') #)
| Int -> Int -> Bool
zero Int
k Int
m -> case IntPSQ p v -> (# IntPSQ p v, Maybe (p, v) #)
go IntPSQ p v
l of
(# l' :: IntPSQ p v
l', mbPX :: 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` (# Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
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
(# r' :: IntPSQ p v
r', mbPX :: 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` (# Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
m IntPSQ p v
l IntPSQ p v
r', Maybe (p, v)
mbPX #)
{-# INLINABLE unsafeLookupIncreasePriority #-}
unsafeLookupIncreasePriority
:: Ord p
=> (p -> v -> (Maybe b, p, v))
-> Key
-> IntPSQ p v
-> (Maybe b, IntPSQ p v)
unsafeLookupIncreasePriority :: (p -> v -> (Maybe b, p, v))
-> Int -> IntPSQ p v -> (Maybe b, IntPSQ p v)
unsafeLookupIncreasePriority f :: p -> v -> (Maybe b, p, v)
f k :: Int
k t0 :: IntPSQ p v
t0 =
case IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
t0 of
(# t :: IntPSQ p v
t, mbB :: Maybe b
mbB #) -> (Maybe b
mbB, IntPSQ p v
t)
where
go :: IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go t :: IntPSQ p v
t = case IntPSQ p v
t of
Nil -> (# IntPSQ p v
forall p v. IntPSQ p v
Nil, Maybe b
forall a. Maybe a
Nothing #)
Tip k' :: Int
k' p' :: p
p' x' :: v
x'
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> (Maybe b, p, v)
f p
p' v
x' of
(!Maybe b
fb, !p
fp, !v
fx) -> (# Int -> p -> v -> IntPSQ p v
forall p v. Int -> p -> v -> IntPSQ p v
Tip Int
k p
fp v
fx, Maybe b
fb #)
| Bool
otherwise -> (# IntPSQ p v
t, Maybe b
forall a. Maybe a
Nothing #)
Bin k' :: Int
k' p' :: p
p' x' :: v
x' m :: Int
m l :: IntPSQ p v
l r :: IntPSQ p v
r
| Int -> Int -> Int -> Bool
nomatch Int
k Int
k' Int
m -> (# IntPSQ p v
t, Maybe b
forall a. Maybe a
Nothing #)
| Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k' -> case p -> v -> (Maybe b, p, v)
f p
p' v
x' of
(!Maybe b
fb, !p
fp, !v
fx)
| Int -> Int -> Bool
zero Int
k Int
m ->
let t' :: IntPSQ p v
t' = Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
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' = Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
merge Int
m IntPSQ p v
l (Int -> p -> v -> IntPSQ p v -> IntPSQ p v
forall p v. Ord p => Int -> p -> v -> IntPSQ p v -> IntPSQ p v
unsafeInsertNew Int
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 #)
| Int -> Int -> Bool
zero Int
k Int
m -> case IntPSQ p v -> (# IntPSQ p v, Maybe b #)
go IntPSQ p v
l of
(# l' :: IntPSQ p v
l', mbB :: 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` (# Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
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
(# r' :: IntPSQ p v
r', mbB :: 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` (# Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
forall p v.
Int -> p -> v -> Int -> IntPSQ p v -> IntPSQ p v -> IntPSQ p v
Bin Int
k' p
p' v
x' Int
m IntPSQ p v
l IntPSQ p v
r', Maybe b
mbB #)
valid :: Ord p => IntPSQ p v -> Bool
valid :: IntPSQ p v -> Bool
valid psq :: 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 :: IntPSQ p v -> Bool
hasBadNils psq :: IntPSQ p v
psq = case IntPSQ p v
psq of
Nil -> Bool
False
Tip _ _ _ -> Bool
False
Bin _ _ _ _ Nil Nil -> Bool
True
Bin _ _ _ _ l :: IntPSQ p v
l r :: 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 :: IntPSQ p v -> Bool
hasDuplicateKeys psq :: IntPSQ p v
psq =
([Int] -> Bool) -> [[Int]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1) (Int -> Bool) -> ([Int] -> Int) -> [Int] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
List.group ([Int] -> [[Int]]) -> ([Int] -> [Int]) -> [Int] -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
List.sort ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> IntPSQ p v -> [Int]
forall p v. [Int] -> IntPSQ p v -> [Int]
collectKeys [] IntPSQ p v
psq)
where
collectKeys :: [Int] -> IntPSQ p v -> [Int]
collectKeys :: [Int] -> IntPSQ p v -> [Int]
collectKeys ks :: [Int]
ks Nil = [Int]
ks
collectKeys ks :: [Int]
ks (Tip k :: Int
k _ _) = Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ks
collectKeys ks :: [Int]
ks (Bin k :: Int
k _ _ _ l :: IntPSQ p v
l r :: IntPSQ p v
r) =
let ks' :: [Int]
ks' = [Int] -> IntPSQ p v -> [Int]
forall p v. [Int] -> IntPSQ p v -> [Int]
collectKeys (Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ks) IntPSQ p v
l
in [Int] -> IntPSQ p v -> [Int]
forall p v. [Int] -> IntPSQ p v -> [Int]
collectKeys [Int]
ks' IntPSQ p v
r
hasMinHeapProperty :: Ord p => IntPSQ p v -> Bool
hasMinHeapProperty :: IntPSQ p v -> Bool
hasMinHeapProperty psq :: IntPSQ p v
psq = case IntPSQ p v
psq of
Nil -> Bool
True
Tip _ _ _ -> Bool
True
Bin _ p :: p
p _ _ l :: IntPSQ p v
l r :: 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 :: p -> IntPSQ p v -> Bool
go _ Nil = Bool
True
go parentPrio :: p
parentPrio (Tip _ prio :: p
prio _) = p
parentPrio p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
prio
go parentPrio :: p
parentPrio (Bin _ prio :: p
prio _ _ l :: IntPSQ p v
l r :: 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 :: IntPSQ p v -> Bool
validMask Nil = Bool
True
validMask (Tip _ _ _) = Bool
True
validMask (Bin _ _ _ m :: Int
m left :: IntPSQ p v
left right :: IntPSQ p v
right ) =
Int -> IntPSQ p v -> IntPSQ p v -> Bool
forall p v. Int -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk Int
m IntPSQ p v
left IntPSQ p v
right Bool -> Bool -> Bool
&& Int -> Side -> IntPSQ p v -> Bool
forall p v. Int -> Side -> IntPSQ p v -> Bool
go Int
m Side
L IntPSQ p v
left Bool -> Bool -> Bool
&& Int -> Side -> IntPSQ p v -> Bool
forall p v. Int -> Side -> IntPSQ p v -> Bool
go Int
m Side
R IntPSQ p v
right
where
go :: Mask -> Side -> IntPSQ p v -> Bool
go :: Int -> Side -> IntPSQ p v -> Bool
go parentMask :: Int
parentMask side :: Side
side psq :: IntPSQ p v
psq = case IntPSQ p v
psq of
Nil -> Bool
True
Tip k :: Int
k _ _ -> Int -> Side -> Int -> Bool
forall a. (Bits a, Num a) => a -> Side -> a -> Bool
checkMaskAndSideMatchKey Int
parentMask Side
side Int
k
Bin k :: Int
k _ _ mask :: Int
mask l :: IntPSQ p v
l r :: IntPSQ p v
r ->
Int -> Side -> Int -> Bool
forall a. (Bits a, Num a) => a -> Side -> a -> Bool
checkMaskAndSideMatchKey Int
parentMask Side
side Int
k Bool -> Bool -> Bool
&&
Int -> IntPSQ p v -> IntPSQ p v -> Bool
forall p v. Int -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk Int
mask IntPSQ p v
l IntPSQ p v
r Bool -> Bool -> Bool
&&
Int -> Side -> IntPSQ p v -> Bool
forall p v. Int -> Side -> IntPSQ p v -> Bool
go Int
mask Side
L IntPSQ p v
l Bool -> Bool -> Bool
&&
Int -> Side -> IntPSQ p v -> Bool
forall p v. Int -> Side -> IntPSQ p v -> Bool
go Int
mask Side
R IntPSQ p v
r
checkMaskAndSideMatchKey :: a -> Side -> a -> Bool
checkMaskAndSideMatchKey parentMask :: a
parentMask side :: Side
side key :: a
key =
case Side
side of
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
== 0
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 :: Int -> IntPSQ p v -> IntPSQ p v -> Bool
maskOk mask :: Int
mask l :: IntPSQ p v
l r :: IntPSQ p v
r = case Int -> Int -> Int
forall a. Bits a => a -> a -> a
xor (Int -> Int -> Int) -> Maybe Int -> Maybe (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntPSQ p v -> Maybe Int
forall p v. IntPSQ p v -> Maybe Int
childKey IntPSQ p v
l Maybe (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IntPSQ p v -> Maybe Int
forall p v. IntPSQ p v -> Maybe Int
childKey IntPSQ p v
r of
Nothing -> Bool
True
Just xoredKeys :: Int
xoredKeys ->
Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mask Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat -> Nat
highestBitMask (Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xoredKeys)
childKey :: IntPSQ p v -> Maybe Int
childKey Nil = Maybe Int
forall a. Maybe a
Nothing
childKey (Tip k :: Int
k _ _) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k
childKey (Bin k :: Int
k _ _ _ _ _) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
k