{-|
Module      : Z.Data.Vector.FlatIntMap
Description : Fast int map based on sorted vector
Copyright   : (c) Dong Han, 2017-2019
              (c) Tao He, 2018-2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides a simple int key value map based on sorted vector and binary search. It's particularly
suitable for small sized key value collections such as deserializing intermediate representation.
But can also used in various place where insertion and deletion is rare but require fast lookup.

-}

module Z.Data.Vector.FlatIntMap
  ( -- * FlatIntMap backed by sorted vector
    FlatIntMap, sortedKeyValues, size, null, empty, map', imap'
  , pack, packN, packR, packRN
  , unpack, unpackR, packVector, packVectorR
  , lookup
  , delete
  , insert
  , adjust'
  , merge, mergeWithKey'
    -- * fold and traverse
  , foldrWithKey, foldrWithKey', foldlWithKey, foldlWithKey', traverseWithKey
    -- * binary search on vectors
  , 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)

-- | /O(1)/ empty flat map.
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

-- | /O(N*logN)/ Pack list of key values, on key duplication prefer left one.
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)))

-- | /O(N*logN)/ Pack list of key values with suggested size, on key duplication prefer left one.
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)))

-- | /O(N*logN)/ Pack list of key values, on key duplication prefer right one.
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)))

-- | /O(N*logN)/ Pack list of key values with suggested size, on key duplication prefer right one.
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)))

-- | /O(N)/ Unpack key value pairs to a list sorted by keys in ascending order.
--
-- This function works with @foldr/build@ fusion in base.
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

-- | /O(N)/ Unpack key value pairs to a list sorted by keys in descending order.
--
-- This function works with @foldr/build@ fusion in base.
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

-- | /O(N*logN)/ Pack vector of key values, on key duplication prefer left one.
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))

-- | /O(N*logN)/ Pack vector of key values, on key duplication prefer right one.
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))

-- | /O(logN)/ Binary search on flat map.
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

-- | /O(N)/ Insert new key value into map, replace old one if key exists.
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)))

-- | /O(N)/ Delete a key value pair by key.
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)

-- | /O(N)/ Modify a value by key.
--
-- The value is evaluated to WHNF before writing into map.
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'

-- | /O(n+m)/ Merge two 'FlatIntMap', prefer right value on key duplication.
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

-- | /O(n+m)/ Merge two 'FlatIntMap' with a merge function.
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

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
--
-- During folding k is in descending order.
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

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
--
-- During folding Int is in ascending order.
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

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
--
-- During folding Int is in descending order.
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

-- | /O(n)/ Reduce this map by applying a binary operator to all
-- elements, using the given starting value (typically the
-- right-identity of the operator).
--
-- During folding Int is in ascending order.
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

-- | /O(n)/.
--
-- @'traverseWithKey' f s == 'pack' \<$\> 'traverse' (\(k, v) -> (,) k \<$\> f k v) ('unpack' m)@
-- That is, behaves exactly like a regular 'traverse' except that the traversing
-- function also has access to the key associated with a value.
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

--------------------------------------------------------------------------------

-- | Find the key's index in the vector slice, if key exists return 'Right',
-- otherwise 'Left', i.e. the insert index
--
-- This function only works on ascending sorted vectors.
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