module Z.Data.Vector.FlatIntMap
(
FlatIntMap, sortedKeyValues, size, null, empty, map', imap'
, pack, packN, packR, packRN
, unpack, unpackR, packVector, packVectorR
, lookup
, delete
, insert
, adjust'
, merge, mergeWithKey'
, foldrWithKey, foldrWithKey', foldlWithKey, foldlWithKey', traverseWithKey
, binarySearch
) where
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import qualified Data.Foldable as Foldable
import qualified Data.Traversable as Traversable
import qualified Data.Semigroup as Semigroup
import qualified Data.Monoid as Monoid
import qualified Data.Primitive.SmallArray as A
import qualified Z.Data.Vector.Base as V
import qualified Z.Data.Vector.Extra as V
import qualified Z.Data.Vector.Sort as V
import qualified Z.Data.Text.Print as T
import Data.Function (on)
import Data.Bits (unsafeShiftR)
import Data.Data
import Prelude hiding (lookup, null)
import Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))
newtype FlatIntMap v = FlatIntMap { forall v. FlatIntMap v -> Vector (IPair v)
sortedKeyValues :: V.Vector (V.IPair v) }
deriving (Int -> FlatIntMap v -> ShowS
forall v. Show v => Int -> FlatIntMap v -> ShowS
forall v. Show v => [FlatIntMap v] -> ShowS
forall v. Show v => FlatIntMap v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatIntMap v] -> ShowS
$cshowList :: forall v. Show v => [FlatIntMap v] -> ShowS
show :: FlatIntMap v -> String
$cshow :: forall v. Show v => FlatIntMap v -> String
showsPrec :: Int -> FlatIntMap v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> FlatIntMap v -> ShowS
Show, FlatIntMap v -> FlatIntMap v -> Bool
forall v. Eq v => FlatIntMap v -> FlatIntMap v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlatIntMap v -> FlatIntMap v -> Bool
$c/= :: forall v. Eq v => FlatIntMap v -> FlatIntMap v -> Bool
== :: FlatIntMap v -> FlatIntMap v -> Bool
$c== :: forall v. Eq v => FlatIntMap v -> FlatIntMap v -> Bool
Eq, FlatIntMap v -> FlatIntMap v -> Bool
FlatIntMap v -> FlatIntMap v -> Ordering
FlatIntMap v -> FlatIntMap v -> FlatIntMap v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v}. Ord v => Eq (FlatIntMap v)
forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Bool
forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Ordering
forall v. Ord v => FlatIntMap v -> FlatIntMap v -> FlatIntMap v
min :: FlatIntMap v -> FlatIntMap v -> FlatIntMap v
$cmin :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> FlatIntMap v
max :: FlatIntMap v -> FlatIntMap v -> FlatIntMap v
$cmax :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> FlatIntMap v
>= :: FlatIntMap v -> FlatIntMap v -> Bool
$c>= :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Bool
> :: FlatIntMap v -> FlatIntMap v -> Bool
$c> :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Bool
<= :: FlatIntMap v -> FlatIntMap v -> Bool
$c<= :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Bool
< :: FlatIntMap v -> FlatIntMap v -> Bool
$c< :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Bool
compare :: FlatIntMap v -> FlatIntMap v -> Ordering
$ccompare :: forall v. Ord v => FlatIntMap v -> FlatIntMap v -> Ordering
Ord, Typeable)
instance T.Print v => T.Print (FlatIntMap v) where
{-# INLINE toUTF8BuilderP #-}
toUTF8BuilderP :: Int -> FlatIntMap v -> Builder ()
toUTF8BuilderP Int
p (FlatIntMap Vector (IPair v)
vec) = Bool -> Builder () -> Builder ()
T.parenWhen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ do
Builder ()
"FlatIntMap{"
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
T.intercalateVec Builder ()
T.comma (\ (V.IPair Int
i v
v) ->
forall a. Print a => a -> Builder ()
T.toUTF8Builder Int
i forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Builder ()
T.char7 Char
':' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Print a => a -> Builder ()
T.toUTF8Builder v
v) Vector (IPair v)
vec
Char -> Builder ()
T.char7 Char
'}'
instance (Arbitrary v) => Arbitrary (FlatIntMap v) where
arbitrary :: Gen (FlatIntMap v)
arbitrary = forall v. [IPair v] -> FlatIntMap v
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
shrink :: FlatIntMap v -> [FlatIntMap v]
shrink FlatIntMap v
v = forall v. [IPair v] -> FlatIntMap v
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink (forall v. FlatIntMap v -> [IPair v]
unpack FlatIntMap v
v)
instance (CoArbitrary v) => CoArbitrary (FlatIntMap v) where
coarbitrary :: forall b. FlatIntMap v -> Gen b -> Gen b
coarbitrary = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> [IPair v]
unpack
instance Semigroup.Semigroup (FlatIntMap v) where
{-# INLINE (<>) #-}
<> :: FlatIntMap v -> FlatIntMap v -> FlatIntMap v
(<>) = forall v. FlatIntMap v -> FlatIntMap v -> FlatIntMap v
merge
instance Monoid.Monoid (FlatIntMap v) where
{-# INLINE mappend #-}
mappend :: FlatIntMap v -> FlatIntMap v -> FlatIntMap v
mappend = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mempty #-}
mempty :: FlatIntMap v
mempty = forall v. FlatIntMap v
empty
instance NFData v => NFData (FlatIntMap v) where
{-# INLINE rnf #-}
rnf :: FlatIntMap v -> ()
rnf (FlatIntMap Vector (IPair v)
ivs) = forall a. NFData a => a -> ()
rnf Vector (IPair v)
ivs
instance Functor (FlatIntMap) where
{-# INLINE fmap #-}
fmap :: forall a b. (a -> b) -> FlatIntMap a -> FlatIntMap b
fmap a -> b
f (FlatIntMap Vector (IPair a)
vs) = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Vector (IPair a)
vs)
instance Foldable.Foldable FlatIntMap where
{-# INLINE foldr' #-}
foldr' :: forall a b. (a -> b -> b) -> b -> FlatIntMap a -> b
foldr' a -> b -> b
f = forall v a. (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
foldrWithKey' (forall a b. a -> b -> a
const a -> b -> b
f)
{-# INLINE foldr #-}
foldr :: forall a b. (a -> b -> b) -> b -> FlatIntMap a -> b
foldr a -> b -> b
f = forall v a. (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
foldrWithKey (forall a b. a -> b -> a
const a -> b -> b
f)
{-# INLINE foldl' #-}
foldl' :: forall b a. (b -> a -> b) -> b -> FlatIntMap a -> b
foldl' b -> a -> b
f = forall a v. (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
foldlWithKey' (\ b
a Int
_ a
v -> b -> a -> b
f b
a a
v)
{-# INLINE foldl #-}
foldl :: forall b a. (b -> a -> b) -> b -> FlatIntMap a -> b
foldl b -> a -> b
f = forall a v. (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
foldlWithKey (\ b
a Int
_ a
v -> b -> a -> b
f b
a a
v)
{-# INLINE toList #-}
toList :: forall a. FlatIntMap a -> [a]
toList = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. IPair a -> a
V.isnd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> [IPair v]
unpack
{-# INLINE null #-}
null :: forall a. FlatIntMap a -> Bool
null (FlatIntMap Vector (IPair a)
vs) = forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector (IPair a)
vs
{-# INLINE length #-}
length :: forall a. FlatIntMap a -> Int
length (FlatIntMap Vector (IPair a)
vs) = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Vector (IPair a)
vs
{-# INLINE elem #-}
elem :: forall a. Eq a => a -> FlatIntMap a -> Bool
elem a
a (FlatIntMap Vector (IPair a)
vs) = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
a (forall a b. (a -> b) -> [a] -> [b]
map forall a. IPair a -> a
V.isnd forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector (IPair a)
vs)
instance Traversable.Traversable FlatIntMap where
{-# INLINE traverse #-}
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FlatIntMap a -> f (FlatIntMap b)
traverse a -> f b
f = forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> FlatIntMap a -> t (FlatIntMap b)
traverseWithKey (forall a b. a -> b -> a
const a -> f b
f)
size :: FlatIntMap v -> Int
{-# INLINE size #-}
size :: forall a. FlatIntMap a -> Int
size = forall (v :: * -> *) a. Vec v a => v a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> Vector (IPair v)
sortedKeyValues
null :: FlatIntMap v -> Bool
{-# INLINE null #-}
null :: forall a. FlatIntMap a -> Bool
null = forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> Vector (IPair v)
sortedKeyValues
map' :: (v -> v') -> FlatIntMap v -> FlatIntMap v'
{-# INLINE map' #-}
map' :: forall a b. (a -> b) -> FlatIntMap a -> FlatIntMap b
map' v -> v'
f (FlatIntMap Vector (IPair v)
vs) = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' (forall a b. (a -> b) -> IPair a -> IPair b
V.mapIPair' v -> v'
f) Vector (IPair v)
vs)
imap' :: (Int -> v -> v') -> FlatIntMap v -> FlatIntMap v'
{-# INLINE imap' #-}
imap' :: forall v v'. (Int -> v -> v') -> FlatIntMap v -> FlatIntMap v'
imap' Int -> v -> v'
f (FlatIntMap Vector (IPair v)
vs) = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(Int -> a -> b) -> u a -> v b
V.imap' (\ Int
i -> forall a b. (a -> b) -> IPair a -> IPair b
V.mapIPair' (Int -> v -> v'
f Int
i)) Vector (IPair v)
vs)
empty :: FlatIntMap v
{-# NOINLINE empty #-}
empty :: forall v. FlatIntMap v
empty = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap forall (v :: * -> *) a. Vec v a => v a
V.empty
pack :: [V.IPair v] -> FlatIntMap v
{-# INLINABLE pack #-}
pack :: forall v. [IPair v] -> FlatIntMap v
pack [IPair v]
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [IPair v]
kvs)))
packN :: Int -> [V.IPair v] -> FlatIntMap v
{-# INLINABLE packN #-}
packN :: forall v. Int -> [IPair v] -> FlatIntMap v
packN Int
n [IPair v]
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [IPair v]
kvs)))
packR :: [V.IPair v] -> FlatIntMap v
{-# INLINABLE packR #-}
packR :: forall v. [IPair v] -> FlatIntMap v
packR [IPair v]
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [IPair v]
kvs)))
packRN :: Int -> [V.IPair v] -> FlatIntMap v
{-# INLINABLE packRN #-}
packRN :: forall v. Int -> [IPair v] -> FlatIntMap v
packRN Int
n [IPair v]
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [IPair v]
kvs)))
unpack :: FlatIntMap v -> [V.IPair v]
{-# INLINE unpack #-}
unpack :: forall v. FlatIntMap v -> [IPair v]
unpack = forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> Vector (IPair v)
sortedKeyValues
unpackR :: FlatIntMap v -> [V.IPair v]
{-# INLINE unpackR #-}
unpackR :: forall v. FlatIntMap v -> [IPair v]
unpackR = forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. FlatIntMap v -> Vector (IPair v)
sortedKeyValues
packVector :: V.Vector (V.IPair v) -> FlatIntMap v
{-# INLINABLE packVector #-}
packVector :: forall v. Vector (IPair v) -> FlatIntMap v
packVector Vector (IPair v)
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) Vector (IPair v)
kvs))
packVectorR :: V.Vector (V.IPair v) -> FlatIntMap v
{-# INLINABLE packVectorR #-}
packVectorR :: forall v. Vector (IPair v) -> FlatIntMap v
packVectorR Vector (IPair v)
kvs = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) (forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. IPair a -> Int
V.ifst) Vector (IPair v)
kvs))
lookup :: Int -> FlatIntMap v -> Maybe v
{-# INLINABLE lookup #-}
lookup :: forall v. Int -> FlatIntMap v -> Maybe v
lookup Int
_ (FlatIntMap (V.Vector SmallArray (IPair v)
_ Int
_ Int
0)) = forall a. Maybe a
Nothing
lookup Int
k' (FlatIntMap (V.Vector SmallArray (IPair v)
arr Int
s0 Int
l)) = Int -> Int -> Maybe v
go Int
s0 (Int
s0forall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> Int -> Maybe v
go !Int
s !Int
e
| Int
s forall a. Eq a => a -> a -> Bool
== Int
e =
case SmallArray (IPair v)
arr forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
s of (V.IPair Int
k v
v) | Int
k forall a. Eq a => a -> a -> Bool
== Int
k' -> forall a. a -> Maybe a
Just v
v
| Bool
otherwise -> forall a. Maybe a
Nothing
| Int
s forall a. Ord a => a -> a -> Bool
> Int
e = forall a. Maybe a
Nothing
| Bool
otherwise =
let mid :: Int
mid = (Int
sforall a. Num a => a -> a -> a
+Int
e) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
(V.IPair Int
k v
v) = SmallArray (IPair v)
arr forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
mid
in case Int
k' forall a. Ord a => a -> a -> Ordering
`compare` Int
k of Ordering
LT -> Int -> Int -> Maybe v
go Int
s (Int
midforall a. Num a => a -> a -> a
-Int
1)
Ordering
GT -> Int -> Int -> Maybe v
go (Int
midforall a. Num a => a -> a -> a
+Int
1) Int
e
Ordering
_ -> forall a. a -> Maybe a
Just v
v
insert :: Int -> v -> FlatIntMap v -> FlatIntMap v
{-# INLINABLE insert #-}
insert :: forall v. Int -> v -> FlatIntMap v -> FlatIntMap v
insert Int
k v
v (FlatIntMap Vector (IPair v)
vec) =
case forall v. Vector (IPair v) -> Int -> Either Int Int
binarySearch Vector (IPair v)
vec Int
k of
Left Int
i -> forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
v a -> Int -> a -> v a
V.unsafeInsertIndex Vector (IPair v)
vec Int
i (forall a. Int -> a -> IPair a
V.IPair Int
k v
v))
Right Int
i -> forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
v a -> Int -> (a -> a) -> v a
V.unsafeModifyIndex Vector (IPair v)
vec Int
i (forall a b. a -> b -> a
const (forall a. Int -> a -> IPair a
V.IPair Int
k v
v)))
delete :: Int -> FlatIntMap v -> FlatIntMap v
{-# INLINABLE delete #-}
delete :: forall v. Int -> FlatIntMap v -> FlatIntMap v
delete Int
k m :: FlatIntMap v
m@(FlatIntMap Vector (IPair v)
vec) =
case forall v. Vector (IPair v) -> Int -> Either Int Int
binarySearch Vector (IPair v)
vec Int
k of
Left Int
_ -> FlatIntMap v
m
Right Int
i -> forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
v a -> Int -> v a
V.unsafeDeleteIndex Vector (IPair v)
vec Int
i)
adjust' :: (v -> v) -> Int -> FlatIntMap v -> FlatIntMap v
{-# INLINABLE adjust' #-}
adjust' :: forall v. (v -> v) -> Int -> FlatIntMap v -> FlatIntMap v
adjust' v -> v
f Int
k m :: FlatIntMap v
m@(FlatIntMap Vector (IPair v)
vec) =
case forall v. Vector (IPair v) -> Int -> Either Int Int
binarySearch Vector (IPair v)
vec Int
k of
Left Int
_ -> FlatIntMap v
m
Right Int
i -> forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
v a -> Int -> (a -> a) -> v a
V.unsafeModifyIndex Vector (IPair v)
vec Int
i forall a b. (a -> b) -> a -> b
$
\ (V.IPair Int
k' v
v) -> let !v' :: v
v' = v -> v
f v
v in forall a. Int -> a -> IPair a
V.IPair Int
k' v
v'
merge :: forall v. FlatIntMap v -> FlatIntMap v -> FlatIntMap v
{-# INLINABLE merge #-}
merge :: forall v. FlatIntMap v -> FlatIntMap v -> FlatIntMap v
merge fmL :: FlatIntMap v
fmL@(FlatIntMap (V.Vector SmallArray (IPair v)
arrL Int
sL Int
lL)) fmR :: FlatIntMap v
fmR@(FlatIntMap (V.Vector SmallArray (IPair v)
arrR Int
sR Int
lR))
| forall a. FlatIntMap a -> Bool
null FlatIntMap v
fmL = FlatIntMap v
fmR
| forall a. FlatIntMap a -> Bool
null FlatIntMap v
fmR = FlatIntMap v
fmL
| Bool
otherwise = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
lLforall a. Num a => a -> a -> a
+Int
lR) (forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go Int
sL Int
sR Int
0))
where
endL :: Int
endL = Int
sL forall a. Num a => a -> a -> a
+ Int
lL
endR :: Int
endR = Int
sR forall a. Num a => a -> a -> a
+ Int
lR
go :: Int -> Int -> Int -> A.SmallMutableArray s (V.IPair v) -> ST s Int
go :: forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go !Int
i !Int
j !Int
k SmallMutableArray s (IPair v)
marr
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
endL = do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (IPair v)
marr Int
k SmallArray (IPair v)
arrR Int
j (Int
lRforall a. Num a => a -> a -> a
-Int
j)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
kforall a. Num a => a -> a -> a
+Int
lRforall a. Num a => a -> a -> a
-Int
j
| Int
j forall a. Ord a => a -> a -> Bool
>= Int
endR = do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (IPair v)
marr Int
k SmallArray (IPair v)
arrL Int
i (Int
lLforall a. Num a => a -> a -> a
-Int
i)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
kforall a. Num a => a -> a -> a
+Int
lLforall a. Num a => a -> a -> a
-Int
i
| Bool
otherwise = do
kvL :: IPair v
kvL@(V.IPair Int
kL v
_) <- SmallArray (IPair v)
arrL forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
i
kvR :: IPair v
kvR@(V.IPair Int
kR v
_) <- SmallArray (IPair v)
arrR forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
j
case Int
kL forall a. Ord a => a -> a -> Ordering
`compare` Int
kR of Ordering
LT -> do forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k IPair v
kvL
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
Ordering
EQ -> do forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k IPair v
kvR
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
Ordering
_ -> do forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k IPair v
kvR
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go Int
i (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
mergeWithKey' :: forall v. (Int -> v -> v -> v) -> FlatIntMap v -> FlatIntMap v -> FlatIntMap v
{-# INLINABLE mergeWithKey' #-}
mergeWithKey' :: forall v.
(Int -> v -> v -> v)
-> FlatIntMap v -> FlatIntMap v -> FlatIntMap v
mergeWithKey' Int -> v -> v -> v
f fmL :: FlatIntMap v
fmL@(FlatIntMap (V.Vector SmallArray (IPair v)
arrL Int
sL Int
lL)) fmR :: FlatIntMap v
fmR@(FlatIntMap (V.Vector SmallArray (IPair v)
arrR Int
sR Int
lR))
| forall a. FlatIntMap a -> Bool
null FlatIntMap v
fmL = FlatIntMap v
fmR
| forall a. FlatIntMap a -> Bool
null FlatIntMap v
fmR = FlatIntMap v
fmL
| Bool
otherwise = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap (forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
lLforall a. Num a => a -> a -> a
+Int
lR) (forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go Int
sL Int
sR Int
0))
where
endL :: Int
endL = Int
sL forall a. Num a => a -> a -> a
+ Int
lL
endR :: Int
endR = Int
sR forall a. Num a => a -> a -> a
+ Int
lR
go :: Int -> Int -> Int -> A.SmallMutableArray s (V.IPair v) -> ST s Int
go :: forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go !Int
i !Int
j !Int
k SmallMutableArray s (IPair v)
marr
| Int
i forall a. Ord a => a -> a -> Bool
>= Int
endL = do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (IPair v)
marr Int
k SmallArray (IPair v)
arrR Int
j (Int
lRforall a. Num a => a -> a -> a
-Int
j)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
kforall a. Num a => a -> a -> a
+Int
lRforall a. Num a => a -> a -> a
-Int
j
| Int
j forall a. Ord a => a -> a -> Bool
>= Int
endR = do
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (IPair v)
marr Int
k SmallArray (IPair v)
arrL Int
i (Int
lLforall a. Num a => a -> a -> a
-Int
i)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Int
kforall a. Num a => a -> a -> a
+Int
lLforall a. Num a => a -> a -> a
-Int
i
| Bool
otherwise = do
kvL :: IPair v
kvL@(V.IPair Int
kL v
vL) <- SmallArray (IPair v)
arrL forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
i
kvR :: IPair v
kvR@(V.IPair Int
kR v
vR) <- SmallArray (IPair v)
arrR forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
j
case Int
kL forall a. Ord a => a -> a -> Ordering
`compare` Int
kR of Ordering
LT -> do forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k IPair v
kvL
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go (Int
iforall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
Ordering
EQ -> do let !v' :: v
v' = Int -> v -> v -> v
f Int
kL v
vL v
vR
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k (forall a. Int -> a -> IPair a
V.IPair Int
kL v
v')
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go (Int
iforall a. Num a => a -> a -> a
+Int
1) (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
Ordering
_ -> do forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (IPair v)
marr Int
k IPair v
kvR
forall s.
Int -> Int -> Int -> SmallMutableArray s (IPair v) -> ST s Int
go Int
i (Int
jforall a. Num a => a -> a -> a
+Int
1) (Int
kforall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (IPair v)
marr
foldrWithKey :: (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
{-# INLINE foldrWithKey #-}
foldrWithKey :: forall v a. (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
foldrWithKey Int -> v -> a -> a
f a
a (FlatIntMap Vector (IPair v)
vs) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (V.IPair Int
k v
v) a
a' -> Int -> v -> a -> a
f Int
k v
v a
a') a
a Vector (IPair v)
vs
foldlWithKey :: (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
{-# INLINE foldlWithKey #-}
foldlWithKey :: forall a v. (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
foldlWithKey a -> Int -> v -> a
f a
a (FlatIntMap Vector (IPair v)
vs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ a
a' (V.IPair Int
k v
v) -> a -> Int -> v -> a
f a
a' Int
k v
v) a
a Vector (IPair v)
vs
foldrWithKey' :: (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
{-# INLINE foldrWithKey' #-}
foldrWithKey' :: forall v a. (Int -> v -> a -> a) -> a -> FlatIntMap v -> a
foldrWithKey' Int -> v -> a -> a
f a
a (FlatIntMap Vector (IPair v)
vs) = forall (v :: * -> *) a b. Vec v a => (a -> b -> b) -> b -> v a -> b
V.foldr' (\ (V.IPair Int
k v
v) -> Int -> v -> a -> a
f Int
k v
v) a
a Vector (IPair v)
vs
foldlWithKey' :: (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
{-# INLINE foldlWithKey' #-}
foldlWithKey' :: forall a v. (a -> Int -> v -> a) -> a -> FlatIntMap v -> a
foldlWithKey' a -> Int -> v -> a
f a
a (FlatIntMap Vector (IPair v)
vs) = forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' (\ a
a' (V.IPair Int
k v
v) -> a -> Int -> v -> a
f a
a' Int
k v
v) a
a Vector (IPair v)
vs
traverseWithKey :: Applicative t => (Int -> a -> t b) -> FlatIntMap a -> t (FlatIntMap b)
{-# INLINE traverseWithKey #-}
traverseWithKey :: forall (t :: * -> *) a b.
Applicative t =>
(Int -> a -> t b) -> FlatIntMap a -> t (FlatIntMap b)
traverseWithKey Int -> a -> t b
f (FlatIntMap Vector (IPair a)
vs) = forall v. Vector (IPair v) -> FlatIntMap v
FlatIntMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(a -> f b) -> v a -> f (u b)
V.traverse (\ (V.IPair Int
k a
v) -> forall a. Int -> a -> IPair a
V.IPair Int
k forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> a -> t b
f Int
k a
v) Vector (IPair a)
vs
binarySearch :: V.Vector (V.IPair v) -> Int -> Either Int Int
{-# INLINABLE binarySearch #-}
binarySearch :: forall v. Vector (IPair v) -> Int -> Either Int Int
binarySearch (V.Vector SmallArray (IPair v)
_ Int
_ Int
0) Int
_ = forall a b. a -> Either a b
Left Int
0
binarySearch (V.Vector SmallArray (IPair v)
arr Int
s0 Int
l) !Int
k' = Int -> Int -> Either Int Int
go Int
s0 (Int
s0forall a. Num a => a -> a -> a
+Int
lforall a. Num a => a -> a -> a
-Int
1)
where
go :: Int -> Int -> Either Int Int
go !Int
s !Int
e
| Int
s forall a. Eq a => a -> a -> Bool
== Int
e =
let V.IPair Int
k v
_ = SmallArray (IPair v)
arr forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
s
in case Int
k' forall a. Ord a => a -> a -> Ordering
`compare` Int
k of Ordering
LT -> forall a b. a -> Either a b
Left Int
s
Ordering
GT -> let !s' :: Int
s' = Int
sforall a. Num a => a -> a -> a
+Int
1 in forall a b. a -> Either a b
Left Int
s'
Ordering
_ -> forall a b. b -> Either a b
Right Int
s
| Int
s forall a. Ord a => a -> a -> Bool
> Int
e = forall a b. a -> Either a b
Left Int
s
| Bool
otherwise =
let !mid :: Int
mid = (Int
sforall a. Num a => a -> a -> a
+Int
e) forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
(V.IPair Int
k v
_) = SmallArray (IPair v)
arr forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
mid
in case Int
k' forall a. Ord a => a -> a -> Ordering
`compare` Int
k of Ordering
LT -> Int -> Int -> Either Int Int
go Int
s (Int
midforall a. Num a => a -> a -> a
-Int
1)
Ordering
GT -> Int -> Int -> Either Int Int
go (Int
midforall a. Num a => a -> a -> a
+Int
1) Int
e
Ordering
_ -> forall a b. b -> Either a b
Right Int
mid