{-# 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 :: 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
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 #-}
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 #-}
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 #-}
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 #-}
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 :: 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 #-}
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
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 :: Int -> [(k, p)] -> (LeqMap k p, [(k,p)])
create :: forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (forall k p. LeqMap k p
Tip, [])
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)
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 :: Int -> [(k, p)] -> (LeqMap k p, [(k,p)])
create :: forall k p. Size -> [(k, p)] -> (LeqMap k p, [(k, p)])
create Size
_ [] = (forall k p. LeqMap k p
Tip, [])
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)