{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternGuards #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE MagicHash, DeriveDataTypeable, StandaloneDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE TypeFamilies #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
#include "containers.h"
module Data.IntMap.Internal (
IntMap(..), Key
, (!), (!?), (\\)
, null
, size
, member
, notMember
, lookup
, findWithDefault
, lookupLT
, lookupGT
, lookupLE
, lookupGE
, disjoint
, empty
, singleton
, insert
, insertWith
, insertWithKey
, insertLookupWithKey
, delete
, adjust
, adjustWithKey
, update
, updateWithKey
, updateLookupWithKey
, alter
, alterF
, union
, unionWith
, unionWithKey
, unions
, unionsWith
, difference
, differenceWith
, differenceWithKey
, intersection
, intersectionWith
, intersectionWithKey
, compose
, SimpleWhenMissing
, SimpleWhenMatched
, runWhenMatched
, runWhenMissing
, merge
, zipWithMaybeMatched
, zipWithMatched
, mapMaybeMissing
, dropMissing
, preserveMissing
, mapMissing
, filterMissing
, WhenMissing (..)
, WhenMatched (..)
, mergeA
, zipWithMaybeAMatched
, zipWithAMatched
, traverseMaybeMissing
, traverseMissing
, filterAMissing
, mergeWithKey
, mergeWithKey'
, map
, mapWithKey
, traverseWithKey
, traverseMaybeWithKey
, mapAccum
, mapAccumWithKey
, mapAccumRWithKey
, mapKeys
, mapKeysWith
, mapKeysMonotonic
, foldr
, foldl
, foldrWithKey
, foldlWithKey
, foldMapWithKey
, foldr'
, foldl'
, foldrWithKey'
, foldlWithKey'
, elems
, keys
, assocs
, keysSet
, fromSet
, toList
, fromList
, fromListWith
, fromListWithKey
, toAscList
, toDescList
, fromAscList
, fromAscListWith
, fromAscListWithKey
, fromDistinctAscList
, filter
, filterWithKey
, restrictKeys
, withoutKeys
, partition
, partitionWithKey
, mapMaybe
, mapMaybeWithKey
, mapEither
, mapEitherWithKey
, split
, splitLookup
, splitRoot
, isSubmapOf, isSubmapOfBy
, isProperSubmapOf, isProperSubmapOfBy
, lookupMin
, lookupMax
, findMin
, findMax
, deleteMin
, deleteMax
, deleteFindMin
, deleteFindMax
, updateMin
, updateMax
, updateMinWithKey
, updateMaxWithKey
, minView
, maxView
, minViewWithKey
, maxViewWithKey
, showTree
, showTreeWith
, Mask, Prefix, Nat
, natFromInt
, intFromNat
, link
, linkWithMask
, bin
, binCheckLeft
, binCheckRight
, zero
, nomatch
, match
, mask
, maskW
, shorter
, branchMask
, highestBitMask
, mapWhenMissing
, mapWhenMatched
, lmapWhenMissing
, contramapFirstWhenMatched
, contramapSecondWhenMatched
, mapGentlyWhenMissing
, mapGentlyWhenMatched
) where
#if MIN_VERSION_base(4,8,0)
import Data.Functor.Identity (Identity (..))
import Control.Applicative (liftA2)
#else
import Control.Applicative (Applicative(pure, (<*>)), (<$>), liftA2)
import Data.Monoid (Monoid(..))
import Data.Traversable (Traversable(traverse))
import Data.Word (Word)
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(stimes))
#endif
#if !(MIN_VERSION_base(4,11,0)) && MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup((<>)))
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (stimesIdempotentMonoid)
import Data.Functor.Classes
#endif
import Control.DeepSeq (NFData(rnf))
import Data.Bits
import qualified Data.Foldable as Foldable
#if !MIN_VERSION_base(4,8,0)
import Data.Foldable (Foldable())
#endif
import Data.Maybe (fromMaybe)
import Data.Typeable
import Prelude hiding (lookup, map, filter, foldr, foldl, null)
import Data.IntSet.Internal (Key)
import qualified Data.IntSet.Internal as IntSet
import Utils.Containers.Internal.BitUtil
import Utils.Containers.Internal.StrictPair
#if __GLASGOW_HASKELL__
import Data.Data (Data(..), Constr, mkConstr, constrIndex, Fixity(Prefix),
DataType, mkDataType)
import GHC.Exts (build)
#if !MIN_VERSION_base(4,8,0)
import Data.Functor ((<$))
#endif
#if __GLASGOW_HASKELL__ >= 708
import qualified GHC.Exts as GHCExts
#endif
import Text.Read
#endif
import qualified Control.Category as Category
#if __GLASGOW_HASKELL__ >= 709
import Data.Coerce
#endif
type Nat = Word
natFromInt :: Key -> Nat
natFromInt :: Int -> Nat
natFromInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE natFromInt #-}
intFromNat :: Nat -> Key
intFromNat :: Nat -> Int
intFromNat = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE intFromNat #-}
data IntMap a = Bin {-# UNPACK #-} !Prefix
{-# UNPACK #-} !Mask
!(IntMap a)
!(IntMap a)
| Tip {-# UNPACK #-} !Key a
| Nil
type Prefix = Int
type Mask = Int
type IntSetPrefix = Int
type IntSetBitMap = Word
bitmapOf :: Int -> IntSetBitMap
bitmapOf :: Int -> Nat
bitmapOf Int
x = Nat -> Int -> Nat
shiftLL Nat
1 (Int
x forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask)
{-# INLINE bitmapOf #-}
(!) :: IntMap a -> Key -> a
! :: forall a. IntMap a -> Int -> a
(!) IntMap a
m Int
k = forall a. Int -> IntMap a -> a
find Int
k IntMap a
m
(!?) :: IntMap a -> Key -> Maybe a
!? :: forall a. IntMap a -> Int -> Maybe a
(!?) IntMap a
m Int
k = forall a. Int -> IntMap a -> Maybe a
lookup Int
k IntMap a
m
(\\) :: IntMap a -> IntMap b -> IntMap a
IntMap a
m1 \\ :: forall a b. IntMap a -> IntMap b -> IntMap a
\\ IntMap b
m2 = forall a b. IntMap a -> IntMap b -> IntMap a
difference IntMap a
m1 IntMap b
m2
infixl 9 !?,\\
instance Monoid (IntMap a) where
mempty :: IntMap a
mempty = forall a. IntMap a
empty
mconcat :: [IntMap a] -> IntMap a
mconcat = forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
unions
#if !(MIN_VERSION_base(4,9,0))
mappend = union
#else
mappend :: IntMap a -> IntMap a -> IntMap a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (IntMap a) where
<> :: IntMap a -> IntMap a -> IntMap a
(<>) = forall a. IntMap a -> IntMap a -> IntMap a
union
stimes :: forall b. Integral b => b -> IntMap a -> IntMap a
stimes = forall b a. (Integral b, Monoid a) => b -> a -> a
stimesIdempotentMonoid
#endif
instance Foldable.Foldable IntMap where
fold :: forall m. Monoid m => IntMap m -> m
fold = forall m. Monoid m => IntMap m -> m
go
where go :: IntMap a -> a
go IntMap a
Nil = forall a. Monoid a => a
mempty
go (Tip Int
_ a
v) = a
v
go (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> a
go IntMap a
r forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> a
go IntMap a
l
| Bool
otherwise = IntMap a -> a
go IntMap a
l forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> a
go IntMap a
r
{-# INLINABLE fold #-}
foldr :: forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr = forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr
{-# INLINE foldr #-}
foldl :: forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl = forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl
{-# INLINE foldl #-}
foldMap :: forall m a. Monoid m => (a -> m) -> IntMap a -> m
foldMap a -> m
f IntMap a
t = IntMap a -> m
go IntMap a
t
where go :: IntMap a -> m
go IntMap a
Nil = forall a. Monoid a => a
mempty
go (Tip Int
_ a
v) = a -> m
f a
v
go (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> m
go IntMap a
r forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> m
go IntMap a
l
| Bool
otherwise = IntMap a -> m
go IntMap a
l forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> m
go IntMap a
r
{-# INLINE foldMap #-}
foldl' :: forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' = forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl'
{-# INLINE foldl' #-}
foldr' :: forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr' = forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr'
{-# INLINE foldr' #-}
#if MIN_VERSION_base(4,8,0)
length :: forall a. IntMap a -> Int
length = forall a. IntMap a -> Int
size
{-# INLINE length #-}
null :: forall a. IntMap a -> Bool
null = forall a. IntMap a -> Bool
null
{-# INLINE null #-}
toList :: forall a. IntMap a -> [a]
toList = forall a. IntMap a -> [a]
elems
{-# INLINE toList #-}
elem :: forall a. Eq a => a -> IntMap a -> Bool
elem = forall a. Eq a => a -> IntMap a -> Bool
go
where go :: t -> IntMap t -> Bool
go !t
_ IntMap t
Nil = Bool
False
go t
x (Tip Int
_ t
y) = t
x forall a. Eq a => a -> a -> Bool
== t
y
go t
x (Bin Int
_ Int
_ IntMap t
l IntMap t
r) = t -> IntMap t -> Bool
go t
x IntMap t
l Bool -> Bool -> Bool
|| t -> IntMap t -> Bool
go t
x IntMap t
r
{-# INLINABLE elem #-}
maximum :: forall a. Ord a => IntMap a -> a
maximum = forall a. Ord a => IntMap a -> a
start
where start :: IntMap a -> a
start IntMap a
Nil = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Foldable.maximum (for Data.IntMap): empty map"
start (Tip Int
_ a
y) = a
y
start (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
r) IntMap a
l
| Bool
otherwise = forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
l) IntMap a
r
go :: t -> IntMap t -> t
go !t
m IntMap t
Nil = t
m
go t
m (Tip Int
_ t
y) = forall a. Ord a => a -> a -> a
max t
m t
y
go t
m (Bin Int
_ Int
_ IntMap t
l IntMap t
r) = t -> IntMap t -> t
go (t -> IntMap t -> t
go t
m IntMap t
l) IntMap t
r
{-# INLINABLE maximum #-}
minimum :: forall a. Ord a => IntMap a -> a
minimum = forall a. Ord a => IntMap a -> a
start
where start :: IntMap a -> a
start IntMap a
Nil = forall a. HasCallStack => [Char] -> a
error [Char]
"Data.Foldable.minimum (for Data.IntMap): empty map"
start (Tip Int
_ a
y) = a
y
start (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
r) IntMap a
l
| Bool
otherwise = forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
l) IntMap a
r
go :: t -> IntMap t -> t
go !t
m IntMap t
Nil = t
m
go t
m (Tip Int
_ t
y) = forall a. Ord a => a -> a -> a
min t
m t
y
go t
m (Bin Int
_ Int
_ IntMap t
l IntMap t
r) = t -> IntMap t -> t
go (t -> IntMap t -> t
go t
m IntMap t
l) IntMap t
r
{-# INLINABLE minimum #-}
sum :: forall a. Num a => IntMap a -> a
sum = forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' forall a. Num a => a -> a -> a
(+) a
0
{-# INLINABLE sum #-}
product :: forall a. Num a => IntMap a -> a
product = forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' forall a. Num a => a -> a -> a
(*) a
1
{-# INLINABLE product #-}
#endif
instance Traversable IntMap where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IntMap a -> f (IntMap b)
traverse a -> f b
f = forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
traverseWithKey (\Int
_ -> a -> f b
f)
{-# INLINE traverse #-}
instance NFData a => NFData (IntMap a) where
rnf :: IntMap a -> ()
rnf IntMap a
Nil = ()
rnf (Tip Int
_ a
v) = forall a. NFData a => a -> ()
rnf a
v
rnf (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = forall a. NFData a => a -> ()
rnf IntMap a
l seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf IntMap a
r
#if __GLASGOW_HASKELL__
instance Data a => Data (IntMap a) where
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IntMap a -> c (IntMap a)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z IntMap a
im = forall g. g -> c g
z forall a. [(Int, a)] -> IntMap a
fromList forall d b. Data d => c (d -> b) -> d -> c b
`f` (forall a. IntMap a -> [(Int, a)]
toList IntMap a
im)
toConstr :: IntMap a -> Constr
toConstr IntMap a
_ = Constr
fromListConstr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (IntMap a)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
Int
1 -> forall b r. Data b => c (b -> r) -> c r
k (forall r. r -> c r
z forall a. [(Int, a)] -> IntMap a
fromList)
Int
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
dataTypeOf :: IntMap a -> DataType
dataTypeOf IntMap a
_ = DataType
intMapDataType
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (IntMap a))
dataCast1 forall d. Data d => c (t d)
f = forall {k1} {k2} (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
(a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 forall d. Data d => c (t d)
f
fromListConstr :: Constr
fromListConstr :: Constr
fromListConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
intMapDataType [Char]
"fromList" [] Fixity
Prefix
intMapDataType :: DataType
intMapDataType :: DataType
intMapDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.IntMap.Internal.IntMap" [Constr
fromListConstr]
#endif
null :: IntMap a -> Bool
null :: forall a. IntMap a -> Bool
null IntMap a
Nil = Bool
True
null IntMap a
_ = Bool
False
{-# INLINE null #-}
size :: IntMap a -> Int
size :: forall a. IntMap a -> Int
size = forall {t} {a}. Num t => t -> IntMap a -> t
go Int
0
where
go :: t -> IntMap a -> t
go !t
acc (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = t -> IntMap a -> t
go (t -> IntMap a -> t
go t
acc IntMap a
l) IntMap a
r
go t
acc (Tip Int
_ a
_) = t
1 forall a. Num a => a -> a -> a
+ t
acc
go t
acc IntMap a
Nil = t
acc
member :: Key -> IntMap a -> Bool
member :: forall a. Int -> IntMap a -> Bool
member !Int
k = IntMap a -> Bool
go
where
go :: IntMap a -> Bool
go (Bin Int
p Int
m IntMap a
l IntMap a
r) | Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = Bool
False
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> Bool
go IntMap a
l
| Bool
otherwise = IntMap a -> Bool
go IntMap a
r
go (Tip Int
kx a
_) = Int
k forall a. Eq a => a -> a -> Bool
== Int
kx
go IntMap a
Nil = Bool
False
notMember :: Key -> IntMap a -> Bool
notMember :: forall a. Int -> IntMap a -> Bool
notMember Int
k IntMap a
m = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Int -> IntMap a -> Bool
member Int
k IntMap a
m
lookup :: Key -> IntMap a -> Maybe a
lookup :: forall a. Int -> IntMap a -> Maybe a
lookup !Int
k = IntMap a -> Maybe a
go
where
go :: IntMap a -> Maybe a
go (Bin Int
p Int
m IntMap a
l IntMap a
r) | Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = forall a. Maybe a
Nothing
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> Maybe a
go IntMap a
l
| Bool
otherwise = IntMap a -> Maybe a
go IntMap a
r
go (Tip Int
kx a
x) | Int
k forall a. Eq a => a -> a -> Bool
== Int
kx = forall a. a -> Maybe a
Just a
x
| Bool
otherwise = forall a. Maybe a
Nothing
go IntMap a
Nil = forall a. Maybe a
Nothing
find :: Key -> IntMap a -> a
find :: forall a. Int -> IntMap a -> a
find !Int
k = IntMap a -> a
go
where
go :: IntMap a -> a
go (Bin Int
p Int
m IntMap a
l IntMap a
r) | Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = a
not_found
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> a
go IntMap a
l
| Bool
otherwise = IntMap a -> a
go IntMap a
r
go (Tip Int
kx a
x) | Int
k forall a. Eq a => a -> a -> Bool
== Int
kx = a
x
| Bool
otherwise = a
not_found
go IntMap a
Nil = a
not_found
not_found :: a
not_found = forall a. HasCallStack => [Char] -> a
error ([Char]
"IntMap.!: key " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
k forall a. [a] -> [a] -> [a]
++ [Char]
" is not an element of the map")
findWithDefault :: a -> Key -> IntMap a -> a
findWithDefault :: forall a. a -> Int -> IntMap a -> a
findWithDefault a
def !Int
k = IntMap a -> a
go
where
go :: IntMap a -> a
go (Bin Int
p Int
m IntMap a
l IntMap a
r) | Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = a
def
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> a
go IntMap a
l
| Bool
otherwise = IntMap a -> a
go IntMap a
r
go (Tip Int
kx a
x) | Int
k forall a. Eq a => a -> a -> Bool
== Int
kx = a
x
| Bool
otherwise = a
def
go IntMap a
Nil = a
def
lookupLT :: Key -> IntMap a -> Maybe (Key, a)
lookupLT :: forall a. Int -> IntMap a -> Maybe (Int, a)
lookupLT !Int
k IntMap a
t = case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r | Int
m forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
r IntMap a
l else IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
t
where
go :: IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = if Int
k forall a. Ord a => a -> a -> Bool
< Int
p then forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def else forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
r
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def IntMap a
l
| Bool
otherwise = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
l IntMap a
r
go IntMap a
def (Tip Int
ky a
y)
| Int
k forall a. Ord a => a -> a -> Bool
<= Int
ky = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
| Bool
otherwise = forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
lookupGT :: Key -> IntMap a -> Maybe (Key, a)
lookupGT :: forall a. Int -> IntMap a -> Maybe (Int, a)
lookupGT !Int
k IntMap a
t = case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r | Int
m forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
l else IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
l IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
t
where
go :: IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = if Int
k forall a. Ord a => a -> a -> Bool
< Int
p then forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
l else forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
r IntMap a
l
| Bool
otherwise = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def IntMap a
r
go IntMap a
def (Tip Int
ky a
y)
| Int
k forall a. Ord a => a -> a -> Bool
>= Int
ky = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Bool
otherwise = forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
lookupLE :: Key -> IntMap a -> Maybe (Key, a)
lookupLE :: forall a. Int -> IntMap a -> Maybe (Int, a)
lookupLE !Int
k IntMap a
t = case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r | Int
m forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
r IntMap a
l else IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
t
where
go :: IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = if Int
k forall a. Ord a => a -> a -> Bool
< Int
p then forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def else forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
r
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def IntMap a
l
| Bool
otherwise = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
l IntMap a
r
go IntMap a
def (Tip Int
ky a
y)
| Int
k forall a. Ord a => a -> a -> Bool
< Int
ky = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
| Bool
otherwise = forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
lookupGE :: Key -> IntMap a -> Maybe (Key, a)
lookupGE :: forall a. Int -> IntMap a -> Maybe (Int, a)
lookupGE !Int
k IntMap a
t = case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r | Int
m forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
l else IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
l IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go forall a. IntMap a
Nil IntMap a
t
where
go :: IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = if Int
k forall a. Ord a => a -> a -> Bool
< Int
p then forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
l else forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Int -> Int -> Bool
zero Int
k Int
m = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
r IntMap a
l
| Bool
otherwise = IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
def IntMap a
r
go IntMap a
def (Tip Int
ky a
y)
| Int
k forall a. Ord a => a -> a -> Bool
> Int
ky = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Bool
otherwise = forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
unsafeFindMin :: IntMap a -> Maybe (Key, a)
unsafeFindMin :: forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
Nil = forall a. Maybe a
Nothing
unsafeFindMin (Tip Int
ky a
y) = forall a. a -> Maybe a
Just (Int
ky, a
y)
unsafeFindMin (Bin Int
_ Int
_ IntMap a
l IntMap a
_) = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
l
unsafeFindMax :: IntMap a -> Maybe (Key, a)
unsafeFindMax :: forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
Nil = forall a. Maybe a
Nothing
unsafeFindMax (Tip Int
ky a
y) = forall a. a -> Maybe a
Just (Int
ky, a
y)
unsafeFindMax (Bin Int
_ Int
_ IntMap a
_ IntMap a
r) = forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
r
disjoint :: IntMap a -> IntMap b -> Bool
disjoint :: forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
Nil IntMap b
_ = Bool
True
disjoint IntMap a
_ IntMap b
Nil = Bool
True
disjoint (Tip Int
kx a
_) IntMap b
ys = forall a. Int -> IntMap a -> Bool
notMember Int
kx IntMap b
ys
disjoint IntMap a
xs (Tip Int
ky b
_) = forall a. Int -> IntMap a -> Bool
notMember Int
ky IntMap a
xs
disjoint t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) t2 :: IntMap b
t2@(Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = Bool
disjoint1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = Bool
disjoint2
| Int
p1 forall a. Eq a => a -> a -> Bool
== Int
p2 = forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
l1 IntMap b
l2 Bool -> Bool -> Bool
&& forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
r1 IntMap b
r2
| Bool
otherwise = Bool
True
where
disjoint1 :: Bool
disjoint1 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = Bool
True
| Int -> Int -> Bool
zero Int
p2 Int
m1 = forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
l1 IntMap b
t2
| Bool
otherwise = forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
r1 IntMap b
t2
disjoint2 :: Bool
disjoint2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = Bool
True
| Int -> Int -> Bool
zero Int
p1 Int
m2 = forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
t1 IntMap b
l2
| Bool
otherwise = forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
t1 IntMap b
r2
compose :: IntMap c -> IntMap Int -> IntMap c
compose :: forall c. IntMap c -> IntMap Int -> IntMap c
compose IntMap c
bc !IntMap Int
ab
| forall a. IntMap a -> Bool
null IntMap c
bc = forall a. IntMap a
empty
| Bool
otherwise = forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe (IntMap c
bc forall a. IntMap a -> Int -> Maybe a
!?) IntMap Int
ab
empty :: IntMap a
empty :: forall a. IntMap a
empty
= forall a. IntMap a
Nil
{-# INLINE empty #-}
singleton :: Key -> a -> IntMap a
singleton :: forall a. Int -> a -> IntMap a
singleton Int
k a
x
= forall a. Int -> a -> IntMap a
Tip Int
k a
x
{-# INLINE singleton #-}
insert :: Key -> a -> IntMap a -> IntMap a
insert :: forall a. Int -> a -> IntMap a -> IntMap a
insert !Int
k a
x t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
x IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l (forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
x IntMap a
r)
insert Int
k a
x t :: IntMap a
t@(Tip Int
ky a
_)
| Int
kforall a. Eq a => a -> a -> Bool
==Int
ky = forall a. Int -> a -> IntMap a
Tip Int
k a
x
| Bool
otherwise = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t
insert Int
k a
x IntMap a
Nil = forall a. Int -> a -> IntMap a
Tip Int
k a
x
insertWith :: (a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
insertWith :: forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWith a -> a -> a
f Int
k a
x IntMap a
t
= forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWithKey (\Int
_ a
x' a
y' -> a -> a -> a
f a
x' a
y') Int
k a
x IntMap a
t
insertWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> IntMap a
insertWithKey :: forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWithKey Int -> a -> a -> a
f !Int
k a
x t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l (forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
r)
insertWithKey Int -> a -> a -> a
f Int
k a
x t :: IntMap a
t@(Tip Int
ky a
y)
| Int
k forall a. Eq a => a -> a -> Bool
== Int
ky = forall a. Int -> a -> IntMap a
Tip Int
k (Int -> a -> a -> a
f Int
k a
x a
y)
| Bool
otherwise = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t
insertWithKey Int -> a -> a -> a
_ Int
k a
x IntMap a
Nil = forall a. Int -> a -> IntMap a
Tip Int
k a
x
insertLookupWithKey :: (Key -> a -> a -> a) -> Key -> a -> IntMap a -> (Maybe a, IntMap a)
insertLookupWithKey :: forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
insertLookupWithKey Int -> a -> a -> a
f !Int
k a
x t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = (forall a. Maybe a
Nothing,forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t)
| Int -> Int -> Bool
zero Int
k Int
m = let (Maybe a
found,IntMap a
l') = forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
insertLookupWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
l
in (Maybe a
found,forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l' IntMap a
r)
| Bool
otherwise = let (Maybe a
found,IntMap a
r') = forall a.
(Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
insertLookupWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
r
in (Maybe a
found,forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l IntMap a
r')
insertLookupWithKey Int -> a -> a -> a
f Int
k a
x t :: IntMap a
t@(Tip Int
ky a
y)
| Int
k forall a. Eq a => a -> a -> Bool
== Int
ky = (forall a. a -> Maybe a
Just a
y,forall a. Int -> a -> IntMap a
Tip Int
k (Int -> a -> a -> a
f Int
k a
x a
y))
| Bool
otherwise = (forall a. Maybe a
Nothing,forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t)
insertLookupWithKey Int -> a -> a -> a
_ Int
k a
x IntMap a
Nil = (forall a. Maybe a
Nothing,forall a. Int -> a -> IntMap a
Tip Int
k a
x)
delete :: Key -> IntMap a -> IntMap a
delete :: forall a. Int -> IntMap a -> IntMap a
delete !Int
k t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (forall a. Int -> IntMap a -> IntMap a
delete Int
k IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (forall a. Int -> IntMap a -> IntMap a
delete Int
k IntMap a
r)
delete Int
k t :: IntMap a
t@(Tip Int
ky a
_)
| Int
k forall a. Eq a => a -> a -> Bool
== Int
ky = forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
delete Int
_k IntMap a
Nil = forall a. IntMap a
Nil
adjust :: (a -> a) -> Key -> IntMap a -> IntMap a
adjust :: forall a. (a -> a) -> Int -> IntMap a -> IntMap a
adjust a -> a
f Int
k IntMap a
m
= forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a
adjustWithKey (\Int
_ a
x -> a -> a
f a
x) Int
k IntMap a
m
adjustWithKey :: (Key -> a -> a) -> Key -> IntMap a -> IntMap a
adjustWithKey :: forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a
adjustWithKey Int -> a -> a
f !Int
k t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a
adjustWithKey Int -> a -> a
f Int
k IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l (forall a. (Int -> a -> a) -> Int -> IntMap a -> IntMap a
adjustWithKey Int -> a -> a
f Int
k IntMap a
r)
adjustWithKey Int -> a -> a
f Int
k t :: IntMap a
t@(Tip Int
ky a
y)
| Int
k forall a. Eq a => a -> a -> Bool
== Int
ky = forall a. Int -> a -> IntMap a
Tip Int
ky (Int -> a -> a
f Int
k a
y)
| Bool
otherwise = IntMap a
t
adjustWithKey Int -> a -> a
_ Int
_ IntMap a
Nil = forall a. IntMap a
Nil
update :: (a -> Maybe a) -> Key -> IntMap a -> IntMap a
update :: forall a. (a -> Maybe a) -> Int -> IntMap a -> IntMap a
update a -> Maybe a
f
= forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
updateWithKey (\Int
_ a
x -> a -> Maybe a
f a
x)
updateWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> IntMap a
updateWithKey :: forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
updateWithKey Int -> a -> Maybe a
f !Int
k t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
updateWithKey Int -> a -> Maybe a
f Int
k IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (forall a. (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
updateWithKey Int -> a -> Maybe a
f Int
k IntMap a
r)
updateWithKey Int -> a -> Maybe a
f Int
k t :: IntMap a
t@(Tip Int
ky a
y)
| Int
k forall a. Eq a => a -> a -> Bool
== Int
ky = case (Int -> a -> Maybe a
f Int
k a
y) of
Just a
y' -> forall a. Int -> a -> IntMap a
Tip Int
ky a
y'
Maybe a
Nothing -> forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
updateWithKey Int -> a -> Maybe a
_ Int
_ IntMap a
Nil = forall a. IntMap a
Nil
updateLookupWithKey :: (Key -> a -> Maybe a) -> Key -> IntMap a -> (Maybe a,IntMap a)
updateLookupWithKey :: forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
updateLookupWithKey Int -> a -> Maybe a
f !Int
k t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = (forall a. Maybe a
Nothing,IntMap a
t)
| Int -> Int -> Bool
zero Int
k Int
m = let !(Maybe a
found,IntMap a
l') = forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
updateLookupWithKey Int -> a -> Maybe a
f Int
k IntMap a
l
in (Maybe a
found,forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m IntMap a
l' IntMap a
r)
| Bool
otherwise = let !(Maybe a
found,IntMap a
r') = forall a.
(Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
updateLookupWithKey Int -> a -> Maybe a
f Int
k IntMap a
r
in (Maybe a
found,forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l IntMap a
r')
updateLookupWithKey Int -> a -> Maybe a
f Int
k t :: IntMap a
t@(Tip Int
ky a
y)
| Int
kforall a. Eq a => a -> a -> Bool
==Int
ky = case (Int -> a -> Maybe a
f Int
k a
y) of
Just a
y' -> (forall a. a -> Maybe a
Just a
y,forall a. Int -> a -> IntMap a
Tip Int
ky a
y')
Maybe a
Nothing -> (forall a. a -> Maybe a
Just a
y,forall a. IntMap a
Nil)
| Bool
otherwise = (forall a. Maybe a
Nothing,IntMap a
t)
updateLookupWithKey Int -> a -> Maybe a
_ Int
_ IntMap a
Nil = (forall a. Maybe a
Nothing,forall a. IntMap a
Nil)
alter :: (Maybe a -> Maybe a) -> Key -> IntMap a -> IntMap a
alter :: forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
alter Maybe a -> Maybe a
f !Int
k t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int -> Int -> Int -> Bool
nomatch Int
k Int
p Int
m = case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
Maybe a
Nothing -> IntMap a
t
Just a
x -> forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
alter Maybe a -> Maybe a
f Int
k IntMap a
l) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
alter Maybe a -> Maybe a
f Int
k IntMap a
r)
alter Maybe a -> Maybe a
f Int
k t :: IntMap a
t@(Tip Int
ky a
y)
| Int
kforall a. Eq a => a -> a -> Bool
==Int
ky = case Maybe a -> Maybe a
f (forall a. a -> Maybe a
Just a
y) of
Just a
x -> forall a. Int -> a -> IntMap a
Tip Int
ky a
x
Maybe a
Nothing -> forall a. IntMap a
Nil
| Bool
otherwise = case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
Just a
x -> forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t
Maybe a
Nothing -> forall a. Int -> a -> IntMap a
Tip Int
ky a
y
alter Maybe a -> Maybe a
f Int
k IntMap a
Nil = case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
Just a
x -> forall a. Int -> a -> IntMap a
Tip Int
k a
x
Maybe a
Nothing -> forall a. IntMap a
Nil
alterF :: Functor f
=> (Maybe a -> f (Maybe a)) -> Key -> IntMap a -> f (IntMap a)
alterF :: forall (f :: * -> *) a.
Functor f =>
(Maybe a -> f (Maybe a)) -> Int -> IntMap a -> f (IntMap a)
alterF Maybe a -> f (Maybe a)
f Int
k IntMap a
m = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> f (Maybe a)
f Maybe a
mv) forall a b. (a -> b) -> a -> b
$ \Maybe a
fres ->
case Maybe a
fres of
Maybe a
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap a
m (forall a b. a -> b -> a
const (forall a. Int -> IntMap a -> IntMap a
delete Int
k IntMap a
m)) Maybe a
mv
Just a
v' -> forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
v' IntMap a
m
where mv :: Maybe a
mv = forall a. Int -> IntMap a -> Maybe a
lookup Int
k IntMap a
m
unions :: Foldable f => f (IntMap a) -> IntMap a
unions :: forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
unions f (IntMap a)
xs
= forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' forall a. IntMap a -> IntMap a -> IntMap a
union forall a. IntMap a
empty f (IntMap a)
xs
unionsWith :: Foldable f => (a->a->a) -> f (IntMap a) -> IntMap a
unionsWith :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> f (IntMap a) -> IntMap a
unionsWith a -> a -> a
f f (IntMap a)
ts
= forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' (forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWith a -> a -> a
f) forall a. IntMap a
empty f (IntMap a)
ts
union :: IntMap a -> IntMap a -> IntMap a
union :: forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
m1 IntMap a
m2
= forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin forall a b. a -> b -> a
const forall a. a -> a
id forall a. a -> a
id IntMap a
m1 IntMap a
m2
unionWith :: (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWith :: forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWith a -> a -> a
f IntMap a
m1 IntMap a
m2
= forall a. (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWithKey (\Int
_ a
x a
y -> a -> a -> a
f a
x a
y) IntMap a
m1 IntMap a
m2
unionWithKey :: (Key -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWithKey :: forall a. (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWithKey Int -> a -> a -> a
f IntMap a
m1 IntMap a
m2
= forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin (\(Tip Int
k1 a
x1) (Tip Int
_k2 a
x2) -> forall a. Int -> a -> IntMap a
Tip Int
k1 (Int -> a -> a -> a
f Int
k1 a
x1 a
x2)) forall a. a -> a
id forall a. a -> a
id IntMap a
m1 IntMap a
m2
difference :: IntMap a -> IntMap b -> IntMap a
difference :: forall a b. IntMap a -> IntMap b -> IntMap a
difference IntMap a
m1 IntMap b
m2
= forall a b c.
(Int -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey (\Int
_ a
_ b
_ -> forall a. Maybe a
Nothing) forall a. a -> a
id (forall a b. a -> b -> a
const forall a. IntMap a
Nil) IntMap a
m1 IntMap b
m2
differenceWith :: (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceWith :: forall a b. (a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceWith a -> b -> Maybe a
f IntMap a
m1 IntMap b
m2
= forall a b.
(Int -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceWithKey (\Int
_ a
x b
y -> a -> b -> Maybe a
f a
x b
y) IntMap a
m1 IntMap b
m2
differenceWithKey :: (Key -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceWithKey :: forall a b.
(Int -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
differenceWithKey Int -> a -> b -> Maybe a
f IntMap a
m1 IntMap b
m2
= forall a b c.
(Int -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey Int -> a -> b -> Maybe a
f forall a. a -> a
id (forall a b. a -> b -> a
const forall a. IntMap a
Nil) IntMap a
m1 IntMap b
m2
withoutKeys :: IntMap a -> IntSet.IntSet -> IntMap a
withoutKeys :: forall a. IntMap a -> IntSet -> IntMap a
withoutKeys t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) t2 :: IntSet
t2@(IntSet.Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntMap a
difference1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntMap a
difference2
| Int
p1 forall a. Eq a => a -> a -> Bool
== Int
p2 = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p1 Int
m1 (forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
l1 IntSet
l2) (forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
r1 IntSet
r2)
| Bool
otherwise = IntMap a
t1
where
difference1 :: IntMap a
difference1
| Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = IntMap a
t1
| Int -> Int -> Bool
zero Int
p2 Int
m1 = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p1 Int
m1 (forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
l1 IntSet
t2) IntMap a
r1
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p1 Int
m1 IntMap a
l1 (forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
r1 IntSet
t2)
difference2 :: IntMap a
difference2
| Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = IntMap a
t1
| Int -> Int -> Bool
zero Int
p1 Int
m2 = forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
t1 IntSet
l2
| Bool
otherwise = forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
t1 IntSet
r2
withoutKeys t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
_ IntMap a
_) (IntSet.Tip Int
p2 Nat
bm2) =
let minbit :: Nat
minbit = Int -> Nat
bitmapOf Int
p1
lt_minbit :: Nat
lt_minbit = Nat
minbit forall a. Num a => a -> a -> a
- Nat
1
maxbit :: Nat
maxbit = Int -> Nat
bitmapOf (Int
p1 forall a. Bits a => a -> a -> a
.|. (Int
m1 forall a. Bits a => a -> a -> a
.|. (Int
m1 forall a. Num a => a -> a -> a
- Int
1)))
gt_maxbit :: Nat
gt_maxbit = (-Nat
maxbit) forall a. Bits a => a -> a -> a
`xor` Nat
maxbit
in forall a. Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix Int
p2 IntMap a
t1 forall a b. (a -> b) -> a -> b
$ forall a. Nat -> IntMap a -> IntMap a
withoutBM (Nat
bm2 forall a. Bits a => a -> a -> a
.|. Nat
lt_minbit forall a. Bits a => a -> a -> a
.|. Nat
gt_maxbit)
withoutKeys t1 :: IntMap a
t1@(Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntSet
IntSet.Nil = IntMap a
t1
withoutKeys t1 :: IntMap a
t1@(Tip Int
k1 a
_) IntSet
t2
| Int
k1 Int -> IntSet -> Bool
`IntSet.member` IntSet
t2 = forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t1
withoutKeys IntMap a
Nil IntSet
_ = forall a. IntMap a
Nil
updatePrefix
:: IntSetPrefix -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix :: forall a. Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix !Int
kp t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r) IntMap a -> IntMap a
f
| Int
m forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask forall a. Eq a => a -> a -> Bool
/= Int
0 =
if Int
p forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask forall a. Eq a => a -> a -> Bool
== Int
kp then IntMap a -> IntMap a
f IntMap a
t else IntMap a
t
| Int -> Int -> Int -> Bool
nomatch Int
kp Int
p Int
m = IntMap a
t
| Int -> Int -> Bool
zero Int
kp Int
m = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (forall a. Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix Int
kp IntMap a
l IntMap a -> IntMap a
f) IntMap a
r
| Bool
otherwise = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (forall a. Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix Int
kp IntMap a
r IntMap a -> IntMap a
f)
updatePrefix Int
kp t :: IntMap a
t@(Tip Int
kx a
_) IntMap a -> IntMap a
f
| Int
kx forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask forall a. Eq a => a -> a -> Bool
== Int
kp = IntMap a -> IntMap a
f IntMap a
t
| Bool
otherwise = IntMap a
t
updatePrefix Int
_ IntMap a
Nil IntMap a -> IntMap a
_ = forall a. IntMap a
Nil
withoutBM :: IntSetBitMap -> IntMap a -> IntMap a
withoutBM :: forall a. Nat -> IntMap a -> IntMap a
withoutBM Nat
0 IntMap a
t = IntMap a
t
withoutBM Nat
bm (Bin Int
p Int
m IntMap a
l IntMap a
r) =
let leftBits :: Nat
leftBits = Int -> Nat
bitmapOf (Int
p forall a. Bits a => a -> a -> a
.|. Int
m) forall a. Num a => a -> a -> a
- Nat
1
bmL :: Nat
bmL = Nat
bm forall a. Bits a => a -> a -> a
.&. Nat
leftBits
bmR :: Nat
bmR = Nat
bm forall a. Bits a => a -> a -> a
`xor` Nat
bmL
in forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m (forall a. Nat -> IntMap a -> IntMap a
withoutBM Nat
bmL IntMap a
l) (forall a. Nat -> IntMap a -> IntMap a
withoutBM Nat
bmR IntMap a
r)
withoutBM Nat
bm t :: IntMap a
t@(Tip Int
k a
_)
| Int
k Int -> IntSet -> Bool
`IntSet.member` Int -> Nat -> IntSet
IntSet.Tip (Int
k forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) Nat
bm = forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
withoutBM Nat
_ IntMap a
Nil = forall a. IntMap a
Nil
intersection :: IntMap a -> IntMap b -> IntMap a
intersection :: forall a b. IntMap a -> IntMap b -> IntMap a
intersection IntMap a
m1 IntMap b
m2
= forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin forall a b. a -> b -> a
const (forall a b. a -> b -> a
const forall a. IntMap a
Nil) (forall a b. a -> b -> a
const forall a. IntMap a
Nil) IntMap a
m1 IntMap b
m2
restrictKeys :: IntMap a -> IntSet.IntSet -> IntMap a
restrictKeys :: forall a. IntMap a -> IntSet -> IntMap a
restrictKeys t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) t2 :: IntSet
t2@(IntSet.Bin Int
p2 Int
m2 IntSet
l2 IntSet
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntMap a
intersection1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntMap a
intersection2
| Int
p1 forall a. Eq a => a -> a -> Bool
== Int
p2 = forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p1 Int
m1 (forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
l1 IntSet
l2) (forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
r1 IntSet
r2)
| Bool
otherwise = forall a. IntMap a
Nil
where
intersection1 :: IntMap a
intersection1
| Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
p2 Int
m1 = forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
l1 IntSet
t2
| Bool
otherwise = forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
r1 IntSet
t2
intersection2 :: IntMap a
intersection2
| Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
p1 Int
m2 = forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
t1 IntSet
l2
| Bool
otherwise = forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
t1 IntSet
r2
restrictKeys t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
_ IntMap a
_) (IntSet.Tip Int
p2 Nat
bm2) =
let minbit :: Nat
minbit = Int -> Nat
bitmapOf Int
p1
ge_minbit :: Nat
ge_minbit = forall a. Bits a => a -> a
complement (Nat
minbit forall a. Num a => a -> a -> a
- Nat
1)
maxbit :: Nat
maxbit = Int -> Nat
bitmapOf (Int
p1 forall a. Bits a => a -> a -> a
.|. (Int
m1 forall a. Bits a => a -> a -> a
.|. (Int
m1 forall a. Num a => a -> a -> a
- Int
1)))
le_maxbit :: Nat
le_maxbit = Nat
maxbit forall a. Bits a => a -> a -> a
.|. (Nat
maxbit forall a. Num a => a -> a -> a
- Nat
1)
in forall a. Nat -> IntMap a -> IntMap a
restrictBM (Nat
bm2 forall a. Bits a => a -> a -> a
.&. Nat
ge_minbit forall a. Bits a => a -> a -> a
.&. Nat
le_maxbit) (forall a. Int -> IntMap a -> IntMap a
lookupPrefix Int
p2 IntMap a
t1)
restrictKeys (Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntSet
IntSet.Nil = forall a. IntMap a
Nil
restrictKeys t1 :: IntMap a
t1@(Tip Int
k1 a
_) IntSet
t2
| Int
k1 Int -> IntSet -> Bool
`IntSet.member` IntSet
t2 = IntMap a
t1
| Bool
otherwise = forall a. IntMap a
Nil
restrictKeys IntMap a
Nil IntSet
_ = forall a. IntMap a
Nil
lookupPrefix :: IntSetPrefix -> IntMap a -> IntMap a
lookupPrefix :: forall a. Int -> IntMap a -> IntMap a
lookupPrefix !Int
kp t :: IntMap a
t@(Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask forall a. Eq a => a -> a -> Bool
/= Int
0 =
if Int
p forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask forall a. Eq a => a -> a -> Bool
== Int
kp then IntMap a
t else forall a. IntMap a
Nil
| Int -> Int -> Int -> Bool
nomatch Int
kp Int
p Int
m = forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
kp Int
m = forall a. Int -> IntMap a -> IntMap a
lookupPrefix Int
kp IntMap a
l
| Bool
otherwise = forall a. Int -> IntMap a -> IntMap a
lookupPrefix Int
kp IntMap a
r
lookupPrefix Int
kp t :: IntMap a
t@(Tip Int
kx a
_)
| (Int
kx forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) forall a. Eq a => a -> a -> Bool
== Int
kp = IntMap a
t
| Bool
otherwise = forall a. IntMap a
Nil
lookupPrefix Int
_ IntMap a
Nil = forall a. IntMap a
Nil
restrictBM :: IntSetBitMap -> IntMap a -> IntMap a
restrictBM :: forall a. Nat -> IntMap a -> IntMap a
restrictBM Nat
0 IntMap a
_ = forall a. IntMap a
Nil
restrictBM Nat
bm (Bin Int
p Int
m IntMap a
l IntMap a
r) =
let leftBits :: Nat
leftBits = Int -> Nat
bitmapOf (Int
p forall a. Bits a => a -> a -> a
.|. Int
m) forall a. Num a => a -> a -> a
- Nat
1
bmL :: Nat
bmL = Nat
bm forall a. Bits a => a -> a -> a
.&. Nat
leftBits
bmR :: Nat
bmR = Nat
bm forall a. Bits a => a -> a -> a
`xor` Nat
bmL
in forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m (forall a. Nat -> IntMap a -> IntMap a
restrictBM Nat
bmL IntMap a
l) (forall a. Nat -> IntMap a -> IntMap a
restrictBM Nat
bmR IntMap a
r)
restrictBM Nat
bm t :: IntMap a
t@(Tip Int
k a
_)
| Int
k Int -> IntSet -> Bool
`IntSet.member` Int -> Nat -> IntSet
IntSet.Tip (Int
k forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) Nat
bm = IntMap a
t
| Bool
otherwise = forall a. IntMap a
Nil
restrictBM Nat
_ IntMap a
Nil = forall a. IntMap a
Nil
intersectionWith :: (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionWith :: forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionWith a -> b -> c
f IntMap a
m1 IntMap b
m2
= forall a b c.
(Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionWithKey (\Int
_ a
x b
y -> a -> b -> c
f a
x b
y) IntMap a
m1 IntMap b
m2
intersectionWithKey :: (Key -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionWithKey :: forall a b c.
(Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
intersectionWithKey Int -> a -> b -> c
f IntMap a
m1 IntMap b
m2
= forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin (\(Tip Int
k1 a
x1) (Tip Int
_k2 b
x2) -> forall a. Int -> a -> IntMap a
Tip Int
k1 (Int -> a -> b -> c
f Int
k1 a
x1 b
x2)) (forall a b. a -> b -> a
const forall a. IntMap a
Nil) (forall a b. a -> b -> a
const forall a. IntMap a
Nil) IntMap a
m1 IntMap b
m2
mergeWithKey :: (Key -> a -> b -> Maybe c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
-> IntMap a -> IntMap b -> IntMap c
mergeWithKey :: forall a b c.
(Int -> a -> b -> Maybe c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey Int -> a -> b -> Maybe c
f IntMap a -> IntMap c
g1 IntMap b -> IntMap c
g2 = forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin IntMap a -> IntMap b -> IntMap c
combine IntMap a -> IntMap c
g1 IntMap b -> IntMap c
g2
where
combine :: IntMap a -> IntMap b -> IntMap c
combine = \(Tip Int
k1 a
x1) (Tip Int
_k2 b
x2) ->
case Int -> a -> b -> Maybe c
f Int
k1 a
x1 b
x2 of
Maybe c
Nothing -> forall a. IntMap a
Nil
Just c
x -> forall a. Int -> a -> IntMap a
Tip Int
k1 c
x
{-# INLINE combine #-}
{-# INLINE mergeWithKey #-}
mergeWithKey' :: (Prefix -> Mask -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
-> IntMap a -> IntMap b -> IntMap c
mergeWithKey' :: forall c a b.
(Int -> Int -> IntMap c -> IntMap c -> IntMap c)
-> (IntMap a -> IntMap b -> IntMap c)
-> (IntMap a -> IntMap c)
-> (IntMap b -> IntMap c)
-> IntMap a
-> IntMap b
-> IntMap c
mergeWithKey' Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' IntMap a -> IntMap b -> IntMap c
f IntMap a -> IntMap c
g1 IntMap b -> IntMap c
g2 = IntMap a -> IntMap b -> IntMap c
go
where
go :: IntMap a -> IntMap b -> IntMap c
go t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) t2 :: IntMap b
t2@(Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = IntMap c
merge1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = IntMap c
merge2
| Int
p1 forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p1 Int
m1 (IntMap a -> IntMap b -> IntMap c
go IntMap a
l1 IntMap b
l2) (IntMap a -> IntMap b -> IntMap c
go IntMap a
r1 IntMap b
r2)
| Bool
otherwise = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
p1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
p2 (IntMap b -> IntMap c
g2 IntMap b
t2)
where
merge1 :: IntMap c
merge1 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
p1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
p2 (IntMap b -> IntMap c
g2 IntMap b
t2)
| Int -> Int -> Bool
zero Int
p2 Int
m1 = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p1 Int
m1 (IntMap a -> IntMap b -> IntMap c
go IntMap a
l1 IntMap b
t2) (IntMap a -> IntMap c
g1 IntMap a
r1)
| Bool
otherwise = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p1 Int
m1 (IntMap a -> IntMap c
g1 IntMap a
l1) (IntMap a -> IntMap b -> IntMap c
go IntMap a
r1 IntMap b
t2)
merge2 :: IntMap c
merge2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
p1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
p2 (IntMap b -> IntMap c
g2 IntMap b
t2)
| Int -> Int -> Bool
zero Int
p1 Int
m2 = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p2 Int
m2 (IntMap a -> IntMap b -> IntMap c
go IntMap a
t1 IntMap b
l2) (IntMap b -> IntMap c
g2 IntMap b
r2)
| Bool
otherwise = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p2 Int
m2 (IntMap b -> IntMap c
g2 IntMap b
l2) (IntMap a -> IntMap b -> IntMap c
go IntMap a
t1 IntMap b
r2)
go t1' :: IntMap a
t1'@(Bin Int
_ Int
_ IntMap a
_ IntMap a
_) t2' :: IntMap b
t2'@(Tip Int
k2' b
_) = IntMap b -> Int -> IntMap a -> IntMap c
merge0 IntMap b
t2' Int
k2' IntMap a
t1'
where
merge0 :: IntMap b -> Int -> IntMap a -> IntMap c
merge0 IntMap b
t2 Int
k2 t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1)
| Int -> Int -> Int -> Bool
nomatch Int
k2 Int
p1 Int
m1 = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
p1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
k2 (IntMap b -> IntMap c
g2 IntMap b
t2)
| Int -> Int -> Bool
zero Int
k2 Int
m1 = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p1 Int
m1 (IntMap b -> Int -> IntMap a -> IntMap c
merge0 IntMap b
t2 Int
k2 IntMap a
l1) (IntMap a -> IntMap c
g1 IntMap a
r1)
| Bool
otherwise = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p1 Int
m1 (IntMap a -> IntMap c
g1 IntMap a
l1) (IntMap b -> Int -> IntMap a -> IntMap c
merge0 IntMap b
t2 Int
k2 IntMap a
r1)
merge0 IntMap b
t2 Int
k2 t1 :: IntMap a
t1@(Tip Int
k1 a
_)
| Int
k1 forall a. Eq a => a -> a -> Bool
== Int
k2 = IntMap a -> IntMap b -> IntMap c
f IntMap a
t1 IntMap b
t2
| Bool
otherwise = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
k1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
k2 (IntMap b -> IntMap c
g2 IntMap b
t2)
merge0 IntMap b
t2 Int
_ IntMap a
Nil = IntMap b -> IntMap c
g2 IntMap b
t2
go t1 :: IntMap a
t1@(Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntMap b
Nil = IntMap a -> IntMap c
g1 IntMap a
t1
go t1' :: IntMap a
t1'@(Tip Int
k1' a
_) IntMap b
t2' = IntMap a -> Int -> IntMap b -> IntMap c
merge0 IntMap a
t1' Int
k1' IntMap b
t2'
where
merge0 :: IntMap a -> Int -> IntMap b -> IntMap c
merge0 IntMap a
t1 Int
k1 t2 :: IntMap b
t2@(Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Int -> Bool
nomatch Int
k1 Int
p2 Int
m2 = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
k1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
p2 (IntMap b -> IntMap c
g2 IntMap b
t2)
| Int -> Int -> Bool
zero Int
k1 Int
m2 = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p2 Int
m2 (IntMap a -> Int -> IntMap b -> IntMap c
merge0 IntMap a
t1 Int
k1 IntMap b
l2) (IntMap b -> IntMap c
g2 IntMap b
r2)
| Bool
otherwise = Int -> Int -> IntMap c -> IntMap c -> IntMap c
bin' Int
p2 Int
m2 (IntMap b -> IntMap c
g2 IntMap b
l2) (IntMap a -> Int -> IntMap b -> IntMap c
merge0 IntMap a
t1 Int
k1 IntMap b
r2)
merge0 IntMap a
t1 Int
k1 t2 :: IntMap b
t2@(Tip Int
k2 b
_)
| Int
k1 forall a. Eq a => a -> a -> Bool
== Int
k2 = IntMap a -> IntMap b -> IntMap c
f IntMap a
t1 IntMap b
t2
| Bool
otherwise = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
k1 (IntMap a -> IntMap c
g1 IntMap a
t1) Int
k2 (IntMap b -> IntMap c
g2 IntMap b
t2)
merge0 IntMap a
t1 Int
_ IntMap b
Nil = IntMap a -> IntMap c
g1 IntMap a
t1
go IntMap a
Nil IntMap b
t2 = IntMap b -> IntMap c
g2 IntMap b
t2
maybe_link :: Int -> IntMap a -> Int -> IntMap a -> IntMap a
maybe_link Int
_ IntMap a
Nil Int
_ IntMap a
t2 = IntMap a
t2
maybe_link Int
_ IntMap a
t1 Int
_ IntMap a
Nil = IntMap a
t1
maybe_link Int
p1 IntMap a
t1 Int
p2 IntMap a
t2 = forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
p1 IntMap a
t1 Int
p2 IntMap a
t2
{-# INLINE maybe_link #-}
{-# INLINE mergeWithKey' #-}
data WhenMissing f x y = WhenMissing
{ forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree :: IntMap x -> f (IntMap y)
, forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey :: Key -> x -> f (Maybe y)}
instance (Applicative f, Monad f) => Functor (WhenMissing f x) where
fmap :: forall a b. (a -> b) -> WhenMissing f x a -> WhenMissing f x b
fmap = forall (f :: * -> *) a b x.
(Applicative f, Monad f) =>
(a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing
{-# INLINE fmap #-}
instance (Applicative f, Monad f) => Category.Category (WhenMissing f)
where
id :: forall a. WhenMissing f a a
id = forall (f :: * -> *) x. Applicative f => WhenMissing f x x
preserveMissing
WhenMissing f b c
f . :: forall b c a.
WhenMissing f b c -> WhenMissing f a b -> WhenMissing f a c
. WhenMissing f a b
g =
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$ \ Int
k a
x -> do
Maybe b
y <- forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f a b
g Int
k a
x
case Maybe b
y of
Maybe b
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just b
q -> forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f b c
f Int
k b
q
{-# INLINE id #-}
{-# INLINE (.) #-}
instance (Applicative f, Monad f) => Applicative (WhenMissing f x) where
pure :: forall a. a -> WhenMissing f x a
pure a
x = forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
mapMissing (\ Int
_ x
_ -> a
x)
WhenMissing f x (a -> b)
f <*> :: forall a b.
WhenMissing f x (a -> b) -> WhenMissing f x a -> WhenMissing f x b
<*> WhenMissing f x a
g =
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$ \Int
k x
x -> do
Maybe (a -> b)
res1 <- forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x (a -> b)
f Int
k x
x
case Maybe (a -> b)
res1 of
Maybe (a -> b)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just a -> b
r -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x a
g Int
k x
x
{-# INLINE pure #-}
{-# INLINE (<*>) #-}
instance (Applicative f, Monad f) => Monad (WhenMissing f x) where
#if !MIN_VERSION_base(4,8,0)
return = pure
#endif
WhenMissing f x a
m >>= :: forall a b.
WhenMissing f x a -> (a -> WhenMissing f x b) -> WhenMissing f x b
>>= a -> WhenMissing f x b
f =
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing forall a b. (a -> b) -> a -> b
$ \Int
k x
x -> do
Maybe a
res1 <- forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x a
m Int
k x
x
case Maybe a
res1 of
Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just a
r -> forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey (a -> WhenMissing f x b
f a
r) Int
k x
x
{-# INLINE (>>=) #-}
mapWhenMissing
:: (Applicative f, Monad f)
=> (a -> b)
-> WhenMissing f x a
-> WhenMissing f x b
mapWhenMissing :: forall (f :: * -> *) a b x.
(Applicative f, Monad f) =>
(a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapWhenMissing a -> b
f WhenMissing f x a
t = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap b)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f x a
t IntMap x
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \IntMap a
m' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f IntMap a
m'
, missingKey :: Int -> x -> f (Maybe b)
missingKey = \Int
k x
x -> forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x a
t Int
k x
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
q -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
q) }
{-# INLINE mapWhenMissing #-}
mapGentlyWhenMissing
:: Functor f
=> (a -> b)
-> WhenMissing f x a
-> WhenMissing f x b
mapGentlyWhenMissing :: forall (f :: * -> *) a b x.
Functor f =>
(a -> b) -> WhenMissing f x a -> WhenMissing f x b
mapGentlyWhenMissing a -> b
f WhenMissing f x a
t = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap b)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f x a
t IntMap x
m
, missingKey :: Int -> x -> f (Maybe b)
missingKey = \Int
k x
x -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x a
t Int
k x
x }
{-# INLINE mapGentlyWhenMissing #-}
mapGentlyWhenMatched
:: Functor f
=> (a -> b)
-> WhenMatched f x y a
-> WhenMatched f x y b
mapGentlyWhenMatched :: forall (f :: * -> *) a b x y.
Functor f =>
(a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapGentlyWhenMatched a -> b
f WhenMatched f x y a
t =
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x y a
t Int
k x
x y
y
{-# INLINE mapGentlyWhenMatched #-}
lmapWhenMissing :: (b -> a) -> WhenMissing f a x -> WhenMissing f b x
lmapWhenMissing :: forall b a (f :: * -> *) x.
(b -> a) -> WhenMissing f a x -> WhenMissing f b x
lmapWhenMissing b -> a
f WhenMissing f a x
t = WhenMissing
{ missingSubtree :: IntMap b -> f (IntMap x)
missingSubtree = \IntMap b
m -> forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f a x
t (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
f IntMap b
m)
, missingKey :: Int -> b -> f (Maybe x)
missingKey = \Int
k b
x -> forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f a x
t Int
k (b -> a
f b
x) }
{-# INLINE lmapWhenMissing #-}
contramapFirstWhenMatched
:: (b -> a)
-> WhenMatched f a y z
-> WhenMatched f b y z
contramapFirstWhenMatched :: forall b a (f :: * -> *) y z.
(b -> a) -> WhenMatched f a y z -> WhenMatched f b y z
contramapFirstWhenMatched b -> a
f WhenMatched f a y z
t =
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \Int
k b
x y
y -> forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f a y z
t Int
k (b -> a
f b
x) y
y
{-# INLINE contramapFirstWhenMatched #-}
contramapSecondWhenMatched
:: (b -> a)
-> WhenMatched f x a z
-> WhenMatched f x b z
contramapSecondWhenMatched :: forall b a (f :: * -> *) x z.
(b -> a) -> WhenMatched f x a z -> WhenMatched f x b z
contramapSecondWhenMatched b -> a
f WhenMatched f x a z
t =
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x b
y -> forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x a z
t Int
k x
x (b -> a
f b
y)
{-# INLINE contramapSecondWhenMatched #-}
#if !MIN_VERSION_base(4,8,0)
newtype Identity a = Identity {runIdentity :: a}
instance Functor Identity where
fmap f (Identity x) = Identity (f x)
instance Applicative Identity where
pure = Identity
Identity f <*> Identity x = Identity (f x)
#endif
type SimpleWhenMissing = WhenMissing Identity
newtype WhenMatched f x y z = WhenMatched
{ forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
matchedKey :: Key -> x -> y -> f (Maybe z) }
runWhenMatched :: WhenMatched f x y z -> Key -> x -> y -> f (Maybe z)
runWhenMatched :: forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched = forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
matchedKey
{-# INLINE runWhenMatched #-}
runWhenMissing :: WhenMissing f x y -> Key-> x -> f (Maybe y)
runWhenMissing :: forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
runWhenMissing = forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey
{-# INLINE runWhenMissing #-}
instance Functor f => Functor (WhenMatched f x y) where
fmap :: forall a b. (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
fmap = forall (f :: * -> *) a b x y.
Functor f =>
(a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched
{-# INLINE fmap #-}
instance (Monad f, Applicative f) => Category.Category (WhenMatched f x)
where
id :: forall a. WhenMatched f x a a
id = forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched (\Int
_ x
_ a
y -> a
y)
WhenMatched f x b c
f . :: forall b c a.
WhenMatched f x b c -> WhenMatched f x a b -> WhenMatched f x a c
. WhenMatched f x a b
g =
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x a
y -> do
Maybe b
res <- forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x a b
g Int
k x
x a
y
case Maybe b
res of
Maybe b
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just b
r -> forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x b c
f Int
k x
x b
r
{-# INLINE id #-}
{-# INLINE (.) #-}
instance (Monad f, Applicative f) => Applicative (WhenMatched f x y) where
pure :: forall a. a -> WhenMatched f x y a
pure a
x = forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched (\Int
_ x
_ y
_ -> a
x)
WhenMatched f x y (a -> b)
fs <*> :: forall a b.
WhenMatched f x y (a -> b)
-> WhenMatched f x y a -> WhenMatched f x y b
<*> WhenMatched f x y a
xs =
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> do
Maybe (a -> b)
res <- forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x y (a -> b)
fs Int
k x
x y
y
case Maybe (a -> b)
res of
Maybe (a -> b)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just a -> b
r -> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$!) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x y a
xs Int
k x
x y
y
{-# INLINE pure #-}
{-# INLINE (<*>) #-}
instance (Monad f, Applicative f) => Monad (WhenMatched f x y) where
#if !MIN_VERSION_base(4,8,0)
return = pure
#endif
WhenMatched f x y a
m >>= :: forall a b.
WhenMatched f x y a
-> (a -> WhenMatched f x y b) -> WhenMatched f x y b
>>= a -> WhenMatched f x y b
f =
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> do
Maybe a
res <- forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched WhenMatched f x y a
m Int
k x
x y
y
case Maybe a
res of
Maybe a
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Just a
r -> forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
runWhenMatched (a -> WhenMatched f x y b
f a
r) Int
k x
x y
y
{-# INLINE (>>=) #-}
mapWhenMatched
:: Functor f
=> (a -> b)
-> WhenMatched f x y a
-> WhenMatched f x y b
mapWhenMatched :: forall (f :: * -> *) a b x y.
Functor f =>
(a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
mapWhenMatched a -> b
f (WhenMatched Int -> x -> y -> f (Maybe a)
g) =
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Int -> x -> y -> f (Maybe a)
g Int
k x
x y
y)
{-# INLINE mapWhenMatched #-}
type SimpleWhenMatched = WhenMatched Identity
zipWithMatched
:: Applicative f
=> (Key -> x -> y -> z)
-> WhenMatched f x y z
zipWithMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> z) -> WhenMatched f x y z
zipWithMatched Int -> x -> y -> z
f = forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> x -> y -> z
f Int
k x
x y
y
{-# INLINE zipWithMatched #-}
zipWithAMatched
:: Applicative f
=> (Key -> x -> y -> f z)
-> WhenMatched f x y z
zipWithAMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> f z) -> WhenMatched f x y z
zipWithAMatched Int -> x -> y -> f z
f = forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> x -> y -> f z
f Int
k x
x y
y
{-# INLINE zipWithAMatched #-}
zipWithMaybeMatched
:: Applicative f
=> (Key -> x -> y -> Maybe z)
-> WhenMatched f x y z
zipWithMaybeMatched :: forall (f :: * -> *) x y z.
Applicative f =>
(Int -> x -> y -> Maybe z) -> WhenMatched f x y z
zipWithMaybeMatched Int -> x -> y -> Maybe z
f = forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> x -> y -> Maybe z
f Int
k x
x y
y
{-# INLINE zipWithMaybeMatched #-}
zipWithMaybeAMatched
:: (Key -> x -> y -> f (Maybe z))
-> WhenMatched f x y z
zipWithMaybeAMatched :: forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched Int -> x -> y -> f (Maybe z)
f = forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> Int -> x -> y -> f (Maybe z)
f Int
k x
x y
y
{-# INLINE zipWithMaybeAMatched #-}
dropMissing :: Applicative f => WhenMissing f x y
dropMissing :: forall (f :: * -> *) x y. Applicative f => WhenMissing f x y
dropMissing = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. IntMap a
Nil)
, missingKey :: Int -> x -> f (Maybe y)
missingKey = \Int
_ x
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing }
{-# INLINE dropMissing #-}
preserveMissing :: Applicative f => WhenMissing f x x
preserveMissing :: forall (f :: * -> *) x. Applicative f => WhenMissing f x x
preserveMissing = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap x)
missingSubtree = forall (f :: * -> *) a. Applicative f => a -> f a
pure
, missingKey :: Int -> x -> f (Maybe x)
missingKey = \Int
_ x
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Maybe a
Just x
v) }
{-# INLINE preserveMissing #-}
mapMissing :: Applicative f => (Key -> x -> y) -> WhenMissing f x y
mapMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> y) -> WhenMissing f x y
mapMissing Int -> x -> y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
mapWithKey Int -> x -> y
f IntMap x
m
, missingKey :: Int -> x -> f (Maybe y)
missingKey = \Int
k x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (Int -> x -> y
f Int
k x
x) }
{-# INLINE mapMissing #-}
mapMaybeMissing
:: Applicative f => (Key -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> Maybe y) -> WhenMissing f x y
mapMaybeMissing Int -> x -> Maybe y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey Int -> x -> Maybe y
f IntMap x
m
, missingKey :: Int -> x -> f (Maybe y)
missingKey = \Int
k x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! Int -> x -> Maybe y
f Int
k x
x }
{-# INLINE mapMaybeMissing #-}
filterMissing
:: Applicative f => (Key -> x -> Bool) -> WhenMissing f x x
filterMissing :: forall (f :: * -> *) x.
Applicative f =>
(Int -> x -> Bool) -> WhenMissing f x x
filterMissing Int -> x -> Bool
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap x)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
filterWithKey Int -> x -> Bool
f IntMap x
m
, missingKey :: Int -> x -> f (Maybe x)
missingKey = \Int
k x
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! if Int -> x -> Bool
f Int
k x
x then forall a. a -> Maybe a
Just x
x else forall a. Maybe a
Nothing }
{-# INLINE filterMissing #-}
filterAMissing
:: Applicative f => (Key -> x -> f Bool) -> WhenMissing f x x
filterAMissing :: forall (f :: * -> *) x.
Applicative f =>
(Int -> x -> f Bool) -> WhenMissing f x x
filterAMissing Int -> x -> f Bool
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap x)
missingSubtree = \IntMap x
m -> forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> x -> f Bool
f IntMap x
m
, missingKey :: Int -> x -> f (Maybe x)
missingKey = \Int
k x
x -> forall a. a -> a -> Bool -> a
bool forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just x
x) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> x -> f Bool
f Int
k x
x }
{-# INLINE filterAMissing #-}
filterWithKeyA
:: Applicative f => (Key -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA :: forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
_ IntMap a
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. IntMap a
Nil
filterWithKeyA Int -> a -> f Bool
f t :: IntMap a
t@(Tip Int
k a
x) = (\Bool
b -> if Bool
b then IntMap a
t else forall a. IntMap a
Nil) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f Bool
f Int
k a
x
filterWithKeyA Int -> a -> f Bool
f (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m)) (forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
r) (forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
l)
| Bool
otherwise = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m) (forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
l) (forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
r)
bool :: a -> a -> Bool -> a
bool :: forall a. a -> a -> Bool -> a
bool a
f a
_ Bool
False = a
f
bool a
_ a
t Bool
True = a
t
traverseMissing
:: Applicative f => (Key -> x -> f y) -> WhenMissing f x y
traverseMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f y) -> WhenMissing f x y
traverseMissing Int -> x -> f y
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
traverseWithKey Int -> x -> f y
f
, missingKey :: Int -> x -> f (Maybe y)
missingKey = \Int
k x
x -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> x -> f y
f Int
k x
x }
{-# INLINE traverseMissing #-}
traverseMaybeMissing
:: Applicative f => (Key -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing :: forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing Int -> x -> f (Maybe y)
f = WhenMissing
{ missingSubtree :: IntMap x -> f (IntMap y)
missingSubtree = forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f (Maybe b)) -> IntMap a -> f (IntMap b)
traverseMaybeWithKey Int -> x -> f (Maybe y)
f
, missingKey :: Int -> x -> f (Maybe y)
missingKey = Int -> x -> f (Maybe y)
f }
{-# INLINE traverseMaybeMissing #-}
traverseMaybeWithKey
:: Applicative f => (Key -> a -> f (Maybe b)) -> IntMap a -> f (IntMap b)
traverseMaybeWithKey :: forall (f :: * -> *) a b.
Applicative f =>
(Int -> a -> f (Maybe b)) -> IntMap a -> f (IntMap b)
traverseMaybeWithKey Int -> a -> f (Maybe b)
f = IntMap a -> f (IntMap b)
go
where
go :: IntMap a -> f (IntMap b)
go IntMap a
Nil = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. IntMap a
Nil
go (Tip Int
k a
x) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. IntMap a
Nil (forall a. Int -> a -> IntMap a
Tip Int
k) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> f (Maybe b)
f Int
k a
x
go (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int
m forall a. Ord a => a -> a -> Bool
< Int
0 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m)) (IntMap a -> f (IntMap b)
go IntMap a
r) (IntMap a -> f (IntMap b)
go IntMap a
l)
| Bool
otherwise = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m) (IntMap a -> f (IntMap b)
go IntMap a
l) (IntMap a -> f (IntMap b)
go IntMap a
r)
merge
:: SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> IntMap c
merge :: forall a c b.
SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> IntMap c
merge SimpleWhenMissing a c
g1 SimpleWhenMissing b c
g2 SimpleWhenMatched a b c
f IntMap a
m1 IntMap b
m2 =
forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a c b.
Applicative f =>
WhenMissing f a c
-> WhenMissing f b c
-> WhenMatched f a b c
-> IntMap a
-> IntMap b
-> f (IntMap c)
mergeA SimpleWhenMissing a c
g1 SimpleWhenMissing b c
g2 SimpleWhenMatched a b c
f IntMap a
m1 IntMap b
m2
{-# INLINE merge #-}
mergeA
:: (Applicative f)
=> WhenMissing f a c
-> WhenMissing f b c
-> WhenMatched f a b c
-> IntMap a
-> IntMap b
-> f (IntMap c)
mergeA :: forall (f :: * -> *) a c b.
Applicative f =>
WhenMissing f a c
-> WhenMissing f b c
-> WhenMatched f a b c
-> IntMap a
-> IntMap b
-> f (IntMap c)
mergeA
WhenMissing{missingSubtree :: forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree = IntMap a -> f (IntMap c)
g1t, missingKey :: forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey = Int -> a -> f (Maybe c)
g1k}
WhenMissing{missingSubtree :: forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree = IntMap b -> f (IntMap c)
g2t, missingKey :: forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey = Int -> b -> f (Maybe c)
g2k}
WhenMatched{matchedKey :: forall (f :: * -> *) x y z.
WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
matchedKey = Int -> a -> b -> f (Maybe c)
f}
= IntMap a -> IntMap b -> f (IntMap c)
go
where
go :: IntMap a -> IntMap b -> f (IntMap c)
go IntMap a
t1 IntMap b
Nil = IntMap a -> f (IntMap c)
g1t IntMap a
t1
go IntMap a
Nil IntMap b
t2 = IntMap b -> f (IntMap c)
g2t IntMap b
t2
go (Tip Int
k1 a
x1) IntMap b
t2' = IntMap b -> f (IntMap c)
merge2 IntMap b
t2'
where
merge2 :: IntMap b -> f (IntMap c)
merge2 t2 :: IntMap b
t2@(Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Int -> Bool
nomatch Int
k1 Int
p2 Int
m2 = forall (f :: * -> *) a.
Applicative f =>
Int -> f (IntMap a) -> Int -> f (IntMap a) -> f (IntMap a)
linkA Int
k1 (forall {f :: * -> *} {t} {a}.
Functor f =>
(Int -> t -> f (Maybe a)) -> Int -> t -> f (IntMap a)
subsingletonBy Int -> a -> f (Maybe c)
g1k Int
k1 a
x1) Int
p2 (IntMap b -> f (IntMap c)
g2t IntMap b
t2)
| Int -> Int -> Bool
zero Int
k1 Int
m2 = forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p2 Int
m2 (IntMap b -> f (IntMap c)
merge2 IntMap b
l2) (IntMap b -> f (IntMap c)
g2t IntMap b
r2)
| Bool
otherwise = forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p2 Int
m2 (IntMap b -> f (IntMap c)
g2t IntMap b
l2) (IntMap b -> f (IntMap c)
merge2 IntMap b
r2)
merge2 (Tip Int
k2 b
x2) = Int -> a -> Int -> b -> f (IntMap c)
mergeTips Int
k1 a
x1 Int
k2 b
x2
merge2 IntMap b
Nil = forall {f :: * -> *} {t} {a}.
Functor f =>
(Int -> t -> f (Maybe a)) -> Int -> t -> f (IntMap a)
subsingletonBy Int -> a -> f (Maybe c)
g1k Int
k1 a
x1
go IntMap a
t1' (Tip Int
k2 b
x2) = IntMap a -> f (IntMap c)
merge1 IntMap a
t1'
where
merge1 :: IntMap a -> f (IntMap c)
merge1 t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1)
| Int -> Int -> Int -> Bool
nomatch Int
k2 Int
p1 Int
m1 = forall (f :: * -> *) a.
Applicative f =>
Int -> f (IntMap a) -> Int -> f (IntMap a) -> f (IntMap a)
linkA Int
p1 (IntMap a -> f (IntMap c)
g1t IntMap a
t1) Int
k2 (forall {f :: * -> *} {t} {a}.
Functor f =>
(Int -> t -> f (Maybe a)) -> Int -> t -> f (IntMap a)
subsingletonBy Int -> b -> f (Maybe c)
g2k Int
k2 b
x2)
| Int -> Int -> Bool
zero Int
k2 Int
m1 = forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p1 Int
m1 (IntMap a -> f (IntMap c)
merge1 IntMap a
l1) (IntMap a -> f (IntMap c)
g1t IntMap a
r1)
| Bool
otherwise = forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p1 Int
m1 (IntMap a -> f (IntMap c)
g1t IntMap a
l1) (IntMap a -> f (IntMap c)
merge1 IntMap a
r1)
merge1 (Tip Int
k1 a
x1) = Int -> a -> Int -> b -> f (IntMap c)
mergeTips Int
k1 a
x1 Int
k2 b
x2
merge1 IntMap a
Nil = forall {f :: * -> *} {t} {a}.
Functor f =>
(Int -> t -> f (Maybe a)) -> Int -> t -> f (IntMap a)
subsingletonBy Int -> b -> f (Maybe c)
g2k Int
k2 b
x2
go t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a