{-|
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 :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
k p
x LeqMap k p
l LeqMap k p
r = Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
l Size -> Size -> Size
forall a. Num a => a -> a -> a
+ LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
r Size -> Size -> Size
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 :: 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 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size -> Size -> Size
forall a. Ord a => a -> a -> a
max Size
1 (Size
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*LeqMap k p -> Size
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 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
>= Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
* LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
ll ->
          k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
bin k
lrk p
lrx (k -> p -> LeqMap k p -> LeqMap k p -> 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  LeqMap k p
lrl) (k -> p -> LeqMap k p -> LeqMap k p -> 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
lrr LeqMap k p
r)
        LeqMap k p
_ -> k -> p -> LeqMap k p -> LeqMap k p -> 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 (k -> p -> LeqMap k p -> LeqMap k p -> 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
lr LeqMap k p
r)
    LeqMap k p
_ -> k -> p -> LeqMap k p -> LeqMap k p -> 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 :: 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 -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip
           (Bin Size
_ k
_ p
_ LeqMap k p
Tip LeqMap k p
Tip) -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
2 k
k p
x LeqMap k p
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{})) -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
3 k
rk p
rx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
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) -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
3 k
rlk p
rlx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
k p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip) (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
rk p
rx LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
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 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rrs -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) k
rk p
rx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rls) k
k p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
rl) LeqMap k p
rr
             | Bool
otherwise -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) k
rlk p
rlx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
rll) k
k p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
rll) (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rrsSize -> Size -> Size
forall a. Num a => a -> a -> a
+LeqMap k p -> Size
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 -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
ls) k
k p
x LeqMap k p
l LeqMap k p
forall k p. LeqMap k p
Tip

           (Bin Size
rs k
rk p
rx LeqMap k p
rl LeqMap k p
rr)
              | Size
rs Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
> Size
deltaSize -> Size -> Size
forall 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 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
ratioSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
rrs -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) k
rk p
rx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall 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 -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rs) k
rlk p
rlx (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall a. Num a => a -> a -> a
+LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
rll) k
k p
x LeqMap k p
l LeqMap k p
rll) (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
rrsSize -> Size -> Size
forall a. Num a => a -> a -> a
+LeqMap k p -> Size
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
_) -> [Char] -> LeqMap k p
forall a. HasCallStack => [Char] -> a
error [Char]
"Failure in Data.Map.balanceR"
              | Bool
otherwise -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin (Size
1Size -> Size -> Size
forall a. Num a => a -> a -> a
+Size
lsSize -> Size -> Size
forall 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 :: 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 -> k -> p -> LeqMap k p
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 -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (k -> p -> LeqMap k p -> LeqMap k p
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 :: 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 -> k -> p -> LeqMap k p
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 -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (k -> p -> LeqMap k p -> LeqMap k p
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 :: k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
Tip LeqMap k p
r  = k -> p -> LeqMap k p -> LeqMap k p
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  = k -> p -> LeqMap k p -> LeqMap k p
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
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeL Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
sizeR  = k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
kz p
z (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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
deltaSize -> Size -> Size
forall a. Num a => a -> a -> a
*Size
sizeR Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
< Size
sizeL  = k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
ly (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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            = k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 = LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
x Size -> Size -> Bool
forall a. Eq a => a -> a -> Bool
== LeqMap k p -> Size
forall k p. LeqMap k p -> Size
size LeqMap k p
y Bool -> Bool -> Bool
&& LeqMap k p -> [(k, p)]
forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
x [(k, p)] -> [(k, p)] -> Bool
forall a. Eq a => a -> a -> Bool
== LeqMap k p -> [(k, p)]
forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
y


instance Functor (LeqMap k) where
  fmap :: (a -> b) -> LeqMap k a -> LeqMap k b
fmap a -> b
_ LeqMap k a
Tip = LeqMap k b
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) = Size -> k -> b -> LeqMap k b -> LeqMap k b -> LeqMap k b
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) ((a -> b) -> LeqMap k a -> LeqMap k b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f LeqMap k a
l) ((a -> b) -> LeqMap k a -> LeqMap k b
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 :: (a -> m) -> LeqMap k a -> m
foldMap = (a -> m) -> LeqMap k a -> m
forall (t :: Type -> Type) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
foldMapDefault

instance Traversable (LeqMap k) where
  traverse :: (a -> f b) -> LeqMap k a -> f (LeqMap k b)
traverse a -> f b
_ LeqMap k a
Tip = LeqMap k b -> f (LeqMap k b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure LeqMap k b
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) = Size -> k -> b -> LeqMap k b -> LeqMap k b -> LeqMap k b
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
s k
k (b -> LeqMap k b -> LeqMap k b -> LeqMap k b)
-> f b -> f (LeqMap k b -> LeqMap k b -> LeqMap k b)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
a f (LeqMap k b -> LeqMap k b -> LeqMap k b)
-> f (LeqMap k b) -> f (LeqMap k b -> LeqMap k b)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (a -> f b) -> LeqMap k a -> f (LeqMap k 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 f (LeqMap k b -> LeqMap k b) -> f (LeqMap k b) -> f (LeqMap k b)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (a -> f b) -> LeqMap k a -> f (LeqMap k 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 :: LeqMap k p
empty = LeqMap k p
forall k p. LeqMap k p
Tip

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

size :: LeqMap k p -> Int
size :: 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 :: LeqMap k p -> Bool
null LeqMap k p
Tip = Bool
True
null Bin{} = Bool
False

findMax :: LeqMap k p -> (k,p)
findMax :: LeqMap k p -> (k, p)
findMax LeqMap k p
Tip = [Char] -> (k, p)
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) = k -> p -> LeqMap k p -> (k, p)
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 :: k -> p -> LeqMap k p -> (k, p)
go k
_ p
_ (Bin Size
_ k
k p
a LeqMap k p
_ LeqMap k p
r) = k -> p -> LeqMap k p -> (k, p)
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 :: LeqMap k p -> (k, p)
findMin LeqMap k p
Tip = [Char] -> (k, p)
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
_) = k -> p -> LeqMap k p -> (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 :: k -> p -> LeqMap k p -> (k, p)
go k
_ p
_ (Bin Size
_ k
k p
a LeqMap k p
l LeqMap k p
_) = k -> p -> LeqMap k p -> (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 :: 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) = LeqMap k p -> [(k, p)]
forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
l [(k, p)] -> [(k, p)] -> [(k, p)]
forall a. [a] -> [a] -> [a]
++ ((k
k,p
a)(k, p) -> [(k, p)] -> [(k, p)]
forall a. a -> [a] -> [a]
:LeqMap k p -> [(k, p)]
forall k p. LeqMap k p -> [(k, p)]
toList LeqMap k p
r)

mapKeysMonotonic :: (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic :: (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic k1 -> k2
_ LeqMap k1 p
Tip = LeqMap k2 p
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) =
  Size -> k2 -> p -> LeqMap k2 p -> LeqMap k2 p -> LeqMap k2 p
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 ((k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
forall k1 k2 p. (k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
mapKeysMonotonic k1 -> k2
f LeqMap k1 p
l) ((k1 -> k2) -> LeqMap k1 p -> LeqMap k2 p
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 :: k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
splitLeq k
k LeqMap k p
m = k -> (LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p)
seq k
k ((LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p))
-> (LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p)
forall a b. (a -> b) -> a -> b
$
  case LeqMap k p
m of
    LeqMap k p
Tip -> (LeqMap k p
forall k p. LeqMap k p
Tip, LeqMap k p
forall k p. LeqMap k p
Tip)
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
k k
kx of
        Ordering
LT ->
          let (LeqMap k p
ll, LeqMap k p
lr) = k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
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' = k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 LeqMap k p -> (LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p)
seq LeqMap k p
r' (LeqMap k p
ll, LeqMap k p
r')
        Ordering
GT ->
          let (LeqMap k p
rl, LeqMap k p
rr) = k -> LeqMap k p -> (LeqMap k p, LeqMap k p)
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' = k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 LeqMap k p -> (LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p)
seq LeqMap k p
l' (LeqMap k p
l', LeqMap k p
rr)
        Ordering
EQ ->
          let l' :: LeqMap k p
l' = k -> p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p
insertMax k
kx p
x LeqMap k p
l
           in LeqMap k p -> (LeqMap k p, LeqMap k p) -> (LeqMap k p, LeqMap k p)
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 :: LeqMap k p -> Maybe (LeqMap k p, (k, p), LeqMap k p)
splitEntry LeqMap k p
Tip = Maybe (LeqMap k p, (k, p), LeqMap k p)
forall a. Maybe a
Nothing
splitEntry (Bin Size
_ k
k p
a LeqMap k p
l LeqMap k p
r) = (LeqMap k p, (k, p), LeqMap k p)
-> Maybe (LeqMap k p, (k, p), LeqMap k p)
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 :: k -> p -> LeqMap k p -> LeqMap k p
insert = k -> p -> LeqMap k p -> LeqMap k p
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 :: k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
_ | k -> Bool -> Bool
seq k
kx (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ p -> Bool -> Bool
seq p
x (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
False = [Char] -> LeqMap k p
forall a. HasCallStack => [Char] -> a
error [Char]
"insert bad"
    go k
kx p
x LeqMap k p
Tip = k -> p -> LeqMap k p
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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
        Ordering
LT -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (k -> p -> LeqMap k p -> LeqMap k p
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 -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (k -> p -> LeqMap k p -> LeqMap k p
forall k p. Ord k => k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
r)
        Ordering
EQ -> Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 :: 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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
    Ordering
LT -> k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> k -> p -> LeqMap k p -> (k, p)
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 :: 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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
    Ordering
LT -> k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> k -> p -> LeqMap k p -> (k, p)
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 :: 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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k of
    Bool
True  -> k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> k -> p -> LeqMap k p -> (k, p)
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 :: 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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
k of
    Bool
True  -> k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> k -> p -> LeqMap k p -> (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
lookupLE k
k0 LeqMap k p
m0 = k -> Maybe (k, p) -> Maybe (k, p)
seq k
k0 (k -> LeqMap k p -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = Maybe (k, p)
forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
            Ordering
LT -> (k, p) -> Maybe (k, p)
forall a. a -> Maybe a
Just ((k, p) -> Maybe (k, p)) -> (k, p) -> Maybe (k, p)
forall a b. (a -> b) -> a -> b
$ k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> LeqMap k p -> Maybe (k, p)
forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
l
            Ordering
EQ -> (k, p) -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
lookupGE k
k0 LeqMap k p
m0 = k -> Maybe (k, p) -> Maybe (k, p)
seq k
k0 (k -> LeqMap k p -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = Maybe (k, p)
forall a. Maybe a
Nothing
        goNothing k
k (Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r) =
          case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
k of
            Ordering
LT -> k -> LeqMap k p -> Maybe (k, p)
forall k p. Ord k => k -> LeqMap k p -> Maybe (k, p)
goNothing k
k LeqMap k p
r
            Ordering
GT -> (k, p) -> Maybe (k, p)
forall a. a -> Maybe a
Just ((k, p) -> Maybe (k, p)) -> (k, p) -> Maybe (k, p)
forall a b. (a -> b) -> a -> b
$ k -> k -> p -> LeqMap k p -> (k, p)
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, p) -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
lookupLT k
k0 LeqMap k p
m0 = k -> Maybe (k, p) -> Maybe (k, p)
seq k
k0 (k -> LeqMap k p -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = Maybe (k, p)
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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
< k
k of
            Bool
True -> (k, p) -> Maybe (k, p)
forall a. a -> Maybe a
Just ((k, p) -> Maybe (k, p)) -> (k, p) -> Maybe (k, p)
forall a b. (a -> b) -> a -> b
$ k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> LeqMap k p -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
lookupGT k
k0 LeqMap k p
m0 = k -> Maybe (k, p) -> Maybe (k, p)
seq k
k0 (k -> LeqMap k p -> Maybe (k, p)
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 :: k -> LeqMap k p -> Maybe (k, p)
goNothing k
_ LeqMap k p
Tip = Maybe (k, p)
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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
k of
            Bool
True -> (k, p) -> Maybe (k, p)
forall a. a -> Maybe a
Just ((k, p) -> Maybe (k, p)) -> (k, p) -> Maybe (k, p)
forall a b. (a -> b) -> a -> b
$ k -> k -> p -> LeqMap k p -> (k, p)
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 -> k -> LeqMap k p -> Maybe (k, p)
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 :: 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 = k -> LeqMap k p -> LeqMap k p
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 :: k -> LeqMap k p -> LeqMap k p
filterGt k
b LeqMap k p
t = k -> LeqMap k p -> LeqMap k p
seq k
b (LeqMap k p -> LeqMap k p) -> LeqMap k p -> LeqMap k p
forall a b. (a -> b) -> a -> b
$ do
  case LeqMap k p
t of
    LeqMap k p
Tip -> LeqMap k p
forall k p. LeqMap k p
Tip
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
b k
kx of
        Ordering
LT -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (k -> LeqMap k p -> LeqMap k p
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 -> k -> LeqMap k p -> LeqMap k p
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 :: 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 = k -> LeqMap k p -> LeqMap k p
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 :: k -> LeqMap k p -> LeqMap k p
filterLt k
b LeqMap k p
t = k -> LeqMap k p -> LeqMap k p
seq k
b (LeqMap k p -> LeqMap k p) -> LeqMap k p -> LeqMap k p
forall a b. (a -> b) -> a -> b
$ do
  case LeqMap k p
t of
    LeqMap k p
Tip -> LeqMap k p
forall k p. LeqMap k p
Tip
    Bin Size
_ k
kx p
x LeqMap k p
l LeqMap k p
r ->
      case k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
b of
        Ordering
LT -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x LeqMap k p
l (k -> LeqMap k p -> LeqMap k p
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 -> k -> LeqMap k p -> LeqMap k p
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 :: 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 = k -> LeqMap k p -> LeqMap k p
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 = k -> LeqMap k p -> LeqMap k p
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 = k -> k -> LeqMap k p -> LeqMap k p
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 :: k -> LeqMap k p -> LeqMap k p
lesser k
hi (Bin Size
_ k
k p
_ LeqMap k p
l LeqMap k p
_) | k
hi k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
k = k -> LeqMap k p -> LeqMap k p
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 :: k -> MaybeS k -> Bool
mgt k
_ MaybeS k
NothingS = Bool
True
mgt k
k (JustS k
y) = k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
> k
y

middle :: Ord k => k -> k -> LeqMap k p -> LeqMap k p
middle :: 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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
lo = k -> k -> LeqMap k p -> LeqMap k p
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 k -> k -> Bool
forall a. Ord a => a -> a -> Bool
>= k
hi = k -> k -> LeqMap k p -> LeqMap k p
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 :: k -> LeqMap k p -> LeqMap k p
greater k
lo (Bin Size
_ k
k p
_ LeqMap k p
_ LeqMap k p
r) | k
k k -> k -> Bool
forall a. Ord a => a -> a -> Bool
<= k
lo = k -> LeqMap k p -> LeqMap k p
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 :: 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 = MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Ord k =>
MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
hedgeUnion MaybeS k
forall a. MaybeS a
NothingS MaybeS k
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 :: k -> p -> LeqMap k p -> LeqMap k p
insertR = k -> p -> LeqMap k p -> LeqMap k p
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 :: k -> p -> LeqMap k p -> LeqMap k p
go k
kx p
x LeqMap k p
_ | k -> Bool -> Bool
seq k
kx (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ p -> Bool -> Bool
seq p
x (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
False = [Char] -> LeqMap k p
forall a. HasCallStack => [Char] -> a
error [Char]
"insert bad"
    go k
kx p
x LeqMap k p
Tip = k -> p -> LeqMap k p
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 k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare k
kx k
ky of
        Ordering
LT -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceL k
ky p
y (k -> p -> LeqMap k p -> LeqMap k p
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 -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
balanceR k
ky p
y LeqMap k p
l (k -> p -> LeqMap k p -> LeqMap k p
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 :: 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) =
  k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (MaybeS k -> LeqMap k p -> LeqMap k p
forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS k
blo LeqMap k p
l) (MaybeS k -> LeqMap k p -> LeqMap k p
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) =
  k -> p -> LeqMap k p -> LeqMap k p
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 =
  k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link k
kx p
x (MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 (MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
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))
            (MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 (MaybeS k -> MaybeS k -> LeqMap k p -> LeqMap k p
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 = k -> MaybeS k
forall a. a -> MaybeS a
JustS k
kx
{-# INLINABLE hedgeUnion #-}

foldlWithKey' :: (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' :: (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) =
  (a -> k -> b -> a) -> a -> LeqMap k b -> a
forall a k b. (a -> k -> b -> a) -> a -> LeqMap k b -> a
foldlWithKey' a -> k -> b -> a
f (a -> k -> b -> a
f ((a -> k -> b -> a) -> a -> LeqMap k b -> a
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 :: LeqMap k p -> [k]
keys LeqMap k p
Tip = []
keys (Bin Size
_ k
kx p
_ LeqMap k p
l LeqMap k p
r) = LeqMap k p -> [k]
forall k p. LeqMap k p -> [k]
keys LeqMap k p
l [k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++ (k
kxk -> [k] -> [k]
forall a. a -> [a] -> [a]
:LeqMap k p -> [k]
forall k p. LeqMap k p -> [k]
keys LeqMap k p
r)

minViewWithKey :: LeqMap k p -> Maybe ((k,p), LeqMap k p)
minViewWithKey :: LeqMap k p -> Maybe ((k, p), LeqMap k p)
minViewWithKey LeqMap k p
Tip = Maybe ((k, p), LeqMap k p)
forall a. Maybe a
Nothing
minViewWithKey t :: LeqMap k p
t@Bin{} = ((k, p), LeqMap k p) -> Maybe ((k, p), LeqMap k p)
forall a. a -> Maybe a
Just (LeqMap k p -> ((k, p), LeqMap k p)
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 :: 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') = LeqMap k p -> ((k, p), LeqMap k p)
forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMin LeqMap k p
l in ((k, p)
km,k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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             -> ([Char] -> (k, p)
forall a. HasCallStack => [Char] -> a
error [Char]
"LeqMap.deleteFindMin: can not return the minimal element of an empty map", LeqMap k p
forall k p. LeqMap k p
Tip)

deleteFindMax :: LeqMap k p -> ((k,p),LeqMap k p)
deleteFindMax :: 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') = LeqMap k p -> ((k, p), LeqMap k p)
forall k p. LeqMap k p -> ((k, p), LeqMap k p)
deleteFindMax LeqMap k p
r in ((k, p)
km,k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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             -> ([Char] -> (k, p)
forall a. HasCallStack => [Char] -> a
error [Char]
"LeqMap.deleteFindMax: can not return the maximal element of an empty map", LeqMap k p
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 :: (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 = (b -> IO c) -> LeqMap Integer b -> IO (LeqMap Integer c)
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 = (a -> IO c) -> LeqMap Integer a -> IO (LeqMap Integer c)
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 | LeqMap Integer a -> Size
forall k p. LeqMap k p -> Size
size LeqMap Integer a
t1 Size -> Size -> Bool
forall a. Ord a => a -> a -> Bool
<= LeqMap Integer b -> Size
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 MaybeS Integer
forall a. MaybeS a
NothingS MaybeS Integer
forall a. MaybeS a
NothingS MaybeS a
forall a. MaybeS a
NothingS LeqMap Integer a
t1 MaybeS b
forall a. MaybeS a
NothingS LeqMap Integer b
t2
             | Bool
otherwise = (b -> a -> IO c)
-> (b -> IO c)
-> (a -> IO c)
-> LeqMap Integer b
-> LeqMap Integer a
-> IO (LeqMap Integer c)
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) -> b -> a -> IO c
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
_ | MaybeS Integer -> Bool -> Bool
seq MaybeS Integer
mlo (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MaybeS Integer -> Bool -> Bool
seq MaybeS Integer
mhi (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MaybeS a -> Bool -> Bool
seq MaybeS a
a (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ MaybeS b -> Bool -> Bool
seq MaybeS b
b (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool
False = [Char] -> IO (LeqMap Integer c)
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 -> (a -> IO c) -> LeqMap Integer a -> IO (LeqMap Integer c)
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 -> (a -> IO c) -> LeqMap Integer a -> IO (LeqMap Integer c)
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 ->
          Integer
-> c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx (c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
-> IO c
-> IO (LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> IO c
g2 b
x
                  IO (LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
-> IO (LeqMap Integer c)
-> IO (LeqMap Integer c -> LeqMap Integer c)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (b -> IO c) -> LeqMap Integer b -> IO (LeqMap Integer c)
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 (MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS Integer
blo LeqMap Integer b
l)
                  IO (LeqMap Integer c -> LeqMap Integer c)
-> IO (LeqMap Integer c) -> IO (LeqMap Integer c)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (b -> IO c) -> LeqMap Integer b -> IO (LeqMap Integer c)
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 (MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMLt MaybeS Integer
bhi LeqMap Integer b
r)
        JustS a
a ->
          Integer
-> c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c
forall k p. k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
link Integer
kx (c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
-> IO c
-> IO (LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> IO c
f0 a
a b
x
                  IO (LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c)
-> IO (LeqMap Integer c)
-> IO (LeqMap Integer c -> LeqMap Integer c)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (b -> IO c) -> LeqMap Integer b -> IO (LeqMap Integer c)
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) (MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
forall k p. Ord k => MaybeS k -> LeqMap k p -> LeqMap k p
filterMGt MaybeS Integer
blo LeqMap Integer b
l)
                  IO (LeqMap Integer c -> LeqMap Integer c)
-> IO (LeqMap Integer c) -> IO (LeqMap Integer c)
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (b -> IO c) -> LeqMap Integer b -> IO (LeqMap Integer c)
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) (MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
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 = Integer -> MaybeS Integer
forall a. a -> MaybeS a
JustS Integer
kx
      case Integer -> LeqMap Integer b -> Maybe (Integer, b)
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 Integer -> MaybeS Integer -> Bool
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 (MaybeS Integer
-> MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
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 (a -> MaybeS a
forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r (b -> MaybeS b
forall a. a -> MaybeS a
JustS b
y) (MaybeS Integer
-> MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
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)
          LeqMap Integer c -> IO (LeqMap Integer c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LeqMap Integer c -> IO (LeqMap Integer c))
-> LeqMap Integer c -> IO (LeqMap Integer c)
forall a b. (a -> b) -> a -> b
$! Integer
-> c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c
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' <- (a -> IO c) -> LeqMap Integer a -> IO (LeqMap Integer c)
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 (a -> MaybeS a
forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r MaybeS b
mb (MaybeS Integer
-> MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
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)
              LeqMap Integer c -> IO (LeqMap Integer c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LeqMap Integer c -> IO (LeqMap Integer c))
-> LeqMap Integer c -> IO (LeqMap Integer c)
forall a b. (a -> b) -> a -> b
$! Integer
-> c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c
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' <- (a -> IO c) -> LeqMap Integer a -> IO (LeqMap Integer c)
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 (a -> MaybeS a
forall a. a -> MaybeS a
JustS a
x) LeqMap Integer a
r MaybeS b
mb (MaybeS Integer
-> MaybeS Integer -> LeqMap Integer b -> LeqMap Integer b
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)
              LeqMap Integer c -> IO (LeqMap Integer c)
forall (m :: Type -> Type) a. Monad m => a -> m a
return (LeqMap Integer c -> IO (LeqMap Integer c))
-> LeqMap Integer c -> IO (LeqMap Integer c)
forall a b. (a -> b) -> a -> b
$! Integer
-> c -> LeqMap Integer c -> LeqMap Integer c -> LeqMap Integer c
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 :: (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 :: LeqMap k p -> [(k, p)]
toDescList = ([(k, p)] -> k -> p -> [(k, p)])
-> [(k, p)] -> LeqMap k p -> [(k, p)]
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)(k, p) -> [(k, p)] -> [(k, p)]
forall a. a -> [a] -> [a]
:[(k, p)]
xs) []

fromDistinctAscList :: [(k,p)] -> LeqMap k p
fromDistinctAscList :: [(k, p)] -> LeqMap k p
fromDistinctAscList [] = LeqMap k p
forall k p. LeqMap k p
Tip
fromDistinctAscList ((k
kx0, p
x0) : [(k, p)]
xs0) = p
x0 p -> LeqMap k p -> LeqMap k p
`seq` Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
0 (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx0 p
x0 LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip) [(k, p)]
xs0
  where
    go :: Int -> LeqMap k p -> [(k,p)] -> LeqMap k p
    go :: 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 Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
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 p -> LeqMap k p -> LeqMap k p
`seq` Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go (Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 :: Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (LeqMap k p
forall k p. LeqMap k p
Tip, [])
    -- Extract single element
    create Size
0 ((k
kx,p
x) : [(k, p)]
xs') = p
x p -> (LeqMap k p, [(k, p)]) -> (LeqMap k p, [(k, p)])
`seq` (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip, [(k, p)]
xs')
    create Size
s [(k, p)]
xs
      | Bool
otherwise =
        case Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s Size -> Size -> Size
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 Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
ys of
              (LeqMap k p
r, [(k, p)]
zs) -> p
y p -> (LeqMap k p, [(k, p)]) -> (LeqMap k p, [(k, p)])
`seq` (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 :: [(k, p)] -> LeqMap k p
fromDistinctDescList [] = LeqMap k p
forall k p. LeqMap k p
Tip
fromDistinctDescList ((k
kx0, p
x0) : [(k, p)]
xs0) = p
x0 p -> LeqMap k p -> LeqMap k p
`seq` Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go Size
0 (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx0 p
x0 LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip) [(k, p)]
xs0
  where
    go :: Int -> LeqMap k p -> [(k,p)] -> LeqMap k p
    go :: 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 Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
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 p -> LeqMap k p -> LeqMap k p
`seq` Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
forall k p. Size -> LeqMap k p -> [(k, p)] -> LeqMap k p
go (Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
1) (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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 :: Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (LeqMap k p
forall k p. LeqMap k p
Tip, [])
    -- Extract single element
    create Size
0 ((k
kx,p
x) : [(k, p)]
xs') = p
x p -> (LeqMap k p, [(k, p)]) -> (LeqMap k p, [(k, p)])
`seq` (Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
forall k p.
Size -> k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
Bin Size
1 k
kx p
x LeqMap k p
forall k p. LeqMap k p
Tip LeqMap k p
forall k p. LeqMap k p
Tip, [(k, p)]
xs')
    create Size
s [(k, p)]
xs
      | Bool
otherwise =
        case Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s Size -> Size -> Size
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 Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create (Size
s Size -> Size -> Size
forall a. Num a => a -> a -> a
- Size
1) [(k, p)]
ys of
              (LeqMap k p
l, [(k, p)]
zs) -> p
y p -> (LeqMap k p, [(k, p)]) -> (LeqMap k p, [(k, p)])
`seq` (k -> p -> LeqMap k p -> LeqMap k p -> LeqMap k p
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)