{-# 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 = Int -> Nat
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE natFromInt #-}
intFromNat :: Nat -> Key
intFromNat :: Nat -> Int
intFromNat = Nat -> Int
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 Int -> Int -> Int
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 = Int -> IntMap a -> a
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 = Int -> IntMap a -> Maybe a
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 = IntMap a -> IntMap b -> IntMap a
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 = IntMap a
forall a. IntMap a
empty
mconcat :: [IntMap a] -> IntMap a
mconcat = [IntMap a] -> IntMap a
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 = IntMap a -> IntMap a -> IntMap a
forall a. Semigroup a => a -> a -> a
(<>)
instance Semigroup (IntMap a) where
<> :: IntMap a -> IntMap a -> IntMap a
(<>) = 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 = b -> IntMap a -> IntMap a
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 = IntMap m -> m
forall m. Monoid m => IntMap m -> m
go
where go :: IntMap a -> a
go IntMap a
Nil = a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> a
go IntMap a
r a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> a
go IntMap a
l
| Bool
otherwise = IntMap a -> a
go IntMap a
l a -> a -> a
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 = (a -> b -> b) -> b -> IntMap a -> b
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 = (b -> a -> b) -> b -> IntMap a -> b
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 = m
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> m
go IntMap a
r m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> m
go IntMap a
l
| Bool
otherwise = IntMap a -> m
go IntMap a
l m -> m -> m
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' = (b -> a -> b) -> b -> IntMap a -> b
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' = (a -> b -> b) -> b -> IntMap a -> b
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 = IntMap a -> Int
forall a. IntMap a -> Int
size
{-# INLINE length #-}
null :: forall a. IntMap a -> Bool
null = IntMap a -> Bool
forall a. IntMap a -> Bool
null
{-# INLINE null #-}
toList :: forall a. IntMap a -> [a]
toList = IntMap a -> [a]
forall a. IntMap a -> [a]
elems
{-# INLINE toList #-}
elem :: forall a. Eq a => a -> IntMap a -> Bool
elem = a -> IntMap a -> Bool
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 t -> t -> Bool
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 = IntMap a -> a
forall a. Ord a => IntMap a -> a
start
where start :: IntMap a -> a
start IntMap a
Nil = [Char] -> a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = a -> IntMap a -> a
forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
r) IntMap a
l
| Bool
otherwise = a -> IntMap a -> a
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) = t -> t -> t
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 = IntMap a -> a
forall a. Ord a => IntMap a -> a
start
where start :: IntMap a -> a
start IntMap a
Nil = [Char] -> a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = a -> IntMap a -> a
forall {t}. Ord t => t -> IntMap t -> t
go (IntMap a -> a
start IntMap a
r) IntMap a
l
| Bool
otherwise = a -> IntMap a -> a
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) = t -> t -> t
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 = (a -> a -> a) -> a -> IntMap a -> a
forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0
{-# INLINABLE sum #-}
product :: forall a. Num a => IntMap a -> a
product = (a -> a -> a) -> a -> IntMap a -> a
forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' a -> a -> a
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 = (Int -> a -> f b) -> IntMap a -> f (IntMap b)
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) = a -> ()
forall a. NFData a => a -> ()
rnf a
v
rnf (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = IntMap a -> ()
forall a. NFData a => a -> ()
rnf IntMap a
l () -> () -> ()
`seq` IntMap a -> ()
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 = ([(Int, a)] -> IntMap a) -> c ([(Int, a)] -> IntMap a)
forall g. g -> c g
z [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromList c ([(Int, a)] -> IntMap a) -> [(Int, a)] -> c (IntMap a)
forall d b. Data d => c (d -> b) -> d -> c b
`f` (IntMap a -> [(Int, a)]
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 -> c ([(Int, a)] -> IntMap a) -> c (IntMap a)
forall b r. Data b => c (b -> r) -> c r
k (([(Int, a)] -> IntMap a) -> c ([(Int, a)] -> IntMap a)
forall r. r -> c r
z [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromList)
Int
_ -> [Char] -> c (IntMap a)
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 = c (t a) -> Maybe (c (IntMap a))
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 c (t a)
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 = Int -> IntMap a -> Int
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 t -> t -> t
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 Int -> Int -> Bool
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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> IntMap a -> Bool
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 = Maybe a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kx = a -> Maybe a
forall a. a -> Maybe a
Just a
x
| Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
go IntMap a
Nil = Maybe a
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 Int -> Int -> Bool
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 = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char]
"IntMap.!: key " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
k [Char] -> [Char] -> [Char]
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k Int -> Int -> Bool
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 IntMap a
forall a. IntMap a
Nil IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def else IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ky = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
| Bool
otherwise = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
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 IntMap a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
l else IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
ky = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Bool
otherwise = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k Int -> Int -> Bool
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 IntMap a
forall a. IntMap a
Nil IntMap a
r
IntMap a
_ -> IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def else IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ky = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMax IntMap a
def
| Bool
otherwise = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 then IntMap a -> IntMap a -> Maybe (Int, a)
go IntMap a
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 IntMap a
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
p then IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
l else IntMap a -> Maybe (Int, a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ky = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
unsafeFindMin IntMap a
def
| Bool
otherwise = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
go IntMap a
def IntMap a
Nil = IntMap a -> Maybe (Int, a)
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 = Maybe (Int, a)
forall a. Maybe a
Nothing
unsafeFindMin (Tip Int
ky a
y) = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
unsafeFindMin (Bin Int
_ Int
_ IntMap a
l IntMap a
_) = IntMap a -> Maybe (Int, 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 = Maybe (Int, a)
forall a. Maybe a
Nothing
unsafeFindMax (Tip Int
ky a
y) = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
ky, a
y)
unsafeFindMax (Bin Int
_ Int
_ IntMap a
_ IntMap a
r) = IntMap a -> Maybe (Int, a)
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 = Int -> IntMap b -> Bool
forall a. Int -> IntMap a -> Bool
notMember Int
kx IntMap b
ys
disjoint IntMap a
xs (Tip Int
ky b
_) = Int -> IntMap a -> Bool
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = IntMap a -> IntMap b -> Bool
forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
l1 IntMap b
l2 Bool -> Bool -> Bool
&& IntMap a -> IntMap b -> 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 = IntMap a -> IntMap b -> Bool
forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
l1 IntMap b
t2
| Bool
otherwise = IntMap a -> IntMap b -> Bool
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 = IntMap a -> IntMap b -> Bool
forall a b. IntMap a -> IntMap b -> Bool
disjoint IntMap a
t1 IntMap b
l2
| Bool
otherwise = IntMap a -> IntMap b -> Bool
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
| IntMap c -> Bool
forall a. IntMap a -> Bool
null IntMap c
bc = IntMap c
forall a. IntMap a
empty
| Bool
otherwise = (Int -> Maybe c) -> IntMap Int -> IntMap c
forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe (IntMap c
bc IntMap c -> Int -> Maybe c
forall a. IntMap a -> Int -> Maybe a
!?) IntMap Int
ab
empty :: IntMap a
empty :: forall a. IntMap a
empty
= IntMap a
forall a. IntMap a
Nil
{-# INLINE empty #-}
singleton :: Key -> a -> IntMap a
singleton :: forall a. Int -> a -> IntMap a
singleton Int
k a
x
= Int -> a -> IntMap a
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 = Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
x IntMap a
l) IntMap a
r
| Bool
otherwise = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l (Int -> a -> IntMap a -> IntMap a
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
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
ky = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x
| Bool
otherwise = Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t
insert Int
k a
x IntMap a
Nil = Int -> a -> IntMap a
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
= (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
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 = Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m ((Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l ((Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k (Int -> a -> a -> a
f Int
k a
x a
y)
| Bool
otherwise = Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
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 = Int -> a -> IntMap a
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 = (Maybe a
forall a. Maybe a
Nothing,Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
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') = (Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
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,Int -> Int -> IntMap a -> IntMap a -> IntMap a
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') = (Int -> a -> a -> a) -> Int -> a -> IntMap a -> (Maybe a, IntMap a)
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,Int -> Int -> IntMap a -> IntMap a -> IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky = (a -> Maybe a
forall a. a -> Maybe a
Just a
y,Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k (Int -> a -> a -> a
f Int
k a
x a
y))
| Bool
otherwise = (Maybe a
forall a. Maybe a
Nothing,Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
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 = (Maybe a
forall a. Maybe a
Nothing,Int -> a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
delete Int
k IntMap a
l) IntMap a
r
| Bool
otherwise = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (Int -> IntMap a -> IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky = IntMap a
forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
delete Int
_k IntMap a
Nil = IntMap a
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
= (Int -> a -> a) -> Int -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m ((Int -> a -> a) -> Int -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l ((Int -> a -> a) -> Int -> IntMap a -> IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky = Int -> a -> IntMap a
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 = IntMap a
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
= (Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m ((Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l ((Int -> a -> Maybe a) -> Int -> IntMap a -> IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky = case (Int -> a -> Maybe a
f Int
k a
y) of
Just a
y' -> Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
ky a
y'
Maybe a
Nothing -> IntMap a
forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
updateWithKey Int -> a -> Maybe a
_ Int
_ IntMap a
Nil = IntMap a
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 = (Maybe a
forall a. Maybe a
Nothing,IntMap a
t)
| Int -> Int -> Bool
zero Int
k Int
m = let !(Maybe a
found,IntMap a
l') = (Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
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,Int -> Int -> IntMap a -> IntMap a -> IntMap a
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') = (Int -> a -> Maybe a) -> Int -> IntMap a -> (Maybe a, IntMap a)
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,Int -> Int -> IntMap a -> IntMap a -> IntMap a
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
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
ky = case (Int -> a -> Maybe a
f Int
k a
y) of
Just a
y' -> (a -> Maybe a
forall a. a -> Maybe a
Just a
y,Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
ky a
y')
Maybe a
Nothing -> (a -> Maybe a
forall a. a -> Maybe a
Just a
y,IntMap a
forall a. IntMap a
Nil)
| Bool
otherwise = (Maybe a
forall a. Maybe a
Nothing,IntMap a
t)
updateLookupWithKey Int -> a -> Maybe a
_ Int
_ IntMap a
Nil = (Maybe a
forall a. Maybe a
Nothing,IntMap a
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 Maybe a
forall a. Maybe a
Nothing of
Maybe a
Nothing -> IntMap a
t
Just a
x -> Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
p IntMap a
t
| Int -> Int -> Bool
zero Int
k Int
m = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m ((Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l ((Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
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
kInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
ky = case Maybe a -> Maybe a
f (a -> Maybe a
forall a. a -> Maybe a
Just a
y) of
Just a
x -> Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
ky a
x
Maybe a
Nothing -> IntMap a
forall a. IntMap a
Nil
| Bool
otherwise = case Maybe a -> Maybe a
f Maybe a
forall a. Maybe a
Nothing of
Just a
x -> Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x) Int
ky IntMap a
t
Maybe a
Nothing -> Int -> a -> IntMap a
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 Maybe a
forall a. Maybe a
Nothing of
Just a
x -> Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
x
Maybe a
Nothing -> IntMap a
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 = ((Maybe a -> IntMap a) -> f (Maybe a) -> f (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a -> f (Maybe a)
f Maybe a
mv) ((Maybe a -> IntMap a) -> f (IntMap a))
-> (Maybe a -> IntMap a) -> f (IntMap a)
forall a b. (a -> b) -> a -> b
$ \Maybe a
fres ->
case Maybe a
fres of
Maybe a
Nothing -> IntMap a -> (a -> IntMap a) -> Maybe a -> IntMap a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap a
m (IntMap a -> a -> IntMap a
forall a b. a -> b -> a
const (Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
delete Int
k IntMap a
m)) Maybe a
mv
Just a
v' -> Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
v' IntMap a
m
where mv :: Maybe a
mv = Int -> IntMap a -> Maybe a
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
= (IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> f (IntMap a) -> IntMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
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
= (IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> f (IntMap a) -> IntMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' ((a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
unionWith a -> a -> a
f) IntMap a
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
= (Int -> Int -> IntMap a -> IntMap a -> IntMap a)
-> (IntMap a -> IntMap a -> IntMap a)
-> (IntMap a -> IntMap a)
-> (IntMap a -> IntMap a)
-> IntMap a
-> IntMap a
-> IntMap a
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 a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin IntMap a -> IntMap a -> IntMap a
forall a b. a -> b -> a
const IntMap a -> IntMap a
forall a. a -> a
id IntMap a -> IntMap a
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
= (Int -> a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
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
= (Int -> Int -> IntMap a -> IntMap a -> IntMap a)
-> (IntMap a -> IntMap a -> IntMap a)
-> (IntMap a -> IntMap a)
-> (IntMap a -> IntMap a)
-> IntMap a
-> IntMap a
-> IntMap a
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 a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin (\(Tip Int
k1 a
x1) (Tip Int
_k2 a
x2) -> Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k1 (Int -> a -> a -> a
f Int
k1 a
x1 a
x2)) IntMap a -> IntMap a
forall a. a -> a
id IntMap a -> IntMap a
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
= (Int -> a -> b -> Maybe a)
-> (IntMap a -> IntMap a)
-> (IntMap b -> IntMap a)
-> IntMap a
-> IntMap b
-> IntMap a
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
forall a. Maybe a
Nothing) IntMap a -> IntMap a
forall a. a -> a
id (IntMap a -> IntMap b -> IntMap a
forall a b. a -> b -> a
const IntMap a
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
= (Int -> a -> b -> Maybe a) -> IntMap a -> IntMap b -> IntMap a
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
= (Int -> a -> b -> Maybe a)
-> (IntMap a -> IntMap a)
-> (IntMap b -> IntMap a)
-> IntMap a
-> IntMap b
-> IntMap a
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 IntMap a -> IntMap a
forall a. a -> a
id (IntMap a -> IntMap b -> IntMap a
forall a b. a -> b -> a
const IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p1 Int
m1 (IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
l1 IntSet
l2) (IntMap a -> IntSet -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p1 Int
m1 (IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
l1 IntSet
t2) IntMap a
r1
| Bool
otherwise = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p1 Int
m1 IntMap a
l1 (IntMap a -> IntSet -> IntMap a
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 = IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
withoutKeys IntMap a
t1 IntSet
l2
| Bool
otherwise = IntMap a -> IntSet -> IntMap a
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 Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1
maxbit :: Nat
maxbit = Int -> Nat
bitmapOf (Int
p1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
m1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
m1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
gt_maxbit :: Nat
gt_maxbit = (-Nat
maxbit) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
maxbit
in Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
forall a. Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
updatePrefix Int
p2 IntMap a
t1 ((IntMap a -> IntMap a) -> IntMap a)
-> (IntMap a -> IntMap a) -> IntMap a
forall a b. (a -> b) -> a -> b
$ Nat -> IntMap a -> IntMap a
forall a. Nat -> IntMap a -> IntMap a
withoutBM (Nat
bm2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Nat
lt_minbit Nat -> Nat -> Nat
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 = IntMap a
forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t1
withoutKeys IntMap a
Nil IntSet
_ = IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
if Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask Int -> Int -> Bool
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m (Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
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 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l (Int -> IntMap a -> (IntMap a -> IntMap a) -> IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask Int -> Int -> Bool
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
_ = 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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1
bmL :: Nat
bmL = Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
leftBits
bmR :: Nat
bmR = Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
bmL
in Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m (Nat -> IntMap a -> IntMap a
forall a. Nat -> IntMap a -> IntMap a
withoutBM Nat
bmL IntMap a
l) (Nat -> IntMap a -> IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) Nat
bm = IntMap a
forall a. IntMap a
Nil
| Bool
otherwise = IntMap a
t
withoutBM Nat
_ IntMap a
Nil = IntMap a
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
= (Int -> Int -> IntMap a -> IntMap a -> IntMap a)
-> (IntMap a -> IntMap b -> IntMap a)
-> (IntMap a -> IntMap a)
-> (IntMap b -> IntMap a)
-> IntMap a
-> IntMap b
-> IntMap a
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 a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin IntMap a -> IntMap b -> IntMap a
forall a b. a -> b -> a
const (IntMap a -> IntMap a -> IntMap a
forall a b. a -> b -> a
const IntMap a
forall a. IntMap a
Nil) (IntMap a -> IntMap b -> IntMap a
forall a b. a -> b -> a
const IntMap a
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p1 Int
m1 (IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
l1 IntSet
l2) (IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
r1 IntSet
r2)
| Bool
otherwise = IntMap a
forall a. IntMap a
Nil
where
intersection1 :: IntMap a
intersection1
| Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = IntMap a
forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
p2 Int
m1 = IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
l1 IntSet
t2
| Bool
otherwise = IntMap a -> IntSet -> IntMap a
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 = IntMap a
forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
p1 Int
m2 = IntMap a -> IntSet -> IntMap a
forall a. IntMap a -> IntSet -> IntMap a
restrictKeys IntMap a
t1 IntSet
l2
| Bool
otherwise = IntMap a -> IntSet -> IntMap a
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 = Nat -> Nat
forall a. Bits a => a -> a
complement (Nat
minbit Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1)
maxbit :: Nat
maxbit = Int -> Nat
bitmapOf (Int
p1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
m1 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
m1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
le_maxbit :: Nat
le_maxbit = Nat
maxbit Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. (Nat
maxbit Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1)
in Nat -> IntMap a -> IntMap a
forall a. Nat -> IntMap a -> IntMap a
restrictBM (Nat
bm2 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
ge_minbit Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
le_maxbit) (Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
lookupPrefix Int
p2 IntMap a
t1)
restrictKeys (Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntSet
IntSet.Nil = IntMap a
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 = IntMap a
forall a. IntMap a
Nil
restrictKeys IntMap a
Nil IntSet
_ = IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
if Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kp then IntMap a
t else IntMap a
forall a. IntMap a
Nil
| Int -> Int -> Int -> Bool
nomatch Int
kp Int
p Int
m = IntMap a
forall a. IntMap a
Nil
| Int -> Int -> Bool
zero Int
kp Int
m = Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> IntMap a
lookupPrefix Int
kp IntMap a
l
| Bool
otherwise = Int -> IntMap a -> IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
kp = IntMap a
t
| Bool
otherwise = IntMap a
forall a. IntMap a
Nil
lookupPrefix Int
_ IntMap a
Nil = IntMap a
forall a. IntMap a
Nil
restrictBM :: IntSetBitMap -> IntMap a -> IntMap a
restrictBM :: forall a. Nat -> IntMap a -> IntMap a
restrictBM Nat
0 IntMap a
_ = 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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
m) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1
bmL :: Nat
bmL = Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. Nat
leftBits
bmR :: Nat
bmR = Nat
bm Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
bmL
in Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m (Nat -> IntMap a -> IntMap a
forall a. Nat -> IntMap a -> IntMap a
restrictBM Nat
bmL IntMap a
l) (Nat -> IntMap a -> IntMap a
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 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) Nat
bm = IntMap a
t
| Bool
otherwise = IntMap a
forall a. IntMap a
Nil
restrictBM Nat
_ IntMap a
Nil = IntMap a
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
= (Int -> a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
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
= (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
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
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin (\(Tip Int
k1 a
x1) (Tip Int
_k2 b
x2) -> Int -> c -> IntMap c
forall a. Int -> a -> IntMap a
Tip Int
k1 (Int -> a -> b -> c
f Int
k1 a
x1 b
x2)) (IntMap c -> IntMap a -> IntMap c
forall a b. a -> b -> a
const IntMap c
forall a. IntMap a
Nil) (IntMap c -> IntMap b -> IntMap c
forall a b. a -> b -> a
const IntMap c
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 = (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
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
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 -> IntMap c
forall a. IntMap a
Nil
Just c
x -> Int -> c -> IntMap c
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 Int -> Int -> Bool
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 = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k2 = IntMap a -> IntMap b -> IntMap c
f IntMap a
t1 IntMap b
t2
| Bool
otherwise = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k2 = IntMap a -> IntMap b -> IntMap c
f IntMap a
t1 IntMap b
t2
| Bool
otherwise = Int -> IntMap c -> Int -> IntMap c -> IntMap c
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 = Int -> IntMap a -> Int -> IntMap a -> IntMap a
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 = (a -> b) -> WhenMissing f x a -> WhenMissing f x b
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 = WhenMissing f a a
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 =
(Int -> a -> f (Maybe c)) -> WhenMissing f a c
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing ((Int -> a -> f (Maybe c)) -> WhenMissing f a c)
-> (Int -> a -> f (Maybe c)) -> WhenMissing f a c
forall a b. (a -> b) -> a -> b
$ \ Int
k a
x -> do
Maybe b
y <- WhenMissing f a b -> Int -> a -> f (Maybe b)
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 -> Maybe c -> f (Maybe c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe c
forall a. Maybe a
Nothing
Just b
q -> WhenMissing f b c -> Int -> b -> f (Maybe c)
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 = (Int -> x -> a) -> WhenMissing f x a
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 =
(Int -> x -> f (Maybe b)) -> WhenMissing f x b
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing ((Int -> x -> f (Maybe b)) -> WhenMissing f x b)
-> (Int -> x -> f (Maybe b)) -> WhenMissing f x b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x -> do
Maybe (a -> b)
res1 <- WhenMissing f x (a -> b) -> Int -> x -> f (Maybe (a -> b))
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
Just a -> b
r -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$!) (Maybe b -> f (Maybe b))
-> (Maybe a -> Maybe b) -> Maybe a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r (Maybe a -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WhenMissing f x a -> Int -> x -> f (Maybe a)
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 =
(Int -> x -> f (Maybe b)) -> WhenMissing f x b
forall (f :: * -> *) x y.
Applicative f =>
(Int -> x -> f (Maybe y)) -> WhenMissing f x y
traverseMaybeMissing ((Int -> x -> f (Maybe b)) -> WhenMissing f x b)
-> (Int -> x -> f (Maybe b)) -> WhenMissing f x b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x -> do
Maybe a
res1 <- WhenMissing f x a -> Int -> x -> f (Maybe a)
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
Just a
r -> WhenMissing f x b -> Int -> x -> f (Maybe b)
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 -> WhenMissing f x a -> IntMap x -> f (IntMap a)
forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f x a
t IntMap x
m f (IntMap a) -> (IntMap a -> f (IntMap b)) -> f (IntMap b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \IntMap a
m' -> IntMap b -> f (IntMap b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap b -> f (IntMap b)) -> IntMap b -> f (IntMap b)
forall a b. (a -> b) -> a -> b
$! (a -> b) -> IntMap a -> IntMap 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 -> WhenMissing f x a -> Int -> x -> f (Maybe a)
forall (f :: * -> *) x y.
WhenMissing f x y -> Int -> x -> f (Maybe y)
missingKey WhenMissing f x a
t Int
k x
x f (Maybe a) -> (Maybe a -> f (Maybe b)) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe a
q -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$! (a -> b) -> Maybe a -> Maybe 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 -> (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (IntMap a -> IntMap b) -> f (IntMap a) -> f (IntMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing f x a -> IntMap x -> f (IntMap a)
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 -> (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMissing f x a -> Int -> x -> f (Maybe a)
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 =
(Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched ((Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b)
-> (Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WhenMatched f x y a -> Int -> x -> y -> f (Maybe a)
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 -> WhenMissing f a x -> IntMap a -> f (IntMap x)
forall (f :: * -> *) x y.
WhenMissing f x y -> IntMap x -> f (IntMap y)
missingSubtree WhenMissing f a x
t ((b -> a) -> IntMap b -> IntMap a
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 -> WhenMissing f a x -> Int -> a -> f (Maybe 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 =
(Int -> b -> y -> f (Maybe z)) -> WhenMatched f b y z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> b -> y -> f (Maybe z)) -> WhenMatched f b y z)
-> (Int -> b -> y -> f (Maybe z)) -> WhenMatched f b y z
forall a b. (a -> b) -> a -> b
$ \Int
k b
x y
y -> WhenMatched f a y z -> Int -> a -> y -> f (Maybe z)
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 =
(Int -> x -> b -> f (Maybe z)) -> WhenMatched f x b z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> b -> f (Maybe z)) -> WhenMatched f x b z)
-> (Int -> x -> b -> f (Maybe z)) -> WhenMatched f x b z
forall a b. (a -> b) -> a -> b
$ \Int
k x
x b
y -> WhenMatched f x a z -> Int -> x -> a -> f (Maybe z)
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 = WhenMatched f x y z -> Int -> x -> y -> f (Maybe z)
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 = WhenMissing f x y -> Int -> x -> f (Maybe y)
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 = (a -> b) -> WhenMatched f x y a -> WhenMatched f x y b
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 = (Int -> x -> a -> a) -> WhenMatched f x a a
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 =
(Int -> x -> a -> f (Maybe c)) -> WhenMatched f x a c
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched ((Int -> x -> a -> f (Maybe c)) -> WhenMatched f x a c)
-> (Int -> x -> a -> f (Maybe c)) -> WhenMatched f x a c
forall a b. (a -> b) -> a -> b
$ \Int
k x
x a
y -> do
Maybe b
res <- WhenMatched f x a b -> Int -> x -> a -> f (Maybe b)
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 -> Maybe c -> f (Maybe c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe c
forall a. Maybe a
Nothing
Just b
r -> WhenMatched f x b c -> Int -> x -> b -> f (Maybe c)
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 = (Int -> x -> y -> a) -> WhenMatched f x y a
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 =
(Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched ((Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b)
-> (Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> do
Maybe (a -> b)
res <- WhenMatched f x y (a -> b) -> Int -> x -> y -> f (Maybe (a -> b))
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
Just a -> b
r -> (Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe b -> f (Maybe b)) -> Maybe b -> f (Maybe b)
forall a b. (a -> b) -> a -> b
$!) (Maybe b -> f (Maybe b))
-> (Maybe a -> Maybe b) -> Maybe a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
r (Maybe a -> f (Maybe b)) -> f (Maybe a) -> f (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< WhenMatched f x y a -> Int -> x -> y -> f (Maybe a)
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 =
(Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall x y (f :: * -> *) z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
zipWithMaybeAMatched ((Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b)
-> (Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> do
Maybe a
res <- WhenMatched f x y a -> Int -> x -> y -> f (Maybe a)
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 -> Maybe b -> f (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
Just a
r -> WhenMatched f x y b -> Int -> x -> y -> f (Maybe b)
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) =
(Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b)
-> (Int -> x -> y -> f (Maybe b)) -> WhenMatched f x y b
forall a b. (a -> b) -> a -> b
$ \Int
k x
x y
y -> (Maybe a -> Maybe b) -> f (Maybe a) -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
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 = (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> (z -> Maybe z) -> z -> f (Maybe z)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> Maybe z
forall a. a -> Maybe a
Just (z -> f (Maybe z)) -> z -> f (Maybe z)
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 = (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> z -> Maybe z
forall a. a -> Maybe a
Just (z -> Maybe z) -> f z -> f (Maybe z)
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 = (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall a b. (a -> b) -> a -> b
$ \ Int
k x
x y
y -> Maybe z -> f (Maybe z)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe z -> f (Maybe z)) -> Maybe z -> f (Maybe z)
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 = (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
forall (f :: * -> *) x y z.
(Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
WhenMatched ((Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z)
-> (Int -> x -> y -> f (Maybe z)) -> WhenMatched f x y z
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 = f (IntMap y) -> IntMap x -> f (IntMap y)
forall a b. a -> b -> a
const (IntMap y -> f (IntMap y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap y
forall a. IntMap a
Nil)
, missingKey :: Int -> x -> f (Maybe y)
missingKey = \Int
_ x
_ -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe y
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 = IntMap x -> f (IntMap x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
, missingKey :: Int -> x -> f (Maybe x)
missingKey = \Int
_ x
v -> Maybe x -> f (Maybe x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (x -> Maybe x
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 -> IntMap y -> f (IntMap y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap y -> f (IntMap y)) -> IntMap y -> f (IntMap y)
forall a b. (a -> b) -> a -> b
$! (Int -> x -> y) -> IntMap x -> IntMap y
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 -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
forall a b. (a -> b) -> a -> b
$ y -> Maybe y
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 -> IntMap y -> f (IntMap y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap y -> f (IntMap y)) -> IntMap y -> f (IntMap y)
forall a b. (a -> b) -> a -> b
$! (Int -> x -> Maybe y) -> IntMap x -> IntMap y
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 -> Maybe y -> f (Maybe y)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe y -> f (Maybe y)) -> Maybe y -> f (Maybe y)
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 -> IntMap x -> f (IntMap x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IntMap x -> f (IntMap x)) -> IntMap x -> f (IntMap x)
forall a b. (a -> b) -> a -> b
$! (Int -> x -> Bool) -> IntMap x -> IntMap x
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 -> Maybe x -> f (Maybe x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe x -> f (Maybe x)) -> Maybe x -> f (Maybe x)
forall a b. (a -> b) -> a -> b
$! if Int -> x -> Bool
f Int
k x
x then x -> Maybe x
forall a. a -> Maybe a
Just x
x else Maybe x
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 -> (Int -> x -> f Bool) -> IntMap x -> f (IntMap x)
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 -> Maybe x -> Maybe x -> Bool -> Maybe x
forall a. a -> a -> Bool -> a
bool Maybe x
forall a. Maybe a
Nothing (x -> Maybe x
forall a. a -> Maybe a
Just x
x) (Bool -> Maybe x) -> f Bool -> f (Maybe 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 = IntMap a -> f (IntMap a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap a
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 IntMap a
forall a. IntMap a
Nil) (Bool -> IntMap a) -> f Bool -> f (IntMap a)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntMap a -> IntMap a -> IntMap a)
-> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> IntMap a -> IntMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m)) ((Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
r) ((Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
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 = (IntMap a -> IntMap a -> IntMap a)
-> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m) ((Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
forall (f :: * -> *) a.
Applicative f =>
(Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
filterWithKeyA Int -> a -> f Bool
f IntMap a
l) ((Int -> a -> f Bool) -> IntMap a -> f (IntMap a)
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 = (Int -> x -> f y) -> IntMap x -> f (IntMap y)
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 -> y -> Maybe y
forall a. a -> Maybe a
Just (y -> Maybe y) -> f y -> f (Maybe y)
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 = (Int -> x -> f (Maybe y)) -> IntMap x -> f (IntMap y)
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 = IntMap b -> f (IntMap b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap b
forall a. IntMap a
Nil
go (Tip Int
k a
x) = IntMap b -> (b -> IntMap b) -> Maybe b -> IntMap b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap b
forall a. IntMap a
Nil (Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
Tip Int
k) (Maybe b -> IntMap b) -> f (Maybe b) -> f (IntMap b)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntMap b -> IntMap b -> IntMap b)
-> f (IntMap b) -> f (IntMap b) -> f (IntMap b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((IntMap b -> IntMap b -> IntMap b)
-> IntMap b -> IntMap b -> IntMap b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Int -> IntMap b -> IntMap b -> IntMap b
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 = (IntMap b -> IntMap b -> IntMap b)
-> f (IntMap b) -> f (IntMap b) -> f (IntMap b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> IntMap b -> IntMap b -> IntMap b
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 =
Identity (IntMap c) -> IntMap c
forall a. Identity a -> a
runIdentity (Identity (IntMap c) -> IntMap c)
-> Identity (IntMap c) -> IntMap c
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing a c
-> SimpleWhenMissing b c
-> SimpleWhenMatched a b c
-> IntMap a
-> IntMap b
-> Identity (IntMap c)
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 = Int -> f (IntMap c) -> Int -> f (IntMap c) -> f (IntMap c)
forall (f :: * -> *) a.
Applicative f =>
Int -> f (IntMap a) -> Int -> f (IntMap a) -> f (IntMap a)
linkA Int
k1 ((Int -> a -> f (Maybe c)) -> Int -> a -> f (IntMap c)
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 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 = (Int -> a -> f (Maybe c)) -> Int -> a -> f (IntMap c)
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 = Int -> f (IntMap c) -> Int -> f (IntMap c) -> f (IntMap c)
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 ((Int -> b -> f (Maybe c)) -> Int -> b -> f (IntMap c)
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 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 = (Int -> b -> f (Maybe c)) -> Int -> b -> f (IntMap c)
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
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 = f (IntMap c)
merge1
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = f (IntMap c)
merge2
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p1 Int
m1 (IntMap a -> IntMap b -> f (IntMap c)
go IntMap a
l1 IntMap b
l2) (IntMap a -> IntMap b -> f (IntMap c)
go IntMap a
r1 IntMap b
r2)
| Bool
otherwise = Int -> f (IntMap c) -> Int -> f (IntMap c) -> f (IntMap c)
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
p2 (IntMap b -> f (IntMap c)
g2t IntMap b
t2)
where
merge1 :: f (IntMap c)
merge1 | Int -> Int -> Int -> Bool
nomatch Int
p2 Int
p1 Int
m1 = Int -> f (IntMap c) -> Int -> f (IntMap c) -> f (IntMap c)
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
p2 (IntMap b -> f (IntMap c)
g2t IntMap b
t2)
| Int -> Int -> Bool
zero Int
p2 Int
m1 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p1 Int
m1 (IntMap a -> IntMap b -> f (IntMap c)
go IntMap a
l1 IntMap b
t2) (IntMap a -> f (IntMap c)
g1t IntMap a
r1)
| Bool
otherwise = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 -> IntMap b -> f (IntMap c)
go IntMap a
r1 IntMap b
t2)
merge2 :: f (IntMap c)
merge2 | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = Int -> f (IntMap c) -> Int -> f (IntMap c) -> f (IntMap c)
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
p2 (IntMap b -> f (IntMap c)
g2t IntMap b
t2)
| Int -> Int -> Bool
zero Int
p1 Int
m2 = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p2 Int
m2 (IntMap a -> IntMap b -> f (IntMap c)
go IntMap a
t1 IntMap b
l2) (IntMap b -> f (IntMap c)
g2t IntMap b
r2)
| Bool
otherwise = Int -> Int -> f (IntMap c) -> f (IntMap c) -> f (IntMap c)
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 a -> IntMap b -> f (IntMap c)
go IntMap a
t1 IntMap b
r2)
subsingletonBy :: (Int -> t -> f (Maybe a)) -> Int -> t -> f (IntMap a)
subsingletonBy Int -> t -> f (Maybe a)
gk Int
k t
x = IntMap a -> (a -> IntMap a) -> Maybe a -> IntMap a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap a
forall a. IntMap a
Nil (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k) (Maybe a -> IntMap a) -> f (Maybe a) -> f (IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> t -> f (Maybe a)
gk Int
k t
x
{-# INLINE subsingletonBy #-}
mergeTips :: Int -> a -> Int -> b -> f (IntMap c)
mergeTips Int
k1 a
x1 Int
k2 b
x2
| Int
k1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k2 = IntMap c -> (c -> IntMap c) -> Maybe c -> IntMap c
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap c
forall a. IntMap a
Nil (Int -> c -> IntMap c
forall a. Int -> a -> IntMap a
Tip Int
k1) (Maybe c -> IntMap c) -> f (Maybe c) -> f (IntMap c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> b -> f (Maybe c)
f Int
k1 a
x1 b
x2
| Int
k1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
k2 = (Maybe c -> Maybe c -> IntMap c)
-> f (Maybe c) -> f (Maybe c) -> f (IntMap c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> Maybe c -> Maybe c -> IntMap c
forall {a}. Int -> Int -> Maybe a -> Maybe a -> IntMap a
subdoubleton Int
k1 Int
k2) (Int -> a -> f (Maybe c)
g1k Int
k1 a
x1) (Int -> b -> f (Maybe c)
g2k Int
k2 b
x2)
| Bool
otherwise = (Maybe c -> Maybe c -> IntMap c)
-> f (Maybe c) -> f (Maybe c) -> f (IntMap c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> Maybe c -> Maybe c -> IntMap c
forall {a}. Int -> Int -> Maybe a -> Maybe a -> IntMap a
subdoubleton Int
k2 Int
k1) (Int -> b -> f (Maybe c)
g2k Int
k2 b
x2) (Int -> a -> f (Maybe c)
g1k Int
k1 a
x1)
{-# INLINE mergeTips #-}
subdoubleton :: Int -> Int -> Maybe a -> Maybe a -> IntMap a
subdoubleton Int
_ Int
_ Maybe a
Nothing Maybe a
Nothing = IntMap a
forall a. IntMap a
Nil
subdoubleton Int
_ Int
k2 Maybe a
Nothing (Just a
y2) = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k2 a
y2
subdoubleton Int
k1 Int
_ (Just a
y1) Maybe a
Nothing = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k1 a
y1
subdoubleton Int
k1 Int
k2 (Just a
y1) (Just a
y2) = Int -> IntMap a -> Int -> IntMap a -> IntMap a
forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
k1 (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k1 a
y1) Int
k2 (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k2 a
y2)
{-# INLINE subdoubleton #-}
linkA
:: Applicative f
=> Prefix -> f (IntMap a)
-> Prefix -> f (IntMap a)
-> f (IntMap a)
linkA :: forall (f :: * -> *) a.
Applicative f =>
Int -> f (IntMap a) -> Int -> f (IntMap a) -> f (IntMap a)
linkA Int
p1 f (IntMap a)
t1 Int
p2 f (IntMap a)
t2
| Int -> Int -> Bool
zero Int
p1 Int
m = Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p Int
m f (IntMap a)
t1 f (IntMap a)
t2
| Bool
otherwise = Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p Int
m f (IntMap a)
t2 f (IntMap a)
t1
where
m :: Int
m = Int -> Int -> Int
branchMask Int
p1 Int
p2
p :: Int
p = Int -> Int -> Int
mask Int
p1 Int
m
{-# INLINE linkA #-}
binA
:: Applicative f
=> Prefix
-> Mask
-> f (IntMap a)
-> f (IntMap a)
-> f (IntMap a)
binA :: forall (f :: * -> *) a.
Applicative f =>
Int -> Int -> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
binA Int
p Int
m f (IntMap a)
a f (IntMap a)
b
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntMap a -> IntMap a -> IntMap a)
-> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((IntMap a -> IntMap a -> IntMap a)
-> IntMap a -> IntMap a -> IntMap a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m)) f (IntMap a)
b f (IntMap a)
a
| Bool
otherwise = (IntMap a -> IntMap a -> IntMap a)
-> f (IntMap a) -> f (IntMap a) -> f (IntMap a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m) f (IntMap a)
a f (IntMap a)
b
{-# INLINE binA #-}
{-# INLINE mergeA #-}
updateMinWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMinWithKey :: forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
updateMinWithKey Int -> a -> Maybe a
f IntMap a
t =
case IntMap a
t of Bin Int
p Int
m IntMap a
l IntMap a
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l ((Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
go Int -> a -> Maybe a
f IntMap a
r)
IntMap a
_ -> (Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
go Int -> a -> Maybe a
f IntMap a
t
where
go :: (Int -> t -> Maybe t) -> IntMap t -> IntMap t
go Int -> t -> Maybe t
f' (Bin Int
p Int
m IntMap t
l IntMap t
r) = Int -> Int -> IntMap t -> IntMap t -> IntMap t
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m ((Int -> t -> Maybe t) -> IntMap t -> IntMap t
go Int -> t -> Maybe t
f' IntMap t
l) IntMap t
r
go Int -> t -> Maybe t
f' (Tip Int
k t
y) = case Int -> t -> Maybe t
f' Int
k t
y of
Just t
y' -> Int -> t -> IntMap t
forall a. Int -> a -> IntMap a
Tip Int
k t
y'
Maybe t
Nothing -> IntMap t
forall a. IntMap a
Nil
go Int -> t -> Maybe t
_ IntMap t
Nil = [Char] -> IntMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"updateMinWithKey Nil"
updateMaxWithKey :: (Key -> a -> Maybe a) -> IntMap a -> IntMap a
updateMaxWithKey :: forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
updateMaxWithKey Int -> a -> Maybe a
f IntMap a
t =
case IntMap a
t of Bin Int
p Int
m IntMap a
l IntMap a
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m ((Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
go Int -> a -> Maybe a
f IntMap a
l) IntMap a
r
IntMap a
_ -> (Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
go Int -> a -> Maybe a
f IntMap a
t
where
go :: (Int -> t -> Maybe t) -> IntMap t -> IntMap t
go Int -> t -> Maybe t
f' (Bin Int
p Int
m IntMap t
l IntMap t
r) = Int -> Int -> IntMap t -> IntMap t -> IntMap t
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap t
l ((Int -> t -> Maybe t) -> IntMap t -> IntMap t
go Int -> t -> Maybe t
f' IntMap t
r)
go Int -> t -> Maybe t
f' (Tip Int
k t
y) = case Int -> t -> Maybe t
f' Int
k t
y of
Just t
y' -> Int -> t -> IntMap t
forall a. Int -> a -> IntMap a
Tip Int
k t
y'
Maybe t
Nothing -> IntMap t
forall a. IntMap a
Nil
go Int -> t -> Maybe t
_ IntMap t
Nil = [Char] -> IntMap t
forall a. HasCallStack => [Char] -> a
error [Char]
"updateMaxWithKey Nil"
data View a = View {-# UNPACK #-} !Key a !(IntMap a)
maxViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
maxViewWithKey :: forall a. IntMap a -> Maybe ((Int, a), IntMap a)
maxViewWithKey IntMap a
t = case IntMap a
t of
IntMap a
Nil -> Maybe ((Int, a), IntMap a)
forall a. Maybe a
Nothing
IntMap a
_ -> ((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a)
forall a. a -> Maybe a
Just (((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a))
-> ((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a)
forall a b. (a -> b) -> a -> b
$ case IntMap a -> View a
forall a. IntMap a -> View a
maxViewWithKeySure IntMap a
t of
View Int
k a
v IntMap a
t' -> ((Int
k, a
v), IntMap a
t')
{-# INLINE maxViewWithKey #-}
maxViewWithKeySure :: IntMap a -> View a
maxViewWithKeySure :: forall a. IntMap a -> View a
maxViewWithKeySure IntMap a
t =
case IntMap a
t of
IntMap a
Nil -> [Char] -> View a
forall a. HasCallStack => [Char] -> a
error [Char]
"maxViewWithKeySure Nil"
Bin Int
p Int
m IntMap a
l IntMap a
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
case IntMap a -> View a
forall a. IntMap a -> View a
go IntMap a
l of View Int
k a
a IntMap a
l' -> Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
a (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m IntMap a
l' IntMap a
r)
IntMap a
_ -> IntMap a -> View a
forall a. IntMap a -> View a
go IntMap a
t
where
go :: IntMap a -> View a
go (Bin Int
p Int
m IntMap a
l IntMap a
r) =
case IntMap a -> View a
go IntMap a
r of View Int
k a
a IntMap a
r' -> Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
a (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l IntMap a
r')
go (Tip Int
k a
y) = Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
y IntMap a
forall a. IntMap a
Nil
go IntMap a
Nil = [Char] -> View a
forall a. HasCallStack => [Char] -> a
error [Char]
"maxViewWithKey_go Nil"
{-# NOINLINE maxViewWithKeySure #-}
minViewWithKey :: IntMap a -> Maybe ((Key, a), IntMap a)
minViewWithKey :: forall a. IntMap a -> Maybe ((Int, a), IntMap a)
minViewWithKey IntMap a
t =
case IntMap a
t of
IntMap a
Nil -> Maybe ((Int, a), IntMap a)
forall a. Maybe a
Nothing
IntMap a
_ -> ((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a)
forall a. a -> Maybe a
Just (((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a))
-> ((Int, a), IntMap a) -> Maybe ((Int, a), IntMap a)
forall a b. (a -> b) -> a -> b
$ case IntMap a -> View a
forall a. IntMap a -> View a
minViewWithKeySure IntMap a
t of
View Int
k a
v IntMap a
t' -> ((Int
k, a
v), IntMap a
t')
{-# INLINE minViewWithKey #-}
minViewWithKeySure :: IntMap a -> View a
minViewWithKeySure :: forall a. IntMap a -> View a
minViewWithKeySure IntMap a
t =
case IntMap a
t of
IntMap a
Nil -> [Char] -> View a
forall a. HasCallStack => [Char] -> a
error [Char]
"minViewWithKeySure Nil"
Bin Int
p Int
m IntMap a
l IntMap a
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
case IntMap a -> View a
forall a. IntMap a -> View a
go IntMap a
r of
View Int
k a
a IntMap a
r' -> Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
a (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
p Int
m IntMap a
l IntMap a
r')
IntMap a
_ -> IntMap a -> View a
forall a. IntMap a -> View a
go IntMap a
t
where
go :: IntMap a -> View a
go (Bin Int
p Int
m IntMap a
l IntMap a
r) =
case IntMap a -> View a
go IntMap a
l of View Int
k a
a IntMap a
l' -> Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
a (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
p Int
m IntMap a
l' IntMap a
r)
go (Tip Int
k a
y) = Int -> a -> IntMap a -> View a
forall a. Int -> a -> IntMap a -> View a
View Int
k a
y IntMap a
forall a. IntMap a
Nil
go IntMap a
Nil = [Char] -> View a
forall a. HasCallStack => [Char] -> a
error [Char]
"minViewWithKey_go Nil"
{-# NOINLINE minViewWithKeySure #-}
updateMax :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMax :: forall a. (a -> Maybe a) -> IntMap a -> IntMap a
updateMax a -> Maybe a
f = (Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
updateMaxWithKey ((a -> Maybe a) -> Int -> a -> Maybe a
forall a b. a -> b -> a
const a -> Maybe a
f)
updateMin :: (a -> Maybe a) -> IntMap a -> IntMap a
updateMin :: forall a. (a -> Maybe a) -> IntMap a -> IntMap a
updateMin a -> Maybe a
f = (Int -> a -> Maybe a) -> IntMap a -> IntMap a
forall a. (Int -> a -> Maybe a) -> IntMap a -> IntMap a
updateMinWithKey ((a -> Maybe a) -> Int -> a -> Maybe a
forall a b. a -> b -> a
const a -> Maybe a
f)
maxView :: IntMap a -> Maybe (a, IntMap a)
maxView :: forall a. IntMap a -> Maybe (a, IntMap a)
maxView IntMap a
t = (((Int, a), IntMap a) -> (a, IntMap a))
-> Maybe ((Int, a), IntMap a) -> Maybe (a, IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Int
_, a
x), IntMap a
t') -> (a
x, IntMap a
t')) (IntMap a -> Maybe ((Int, a), IntMap a)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
maxViewWithKey IntMap a
t)
minView :: IntMap a -> Maybe (a, IntMap a)
minView :: forall a. IntMap a -> Maybe (a, IntMap a)
minView IntMap a
t = (((Int, a), IntMap a) -> (a, IntMap a))
-> Maybe ((Int, a), IntMap a) -> Maybe (a, IntMap a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\((Int
_, a
x), IntMap a
t') -> (a
x, IntMap a
t')) (IntMap a -> Maybe ((Int, a), IntMap a)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
minViewWithKey IntMap a
t)
deleteFindMax :: IntMap a -> ((Key, a), IntMap a)
deleteFindMax :: forall a. IntMap a -> ((Int, a), IntMap a)
deleteFindMax = ((Int, a), IntMap a)
-> Maybe ((Int, a), IntMap a) -> ((Int, a), IntMap a)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ((Int, a), IntMap a)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMax: empty map has no maximal element") (Maybe ((Int, a), IntMap a) -> ((Int, a), IntMap a))
-> (IntMap a -> Maybe ((Int, a), IntMap a))
-> IntMap a
-> ((Int, a), IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> Maybe ((Int, a), IntMap a)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
maxViewWithKey
deleteFindMin :: IntMap a -> ((Key, a), IntMap a)
deleteFindMin :: forall a. IntMap a -> ((Int, a), IntMap a)
deleteFindMin = ((Int, a), IntMap a)
-> Maybe ((Int, a), IntMap a) -> ((Int, a), IntMap a)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ((Int, a), IntMap a)
forall a. HasCallStack => [Char] -> a
error [Char]
"deleteFindMin: empty map has no minimal element") (Maybe ((Int, a), IntMap a) -> ((Int, a), IntMap a))
-> (IntMap a -> Maybe ((Int, a), IntMap a))
-> IntMap a
-> ((Int, a), IntMap a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> Maybe ((Int, a), IntMap a)
forall a. IntMap a -> Maybe ((Int, a), IntMap a)
minViewWithKey
lookupMin :: IntMap a -> Maybe (Key, a)
lookupMin :: forall a. IntMap a -> Maybe (Int, a)
lookupMin IntMap a
Nil = Maybe (Int, a)
forall a. Maybe a
Nothing
lookupMin (Tip Int
k a
v) = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
k,a
v)
lookupMin (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
go IntMap a
r
| Bool
otherwise = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
go IntMap a
l
where go :: IntMap b -> Maybe (Int, b)
go (Tip Int
k b
v) = (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int
k,b
v)
go (Bin Int
_ Int
_ IntMap b
l' IntMap b
_) = IntMap b -> Maybe (Int, b)
go IntMap b
l'
go IntMap b
Nil = Maybe (Int, b)
forall a. Maybe a
Nothing
findMin :: IntMap a -> (Key, a)
findMin :: forall a. IntMap a -> (Int, a)
findMin IntMap a
t
| Just (Int, a)
r <- IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
lookupMin IntMap a
t = (Int, a)
r
| Bool
otherwise = [Char] -> (Int, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"findMin: empty map has no minimal element"
lookupMax :: IntMap a -> Maybe (Key, a)
lookupMax :: forall a. IntMap a -> Maybe (Int, a)
lookupMax IntMap a
Nil = Maybe (Int, a)
forall a. Maybe a
Nothing
lookupMax (Tip Int
k a
v) = (Int, a) -> Maybe (Int, a)
forall a. a -> Maybe a
Just (Int
k,a
v)
lookupMax (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
go IntMap a
l
| Bool
otherwise = IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
go IntMap a
r
where go :: IntMap b -> Maybe (Int, b)
go (Tip Int
k b
v) = (Int, b) -> Maybe (Int, b)
forall a. a -> Maybe a
Just (Int
k,b
v)
go (Bin Int
_ Int
_ IntMap b
_ IntMap b
r') = IntMap b -> Maybe (Int, b)
go IntMap b
r'
go IntMap b
Nil = Maybe (Int, b)
forall a. Maybe a
Nothing
findMax :: IntMap a -> (Key, a)
findMax :: forall a. IntMap a -> (Int, a)
findMax IntMap a
t
| Just (Int, a)
r <- IntMap a -> Maybe (Int, a)
forall a. IntMap a -> Maybe (Int, a)
lookupMax IntMap a
t = (Int, a)
r
| Bool
otherwise = [Char] -> (Int, a)
forall a. HasCallStack => [Char] -> a
error [Char]
"findMax: empty map has no maximal element"
deleteMin :: IntMap a -> IntMap a
deleteMin :: forall a. IntMap a -> IntMap a
deleteMin = IntMap a
-> ((a, IntMap a) -> IntMap a) -> Maybe (a, IntMap a) -> IntMap a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap a
forall a. IntMap a
Nil (a, IntMap a) -> IntMap a
forall a b. (a, b) -> b
snd (Maybe (a, IntMap a) -> IntMap a)
-> (IntMap a -> Maybe (a, IntMap a)) -> IntMap a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> Maybe (a, IntMap a)
forall a. IntMap a -> Maybe (a, IntMap a)
minView
deleteMax :: IntMap a -> IntMap a
deleteMax :: forall a. IntMap a -> IntMap a
deleteMax = IntMap a
-> ((a, IntMap a) -> IntMap a) -> Maybe (a, IntMap a) -> IntMap a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IntMap a
forall a. IntMap a
Nil (a, IntMap a) -> IntMap a
forall a b. (a, b) -> b
snd (Maybe (a, IntMap a) -> IntMap a)
-> (IntMap a -> Maybe (a, IntMap a)) -> IntMap a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap a -> Maybe (a, IntMap a)
forall a. IntMap a -> Maybe (a, IntMap a)
maxView
isProperSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
isProperSubmapOf :: forall a. Eq a => IntMap a -> IntMap a -> Bool
isProperSubmapOf IntMap a
m1 IntMap a
m2
= (a -> a -> Bool) -> IntMap a -> IntMap a -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isProperSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) IntMap a
m1 IntMap a
m2
isProperSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isProperSubmapOfBy :: forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isProperSubmapOfBy a -> b -> Bool
predicate IntMap a
t1 IntMap b
t2
= case (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate IntMap a
t1 IntMap b
t2 of
Ordering
LT -> Bool
True
Ordering
_ -> Bool
False
submapCmp :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp :: forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) (Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = Ordering
GT
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = Ordering
submapCmpLt
| Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2 = Ordering
submapCmpEq
| Bool
otherwise = Ordering
GT
where
submapCmpLt :: Ordering
submapCmpLt | Int -> Int -> Int -> Bool
nomatch Int
p1 Int
p2 Int
m2 = Ordering
GT
| Int -> Int -> Bool
zero Int
p1 Int
m2 = (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate IntMap a
t1 IntMap b
l2
| Bool
otherwise = (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate IntMap a
t1 IntMap b
r2
submapCmpEq :: Ordering
submapCmpEq = case ((a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate IntMap a
l1 IntMap b
l2, (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Ordering
submapCmp a -> b -> Bool
predicate IntMap a
r1 IntMap b
r2) of
(Ordering
GT,Ordering
_ ) -> Ordering
GT
(Ordering
_ ,Ordering
GT) -> Ordering
GT
(Ordering
EQ,Ordering
EQ) -> Ordering
EQ
(Ordering, Ordering)
_ -> Ordering
LT
submapCmp a -> b -> Bool
_ (Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntMap b
_ = Ordering
GT
submapCmp a -> b -> Bool
predicate (Tip Int
kx a
x) (Tip Int
ky b
y)
| (Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky) Bool -> Bool -> Bool
&& a -> b -> Bool
predicate a
x b
y = Ordering
EQ
| Bool
otherwise = Ordering
GT
submapCmp a -> b -> Bool
predicate (Tip Int
k a
x) IntMap b
t
= case Int -> IntMap b -> Maybe b
forall a. Int -> IntMap a -> Maybe a
lookup Int
k IntMap b
t of
Just b
y | a -> b -> Bool
predicate a
x b
y -> Ordering
LT
Maybe b
_ -> Ordering
GT
submapCmp a -> b -> Bool
_ IntMap a
Nil IntMap b
Nil = Ordering
EQ
submapCmp a -> b -> Bool
_ IntMap a
Nil IntMap b
_ = Ordering
LT
isSubmapOf :: Eq a => IntMap a -> IntMap a -> Bool
isSubmapOf :: forall a. Eq a => IntMap a -> IntMap a -> Bool
isSubmapOf IntMap a
m1 IntMap a
m2
= (a -> a -> Bool) -> IntMap a -> IntMap a -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==) IntMap a
m1 IntMap a
m2
isSubmapOfBy :: (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy :: forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> b -> Bool
predicate t1 :: IntMap a
t1@(Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) (Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
| Int -> Int -> Bool
shorter Int
m1 Int
m2 = Bool
False
| Int -> Int -> Bool
shorter Int
m2 Int
m1 = Int -> Int -> Int -> Bool
match Int
p1 Int
p2 Int
m2 Bool -> Bool -> Bool
&&
if Int -> Int -> Bool
zero Int
p1 Int
m2
then (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> b -> Bool
predicate IntMap a
t1 IntMap b
l2
else (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> b -> Bool
predicate IntMap a
t1 IntMap b
r2
| Bool
otherwise = (Int
p1Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
p2) Bool -> Bool -> Bool
&& (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> b -> Bool
predicate IntMap a
l1 IntMap b
l2 Bool -> Bool -> Bool
&& (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
isSubmapOfBy a -> b -> Bool
predicate IntMap a
r1 IntMap b
r2
isSubmapOfBy a -> b -> Bool
_ (Bin Int
_ Int
_ IntMap a
_ IntMap a
_) IntMap b
_ = Bool
False
isSubmapOfBy a -> b -> Bool
predicate (Tip Int
k a
x) IntMap b
t = case Int -> IntMap b -> Maybe b
forall a. Int -> IntMap a -> Maybe a
lookup Int
k IntMap b
t of
Just b
y -> a -> b -> Bool
predicate a
x b
y
Maybe b
Nothing -> Bool
False
isSubmapOfBy a -> b -> Bool
_ IntMap a
Nil IntMap b
_ = Bool
True
map :: (a -> b) -> IntMap a -> IntMap b
map :: forall a b. (a -> b) -> IntMap a -> IntMap b
map a -> b
f = IntMap a -> IntMap b
go
where
go :: IntMap a -> IntMap b
go (Bin Int
p Int
m IntMap a
l IntMap a
r) = Int -> Int -> IntMap b -> IntMap b -> IntMap b
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (IntMap a -> IntMap b
go IntMap a
l) (IntMap a -> IntMap b
go IntMap a
r)
go (Tip Int
k a
x) = Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
Tip Int
k (a -> b
f a
x)
go IntMap a
Nil = IntMap b
forall a. IntMap a
Nil
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] map #-}
{-# RULES
"map/map" forall f g xs . map f (map g xs) = map (f . g) xs
#-}
#endif
#if __GLASGOW_HASKELL__ >= 709
{-# RULES
"map/coerce" map coerce = coerce
#-}
#endif
mapWithKey :: (Key -> a -> b) -> IntMap a -> IntMap b
mapWithKey :: forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
mapWithKey Int -> a -> b
f IntMap a
t
= case IntMap a
t of
Bin Int
p Int
m IntMap a
l IntMap a
r -> Int -> Int -> IntMap b -> IntMap b -> IntMap b
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m ((Int -> a -> b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
mapWithKey Int -> a -> b
f IntMap a
l) ((Int -> a -> b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> b) -> IntMap a -> IntMap b
mapWithKey Int -> a -> b
f IntMap a
r)
Tip Int
k a
x -> Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
Tip Int
k (Int -> a -> b
f Int
k a
x)
IntMap a
Nil -> IntMap b
forall a. IntMap a
Nil
#ifdef __GLASGOW_HASKELL__
{-# NOINLINE [1] mapWithKey #-}
{-# RULES
"mapWithKey/mapWithKey" forall f g xs . mapWithKey f (mapWithKey g xs) =
mapWithKey (\k a -> f k (g k a)) xs
"mapWithKey/map" forall f g xs . mapWithKey f (map g xs) =
mapWithKey (\k a -> f k (g a)) xs
"map/mapWithKey" forall f g xs . map f (mapWithKey g xs) =
mapWithKey (\k a -> f (g k a)) xs
#-}
#endif
traverseWithKey :: Applicative t => (Key -> a -> t b) -> IntMap a -> t (IntMap b)
traverseWithKey :: forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> IntMap a -> t (IntMap b)
traverseWithKey Int -> a -> t b
f = IntMap a -> t (IntMap b)
go
where
go :: IntMap a -> t (IntMap b)
go IntMap a
Nil = IntMap b -> t (IntMap b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure IntMap b
forall a. IntMap a
Nil
go (Tip Int
k a
v) = Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
Tip Int
k (b -> IntMap b) -> t b -> t (IntMap b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> t b
f Int
k a
v
go (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = (IntMap b -> IntMap b -> IntMap b)
-> t (IntMap b) -> t (IntMap b) -> t (IntMap b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((IntMap b -> IntMap b -> IntMap b)
-> IntMap b -> IntMap b -> IntMap b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> Int -> IntMap b -> IntMap b -> IntMap b
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m)) (IntMap a -> t (IntMap b)
go IntMap a
r) (IntMap a -> t (IntMap b)
go IntMap a
l)
| Bool
otherwise = (IntMap b -> IntMap b -> IntMap b)
-> t (IntMap b) -> t (IntMap b) -> t (IntMap b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (Int -> Int -> IntMap b -> IntMap b -> IntMap b
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m) (IntMap a -> t (IntMap b)
go IntMap a
l) (IntMap a -> t (IntMap b)
go IntMap a
r)
{-# INLINE traverseWithKey #-}
mapAccum :: (a -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
mapAccum :: forall a b c. (a -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccum a -> b -> (a, c)
f = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumWithKey (\a
a' Int
_ b
x -> a -> b -> (a, c)
f a
a' b
x)
mapAccumWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
mapAccumWithKey :: forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumWithKey a -> Int -> b -> (a, c)
f a
a IntMap b
t
= (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a IntMap b
t
mapAccumL :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
mapAccumL :: forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a IntMap b
t
= case IntMap b
t of
Bin Int
p Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
let (a
a1,IntMap c
r') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a IntMap b
r
(a
a2,IntMap c
l') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a1 IntMap b
l
in (a
a2,Int -> Int -> IntMap c -> IntMap c -> IntMap c
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap c
l' IntMap c
r')
| Bool
otherwise ->
let (a
a1,IntMap c
l') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a IntMap b
l
(a
a2,IntMap c
r') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumL a -> Int -> b -> (a, c)
f a
a1 IntMap b
r
in (a
a2,Int -> Int -> IntMap c -> IntMap c -> IntMap c
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap c
l' IntMap c
r')
Tip Int
k b
x -> let (a
a',c
x') = a -> Int -> b -> (a, c)
f a
a Int
k b
x in (a
a',Int -> c -> IntMap c
forall a. Int -> a -> IntMap a
Tip Int
k c
x')
IntMap b
Nil -> (a
a,IntMap c
forall a. IntMap a
Nil)
mapAccumRWithKey :: (a -> Key -> b -> (a,c)) -> a -> IntMap b -> (a,IntMap c)
mapAccumRWithKey :: forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumRWithKey a -> Int -> b -> (a, c)
f a
a IntMap b
t
= case IntMap b
t of
Bin Int
p Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
let (a
a1,IntMap c
l') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumRWithKey a -> Int -> b -> (a, c)
f a
a IntMap b
l
(a
a2,IntMap c
r') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumRWithKey a -> Int -> b -> (a, c)
f a
a1 IntMap b
r
in (a
a2,Int -> Int -> IntMap c -> IntMap c -> IntMap c
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap c
l' IntMap c
r')
| Bool
otherwise ->
let (a
a1,IntMap c
r') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumRWithKey a -> Int -> b -> (a, c)
f a
a IntMap b
r
(a
a2,IntMap c
l') = (a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
forall a b c.
(a -> Int -> b -> (a, c)) -> a -> IntMap b -> (a, IntMap c)
mapAccumRWithKey a -> Int -> b -> (a, c)
f a
a1 IntMap b
l
in (a
a2,Int -> Int -> IntMap c -> IntMap c -> IntMap c
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap c
l' IntMap c
r')
Tip Int
k b
x -> let (a
a',c
x') = a -> Int -> b -> (a, c)
f a
a Int
k b
x in (a
a',Int -> c -> IntMap c
forall a. Int -> a -> IntMap a
Tip Int
k c
x')
IntMap b
Nil -> (a
a,IntMap c
forall a. IntMap a
Nil)
mapKeys :: (Key->Key) -> IntMap a -> IntMap a
mapKeys :: forall a. (Int -> Int) -> IntMap a -> IntMap a
mapKeys Int -> Int
f = [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromList ([(Int, a)] -> IntMap a)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> [(Int, a)] -> [(Int, a)])
-> [(Int, a)] -> IntMap a -> [(Int, a)]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey (\Int
k a
x [(Int, a)]
xs -> (Int -> Int
f Int
k, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
xs) []
mapKeysWith :: (a -> a -> a) -> (Key->Key) -> IntMap a -> IntMap a
mapKeysWith :: forall a. (a -> a -> a) -> (Int -> Int) -> IntMap a -> IntMap a
mapKeysWith a -> a -> a
c Int -> Int
f
= (a -> a -> a) -> [(Int, a)] -> IntMap a
forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
fromListWith a -> a -> a
c ([(Int, a)] -> IntMap a)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> [(Int, a)] -> [(Int, a)])
-> [(Int, a)] -> IntMap a -> [(Int, a)]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey (\Int
k a
x [(Int, a)]
xs -> (Int -> Int
f Int
k, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
xs) []
mapKeysMonotonic :: (Key->Key) -> IntMap a -> IntMap a
mapKeysMonotonic :: forall a. (Int -> Int) -> IntMap a -> IntMap a
mapKeysMonotonic Int -> Int
f
= [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromDistinctAscList ([(Int, a)] -> IntMap a)
-> (IntMap a -> [(Int, a)]) -> IntMap a -> IntMap a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> a -> [(Int, a)] -> [(Int, a)])
-> [(Int, a)] -> IntMap a -> [(Int, a)]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey (\Int
k a
x [(Int, a)]
xs -> (Int -> Int
f Int
k, a
x) (Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
: [(Int, a)]
xs) []
filter :: (a -> Bool) -> IntMap a -> IntMap a
filter :: forall a. (a -> Bool) -> IntMap a -> IntMap a
filter a -> Bool
p IntMap a
m
= (Int -> a -> Bool) -> IntMap a -> IntMap a
forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
filterWithKey (\Int
_ a
x -> a -> Bool
p a
x) IntMap a
m
filterWithKey :: (Key -> a -> Bool) -> IntMap a -> IntMap a
filterWithKey :: forall a. (Int -> a -> Bool) -> IntMap a -> IntMap a
filterWithKey Int -> a -> Bool
predicate = IntMap a -> IntMap a
go
where
go :: IntMap a -> IntMap a
go IntMap a
Nil = IntMap a
forall a. IntMap a
Nil
go t :: IntMap a
t@(Tip Int
k a
x) = if Int -> a -> Bool
predicate Int
k a
x then IntMap a
t else IntMap a
forall a. IntMap a
Nil
go (Bin Int
p Int
m IntMap a
l IntMap a
r) = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m (IntMap a -> IntMap a
go IntMap a
l) (IntMap a -> IntMap a
go IntMap a
r)
partition :: (a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
partition :: forall a. (a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
partition a -> Bool
p IntMap a
m
= (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
forall a. (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
partitionWithKey (\Int
_ a
x -> a -> Bool
p a
x) IntMap a
m
partitionWithKey :: (Key -> a -> Bool) -> IntMap a -> (IntMap a,IntMap a)
partitionWithKey :: forall a. (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
partitionWithKey Int -> a -> Bool
predicate0 IntMap a
t0 = StrictPair (IntMap a) (IntMap a) -> (IntMap a, IntMap a)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (IntMap a) (IntMap a) -> (IntMap a, IntMap a))
-> StrictPair (IntMap a) (IntMap a) -> (IntMap a, IntMap a)
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Bool) -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall {a}.
(Int -> a -> Bool) -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int -> a -> Bool
predicate0 IntMap a
t0
where
go :: (Int -> a -> Bool) -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int -> a -> Bool
predicate IntMap a
t =
case IntMap a
t of
Bin Int
p Int
m IntMap a
l IntMap a
r ->
let (IntMap a
l1 :*: IntMap a
l2) = (Int -> a -> Bool) -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int -> a -> Bool
predicate IntMap a
l
(IntMap a
r1 :*: IntMap a
r2) = (Int -> a -> Bool) -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int -> a -> Bool
predicate IntMap a
r
in Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m IntMap a
l1 IntMap a
r1 IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m IntMap a
l2 IntMap a
r2
Tip Int
k a
x
| Int -> a -> Bool
predicate Int
k a
x -> (IntMap a
t IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
| Bool
otherwise -> (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
t)
IntMap a
Nil -> (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
mapMaybe :: (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe :: forall a b. (a -> Maybe b) -> IntMap a -> IntMap b
mapMaybe a -> Maybe b
f = (Int -> a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey (\Int
_ a
x -> a -> Maybe b
f a
x)
mapMaybeWithKey :: (Key -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey :: forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey Int -> a -> Maybe b
f (Bin Int
p Int
m IntMap a
l IntMap a
r)
= Int -> Int -> IntMap b -> IntMap b -> IntMap b
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m ((Int -> a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey Int -> a -> Maybe b
f IntMap a
l) ((Int -> a -> Maybe b) -> IntMap a -> IntMap b
forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
mapMaybeWithKey Int -> a -> Maybe b
f IntMap a
r)
mapMaybeWithKey Int -> a -> Maybe b
f (Tip Int
k a
x) = case Int -> a -> Maybe b
f Int
k a
x of
Just b
y -> Int -> b -> IntMap b
forall a. Int -> a -> IntMap a
Tip Int
k b
y
Maybe b
Nothing -> IntMap b
forall a. IntMap a
Nil
mapMaybeWithKey Int -> a -> Maybe b
_ IntMap a
Nil = IntMap b
forall a. IntMap a
Nil
mapEither :: (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
mapEither :: forall a b c. (a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
mapEither a -> Either b c
f IntMap a
m
= (Int -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
forall a b c.
(Int -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
mapEitherWithKey (\Int
_ a
x -> a -> Either b c
f a
x) IntMap a
m
mapEitherWithKey :: (Key -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
mapEitherWithKey :: forall a b c.
(Int -> a -> Either b c) -> IntMap a -> (IntMap b, IntMap c)
mapEitherWithKey Int -> a -> Either b c
f0 IntMap a
t0 = StrictPair (IntMap b) (IntMap c) -> (IntMap b, IntMap c)
forall a b. StrictPair a b -> (a, b)
toPair (StrictPair (IntMap b) (IntMap c) -> (IntMap b, IntMap c))
-> StrictPair (IntMap b) (IntMap c) -> (IntMap b, IntMap c)
forall a b. (a -> b) -> a -> b
$ (Int -> a -> Either b c)
-> IntMap a -> StrictPair (IntMap b) (IntMap c)
forall {t} {a} {a}.
(Int -> t -> Either a a)
-> IntMap t -> StrictPair (IntMap a) (IntMap a)
go Int -> a -> Either b c
f0 IntMap a
t0
where
go :: (Int -> t -> Either a a)
-> IntMap t -> StrictPair (IntMap a) (IntMap a)
go Int -> t -> Either a a
f (Bin Int
p Int
m IntMap t
l IntMap t
r) =
Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m IntMap a
l1 IntMap a
r1 IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
p Int
m IntMap a
l2 IntMap a
r2
where
(IntMap a
l1 :*: IntMap a
l2) = (Int -> t -> Either a a)
-> IntMap t -> StrictPair (IntMap a) (IntMap a)
go Int -> t -> Either a a
f IntMap t
l
(IntMap a
r1 :*: IntMap a
r2) = (Int -> t -> Either a a)
-> IntMap t -> StrictPair (IntMap a) (IntMap a)
go Int -> t -> Either a a
f IntMap t
r
go Int -> t -> Either a a
f (Tip Int
k t
x) = case Int -> t -> Either a a
f Int
k t
x of
Left a
y -> (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
y IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
Right a
z -> (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
z)
go Int -> t -> Either a a
_ IntMap t
Nil = (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
split :: Key -> IntMap a -> (IntMap a, IntMap a)
split :: forall a. Int -> IntMap a -> (IntMap a, IntMap a)
split Int
k IntMap a
t =
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
then
case Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall {a}. Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int
k IntMap a
l of
(IntMap a
lt :*: IntMap a
gt) ->
let !lt' :: IntMap a
lt' = IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
r IntMap a
lt
in (IntMap a
lt', IntMap a
gt)
else
case Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall {a}. Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int
k IntMap a
r of
(IntMap a
lt :*: IntMap a
gt) ->
let !gt' :: IntMap a
gt' = IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
gt IntMap a
l
in (IntMap a
lt, IntMap a
gt')
IntMap a
_ -> case Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall {a}. Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int
k IntMap a
t of
(IntMap a
lt :*: IntMap a
gt) -> (IntMap a
lt, IntMap a
gt)
where
go :: Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go 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 = if Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p then IntMap a
t' IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil else IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
t'
| Int -> Int -> Bool
zero Int
k' Int
m = case Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int
k' IntMap a
l of (IntMap a
lt :*: IntMap a
gt) -> IntMap a
lt IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
gt IntMap a
r
| Bool
otherwise = case Int -> IntMap a -> StrictPair (IntMap a) (IntMap a)
go Int
k' IntMap a
r of (IntMap a
lt :*: IntMap a
gt) -> IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
l IntMap a
lt IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
gt
go Int
k' t' :: IntMap a
t'@(Tip Int
ky a
_)
| Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ky = (IntMap a
t' IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
| Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ky = (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
t')
| Bool
otherwise = (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
go Int
_ IntMap a
Nil = (IntMap a
forall a. IntMap a
Nil IntMap a -> IntMap a -> StrictPair (IntMap a) (IntMap a)
forall a b. a -> b -> StrictPair a b
:*: IntMap a
forall a. IntMap a
Nil)
data SplitLookup a = SplitLookup !(IntMap a) !(Maybe a) !(IntMap a)
mapLT :: (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapLT :: forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapLT IntMap a -> IntMap a
f (SplitLookup IntMap a
lt Maybe a
fnd IntMap a
gt) = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup (IntMap a -> IntMap a
f IntMap a
lt) Maybe a
fnd IntMap a
gt
{-# INLINE mapLT #-}
mapGT :: (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapGT :: forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapGT IntMap a -> IntMap a
f (SplitLookup IntMap a
lt Maybe a
fnd IntMap a
gt) = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
lt Maybe a
fnd (IntMap a -> IntMap a
f IntMap a
gt)
{-# INLINE mapGT #-}
splitLookup :: Key -> IntMap a -> (IntMap a, Maybe a, IntMap a)
splitLookup :: forall a. Int -> IntMap a -> (IntMap a, Maybe a, IntMap a)
splitLookup Int
k IntMap a
t =
case
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
if Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
then (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapLT (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
r) (Int -> IntMap a -> SplitLookup a
forall {a}. Int -> IntMap a -> SplitLookup a
go Int
k IntMap a
l)
else (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapGT (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
`union` IntMap a
l) (Int -> IntMap a -> SplitLookup a
forall {a}. Int -> IntMap a -> SplitLookup a
go Int
k IntMap a
r)
IntMap a
_ -> Int -> IntMap a -> SplitLookup a
forall {a}. Int -> IntMap a -> SplitLookup a
go Int
k IntMap a
t
of SplitLookup IntMap a
lt Maybe a
fnd IntMap a
gt -> (IntMap a
lt, Maybe a
fnd, IntMap a
gt)
where
go :: Int -> IntMap a -> SplitLookup a
go 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 =
if Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
p
then IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
t' Maybe a
forall a. Maybe a
Nothing IntMap a
forall a. IntMap a
Nil
else IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
forall a. IntMap a
Nil Maybe a
forall a. Maybe a
Nothing IntMap a
t'
| Int -> Int -> Bool
zero Int
k' Int
m = (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapGT (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
`union` IntMap a
r) (Int -> IntMap a -> SplitLookup a
go Int
k' IntMap a
l)
| Bool
otherwise = (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
forall a. (IntMap a -> IntMap a) -> SplitLookup a -> SplitLookup a
mapLT (IntMap a -> IntMap a -> IntMap a
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap a
l) (Int -> IntMap a -> SplitLookup a
go Int
k' IntMap a
r)
go Int
k' t' :: IntMap a
t'@(Tip Int
ky a
y)
| Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
ky = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
t' Maybe a
forall a. Maybe a
Nothing IntMap a
forall a. IntMap a
Nil
| Int
k' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ky = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
forall a. IntMap a
Nil Maybe a
forall a. Maybe a
Nothing IntMap a
t'
| Bool
otherwise = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
forall a. IntMap a
Nil (a -> Maybe a
forall a. a -> Maybe a
Just a
y) IntMap a
forall a. IntMap a
Nil
go Int
_ IntMap a
Nil = IntMap a -> Maybe a -> IntMap a -> SplitLookup a
forall a. IntMap a -> Maybe a -> IntMap a -> SplitLookup a
SplitLookup IntMap a
forall a. IntMap a
Nil Maybe a
forall a. Maybe a
Nothing IntMap a
forall a. IntMap a
Nil
foldr :: (a -> b -> b) -> b -> IntMap a -> b
foldr :: forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr a -> b -> b
f b
z = \IntMap a
t ->
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
l) IntMap a
r
| Bool
otherwise -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
r) IntMap a
l
IntMap a
_ -> b -> IntMap a -> b
go b
z IntMap a
t
where
go :: b -> IntMap a -> b
go b
z' IntMap a
Nil = b
z'
go b
z' (Tip Int
_ a
x) = a -> b -> b
f a
x b
z'
go b
z' (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z' IntMap a
r) IntMap a
l
{-# INLINE foldr #-}
foldr' :: (a -> b -> b) -> b -> IntMap a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr' a -> b -> b
f b
z = \IntMap a
t ->
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
l) IntMap a
r
| Bool
otherwise -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
r) IntMap a
l
IntMap a
_ -> b -> IntMap a -> b
go b
z IntMap a
t
where
go :: b -> IntMap a -> b
go !b
z' IntMap a
Nil = b
z'
go b
z' (Tip Int
_ a
x) = a -> b -> b
f a
x b
z'
go b
z' (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z' IntMap a
r) IntMap a
l
{-# INLINE foldr' #-}
foldl :: (a -> b -> a) -> a -> IntMap b -> a
foldl :: forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl a -> b -> a
f a
z = \IntMap b
t ->
case IntMap b
t of
Bin Int
_ Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
r) IntMap b
l
| Bool
otherwise -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
l) IntMap b
r
IntMap b
_ -> a -> IntMap b -> a
go a
z IntMap b
t
where
go :: a -> IntMap b -> a
go a
z' IntMap b
Nil = a
z'
go a
z' (Tip Int
_ b
x) = a -> b -> a
f a
z' b
x
go a
z' (Bin Int
_ Int
_ IntMap b
l IntMap b
r) = a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z' IntMap b
l) IntMap b
r
{-# INLINE foldl #-}
foldl' :: (a -> b -> a) -> a -> IntMap b -> a
foldl' :: forall b a. (b -> a -> b) -> b -> IntMap a -> b
foldl' a -> b -> a
f a
z = \IntMap b
t ->
case IntMap b
t of
Bin Int
_ Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
r) IntMap b
l
| Bool
otherwise -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
l) IntMap b
r
IntMap b
_ -> a -> IntMap b -> a
go a
z IntMap b
t
where
go :: a -> IntMap b -> a
go !a
z' IntMap b
Nil = a
z'
go a
z' (Tip Int
_ b
x) = a -> b -> a
f a
z' b
x
go a
z' (Bin Int
_ Int
_ IntMap b
l IntMap b
r) = a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z' IntMap b
l) IntMap b
r
{-# INLINE foldl' #-}
foldrWithKey :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey :: forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey Int -> a -> b -> b
f b
z = \IntMap a
t ->
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
l) IntMap a
r
| Bool
otherwise -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
r) IntMap a
l
IntMap a
_ -> b -> IntMap a -> b
go b
z IntMap a
t
where
go :: b -> IntMap a -> b
go b
z' IntMap a
Nil = b
z'
go b
z' (Tip Int
kx a
x) = Int -> a -> b -> b
f Int
kx a
x b
z'
go b
z' (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z' IntMap a
r) IntMap a
l
{-# INLINE foldrWithKey #-}
foldrWithKey' :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey' :: forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey' Int -> a -> b -> b
f b
z = \IntMap a
t ->
case IntMap a
t of
Bin Int
_ Int
m IntMap a
l IntMap a
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
l) IntMap a
r
| Bool
otherwise -> b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z IntMap a
r) IntMap a
l
IntMap a
_ -> b -> IntMap a -> b
go b
z IntMap a
t
where
go :: b -> IntMap a -> b
go !b
z' IntMap a
Nil = b
z'
go b
z' (Tip Int
kx a
x) = Int -> a -> b -> b
f Int
kx a
x b
z'
go b
z' (Bin Int
_ Int
_ IntMap a
l IntMap a
r) = b -> IntMap a -> b
go (b -> IntMap a -> b
go b
z' IntMap a
r) IntMap a
l
{-# INLINE foldrWithKey' #-}
foldlWithKey :: (a -> Key -> b -> a) -> a -> IntMap b -> a
foldlWithKey :: forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey a -> Int -> b -> a
f a
z = \IntMap b
t ->
case IntMap b
t of
Bin Int
_ Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
r) IntMap b
l
| Bool
otherwise -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
l) IntMap b
r
IntMap b
_ -> a -> IntMap b -> a
go a
z IntMap b
t
where
go :: a -> IntMap b -> a
go a
z' IntMap b
Nil = a
z'
go a
z' (Tip Int
kx b
x) = a -> Int -> b -> a
f a
z' Int
kx b
x
go a
z' (Bin Int
_ Int
_ IntMap b
l IntMap b
r) = a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z' IntMap b
l) IntMap b
r
{-# INLINE foldlWithKey #-}
foldlWithKey' :: (a -> Key -> b -> a) -> a -> IntMap b -> a
foldlWithKey' :: forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey' a -> Int -> b -> a
f a
z = \IntMap b
t ->
case IntMap b
t of
Bin Int
_ Int
m IntMap b
l IntMap b
r
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
r) IntMap b
l
| Bool
otherwise -> a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z IntMap b
l) IntMap b
r
IntMap b
_ -> a -> IntMap b -> a
go a
z IntMap b
t
where
go :: a -> IntMap b -> a
go !a
z' IntMap b
Nil = a
z'
go a
z' (Tip Int
kx b
x) = a -> Int -> b -> a
f a
z' Int
kx b
x
go a
z' (Bin Int
_ Int
_ IntMap b
l IntMap b
r) = a -> IntMap b -> a
go (a -> IntMap b -> a
go a
z' IntMap b
l) IntMap b
r
{-# INLINE foldlWithKey' #-}
foldMapWithKey :: Monoid m => (Key -> a -> m) -> IntMap a -> m
foldMapWithKey :: forall m a. Monoid m => (Int -> a -> m) -> IntMap a -> m
foldMapWithKey Int -> a -> m
f = IntMap a -> m
go
where
go :: IntMap a -> m
go IntMap a
Nil = m
forall a. Monoid a => a
mempty
go (Tip Int
kx a
x) = Int -> a -> m
f Int
kx a
x
go (Bin Int
_ Int
m IntMap a
l IntMap a
r)
| Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = IntMap a -> m
go IntMap a
r m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> m
go IntMap a
l
| Bool
otherwise = IntMap a -> m
go IntMap a
l m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` IntMap a -> m
go IntMap a
r
{-# INLINE foldMapWithKey #-}
elems :: IntMap a -> [a]
elems :: forall a. IntMap a -> [a]
elems = (a -> [a] -> [a]) -> [a] -> IntMap a -> [a]
forall a b. (a -> b -> b) -> b -> IntMap a -> b
foldr (:) []
keys :: IntMap a -> [Key]
keys :: forall a. IntMap a -> [Int]
keys = (Int -> a -> [Int] -> [Int]) -> [Int] -> IntMap a -> [Int]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey (\Int
k a
_ [Int]
ks -> Int
k Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
ks) []
assocs :: IntMap a -> [(Key,a)]
assocs :: forall a. IntMap a -> [(Int, a)]
assocs = IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toAscList
keysSet :: IntMap a -> IntSet.IntSet
keysSet :: forall a. IntMap a -> IntSet
keysSet IntMap a
Nil = IntSet
IntSet.Nil
keysSet (Tip Int
kx a
_) = Int -> IntSet
IntSet.singleton Int
kx
keysSet (Bin Int
p Int
m IntMap a
l IntMap a
r)
| Int
m Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.suffixBitMask Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Int -> Int -> IntSet -> IntSet -> IntSet
IntSet.Bin Int
p Int
m (IntMap a -> IntSet
forall a. IntMap a -> IntSet
keysSet IntMap a
l) (IntMap a -> IntSet
forall a. IntMap a -> IntSet
keysSet IntMap a
r)
| Bool
otherwise = Int -> Nat -> IntSet
IntSet.Tip (Int
p Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
IntSet.prefixBitMask) (Nat -> IntMap a -> Nat
forall {a}. Nat -> IntMap a -> Nat
computeBm (Nat -> IntMap a -> Nat
forall {a}. Nat -> IntMap a -> Nat
computeBm Nat
0 IntMap a
l) IntMap a
r)
where computeBm :: Nat -> IntMap a -> Nat
computeBm !Nat
acc (Bin Int
_ Int
_ IntMap a
l' IntMap a
r') = Nat -> IntMap a -> Nat
computeBm (Nat -> IntMap a -> Nat
computeBm Nat
acc IntMap a
l') IntMap a
r'
computeBm Nat
acc (Tip Int
kx a
_) = Nat
acc Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.|. Int -> Nat
IntSet.bitmapOf Int
kx
computeBm Nat
_ IntMap a
Nil = [Char] -> Nat
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.IntSet.keysSet: Nil"
fromSet :: (Key -> a) -> IntSet.IntSet -> IntMap a
fromSet :: forall a. (Int -> a) -> IntSet -> IntMap a
fromSet Int -> a
_ IntSet
IntSet.Nil = IntMap a
forall a. IntMap a
Nil
fromSet Int -> a
f (IntSet.Bin Int
p Int
m IntSet
l IntSet
r) = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m ((Int -> a) -> IntSet -> IntMap a
forall a. (Int -> a) -> IntSet -> IntMap a
fromSet Int -> a
f IntSet
l) ((Int -> a) -> IntSet -> IntMap a
forall a. (Int -> a) -> IntSet -> IntMap a
fromSet Int -> a
f IntSet
r)
fromSet Int -> a
f (IntSet.Tip Int
kx Nat
bm) = (Int -> a) -> Int -> Nat -> Int -> IntMap a
forall {a}. (Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
f Int
kx Nat
bm (Int
IntSet.suffixBitMask Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
where
buildTree :: (Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
g !Int
prefix !Nat
bmask Int
bits = case Int
bits of
Int
0 -> Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
prefix (Int -> a
g Int
prefix)
Int
_ -> case Nat -> Int
intFromNat ((Int -> Nat
natFromInt Int
bits) Nat -> Int -> Nat
`shiftRL` Int
1) of
Int
bits2
| Nat
bmask Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. ((Nat
1 Nat -> Int -> Nat
`shiftLL` Int
bits2) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 ->
(Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
g (Int
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits2) (Nat
bmask Nat -> Int -> Nat
`shiftRL` Int
bits2) Int
bits2
| (Nat
bmask Nat -> Int -> Nat
`shiftRL` Int
bits2) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. ((Nat
1 Nat -> Int -> Nat
`shiftLL` Int
bits2) Nat -> Nat -> Nat
forall a. Num a => a -> a -> a
- Nat
1) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0 ->
(Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
g Int
prefix Nat
bmask Int
bits2
| Bool
otherwise ->
Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
prefix Int
bits2
((Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
g Int
prefix Nat
bmask Int
bits2)
((Int -> a) -> Int -> Nat -> Int -> IntMap a
buildTree Int -> a
g (Int
prefix Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
bits2) (Nat
bmask Nat -> Int -> Nat
`shiftRL` Int
bits2) Int
bits2)
#if __GLASGOW_HASKELL__ >= 708
instance GHCExts.IsList (IntMap a) where
type Item (IntMap a) = (Key,a)
fromList :: [Item (IntMap a)] -> IntMap a
fromList = [Item (IntMap a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromList
toList :: IntMap a -> [Item (IntMap a)]
toList = IntMap a -> [Item (IntMap a)]
forall a. IntMap a -> [(Int, a)]
toList
#endif
toList :: IntMap a -> [(Key,a)]
toList :: forall a. IntMap a -> [(Int, a)]
toList = IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toAscList
toAscList :: IntMap a -> [(Key,a)]
toAscList :: forall a. IntMap a -> [(Int, a)]
toAscList = (Int -> a -> [(Int, a)] -> [(Int, a)])
-> [(Int, a)] -> IntMap a -> [(Int, a)]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey (\Int
k a
x [(Int, a)]
xs -> (Int
k,a
x)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
xs) []
toDescList :: IntMap a -> [(Key,a)]
toDescList :: forall a. IntMap a -> [(Int, a)]
toDescList = ([(Int, a)] -> Int -> a -> [(Int, a)])
-> [(Int, a)] -> IntMap a -> [(Int, a)]
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey (\[(Int, a)]
xs Int
k a
x -> (Int
k,a
x)(Int, a) -> [(Int, a)] -> [(Int, a)]
forall a. a -> [a] -> [a]
:[(Int, a)]
xs) []
#if __GLASGOW_HASKELL__
foldrFB :: (Key -> a -> b -> b) -> b -> IntMap a -> b
foldrFB :: forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrFB = (Int -> a -> b -> b) -> b -> IntMap a -> b
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
foldrWithKey
{-# INLINE[0] foldrFB #-}
foldlFB :: (a -> Key -> b -> a) -> a -> IntMap b -> a
foldlFB :: forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlFB = (a -> Int -> b -> a) -> a -> IntMap b -> a
forall a b. (a -> Int -> b -> a) -> a -> IntMap b -> a
foldlWithKey
{-# INLINE[0] foldlFB #-}
{-# INLINE assocs #-}
{-# INLINE toList #-}
{-# NOINLINE[0] elems #-}
{-# NOINLINE[0] keys #-}
{-# NOINLINE[0] toAscList #-}
{-# NOINLINE[0] toDescList #-}
{-# RULES "IntMap.elems" [~1] forall m . elems m = build (\c n -> foldrFB (\_ x xs -> c x xs) n m) #-}
{-# RULES "IntMap.elemsBack" [1] foldrFB (\_ x xs -> x : xs) [] = elems #-}
{-# RULES "IntMap.keys" [~1] forall m . keys m = build (\c n -> foldrFB (\k _ xs -> c k xs) n m) #-}
{-# RULES "IntMap.keysBack" [1] foldrFB (\k _ xs -> k : xs) [] = keys #-}
{-# RULES "IntMap.toAscList" [~1] forall m . toAscList m = build (\c n -> foldrFB (\k x xs -> c (k,x) xs) n m) #-}
{-# RULES "IntMap.toAscListBack" [1] foldrFB (\k x xs -> (k, x) : xs) [] = toAscList #-}
{-# RULES "IntMap.toDescList" [~1] forall m . toDescList m = build (\c n -> foldlFB (\xs k x -> c (k,x) xs) n m) #-}
{-# RULES "IntMap.toDescListBack" [1] foldlFB (\xs k x -> (k, x) : xs) [] = toDescList #-}
#endif
fromList :: [(Key,a)] -> IntMap a
fromList :: forall a. [(Int, a)] -> IntMap a
fromList [(Int, a)]
xs
= (IntMap a -> (Int, a) -> IntMap a)
-> IntMap a -> [(Int, a)] -> IntMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntMap a -> (Int, a) -> IntMap a
forall {a}. IntMap a -> (Int, a) -> IntMap a
ins IntMap a
forall a. IntMap a
empty [(Int, a)]
xs
where
ins :: IntMap a -> (Int, a) -> IntMap a
ins IntMap a
t (Int
k,a
x) = Int -> a -> IntMap a -> IntMap a
forall a. Int -> a -> IntMap a -> IntMap a
insert Int
k a
x IntMap a
t
fromListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
fromListWith :: forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
fromListWith a -> a -> a
f [(Int, a)]
xs
= (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
forall a. (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromListWithKey (\Int
_ a
x a
y -> a -> a -> a
f a
x a
y) [(Int, a)]
xs
fromListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
fromListWithKey :: forall a. (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromListWithKey Int -> a -> a -> a
f [(Int, a)]
xs
= (IntMap a -> (Int, a) -> IntMap a)
-> IntMap a -> [(Int, a)] -> IntMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' IntMap a -> (Int, a) -> IntMap a
ins IntMap a
forall a. IntMap a
empty [(Int, a)]
xs
where
ins :: IntMap a -> (Int, a) -> IntMap a
ins IntMap a
t (Int
k,a
x) = (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
forall a. (Int -> a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
insertWithKey Int -> a -> a -> a
f Int
k a
x IntMap a
t
fromAscList :: [(Key,a)] -> IntMap a
fromAscList :: forall a. [(Int, a)] -> IntMap a
fromAscList = Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
forall a.
Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromMonoListWithKey Distinct
Nondistinct (\Int
_ a
x a
_ -> a
x)
{-# NOINLINE fromAscList #-}
fromAscListWith :: (a -> a -> a) -> [(Key,a)] -> IntMap a
fromAscListWith :: forall a. (a -> a -> a) -> [(Int, a)] -> IntMap a
fromAscListWith a -> a -> a
f = Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
forall a.
Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromMonoListWithKey Distinct
Nondistinct (\Int
_ a
x a
y -> a -> a -> a
f a
x a
y)
{-# NOINLINE fromAscListWith #-}
fromAscListWithKey :: (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
fromAscListWithKey :: forall a. (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromAscListWithKey Int -> a -> a -> a
f = Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
forall a.
Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromMonoListWithKey Distinct
Nondistinct Int -> a -> a -> a
f
{-# NOINLINE fromAscListWithKey #-}
fromDistinctAscList :: [(Key,a)] -> IntMap a
fromDistinctAscList :: forall a. [(Int, a)] -> IntMap a
fromDistinctAscList = Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
forall a.
Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromMonoListWithKey Distinct
Distinct (\Int
_ a
x a
_ -> a
x)
{-# NOINLINE fromDistinctAscList #-}
fromMonoListWithKey :: Distinct -> (Key -> a -> a -> a) -> [(Key,a)] -> IntMap a
fromMonoListWithKey :: forall a.
Distinct -> (Int -> a -> a -> a) -> [(Int, a)] -> IntMap a
fromMonoListWithKey Distinct
distinct Int -> a -> a -> a
f = [(Int, a)] -> IntMap a
go
where
go :: [(Int, a)] -> IntMap a
go [] = IntMap a
forall a. IntMap a
Nil
go ((Int
kx,a
vx) : [(Int, a)]
zs1) = Int -> a -> [(Int, a)] -> IntMap a
addAll' Int
kx a
vx [(Int, a)]
zs1
addAll' :: Int -> a -> [(Int, a)] -> IntMap a
addAll' !Int
kx a
vx []
= Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
kx a
vx
addAll' !Int
kx a
vx ((Int
ky,a
vy) : [(Int, a)]
zs)
| Distinct
Nondistinct <- Distinct
distinct, Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky
= let v :: a
v = Int -> a -> a -> a
f Int
kx a
vy a
vx in Int -> a -> [(Int, a)] -> IntMap a
addAll' Int
ky a
v [(Int, a)]
zs
| Int
m <- Int -> Int -> Int
branchMask Int
kx Int
ky
, Inserted IntMap a
ty [(Int, a)]
zs' <- Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' Int
m Int
ky a
vy [(Int, a)]
zs
= Int -> IntMap a -> [(Int, a)] -> IntMap a
addAll Int
kx (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask Int
m Int
ky IntMap a
ty (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
kx a
vx)) [(Int, a)]
zs'
addAll :: Int -> IntMap a -> [(Int, a)] -> IntMap a
addAll !Int
_kx !IntMap a
tx []
= IntMap a
tx
addAll !Int
kx !IntMap a
tx ((Int
ky,a
vy) : [(Int, a)]
zs)
| Int
m <- Int -> Int -> Int
branchMask Int
kx Int
ky
, Inserted IntMap a
ty [(Int, a)]
zs' <- Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' Int
m Int
ky a
vy [(Int, a)]
zs
= Int -> IntMap a -> [(Int, a)] -> IntMap a
addAll Int
kx (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask Int
m Int
ky IntMap a
ty IntMap a
tx) [(Int, a)]
zs'
addMany' :: Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' !Int
_m !Int
kx a
vx []
= IntMap a -> [(Int, a)] -> Inserted a
forall a. IntMap a -> [(Int, a)] -> Inserted a
Inserted (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
kx a
vx) []
addMany' !Int
m !Int
kx a
vx zs0 :: [(Int, a)]
zs0@((Int
ky,a
vy) : [(Int, a)]
zs)
| Distinct
Nondistinct <- Distinct
distinct, Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky
= let v :: a
v = Int -> a -> a -> a
f Int
kx a
vy a
vx in Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' Int
m Int
ky a
v [(Int, a)]
zs
| Int -> Int -> Int
mask Int
kx Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int -> Int
mask Int
ky Int
m
= IntMap a -> [(Int, a)] -> Inserted a
forall a. IntMap a -> [(Int, a)] -> Inserted a
Inserted (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
kx a
vx) [(Int, a)]
zs0
| Int
mxy <- Int -> Int -> Int
branchMask Int
kx Int
ky
, Inserted IntMap a
ty [(Int, a)]
zs' <- Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' Int
mxy Int
ky a
vy [(Int, a)]
zs
= Int -> Int -> IntMap a -> [(Int, a)] -> Inserted a
addMany Int
m Int
kx (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask Int
mxy Int
ky IntMap a
ty (Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
kx a
vx)) [(Int, a)]
zs'
addMany :: Int -> Int -> IntMap a -> [(Int, a)] -> Inserted a
addMany !Int
_m !Int
_kx IntMap a
tx []
= IntMap a -> [(Int, a)] -> Inserted a
forall a. IntMap a -> [(Int, a)] -> Inserted a
Inserted IntMap a
tx []
addMany !Int
m !Int
kx IntMap a
tx zs0 :: [(Int, a)]
zs0@((Int
ky,a
vy) : [(Int, a)]
zs)
| Int -> Int -> Int
mask Int
kx Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int -> Int
mask Int
ky Int
m
= IntMap a -> [(Int, a)] -> Inserted a
forall a. IntMap a -> [(Int, a)] -> Inserted a
Inserted IntMap a
tx [(Int, a)]
zs0
| Int
mxy <- Int -> Int -> Int
branchMask Int
kx Int
ky
, Inserted IntMap a
ty [(Int, a)]
zs' <- Int -> Int -> a -> [(Int, a)] -> Inserted a
addMany' Int
mxy Int
ky a
vy [(Int, a)]
zs
= Int -> Int -> IntMap a -> [(Int, a)] -> Inserted a
addMany Int
m Int
kx (Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask Int
mxy Int
ky IntMap a
ty IntMap a
tx) [(Int, a)]
zs'
{-# INLINE fromMonoListWithKey #-}
data Inserted a = Inserted !(IntMap a) ![(Key,a)]
data Distinct = Distinct | Nondistinct
instance Eq a => Eq (IntMap a) where
IntMap a
t1 == :: IntMap a -> IntMap a -> Bool
== IntMap a
t2 = IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
equal IntMap a
t1 IntMap a
t2
IntMap a
t1 /= :: IntMap a -> IntMap a -> Bool
/= IntMap a
t2 = IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
nequal IntMap a
t1 IntMap a
t2
equal :: Eq a => IntMap a -> IntMap a -> Bool
equal :: forall a. Eq a => IntMap a -> IntMap a -> Bool
equal (Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) (Bin Int
p2 Int
m2 IntMap a
l2 IntMap a
r2)
= (Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m2) Bool -> Bool -> Bool
&& (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2) Bool -> Bool -> Bool
&& (IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
equal IntMap a
l1 IntMap a
l2) Bool -> Bool -> Bool
&& (IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
equal IntMap a
r1 IntMap a
r2)
equal (Tip Int
kx a
x) (Tip Int
ky a
y)
= (Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky) Bool -> Bool -> Bool
&& (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y)
equal IntMap a
Nil IntMap a
Nil = Bool
True
equal IntMap a
_ IntMap a
_ = Bool
False
nequal :: Eq a => IntMap a -> IntMap a -> Bool
nequal :: forall a. Eq a => IntMap a -> IntMap a -> Bool
nequal (Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) (Bin Int
p2 Int
m2 IntMap a
l2 IntMap a
r2)
= (Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
m2) Bool -> Bool -> Bool
|| (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
p2) Bool -> Bool -> Bool
|| (IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
nequal IntMap a
l1 IntMap a
l2) Bool -> Bool -> Bool
|| (IntMap a -> IntMap a -> Bool
forall a. Eq a => IntMap a -> IntMap a -> Bool
nequal IntMap a
r1 IntMap a
r2)
nequal (Tip Int
kx a
x) (Tip Int
ky a
y)
= (Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
ky) Bool -> Bool -> Bool
|| (a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=a
y)
nequal IntMap a
Nil IntMap a
Nil = Bool
False
nequal IntMap a
_ IntMap a
_ = Bool
True
#if MIN_VERSION_base(4,9,0)
instance Eq1 IntMap where
liftEq :: forall a b. (a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
liftEq a -> b -> Bool
eq (Bin Int
p1 Int
m1 IntMap a
l1 IntMap a
r1) (Bin Int
p2 Int
m2 IntMap b
l2 IntMap b
r2)
= (Int
m1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
m2) Bool -> Bool -> Bool
&& (Int
p1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p2) Bool -> Bool -> Bool
&& ((a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq IntMap a
l1 IntMap b
l2) Bool -> Bool -> Bool
&& ((a -> b -> Bool) -> IntMap a -> IntMap b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq IntMap a
r1 IntMap b
r2)
liftEq a -> b -> Bool
eq (Tip Int
kx a
x) (Tip Int
ky b
y)
= (Int
kx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
ky) Bool -> Bool -> Bool
&& (a -> b -> Bool
eq a
x b
y)
liftEq a -> b -> Bool
_eq IntMap a
Nil IntMap b
Nil = Bool
True
liftEq a -> b -> Bool
_eq IntMap a
_ IntMap b
_ = Bool
False
#endif
instance Ord a => Ord (IntMap a) where
compare :: IntMap a -> IntMap a -> Ordering
compare IntMap a
m1 IntMap a
m2 = [(Int, a)] -> [(Int, a)] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toList IntMap a
m1) (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toList IntMap a
m2)
#if MIN_VERSION_base(4,9,0)
instance Ord1 IntMap where
liftCompare :: forall a b.
(a -> b -> Ordering) -> IntMap a -> IntMap b -> Ordering
liftCompare a -> b -> Ordering
cmp IntMap a
m IntMap b
n =
((Int, a) -> (Int, b) -> Ordering)
-> [(Int, a)] -> [(Int, b)] -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering) -> (Int, a) -> (Int, b) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp) (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toList IntMap a
m) (IntMap b -> [(Int, b)]
forall a. IntMap a -> [(Int, a)]
toList IntMap b
n)
#endif
instance Functor IntMap where
fmap :: forall a b. (a -> b) -> IntMap a -> IntMap b
fmap = (a -> b) -> IntMap a -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
map
#ifdef __GLASGOW_HASKELL__
a
a <$ :: forall a b. a -> IntMap b -> IntMap a
<$ Bin Int
p Int
m IntMap b
l IntMap b
r = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m (a
a a -> IntMap b -> IntMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IntMap b
l) (a
a a -> IntMap b -> IntMap a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ IntMap b
r)
a
a <$ Tip Int
k b
_ = Int -> a -> IntMap a
forall a. Int -> a -> IntMap a
Tip Int
k a
a
a
_ <$ IntMap b
Nil = IntMap a
forall a. IntMap a
Nil
#endif
instance Show a => Show (IntMap a) where
showsPrec :: Int -> IntMap a -> [Char] -> [Char]
showsPrec Int
d IntMap a
m = Bool -> ([Char] -> [Char]) -> [Char] -> [Char]
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (([Char] -> [Char]) -> [Char] -> [Char])
-> ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
[Char] -> [Char] -> [Char]
showString [Char]
"fromList " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, a)] -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toList IntMap a
m)
#if MIN_VERSION_base(4,9,0)
instance Show1 IntMap where
liftShowsPrec :: forall a.
(Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> Int -> IntMap a -> [Char] -> [Char]
liftShowsPrec Int -> a -> [Char] -> [Char]
sp [a] -> [Char] -> [Char]
sl Int
d IntMap a
m =
(Int -> [(Int, a)] -> [Char] -> [Char])
-> [Char] -> Int -> [(Int, a)] -> [Char] -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> [Char] -> Int -> a -> [Char] -> [Char]
showsUnaryWith ((Int -> (Int, a) -> [Char] -> [Char])
-> ([(Int, a)] -> [Char] -> [Char])
-> Int
-> [(Int, a)]
-> [Char]
-> [Char]
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> Int -> f a -> [Char] -> [Char]
liftShowsPrec Int -> (Int, a) -> [Char] -> [Char]
sp' [(Int, a)] -> [Char] -> [Char]
sl') [Char]
"fromList" Int
d (IntMap a -> [(Int, a)]
forall a. IntMap a -> [(Int, a)]
toList IntMap a
m)
where
sp' :: Int -> (Int, a) -> [Char] -> [Char]
sp' = (Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> Int -> (Int, a) -> [Char] -> [Char]
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> Int -> f a -> [Char] -> [Char]
liftShowsPrec Int -> a -> [Char] -> [Char]
sp [a] -> [Char] -> [Char]
sl
sl' :: [(Int, a)] -> [Char] -> [Char]
sl' = (Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> [(Int, a)] -> [Char] -> [Char]
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> [Char] -> [Char])
-> ([a] -> [Char] -> [Char]) -> [f a] -> [Char] -> [Char]
liftShowList Int -> a -> [Char] -> [Char]
sp [a] -> [Char] -> [Char]
sl
#endif
instance (Read e) => Read (IntMap e) where
#ifdef __GLASGOW_HASKELL__
readPrec :: ReadPrec (IntMap e)
readPrec = ReadPrec (IntMap e) -> ReadPrec (IntMap e)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (IntMap e) -> ReadPrec (IntMap e))
-> ReadPrec (IntMap e) -> ReadPrec (IntMap e)
forall a b. (a -> b) -> a -> b
$ Int -> ReadPrec (IntMap e) -> ReadPrec (IntMap e)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 (ReadPrec (IntMap e) -> ReadPrec (IntMap e))
-> ReadPrec (IntMap e) -> ReadPrec (IntMap e)
forall a b. (a -> b) -> a -> b
$ do
Ident [Char]
"fromList" <- ReadPrec Lexeme
lexP
[(Int, e)]
xs <- ReadPrec [(Int, e)]
forall a. Read a => ReadPrec a
readPrec
IntMap e -> ReadPrec (IntMap e)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, e)] -> IntMap e
forall a. [(Int, a)] -> IntMap a
fromList [(Int, e)]
xs)
readListPrec :: ReadPrec [IntMap e]
readListPrec = ReadPrec [IntMap e]
forall a. Read a => ReadPrec [a]
readListPrecDefault
#else
readsPrec p = readParen (p > 10) $ \ r -> do
("fromList",s) <- lex r
(xs,t) <- reads s
return (fromList xs,t)
#endif
#if MIN_VERSION_base(4,9,0)
instance Read1 IntMap where
liftReadsPrec :: forall a. (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (IntMap a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = ([Char] -> ReadS (IntMap a)) -> Int -> ReadS (IntMap a)
forall a. ([Char] -> ReadS a) -> Int -> ReadS a
readsData (([Char] -> ReadS (IntMap a)) -> Int -> ReadS (IntMap a))
-> ([Char] -> ReadS (IntMap a)) -> Int -> ReadS (IntMap a)
forall a b. (a -> b) -> a -> b
$
(Int -> ReadS [(Int, a)])
-> [Char] -> ([(Int, a)] -> IntMap a) -> [Char] -> ReadS (IntMap a)
forall a t.
(Int -> ReadS a) -> [Char] -> (a -> t) -> [Char] -> ReadS t
readsUnaryWith ((Int -> ReadS (Int, a))
-> ReadS [(Int, a)] -> Int -> ReadS [(Int, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS (Int, a)
rp' ReadS [(Int, a)]
rl') [Char]
"fromList" [(Int, a)] -> IntMap a
forall a. [(Int, a)] -> IntMap a
fromList
where
rp' :: Int -> ReadS (Int, a)
rp' = (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Int, a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl
rl' :: ReadS [(Int, a)]
rl' = (Int -> ReadS a) -> ReadS [a] -> ReadS [(Int, a)]
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> ReadS [f a]
liftReadList Int -> ReadS a
rp ReadS [a]
rl
#endif
INSTANCE_TYPEABLE1(IntMap)
link :: Prefix -> IntMap a -> Prefix -> IntMap a -> IntMap a
link :: forall a. Int -> IntMap a -> Int -> IntMap a -> IntMap a
link Int
p1 IntMap a
t1 Int
p2 IntMap a
t2 = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask (Int -> Int -> Int
branchMask Int
p1 Int
p2) Int
p1 IntMap a
t1 IntMap a
t2
{-# INLINE link #-}
linkWithMask :: Mask -> Prefix -> IntMap a -> IntMap a -> IntMap a
linkWithMask :: forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
linkWithMask Int
m Int
p1 IntMap a
t1 IntMap a
t2
| Int -> Int -> Bool
zero Int
p1 Int
m = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
t1 IntMap a
t2
| Bool
otherwise = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
t2 IntMap a
t1
where
p :: Int
p = Int -> Int -> Int
mask Int
p1 Int
m
{-# INLINE linkWithMask #-}
bin :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
bin :: forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
bin Int
_ Int
_ IntMap a
l IntMap a
Nil = IntMap a
l
bin Int
_ Int
_ IntMap a
Nil IntMap a
r = IntMap a
r
bin Int
p Int
m IntMap a
l IntMap a
r = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l IntMap a
r
{-# INLINE bin #-}
binCheckLeft :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
binCheckLeft :: forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckLeft Int
_ Int
_ IntMap a
Nil IntMap a
r = IntMap a
r
binCheckLeft Int
p Int
m IntMap a
l IntMap a
r = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l IntMap a
r
{-# INLINE binCheckLeft #-}
binCheckRight :: Prefix -> Mask -> IntMap a -> IntMap a -> IntMap a
binCheckRight :: forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
binCheckRight Int
_ Int
_ IntMap a
l IntMap a
Nil = IntMap a
l
binCheckRight Int
p Int
m IntMap a
l IntMap a
r = Int -> Int -> IntMap a -> IntMap a -> IntMap a
forall a. Int -> Int -> IntMap a -> IntMap a -> IntMap a
Bin Int
p Int
m IntMap a
l IntMap a
r
{-# INLINE binCheckRight #-}
zero :: Key -> Mask -> Bool
zero :: Int -> Int -> Bool
zero Int
i Int
m
= (Int -> Nat
natFromInt Int
i) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. (Int -> Nat
natFromInt Int
m) Nat -> Nat -> Bool
forall a. Eq a => a -> a -> Bool
== Nat
0
{-# INLINE zero #-}
nomatch,match :: Key -> Prefix -> Mask -> Bool
nomatch :: Int -> Int -> Int -> Bool
nomatch Int
i Int
p Int
m
= (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
p
{-# INLINE nomatch #-}
match :: Int -> Int -> Int -> Bool
match Int
i Int
p Int
m
= (Int -> Int -> Int
mask Int
i Int
m) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p
{-# INLINE match #-}
mask :: Key -> Mask -> Prefix
mask :: Int -> Int -> Int
mask Int
i Int
m
= Nat -> Nat -> Int
maskW (Int -> Nat
natFromInt Int
i) (Int -> Nat
natFromInt Int
m)
{-# INLINE mask #-}
maskW :: Nat -> Nat -> Prefix
maskW :: Nat -> Nat -> Int
maskW Nat
i Nat
m
= Nat -> Int
intFromNat (Nat
i Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
.&. ((-Nat
m) Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Nat
m))
{-# INLINE maskW #-}
shorter :: Mask -> Mask -> Bool
shorter :: Int -> Int -> Bool
shorter Int
m1 Int
m2
= (Int -> Nat
natFromInt Int
m1) Nat -> Nat -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> Nat
natFromInt Int
m2)
{-# INLINE shorter #-}
branchMask :: Prefix -> Prefix -> Mask
branchMask :: Int -> Int -> Int
branchMask Int
p1 Int
p2
= Nat -> Int
intFromNat (Nat -> Nat
highestBitMask (Int -> Nat
natFromInt Int
p1 Nat -> Nat -> Nat
forall a. Bits a => a -> a -> a
`xor` Int -> Nat
natFromInt Int
p2))
{-# INLINE branchMask #-}
splitRoot :: IntMap a -> [IntMap a]
splitRoot :: forall a. IntMap a -> [IntMap a]
splitRoot IntMap a
orig =
case IntMap a
orig of
IntMap a
Nil -> []
x :: IntMap a
x@(Tip Int
_ a
_) -> [IntMap a
x]
Bin Int
_ Int
m IntMap a
l IntMap a
r | Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> [IntMap a
r, IntMap a
l]
| Bool
otherwise -> [IntMap a
l, IntMap a
r]
{-# INLINE splitRoot #-}
showTree :: Show a => IntMap a -> String
showTree :: forall a. Show a => IntMap a -> [Char]
showTree IntMap a
s
= Bool -> Bool -> IntMap a -> [Char]
forall a. Show a => Bool -> Bool -> IntMap a -> [Char]
showTreeWith Bool
True Bool
False IntMap a
s
showTreeWith :: Show a => Bool -> Bool -> IntMap a -> String
showTreeWith :: forall a. Show a => Bool -> Bool -> IntMap a -> [Char]
showTreeWith Bool
hang Bool
wide IntMap a
t
| Bool
hang = (Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTreeHang Bool
wide [] IntMap a
t) [Char]
""
| Bool
otherwise = (Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTree Bool
wide [] [] IntMap a
t) [Char]
""
showsTree :: Show a => Bool -> [String] -> [String] -> IntMap a -> ShowS
showsTree :: forall a.
Show a =>
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTree Bool
wide [[Char]]
lbars [[Char]]
rbars IntMap a
t = case IntMap a
t of
Bin Int
p Int
m IntMap a
l IntMap a
r ->
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTree Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
rbars) ([[Char]] -> [[Char]]
withEmpty [[Char]]
rbars) IntMap a
r ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [Char] -> [Char]
showWide Bool
wide [[Char]]
rbars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[[Char]] -> [Char] -> [Char]
showsBars [[Char]]
lbars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString (Int -> Int -> [Char]
showBin Int
p Int
m) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"\n" ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [Char] -> [Char]
showWide Bool
wide [[Char]]
lbars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTree Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
lbars) ([[Char]] -> [[Char]]
withBar [[Char]]
lbars) IntMap a
l
Tip Int
k a
x ->
[[Char]] -> [Char] -> [Char]
showsBars [[Char]]
lbars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [Char] -> [Char]
showString [Char]
" " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Int
k ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
":=" ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows a
x ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"\n"
IntMap a
Nil -> [[Char]] -> [Char] -> [Char]
showsBars [[Char]]
lbars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"|\n"
showsTreeHang :: Show a => Bool -> [String] -> IntMap a -> ShowS
showsTreeHang :: forall a.
Show a =>
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTreeHang Bool
wide [[Char]]
bars IntMap a
t = case IntMap a
t of
Bin Int
p Int
m IntMap a
l IntMap a
r ->
[[Char]] -> [Char] -> [Char]
showsBars [[Char]]
bars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString (Int -> Int -> [Char]
showBin Int
p Int
m) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"\n" ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [Char] -> [Char]
showWide Bool
wide [[Char]]
bars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withBar [[Char]]
bars) IntMap a
l ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> [Char] -> [Char]
showWide Bool
wide [[Char]]
bars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
forall a.
Show a =>
Bool -> [[Char]] -> IntMap a -> [Char] -> [Char]
showsTreeHang Bool
wide ([[Char]] -> [[Char]]
withEmpty [[Char]]
bars) IntMap a
r
Tip Int
k a
x ->
[[Char]] -> [Char] -> [Char]
showsBars [[Char]]
bars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Char] -> [Char] -> [Char]
showString [Char]
" " ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows Int
k ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
":=" ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char] -> [Char]
forall a. Show a => a -> [Char] -> [Char]
shows a
x ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"\n"
IntMap a
Nil -> [[Char]] -> [Char] -> [Char]
showsBars [[Char]]
bars ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"|\n"
showBin :: Prefix -> Mask -> String
showBin :: Int -> Int -> [Char]
showBin Int
_ Int
_
= [Char]
"*"
showWide :: Bool -> [String] -> String -> String
showWide :: Bool -> [[Char]] -> [Char] -> [Char]
showWide Bool
wide [[Char]]
bars
| Bool
wide = [Char] -> [Char] -> [Char]
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
bars)) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
"|\n"
| Bool
otherwise = [Char] -> [Char]
forall a. a -> a
id
showsBars :: [String] -> ShowS
showsBars :: [[Char]] -> [Char] -> [Char]
showsBars [[Char]]
bars
= case [[Char]]
bars of
[] -> [Char] -> [Char]
forall a. a -> a
id
[[Char]]
_ -> [Char] -> [Char] -> [Char]
showString ([[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]
forall a. [a] -> [a]
tail [[Char]]
bars))) ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char] -> [Char]
showString [Char]
node
node :: String
node :: [Char]
node = [Char]
"+--"
withBar, withEmpty :: [String] -> [String]
withBar :: [[Char]] -> [[Char]]
withBar [[Char]]
bars = [Char]
"| "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars
withEmpty :: [[Char]] -> [[Char]]
withEmpty [[Char]]
bars = [Char]
" "[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
bars