{-|
Module           : What4.Utils.LeqMap
Copyright        : (c) Galois, Inc 2015-2020
License          : BSD3
Maintainer       : Joe Hendrix <jhendrix@galois.com>

This module defines a strict map.

It is similiar to Data.Map.Strict, but provides some additional operations
including splitEntry, splitLeq, fromDistinctDescList.
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module What4.Utils.LeqMap
  ( LeqMap
  , toList
  , findMin
  , findMax
  , null
  , empty
  , mapKeysMonotonic
  , union
  , fromDistinctAscList
  , fromDistinctDescList
  , toDescList
  , deleteFindMin
  , deleteFindMax
  , minViewWithKey
  , filterGt
  , filterLt
  , insert
  , lookupLE
  , lookupLT
  , lookupGE
  , lookupGT
  , keys
  , mergeWithKey
  , singleton
  , foldlWithKey'
  , size
  , splitEntry
  , splitLeq
  ) where

import Control.Applicative hiding (empty)
import Prelude hiding (lookup, null)
import Data.Traversable (foldMapDefault)

data MaybeS a = NothingS | JustS !a

type Size = Int

data LeqMap k p
   = Bin {-# UNPACK #-} !Size !k !p !(LeqMap k p) !(LeqMap k p)
   | Tip

bin :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin :: forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
k p
x LeqMap k p
l LeqMap k p
r = forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (forall k p. LeqMap k p -> Size
size LeqMap k p
l forall a. Num a => a -> a -> a
+ forall k p. LeqMap k p -> Size
size LeqMap k p
r forall a. Num a => a -> a -> a
+ Size
1) k
k p
x LeqMap k p
l LeqMap k p
r

balanceL :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL :: forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
k p
x LeqMap k p
l LeqMap k p
r =
  case LeqMap k p
l of
    Bin Size
ls k
lk p
lx LeqMap k p
ll LeqMap k p
lr | Size
ls forall a. Ord a => a -> a -> Bool
> forall a. Ord a => a -> a -> a
max Size
1 (Size
deltaforall a. Num a => a -> a -> a
*forall k p. LeqMap k p -> Size
size LeqMap k p
r)  ->
      case LeqMap k p
lr of
        Bin Size
lrs k
lrk p
lrx LeqMap k p
lrl LeqMap k p
lrr | Size
lrs forall a. Ord a => a -> a -> Bool
>= Size
ratioforall a. Num a => a -> a -> a
* forall k p. LeqMap k p -> Size
size LeqMap k p
ll ->
          forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
lrk p
lrx (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
lk p
lx LeqMap k p
ll  LeqMap k p
lrl) (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
k  p
x  LeqMap k p
lrr LeqMap k p
r)
        LeqMap k p
_ -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
lk p
lx LeqMap k p
ll (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
k p
x LeqMap k p
lr LeqMap k p
r)
    LeqMap k p
_ -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
k p
x LeqMap k p
l LeqMap k p
r

-- balanceR is called when right subtree might have been inserted to or when
-- left subtree might have been deleted from.
balanceR :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR :: forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
k p
x LeqMap k p
l LeqMap k p
r = case LeqMap k p
l of
  LeqMap k p
Tip -> case LeqMap k p
r of
           LeqMap k p
Tip -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip
           (Bin Size
_ k
_ p
_ LeqMap k p
Tip LeqMap k p
Tip) -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
2 k
k p
x forall k p. LeqMap k p
Tip LeqMap k p
r
           (Bin Size
_ k
rk p
rx LeqMap k p
Tip rr :: LeqMap k p
rr@(Bin{})) -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
3 k
rk p
rx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip) LeqMap k p
rr
           (Bin Size
_ k
rk p
rx (Bin Size
_ k
rlk p
rlx LeqMap k p
_ LeqMap k p
_) LeqMap k p
Tip) -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
3 k
rlk p
rlx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip) (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
rk p
rx forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip)
           (Bin Size
rs k
rk p
rx rl :: LeqMap k p
rl@(Bin Size
rls k
rlk p
rlx LeqMap k p
rll LeqMap k p
rlr) rr :: LeqMap k p
rr@(Bin Size
rrs k
_ p
_ LeqMap k p
_ LeqMap k p
_))
             | Size
rls forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
rrs -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rs) k
rk p
rx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rls) k
k p
x forall k p. LeqMap k p
Tip LeqMap k p
rl) LeqMap k p
rr
             | Bool
otherwise -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rs) k
rlk p
rlx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+forall k p. LeqMap k p -> Size
size LeqMap k p
rll) k
k p
x forall k p. LeqMap k p
Tip LeqMap k p
rll) (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rrsforall a. Num a => a -> a -> a
+forall k p. LeqMap k p -> Size
size LeqMap k p
rlr) k
rk p
rx LeqMap k p
rlr LeqMap k p
rr)

  (Bin Size
ls k
_ p
_ LeqMap k p
_ LeqMap k p
_) -> case LeqMap k p
r of
           LeqMap k p
Tip -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
ls) k
k p
x LeqMap k p
l forall k p. LeqMap k p
Tip

           (Bin Size
rs k
rk p
rx LeqMap k p
rl LeqMap k p
rr)
              | Size
rs forall a. Ord a => a -> a -> Bool
> Size
deltaforall a. Num a => a -> a -> a
*Size
ls  -> case (LeqMap k p
rl, LeqMap k p
rr) of
                   (Bin Size
rls k
rlk p
rlx LeqMap k p
rll LeqMap k p
rlr, Bin Size
rrs k
_ p
_ LeqMap k p
_ LeqMap k p
_)
                     | Size
rls forall a. Ord a => a -> a -> Bool
< Size
ratioforall a. Num a => a -> a -> a
*Size
rrs -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
rk p
rx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rls) k
k p
x LeqMap k p
l LeqMap k p
rl) LeqMap k p
rr
                     | Bool
otherwise -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
rlk p
rlx (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+forall k p. LeqMap k p -> Size
size LeqMap k p
rll) k
k p
x LeqMap k p
l LeqMap k p
rll) (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
rrsforall a. Num a => a -> a -> a
+forall k p. LeqMap k p -> Size
size LeqMap k p
rlr) k
rk p
rx LeqMap k p
rlr LeqMap k p
rr)
                   (LeqMap k p
_, LeqMap k p
_) -> forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
              | Bool
otherwise -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1forall a. Num a => a -> a -> a
+Size
lsforall a. Num a => a -> a -> a
+Size
rs) k
k p
x LeqMap k p
l LeqMap k p
r

delta,ratio :: Int
delta :: Size
delta = Size
3
ratio :: Size
ratio = Size
2

insertMax :: k -> p -> LeqMap k p -> LeqMap k p
insertMax :: forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMax k
kx p
x LeqMap k p
t =
  case LeqMap k p
t of
    LeqMap k p
Tip -> forall k p. k -> p -> LeqMap k p
singleton k
kx p
x
    Bin Size
_ k
ky p
y LeqMap k p
l LeqMap k p
r -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMax k
kx p
x LeqMap k p
r)

insertMin :: k -> p -> LeqMap k p -> LeqMap k p
insertMin :: forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMin k
kx p
x LeqMap k p
t =
  case LeqMap k p
t of
    LeqMap k p
Tip -> forall k p. k -> p -> LeqMap k p
singleton k
kx p
x
    Bin Size
_ k
ky p
y LeqMap k p
l LeqMap k p
r -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMin k
kx p
x LeqMap k p
l) LeqMap k p
r


link :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link :: forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
Tip LeqMap k p
r  = forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMin k
kx p
x LeqMap k p
r
link k
kx p
x LeqMap k p
l LeqMap k p
Tip  = forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMax k
kx p
x LeqMap k p
l
link k
kx p
x l :: LeqMap k p
l@(Bin Size
sizeL k
ky p
y LeqMap k p
ly LeqMap k p
ry) r :: LeqMap k p
r@(Bin Size
sizeR k
kz p
z LeqMap k p
lz LeqMap k p
rz)
  | Size
deltaforall a. Num a => a -> a -> a
*Size
sizeL forall a. Ord a => a -> a -> Bool
< Size
sizeR  = forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
kz p
z (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l LeqMap k p
lz) LeqMap k p
rz
  | Size
deltaforall a. Num a => a -> a -> a
*Size
sizeR forall a. Ord a => a -> a -> Bool
< Size
sizeL  = forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
ly (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
ry LeqMap k p
r)
  | Bool
otherwise            = forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
kx p
x LeqMap k p
l LeqMap k p
r

instance (Ord k, Eq p) => Eq (LeqMap k p) where
  LeqMap k p
x == :: LeqMap k p -> LeqMap k p -> Bool
== LeqMap k p
y = forall k p. LeqMap k p -> Size
size LeqMap k p
x forall a. Eq a => a -> a -> Bool
== forall k p. LeqMap k p -> Size
size LeqMap k p
y Bool -> Bool -> Bool
&& forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
x forall a. Eq a => a -> a -> Bool
== forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
y


instance Functor (LeqMap k) where
  fmap :: forall a b. (a -> b) -> LeqMap k a -> LeqMap k b
fmap a -> b
_ LeqMap k a
Tip = forall k p. LeqMap k p
Tip
  fmap a -> b
f (Bin Size
s k
k a
a LeqMap k a
l LeqMap k a
r) = forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
s k
k (a -> b
f a
a) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LeqMap k a
l) (forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LeqMap k a
r)

instance Foldable (LeqMap k) where
  foldMap :: forall m a. Monoid m => (a -> m) -> LeqMap k a -> m
foldMap = forall (t :: Type -> Type) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable (LeqMap k) where
  traverse :: forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> LeqMap k a -> f (LeqMap k b)
traverse a -> f b
_ LeqMap k a
Tip = forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall k p. LeqMap k p
Tip
  traverse a -> f b
f (Bin Size
s k
k a
a LeqMap k a
l LeqMap k a
r) = forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
s k
k forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f LeqMap k a
l forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f LeqMap k a
r


-- | Return the empty map
empty :: LeqMap k p
empty :: forall k p. LeqMap k p
empty = forall k p. LeqMap k p
Tip

singleton :: k -> p -> LeqMap k p
singleton :: forall k p. k -> p -> LeqMap k p
singleton k
k p
a = forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
a forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip

size :: LeqMap k p -> Int
size :: forall k p. LeqMap k p -> Size
size LeqMap k p
Tip = Size
0
size (Bin Size
s k
_ p
_ LeqMap k p
_ LeqMap k p
_) = Size
s

null :: LeqMap k p -> Bool
null :: forall k a. LeqMap k a -> Bool
null LeqMap k p
Tip = Bool
True
null Bin{} = Bool
False

findMax :: LeqMap k p -> (k,p)
findMax :: forall k p. LeqMap k p -> (k, p)
findMax LeqMap k p
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"findMax of empty map."
findMax (Bin Size
_ k
k0 p
a0 LeqMap k p
_ LeqMap k p
r0) = forall k p. k -> p -> LeqMap k p -> (k, p)
go k
k0 p
a0 LeqMap k p
r0
  where go :: k -> p -> LeqMap k p -> (k,p)
        go :: forall k p. k -> p -> LeqMap k p -> (k, p)
go k
_ p
_ (Bin Size
_ k
k p
a LeqMap k p
_ LeqMap k p
r) = forall k p. k -> p -> LeqMap k p -> (k, p)
go k
k p
a LeqMap k p
r
        go k
k p
a LeqMap k p
Tip = (k
k, p
a)

findMin :: LeqMap k p -> (k,p)
findMin :: forall k p. LeqMap k p -> (k, p)
findMin LeqMap k p
Tip = forall a. HasCallStack => [Char] -> a
error [Char]
"findMin of empty map."
findMin (Bin Size
_ k
k0 p
a0 LeqMap k p
l0 LeqMap k p
_) = forall k p. k -> p -> LeqMap k p -> (k, p)
go k
k0 p
a0 LeqMap k p
l0
  where go :: k -> p -> LeqMap k p -> (k,p)
        go :: forall k p. k -> p -> LeqMap k p -> (k, p)
go k
_ p
_ (Bin Size
_ k
k p
a LeqMap k p
l LeqMap k p
_) = forall k p. k -> p -> LeqMap k p -> (k, p)
go k
k p
a LeqMap k p
l
        go k
k p
a LeqMap k p
Tip = (k
k, p
a)

toList :: LeqMap k p -> [(k,p)]
toList :: forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
Tip = []
toList (Bin Size
_ k
k p
a LeqMap k p
l LeqMap k p
r) = forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
l forall a. [a] -> [a] -> [a]
++ ((k
k,p
a)forall a. a -> [a] -> [a]
:forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
r)

mapKeysMonotonic :: (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic :: forall k1 k2 p. (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic k1 -> k2
_ LeqMap k1 p
Tip = forall k p. LeqMap k p
Tip
mapKeysMonotonic k1 -> k2
f (Bin Size
s k1
k p
a LeqMap k1 p
l LeqMap k1 p
r) =
  forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
s (k1 -> k2
f k1
k) p
a (forall k1 k2 p. (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic k1 -> k2
f LeqMap k1 p
l) (forall k1 k2 p. (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic k1 -> k2
f LeqMap k1 p
r)

splitLeq :: Ord k => k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
splitLeq :: forall k p. Ord k => k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
splitLeq k
k LeqMap k p
m = seq :: forall a b. a -> b -> b
seq k
k forall a b. (a -> b) -> a -> b
$
  case LeqMap k p
m of
    LeqMap k p
Tip -> (forall k p. LeqMap k p
Tip, forall k p. LeqMap k p
Tip)
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
        Ordering
LT ->
          let (LeqMap k p
ll, LeqMap k p
lr) = forall k p. Ord k => k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
splitLeq k
k LeqMap k p
l
              r' :: LeqMap k p
r' = forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
lr LeqMap k p
r
           in seq :: forall a b. a -> b -> b
seq LeqMap k p
r' (LeqMap k p
ll, LeqMap k p
r')
        Ordering
GT ->
          let (LeqMap k p
rl, LeqMap k p
rr) = forall k p. Ord k => k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
splitLeq k
k LeqMap k p
r
              l' :: LeqMap k p
l' = forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l LeqMap k p
rl
           in seq :: forall a b. a -> b -> b
seq LeqMap k p
l' (LeqMap k p
l', LeqMap k p
rr)
        Ordering
EQ ->
          let l' :: LeqMap k p
l' = forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMax k
kx p
x LeqMap k p
l
           in seq :: forall a b. a -> b -> b
seq LeqMap k p
l' (LeqMap k p
l', LeqMap k p
r)
{-# INLINABLE splitLeq #-}

splitEntry :: LeqMap k p -> Maybe (LeqMap k p, (k, p), LeqMap k p)
splitEntry :: forall k p. LeqMap k p -> Maybe (LeqMap k p, (k, p), LeqMap k p)
splitEntry LeqMap k p
Tip = forall a. Maybe a
Nothing
splitEntry (Bin Size
_ k
k p
a LeqMap k p
l LeqMap k p
r) = forall a. a -> Maybe a
Just (LeqMap k p
l, (k
k, p
a), LeqMap k p
r)

insert :: Ord k => k -> p -> LeqMap k p -> LeqMap k p
insert :: forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
insert = forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go
  where
    go :: Ord k => k -> p -> LeqMap k p -> LeqMap k p
    go :: forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
_ | seq :: forall a b. a -> b -> b
seq k
kx forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq p
x forall a b. (a -> b) -> a -> b
$ Bool
False = forall a. HasCallStack => [Char] -> a
error [Char]
"insert bad"
    go k
kx p
x LeqMap k p
Tip = forall k p. k -> p -> LeqMap k p
singleton k
kx p
x
    go k
kx p
x (Bin Size
sz k
ky p
y LeqMap k p
l LeqMap k p
r) =
      case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
        Ordering
LT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
l) LeqMap k p
r
        Ordering
GT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
r)
        Ordering
EQ -> forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
sz k
kx p
x LeqMap k p
l LeqMap k p
r

lookupLE_Just :: Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLE_Just :: forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLE_Just k
_ k
ky p
y LeqMap k p
Tip = (k
ky,p
y)
lookupLE_Just k
k k
ky p
y (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
  case forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
    Ordering
LT -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLE_Just k
k k
kx p
x LeqMap k p
r
    Ordering
GT -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLE_Just k
k k
ky p
y LeqMap k p
l
    Ordering
EQ -> (k
kx, p
x)
{-# INLINABLE lookupLE_Just #-}

lookupGE_Just :: Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGE_Just :: forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGE_Just k
_ k
ky p
y LeqMap k p
Tip = (k
ky,p
y)
lookupGE_Just k
k k
ky p
y (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
  case forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
    Ordering
LT -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGE_Just k
k k
ky p
y LeqMap k p
r
    Ordering
GT -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGE_Just k
k k
kx p
x LeqMap k p
l
    Ordering
EQ -> (k
kx, p
x)
{-# INLINABLE lookupGE_Just #-}

lookupLT_Just :: Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLT_Just :: forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLT_Just k
_ k
ky p
y LeqMap k p
Tip = (k
ky,p
y)
lookupLT_Just k
k k
ky p
y (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
  case k
kx forall a. Ord a => a -> a -> Bool
< k
k of
    Bool
True  -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLT_Just k
k k
kx p
x LeqMap k p
r
    Bool
False -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLT_Just k
k k
ky p
y LeqMap k p
l
{-# INLINABLE lookupLT_Just #-}

lookupGT_Just :: Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGT_Just :: forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGT_Just k
_ k
ky p
y LeqMap k p
Tip = (k
ky,p
y)
lookupGT_Just k
k k
ky p
y (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
  case k
kx forall a. Ord a => a -> a -> Bool
> k
k of
    Bool
True  -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGT_Just k
k k
kx p
x LeqMap k p
l
    Bool
False -> forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGT_Just k
k k
ky p
y LeqMap k p
r
{-# INLINABLE lookupGT_Just #-}

-- | Find largest element that is less than or equal to key (if any).
lookupLE :: Ord k => k -> LeqMap k p -> Maybe (k,p)
lookupLE :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
lookupLE k
k0 LeqMap k p
m0 = seq :: forall a b. a -> b -> b
seq k
k0 (forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k0 LeqMap k p
m0)
  where goNothing :: Ord k => k -> LeqMap k p -> Maybe (k,p)
        goNothing :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
            Ordering
LT -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLE_Just k
k k
kx p
x LeqMap k p
r
            Ordering
GT -> forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
l
            Ordering
EQ -> forall a. a -> Maybe a
Just (k
kx, p
x)
{-# INLINABLE lookupLE #-}

-- | Find largest element that is at least key (if any).
lookupGE :: Ord k => k -> LeqMap k p -> Maybe (k,p)
lookupGE :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
lookupGE k
k0 LeqMap k p
m0 = seq :: forall a b. a -> b -> b
seq k
k0 (forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k0 LeqMap k p
m0)
  where goNothing :: Ord k => k -> LeqMap k p -> Maybe (k,p)
        goNothing :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
            Ordering
LT -> forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
r
            Ordering
GT -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGE_Just k
k k
kx p
x LeqMap k p
l
            Ordering
EQ -> forall a. a -> Maybe a
Just (k
kx, p
x)
{-# INLINABLE lookupGE #-}

-- | Find less than element that is less than key (if any).
lookupLT :: Ord k => k -> LeqMap k p -> Maybe (k,p)
lookupLT :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
lookupLT k
k0 LeqMap k p
m0 = seq :: forall a b. a -> b -> b
seq k
k0 (forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k0 LeqMap k p
m0)
  where goNothing :: Ord k => k -> LeqMap k p -> Maybe (k,p)
        goNothing :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case k
kx forall a. Ord a => a -> a -> Bool
< k
k of
            Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupLT_Just k
k k
kx p
x LeqMap k p
r
            Bool
False -> forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
l
{-# INLINABLE lookupLT #-}

-- | Find less than element that is less than key (if any).
lookupGT :: Ord k => k -> LeqMap k p -> Maybe (k,p)
lookupGT :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
lookupGT k
k0 LeqMap k p
m0 = seq :: forall a b. a -> b -> b
seq k
k0 (forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k0 LeqMap k p
m0)
  where goNothing :: Ord k => k -> LeqMap k p -> Maybe (k,p)
        goNothing :: forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case k
kx forall a. Ord a => a -> a -> Bool
> k
k of
            Bool
True -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k p. Ord k => k -> k -> p -> LeqMap k p -> (k, p)
lookupGT_Just k
k k
kx p
x LeqMap k p
l
            Bool
False -> forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
r
{-# INLINABLE lookupGT #-}

filterMGt :: Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt :: forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS k
NothingS LeqMap k p
t = LeqMap k p
t
filterMGt (JustS k
b0) LeqMap k p
t = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterGt k
b0 LeqMap k p
t
{-# INLINABLE filterMGt #-}

filterGt :: Ord k => k -> LeqMap k p -> LeqMap k p
filterGt :: forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterGt k
b LeqMap k p
t = seq :: forall a b. a -> b -> b
seq k
b forall a b. (a -> b) -> a -> b
$ do
  case LeqMap k p
t of
    LeqMap k p
Tip -> forall k p. LeqMap k p
Tip
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case forall a. Ord a => a -> a -> Ordering
compare k
b k
kx of
        Ordering
LT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterGt k
b LeqMap k p
l) LeqMap k p
r
        Ordering
GT -> forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterGt k
b LeqMap k p
r
        Ordering
EQ -> LeqMap k p
r
{-# INLINABLE filterGt #-}

filterMLt :: Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt :: forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt MaybeS k
NothingS LeqMap k p
t = LeqMap k p
t
filterMLt (JustS k
b) LeqMap k p
t = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterLt k
b LeqMap k p
t
{-# INLINABLE filterMLt #-}

filterLt :: Ord k => k -> LeqMap k p -> LeqMap k p
filterLt :: forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterLt k
b LeqMap k p
t = seq :: forall a b. a -> b -> b
seq k
b forall a b. (a -> b) -> a -> b
$ do
  case LeqMap k p
t of
    LeqMap k p
Tip -> forall k p. LeqMap k p
Tip
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case forall a. Ord a => a -> a -> Ordering
compare k
kx k
b of
        Ordering
LT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l (forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterLt k
b LeqMap k p
r)
        Ordering
EQ -> LeqMap k p
l
        Ordering
GT -> forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
filterLt k
b LeqMap k p
l
{-# INLINABLE filterLt #-}

trim :: Ord k => MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim :: forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS k
NothingS   MaybeS k
NothingS   LeqMap k p
t = LeqMap k p
t
trim (JustS k
lk) MaybeS k
NothingS   LeqMap k p
t = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
greater k
lk LeqMap k p
t
trim MaybeS k
NothingS   (JustS k
hk) LeqMap k p
t = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
lesser k
hk LeqMap k p
t
trim (JustS k
lk) (JustS k
hk) LeqMap k p
t = forall k p. Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle k
lk k
hk LeqMap k p
t
{-# INLINABLE trim #-}

-- | @lesser hi m@ returns all entries in @m@ less than @hi@.
lesser :: Ord k => k -> LeqMap k p -> LeqMap k p
lesser :: forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
lesser k
hi (Bin Size
_ k
k p
_ LeqMap k p
l LeqMap k p
_) | k
hi forall a. Ord a => a -> a -> Bool
<= k
k = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
lesser k
hi LeqMap k p
l
lesser k
_ LeqMap k p
t' = LeqMap k p
t'
{-# INLINABLE lesser #-}

mgt :: Ord k => k -> MaybeS k -> Bool
mgt :: forall k. Ord k => k -> MaybeS k -> Bool
mgt k
_ MaybeS k
NothingS = Bool
True
mgt k
k (JustS k
y) = k
k forall a. Ord a => a -> a -> Bool
> k
y

middle :: Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle :: forall k p. Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle k
lo k
hi (Bin Size
_ k
k p
_ LeqMap k p
_ LeqMap k p
r) | k
k forall a. Ord a => a -> a -> Bool
<= k
lo = forall k p. Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle k
lo k
hi LeqMap k p
r
middle k
lo k
hi (Bin Size
_ k
k p
_ LeqMap k p
l LeqMap k p
_) | k
k forall a. Ord a => a -> a -> Bool
>= k
hi = forall k p. Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle k
lo k
hi LeqMap k p
l
middle k
_  k
_  LeqMap k p
t' = LeqMap k p
t'
{-# INLINABLE middle #-}

greater :: Ord k => k -> LeqMap k p -> LeqMap k p
greater :: forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
greater k
lo (Bin Size
_ k
k p
_ LeqMap k p
_ LeqMap k p
r) | k
k forall a. Ord a => a -> a -> Bool
<= k
lo = forall k p. Ord k => k -> LeqMap k p -> LeqMap k p
greater k
lo LeqMap k p
r
greater k
_  LeqMap k p
t' = LeqMap k p
t'

union :: Ord k => LeqMap k p -> LeqMap k p -> LeqMap k p
union :: forall k p. Ord k => LeqMap k p -> LeqMap k p -> LeqMap k p
union LeqMap k p
Tip LeqMap k p
t2  = LeqMap k p
t2
union LeqMap k p
t1 LeqMap k p
Tip  = LeqMap k p
t1
union LeqMap k p
t1 LeqMap k p
t2 = forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion forall a. MaybeS a
NothingS forall a. MaybeS a
NothingS LeqMap k p
t1 LeqMap k p
t2
{-# INLINABLE union #-}

insertR :: Ord k => k -> p -> LeqMap k p -> LeqMap k p
insertR :: forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
insertR = forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go
  where
    go :: Ord k => k -> p -> LeqMap k p -> LeqMap k p
    go :: forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
_ | seq :: forall a b. a -> b -> b
seq k
kx forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq p
x forall a b. (a -> b) -> a -> b
$ Bool
False = forall a. HasCallStack => [Char] -> a
error [Char]
"insert bad"
    go k
kx p
x LeqMap k p
Tip = forall k p. k -> p -> LeqMap k p
singleton k
kx p
x
    go k
kx p
x t :: LeqMap k p
t@(Bin Size
_ k
ky p
y LeqMap k p
l LeqMap k p
r) =
      case forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
        Ordering
LT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
l) LeqMap k p
r
        Ordering
GT -> forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
r)
        Ordering
EQ -> LeqMap k p
t
{-# INLINABLE insertR #-}


-- left-biased hedge union
hedgeUnion :: Ord k => MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion :: forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion MaybeS k
_   MaybeS k
_   LeqMap k p
t1  LeqMap k p
Tip = LeqMap k p
t1
hedgeUnion MaybeS k
blo MaybeS k
bhi LeqMap k p
Tip (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
  forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS k
blo LeqMap k p
l) (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt MaybeS k
bhi LeqMap k p
r)
hedgeUnion MaybeS k
_   MaybeS k
_   LeqMap k p
t1  (Bin Size
_ k
kx p
x LeqMap k p
Tip LeqMap k p
Tip) =
  forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
insertR k
kx p
x LeqMap k p
t1  -- According to benchmarks, this special case increases
                   -- performance up to 30%. It does not help in difference or intersection.
hedgeUnion MaybeS k
blo MaybeS k
bhi (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) LeqMap k p
t2 =
  forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion MaybeS k
blo MaybeS k
bmi LeqMap k p
l (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS k
blo MaybeS k
bmi LeqMap k p
t2))
            (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion MaybeS k
bmi MaybeS k
bhi LeqMap k p
r (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS k
bmi MaybeS k
bhi LeqMap k p
t2))
  where bmi :: MaybeS k
bmi = forall a. a -> MaybeS a
JustS k
kx
{-# INLINABLE hedgeUnion #-}

foldlWithKey' :: (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' :: forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' a -> k -> b -> a
_ a
z LeqMap k b
Tip = a
z
foldlWithKey' a -> k -> b -> a
f a
z (Bin Size
_ k
kx b
x LeqMap k b
l LeqMap k b
r) =
  forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' a -> k -> b -> a
f (a -> k -> b -> a
f (forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' a -> k -> b -> a
f a
z LeqMap k b
l) k
kx b
x) LeqMap k b
r

keys :: LeqMap k p -> [k]
keys :: forall k p. LeqMap k p -> [k]
keys LeqMap k p
Tip = []
keys (Bin Size
_ k
kx p
_ LeqMap k p
l LeqMap k p
r) = forall k p. LeqMap k p -> [k]
keys LeqMap k p
l forall a. [a] -> [a] -> [a]
++ (k
kxforall a. a -> [a] -> [a]
:forall k p. LeqMap k p -> [k]
keys LeqMap k p
r)

minViewWithKey :: LeqMap k p -> Maybe ((k,p), LeqMap k p)
minViewWithKey :: forall k p. LeqMap k p -> Maybe ((k, p), LeqMap k p)
minViewWithKey LeqMap k p
Tip = forall a. Maybe a
Nothing
minViewWithKey t :: LeqMap k p
t@Bin{} = forall a. a -> Maybe a
Just (forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMin LeqMap k p
t)

deleteFindMin :: LeqMap k p -> ((k,p),LeqMap k p)
deleteFindMin :: forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMin LeqMap k p
t
  = case LeqMap k p
t of
      Bin Size
_ k
k p
x LeqMap k p
Tip LeqMap k p
r -> ((k
k,p
x),LeqMap k p
r)
      Bin Size
_ k
k p
x LeqMap k p
l LeqMap k p
r   -> let ((k, p)
km,LeqMap k p
l') = forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMin LeqMap k p
l in ((k, p)
km,forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
k p
x LeqMap k p
l' LeqMap k p
r)
      LeqMap k p
Tip             -> (forall a. HasCallStack => [Char] -> a
error [Char]
"LeqMap.deleteFindMin: can not return the minimal element of an empty map", forall k p. LeqMap k p
Tip)

deleteFindMax :: LeqMap k p -> ((k,p),LeqMap k p)
deleteFindMax :: forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMax LeqMap k p
t
  = case LeqMap k p
t of
      Bin Size
_ k
k p
x LeqMap k p
l LeqMap k p
Tip -> ((k
k,p
x),LeqMap k p
l)
      Bin Size
_ k
k p
x LeqMap k p
l LeqMap k p
r   -> let ((k, p)
km,LeqMap k p
r') = forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMax LeqMap k p
r in ((k, p)
km,forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
k p
x LeqMap k p
l LeqMap k p
r')
      LeqMap k p
Tip             -> (forall a. HasCallStack => [Char] -> a
error [Char]
"LeqMap.deleteFindMax: can not return the maximal element of an empty map", forall k p. LeqMap k p
Tip)

mergeWithKey :: forall a b c
              . (a -> b -> IO c)
             -> (a -> IO c)
             -> (b -> IO c)
             -> LeqMap Integer a
             -> LeqMap Integer b
             -> IO (LeqMap Integer c)
mergeWithKey :: forall a b c.
(a -> b -> IO c)
-> (a -> IO c)
-> (b -> IO c)
-> LeqMap Integer a
-> LeqMap Integer b
-> IO (LeqMap Integer c)
mergeWithKey a -> b -> IO c
f0 a -> IO c
g1 b -> IO c
g2 = LeqMap Integer a -> LeqMap Integer b -> IO (LeqMap Integer c)
go
  where

    go :: LeqMap Integer a -> LeqMap Integer b -> IO (LeqMap Integer c)
go LeqMap Integer a
Tip LeqMap Integer b
t2 = forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> IO c
g2 LeqMap Integer b
t2
    go LeqMap Integer a
t1 LeqMap Integer b
Tip = forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> IO c
g1 LeqMap Integer a
t1
    go LeqMap Integer a
t1 LeqMap Integer b
t2 | forall k p. LeqMap k p -> Size
size LeqMap Integer a
t1 forall a. Ord a => a -> a -> Bool
<= forall k p. LeqMap k p -> Size
size LeqMap Integer b
t2 = MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge forall a. MaybeS a
NothingS forall a. MaybeS a
NothingS forall a. MaybeS a
NothingS LeqMap Integer a
t1 forall a. MaybeS a
NothingS LeqMap Integer b
t2
             | Bool
otherwise = forall a b c.
(a -> b -> IO c)
-> (a -> IO c)
-> (b -> IO c)
-> LeqMap Integer a
-> LeqMap Integer b
-> IO (LeqMap Integer c)
mergeWithKey (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> IO c
f0) b -> IO c
g2 a -> IO c
g1 LeqMap Integer b
t2 LeqMap Integer a
t1

    hedgeMerge :: MaybeS Integer
               -> MaybeS Integer
               -> MaybeS a
               -> LeqMap Integer a
               -> MaybeS b
               -> LeqMap Integer b
               -> IO (LeqMap Integer c)
    hedgeMerge :: MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge MaybeS Integer
mlo MaybeS Integer
mhi MaybeS a
a LeqMap Integer a
_ MaybeS b
b LeqMap Integer b
_ | seq :: forall a b. a -> b -> b
seq MaybeS Integer
mlo forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq MaybeS Integer
mhi forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq MaybeS a
a forall a b. (a -> b) -> a -> b
$ seq :: forall a b. a -> b -> b
seq MaybeS b
b forall a b. (a -> b) -> a -> b
$ Bool
False = forall a. HasCallStack => [Char] -> a
error [Char]
"hedgeMerge"
    hedgeMerge MaybeS Integer
_   MaybeS Integer
_  MaybeS a
_ LeqMap Integer a
t1 MaybeS b
mb LeqMap Integer b
Tip = do
      case MaybeS b
mb of
        MaybeS b
NothingS -> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> IO c
g1 LeqMap Integer a
t1
        JustS b
b -> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> b -> IO c
`f0` b
b) LeqMap Integer a
t1

    hedgeMerge MaybeS Integer
blo MaybeS Integer
bhi MaybeS a
ma LeqMap Integer a
Tip MaybeS b
_ (Bin Size
_ Integer
kx b
x LeqMap Integer b
l LeqMap Integer b
r) = do
      case MaybeS a
ma of
        MaybeS a
NothingS ->
          forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> IO c
g2 b
x
                  forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> IO c
g2 (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS Integer
blo LeqMap Integer b
l)
                  forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> IO c
g2 (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt MaybeS Integer
bhi LeqMap Integer b
r)
        JustS a
a ->
          forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> IO c
f0 a
a b
x
                  forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> b -> IO c
f0 a
a) (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS Integer
blo LeqMap Integer b
l)
                  forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> b -> IO c
f0 a
a) (forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt MaybeS Integer
bhi LeqMap Integer b
r)
    hedgeMerge MaybeS Integer
blo MaybeS Integer
bhi MaybeS a
a (Bin Size
_ Integer
kx a
x LeqMap Integer a
l LeqMap Integer a
r) MaybeS b
mb LeqMap Integer b
t2 = do
      let bmi :: MaybeS Integer
bmi = forall a. a -> MaybeS a
JustS Integer
kx
      case forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
lookupLE Integer
kx LeqMap Integer b
t2 of
        Just (Integer
ky,b
y) | Integer
ky forall k. Ord k => k -> MaybeS k -> Bool
`mgt` MaybeS Integer
blo -> do
          LeqMap Integer c
l' <- MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge MaybeS Integer
blo MaybeS Integer
bmi MaybeS a
a LeqMap Integer a
l MaybeS b
mb (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS Integer
blo MaybeS Integer
bmi LeqMap Integer b
t2)
          c
x' <- a -> b -> IO c
f0 a
x b
y
          LeqMap Integer c
r' <- MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge MaybeS Integer
bmi MaybeS Integer
bhi (forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r (forall a. a -> MaybeS a
JustS b
y) (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS Integer
bmi MaybeS Integer
bhi LeqMap Integer b
t2)
          forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx c
x' LeqMap Integer c
l' LeqMap Integer c
r'
        Maybe (Integer, b)
_ -> do
          case MaybeS b
mb of
            MaybeS b
NothingS -> do
              LeqMap Integer c
l' <- forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> IO c
g1 LeqMap Integer a
l
              c
x' <- a -> IO c
g1 a
x
              LeqMap Integer c
r' <- MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge MaybeS Integer
bmi MaybeS Integer
bhi (forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r MaybeS b
mb (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS Integer
bmi MaybeS Integer
bhi LeqMap Integer b
t2)
              forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx c
x' LeqMap Integer c
l' LeqMap Integer c
r'
            JustS b
b -> do
              LeqMap Integer c
l' <- forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (a -> b -> IO c
`f0` b
b) LeqMap Integer a
l
              c
x' <- a -> b -> IO c
f0 a
x b
b
              LeqMap Integer c
r' <- MaybeS Integer
-> MaybeS Integer
-> MaybeS a
-> LeqMap Integer a
-> MaybeS b
-> LeqMap Integer b
-> IO (LeqMap Integer c)
hedgeMerge MaybeS Integer
bmi MaybeS Integer
bhi (forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r MaybeS b
mb (forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
trim MaybeS Integer
bmi MaybeS Integer
bhi LeqMap Integer b
t2)
              forall (m :: Type -> Type) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx c
x' LeqMap Integer c
l' LeqMap Integer c
r'
{-# INLINE mergeWithKey #-}


foldlWithKey :: (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey :: forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey a -> k -> b -> a
f a
z = a -> LeqMap k b -> a
go a
z
  where
    go :: a -> LeqMap k b -> a
go a
z' LeqMap k b
Tip              = a
z'
    go a
z' (Bin Size
_ k
kx b
x LeqMap k b
l LeqMap k b
r) = a -> LeqMap k b -> a
go (a -> k -> b -> a
f (a -> LeqMap k b -> a
go a
z' LeqMap k b
l) k
kx b
x) LeqMap k b
r
{-# INLINE foldlWithKey #-}

toDescList :: LeqMap k p -> [(k,p)]
toDescList :: forall k p. LeqMap k p -> [(k, p)]
toDescList = forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey (\[(k, p)]
xs k
k p
x -> (k
k,p
x)forall a. a -> [a] -> [a]
:[(k, p)]
xs) []

fromDistinctAscList :: [(k,p)] -> LeqMap k p
fromDistinctAscList :: forall k p. [(k, p)] -> LeqMap k p
fromDistinctAscList [] = forall k p. LeqMap k p
Tip
fromDistinctAscList ((k
kx0, p
x0) : [(k, p)]
xs0) = p
x0 seq :: forall a b. a -> b -> b
`seq` forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
0 (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx0 p
x0 forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip) [(k, p)]
xs0
  where
    go :: Int -> LeqMap k p -> [(k,p)] -> LeqMap k p
    go :: forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
_ LeqMap k p
t [] = LeqMap k p
t
    go Size
s LeqMap k p
l ((k
kx, p
x) : [(k, p)]
xs) = case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
s [(k, p)]
xs of
                              (LeqMap k p
r, [(k, p)]
ys) -> p
x seq :: forall a b. a -> b -> b
`seq` forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go (Size
s forall a. Num a => a -> a -> a
+ Size
1) (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l LeqMap k p
r) [(k, p)]
ys

    -- @create k l@ extracts at most @2^k@ elements from @l@ and creates a map.
    -- The remaining elements (if any) are returned as well.
    create :: Int -> [(k, p)] -> (LeqMap k p, [(k,p)])
    -- Reached end of list.
    create :: forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (forall k p. LeqMap k p
Tip, [])
    -- Extract single element
    create Size
0 ((k
kx,p
x) : [(k, p)]
xs') = p
x seq :: forall a b. a -> b -> b
`seq` (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx p
x forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip, [(k, p)]
xs')
    create Size
s [(k, p)]
xs
      | Bool
otherwise =
        case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
xs of
          res :: (LeqMap k p, [(k, p)])
res@(LeqMap k p
_, []) -> (LeqMap k p, [(k, p)])
res
          (LeqMap k p
l, (k
ky, p
y):[(k, p)]
ys) ->
            case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
ys of
              (LeqMap k p
r, [(k, p)]
zs) -> p
y seq :: forall a b. a -> b -> b
`seq` (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
ky p
y LeqMap k p
l LeqMap k p
r, [(k, p)]
zs)

-- | Create a map from a list of keys in descending order.
fromDistinctDescList :: [(k,p)] -> LeqMap k p
fromDistinctDescList :: forall k p. [(k, p)] -> LeqMap k p
fromDistinctDescList [] = forall k p. LeqMap k p
Tip
fromDistinctDescList ((k
kx0, p
x0) : [(k, p)]
xs0) = p
x0 seq :: forall a b. a -> b -> b
`seq` forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
0 (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx0 p
x0 forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip) [(k, p)]
xs0
  where
    go :: Int -> LeqMap k p -> [(k,p)] -> LeqMap k p
    go :: forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
_ LeqMap k p
t [] = LeqMap k p
t
    go Size
s LeqMap k p
r ((k
kx, p
x) : [(k, p)]
xs) = case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
s [(k, p)]
xs of
                              (LeqMap k p
l, [(k, p)]
ys) -> p
x seq :: forall a b. a -> b -> b
`seq` forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go (Size
s forall a. Num a => a -> a -> a
+ Size
1) (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l LeqMap k p
r) [(k, p)]
ys

    -- @create k l@ extracts at most @2^k@ elements from @l@ and creates a map.
    -- The remaining elements (if any) are returned as well.
    create :: Int -> [(k, p)] -> (LeqMap k p, [(k,p)])
    -- Reached end of list.
    create :: forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (forall k p. LeqMap k p
Tip, [])
    -- Extract single element
    create Size
0 ((k
kx,p
x) : [(k, p)]
xs') = p
x seq :: forall a b. a -> b -> b
`seq` (forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx p
x forall k p. LeqMap k p
Tip forall k p. LeqMap k p
Tip, [(k, p)]
xs')
    create Size
s [(k, p)]
xs
      | Bool
otherwise =
        case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
xs of
          res :: (LeqMap k p, [(k, p)])
res@(LeqMap k p
_, []) -> (LeqMap k p, [(k, p)])
res
          (LeqMap k p
r, (k
ky, p
y):[(k, p)]
ys) ->
            case forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
ys of
              (LeqMap k p
l, [(k, p)]
zs) -> p
y seq :: forall a b. a -> b -> b
`seq` (forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
ky p
y LeqMap k p
l LeqMap k p
r, [(k, p)]
zs)