{-|
Module      : Z.Data.Vector.FlatMap
Description : Fast 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 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.FlatMap
  ( -- * FlatMap backed by sorted vector
    FlatMap, sortedKeyValues, size, null, empty, map', kmap'
  , pack, packN, packR, packRN
  , unpack, unpackR, packVector, packVectorR
  , lookup
  , delete
  , insert
  , adjust'
  , merge, mergeWithKey'
    -- * fold and traverse
  , foldrWithKey, foldrWithKey', foldlWithKey, foldlWithKey', traverseWithKey
    -- * search on vectors
  , linearSearch, linearSearchR, binarySearch
  ) where

import           Control.DeepSeq
import           Control.Monad
import           Control.Monad.ST
import qualified Data.Primitive.SmallArray  as A
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 Z.Data.Vector.Base 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 FlatMap k v = FlatMap { FlatMap k v -> Vector (k, v)
sortedKeyValues :: V.Vector (k, v) }
    deriving (Int -> FlatMap k v -> ShowS
[FlatMap k v] -> ShowS
FlatMap k v -> String
(Int -> FlatMap k v -> ShowS)
-> (FlatMap k v -> String)
-> ([FlatMap k v] -> ShowS)
-> Show (FlatMap k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> FlatMap k v -> ShowS
forall k v. (Show k, Show v) => [FlatMap k v] -> ShowS
forall k v. (Show k, Show v) => FlatMap k v -> String
showList :: [FlatMap k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [FlatMap k v] -> ShowS
show :: FlatMap k v -> String
$cshow :: forall k v. (Show k, Show v) => FlatMap k v -> String
showsPrec :: Int -> FlatMap k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> FlatMap k v -> ShowS
Show, FlatMap k v -> FlatMap k v -> Bool
(FlatMap k v -> FlatMap k v -> Bool)
-> (FlatMap k v -> FlatMap k v -> Bool) -> Eq (FlatMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => FlatMap k v -> FlatMap k v -> Bool
/= :: FlatMap k v -> FlatMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => FlatMap k v -> FlatMap k v -> Bool
== :: FlatMap k v -> FlatMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => FlatMap k v -> FlatMap k v -> Bool
Eq, Eq (FlatMap k v)
Eq (FlatMap k v)
-> (FlatMap k v -> FlatMap k v -> Ordering)
-> (FlatMap k v -> FlatMap k v -> Bool)
-> (FlatMap k v -> FlatMap k v -> Bool)
-> (FlatMap k v -> FlatMap k v -> Bool)
-> (FlatMap k v -> FlatMap k v -> Bool)
-> (FlatMap k v -> FlatMap k v -> FlatMap k v)
-> (FlatMap k v -> FlatMap k v -> FlatMap k v)
-> Ord (FlatMap k v)
FlatMap k v -> FlatMap k v -> Bool
FlatMap k v -> FlatMap k v -> Ordering
FlatMap k v -> FlatMap k v -> FlatMap k 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 k v. (Ord k, Ord v) => Eq (FlatMap k v)
forall k v. (Ord k, Ord v) => FlatMap k v -> FlatMap k v -> Bool
forall k v.
(Ord k, Ord v) =>
FlatMap k v -> FlatMap k v -> Ordering
forall k v.
(Ord k, Ord v) =>
FlatMap k v -> FlatMap k v -> FlatMap k v
min :: FlatMap k v -> FlatMap k v -> FlatMap k v
$cmin :: forall k v.
(Ord k, Ord v) =>
FlatMap k v -> FlatMap k v -> FlatMap k v
max :: FlatMap k v -> FlatMap k v -> FlatMap k v
$cmax :: forall k v.
(Ord k, Ord v) =>
FlatMap k v -> FlatMap k v -> FlatMap k v
>= :: FlatMap k v -> FlatMap k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => FlatMap k v -> FlatMap k v -> Bool
> :: FlatMap k v -> FlatMap k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => FlatMap k v -> FlatMap k v -> Bool
<= :: FlatMap k v -> FlatMap k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => FlatMap k v -> FlatMap k v -> Bool
< :: FlatMap k v -> FlatMap k v -> Bool
$c< :: forall k v. (Ord k, Ord v) => FlatMap k v -> FlatMap k v -> Bool
compare :: FlatMap k v -> FlatMap k v -> Ordering
$ccompare :: forall k v.
(Ord k, Ord v) =>
FlatMap k v -> FlatMap k v -> Ordering
$cp1Ord :: forall k v. (Ord k, Ord v) => Eq (FlatMap k v)
Ord, Typeable)

instance (T.Print k, T.Print v) => T.Print (FlatMap k v) where
    {-# INLINE toUTF8BuilderP #-}
    toUTF8BuilderP :: Int -> FlatMap k v -> Builder ()
toUTF8BuilderP Int
p (FlatMap Vector (k, v)
vec) = Bool -> Builder () -> Builder ()
T.parenWhen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Builder ()
"FlatMap{"
        Builder () -> ((k, v) -> Builder ()) -> Vector (k, v) -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
T.intercalateVec Builder ()
T.comma (\ (k
k, v
v) ->
            k -> Builder ()
forall a. Print a => a -> Builder ()
T.toUTF8Builder k
k Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Builder ()
T.char7 Char
':' Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> v -> Builder ()
forall a. Print a => a -> Builder ()
T.toUTF8Builder v
v) Vector (k, v)
vec
        Char -> Builder ()
T.char7 Char
'}'

instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (FlatMap k v) where
    arbitrary :: Gen (FlatMap k v)
arbitrary = [(k, v)] -> FlatMap k v
forall k v. Ord k => [(k, v)] -> FlatMap k v
pack ([(k, v)] -> FlatMap k v) -> Gen [(k, v)] -> Gen (FlatMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [(k, v)]
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: FlatMap k v -> [FlatMap k v]
shrink FlatMap k v
v = [(k, v)] -> FlatMap k v
forall k v. Ord k => [(k, v)] -> FlatMap k v
pack ([(k, v)] -> FlatMap k v) -> [[(k, v)]] -> [FlatMap k v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(k, v)] -> [[(k, v)]]
forall a. Arbitrary a => a -> [a]
shrink (FlatMap k v -> [(k, v)]
forall k v. FlatMap k v -> [(k, v)]
unpack FlatMap k v
v)

instance (CoArbitrary k, CoArbitrary v) => CoArbitrary (FlatMap k v) where
    coarbitrary :: FlatMap k v -> Gen b -> Gen b
coarbitrary = [(k, v)] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ([(k, v)] -> Gen b -> Gen b)
-> (FlatMap k v -> [(k, v)]) -> FlatMap k v -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k v -> [(k, v)]
forall k v. FlatMap k v -> [(k, v)]
unpack

instance Ord k => Semigroup.Semigroup (FlatMap k v) where
    {-# INLINE (<>) #-}
    <> :: FlatMap k v -> FlatMap k v -> FlatMap k v
(<>) = FlatMap k v -> FlatMap k v -> FlatMap k v
forall k v. Ord k => FlatMap k v -> FlatMap k v -> FlatMap k v
merge

instance Ord k => Monoid.Monoid (FlatMap k v) where
    {-# INLINE mappend #-}
    mappend :: FlatMap k v -> FlatMap k v -> FlatMap k v
mappend = FlatMap k v -> FlatMap k v -> FlatMap k v
forall k v. Ord k => FlatMap k v -> FlatMap k v -> FlatMap k v
merge
    {-# INLINE mempty #-}
    mempty :: FlatMap k v
mempty = FlatMap k v
forall k v. FlatMap k v
empty

instance (NFData k, NFData v) => NFData (FlatMap k v) where
    {-# INLINE rnf #-}
    rnf :: FlatMap k v -> ()
rnf (FlatMap Vector (k, v)
kvs) = Vector (k, v) -> ()
forall a. NFData a => a -> ()
rnf Vector (k, v)
kvs

instance Functor (FlatMap k) where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> FlatMap k a -> FlatMap k b
fmap a -> b
f (FlatMap Vector (k, a)
vs) = Vector (k, b) -> FlatMap k b
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, a) -> (k, b)) -> Vector (k, a) -> Vector (k, b)
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' ((a -> b) -> (k, a) -> (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Vector (k, a)
vs)

instance Foldable.Foldable (FlatMap k) where
    {-# INLINE foldr' #-}
    foldr' :: (a -> b -> b) -> b -> FlatMap k a -> b
foldr' a -> b -> b
f = (k -> a -> b -> b) -> b -> FlatMap k a -> b
forall k v a. (k -> v -> a -> a) -> a -> FlatMap k v -> a
foldrWithKey' ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
    {-# INLINE foldr #-}
    foldr :: (a -> b -> b) -> b -> FlatMap k a -> b
foldr a -> b -> b
f = (k -> a -> b -> b) -> b -> FlatMap k a -> b
forall k v a. (k -> v -> a -> a) -> a -> FlatMap k v -> a
foldrWithKey ((a -> b -> b) -> k -> a -> b -> b
forall a b. a -> b -> a
const a -> b -> b
f)
    {-# INLINE foldl' #-}
    foldl' :: (b -> a -> b) -> b -> FlatMap k a -> b
foldl' b -> a -> b
f = (b -> k -> a -> b) -> b -> FlatMap k a -> b
forall a k v. (a -> k -> v -> a) -> a -> FlatMap k v -> a
foldlWithKey' (\ b
a k
_ a
v -> b -> a -> b
f b
a a
v)
    {-# INLINE foldl #-}
    foldl :: (b -> a -> b) -> b -> FlatMap k a -> b
foldl b -> a -> b
f = (b -> k -> a -> b) -> b -> FlatMap k a -> b
forall a k v. (a -> k -> v -> a) -> a -> FlatMap k v -> a
foldlWithKey (\ b
a k
_ a
v -> b -> a -> b
f b
a a
v)
    {-# INLINE toList #-}
    toList :: FlatMap k a -> [a]
toList = ((k, a) -> a) -> [(k, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k, a) -> a
forall a b. (a, b) -> b
snd ([(k, a)] -> [a])
-> (FlatMap k a -> [(k, a)]) -> FlatMap k a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k a -> [(k, a)]
forall k v. FlatMap k v -> [(k, v)]
unpack
    {-# INLINE null #-}
    null :: FlatMap k a -> Bool
null (FlatMap Vector (k, a)
vs) = Vector (k, a) -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null Vector (k, a)
vs
    {-# INLINE length #-}
    length :: FlatMap k a -> Int
length (FlatMap Vector (k, a)
vs) = Vector (k, a) -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length Vector (k, a)
vs
    {-# INLINE elem #-}
    elem :: a -> FlatMap k a -> Bool
elem a
a (FlatMap Vector (k, a)
vs) = a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
a (((k, a) -> a) -> [(k, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (k, a) -> a
forall a b. (a, b) -> b
snd ([(k, a)] -> [a]) -> [(k, a)] -> [a]
forall a b. (a -> b) -> a -> b
$ Vector (k, a) -> [(k, a)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack Vector (k, a)
vs)

instance Traversable.Traversable (FlatMap k) where
    {-# INLINE traverse #-}
    traverse :: (a -> f b) -> FlatMap k a -> f (FlatMap k b)
traverse a -> f b
f = (k -> a -> f b) -> FlatMap k a -> f (FlatMap k b)
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> FlatMap k a -> t (FlatMap k b)
traverseWithKey ((a -> f b) -> k -> a -> f b
forall a b. a -> b -> a
const a -> f b
f)

size :: FlatMap k v -> Int
{-# INLINE size #-}
size :: FlatMap k v -> Int
size = Vector (k, v) -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length (Vector (k, v) -> Int)
-> (FlatMap k v -> Vector (k, v)) -> FlatMap k v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k v -> Vector (k, v)
forall k v. FlatMap k v -> Vector (k, v)
sortedKeyValues

null :: FlatMap k v -> Bool
{-# INLINE null #-}
null :: FlatMap k v -> Bool
null = Vector (k, v) -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null (Vector (k, v) -> Bool)
-> (FlatMap k v -> Vector (k, v)) -> FlatMap k v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k v -> Vector (k, v)
forall k v. FlatMap k v -> Vector (k, v)
sortedKeyValues

map' :: (v -> v') -> FlatMap k v -> FlatMap k v'
{-# INLINE map' #-}
map' :: (v -> v') -> FlatMap k v -> FlatMap k v'
map' v -> v'
f (FlatMap Vector (k, v)
vs) = Vector (k, v') -> FlatMap k v'
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v')) -> Vector (k, v) -> Vector (k, v')
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' ((v -> v') -> (k, v) -> (k, v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v'
f) Vector (k, v)
vs)

kmap' :: (k -> v -> v') -> FlatMap k v -> FlatMap k v'
{-# INLINE kmap' #-}
kmap' :: (k -> v -> v') -> FlatMap k v -> FlatMap k v'
kmap' k -> v -> v'
f (FlatMap Vector (k, v)
vs) = Vector (k, v') -> FlatMap k v'
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v')) -> Vector (k, v) -> Vector (k, v')
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' (\ (k
k, v
v) -> (k
k, k -> v -> v'
f k
k v
v)) Vector (k, v)
vs)

-- | /O(1)/ empty flat map.
empty :: FlatMap k v
{-# INLINE empty #-}
empty :: FlatMap k v
empty = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap Vector (k, v)
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 :: Ord k => [(k, v)] -> FlatMap k v
{-# INLINE pack #-}
pack :: [(k, v)] -> FlatMap k v
pack [(k, v)]
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) ([(k, v)] -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [(k, v)]
kvs)))

-- | /O(N*logN)/ Pack list of key values with suggested size, on key duplication prefer left one.
packN :: Ord k => Int -> [(k, v)] -> FlatMap k v
{-# INLINE packN #-}
packN :: Int -> [(k, v)] -> FlatMap k v
packN Int
n [(k, v)]
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (Int -> [(k, v)] -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [(k, v)]
kvs)))

-- | /O(N*logN)/ Pack list of key values, on key duplication prefer right one.
packR :: Ord k => [(k, v)] -> FlatMap k v
{-# INLINE packR #-}
packR :: [(k, v)] -> FlatMap k v
packR [(k, v)]
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) ([(k, v)] -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [(k, v)]
kvs)))

-- | /O(N*logN)/ Pack list of key values with suggested size, on key duplication prefer right one.
packRN :: Ord k => Int -> [(k, v)] -> FlatMap k v
{-# INLINE packRN #-}
packRN :: Int -> [(k, v)] -> FlatMap k v
packRN Int
n [(k, v)]
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (Int -> [(k, v)] -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [(k, 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 :: FlatMap k v -> [(k, v)]
{-# INLINE unpack #-}
unpack :: FlatMap k v -> [(k, v)]
unpack = Vector (k, v) -> [(k, v)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack (Vector (k, v) -> [(k, v)])
-> (FlatMap k v -> Vector (k, v)) -> FlatMap k v -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k v -> Vector (k, v)
forall k v. FlatMap k v -> Vector (k, 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 :: FlatMap k v -> [(k, v)]
{-# INLINE unpackR #-}
unpackR :: FlatMap k v -> [(k, v)]
unpackR = Vector (k, v) -> [(k, v)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR (Vector (k, v) -> [(k, v)])
-> (FlatMap k v -> Vector (k, v)) -> FlatMap k v -> [(k, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatMap k v -> Vector (k, v)
forall k v. FlatMap k v -> Vector (k, v)
sortedKeyValues

-- | /O(N*logN)/ Pack vector of key values, on key duplication prefer left one.
packVector :: Ord k => V.Vector (k, v) -> FlatMap k v
{-# INLINE packVector #-}
packVector :: Vector (k, v) -> FlatMap k v
packVector Vector (k, v)
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) Vector (k, v)
kvs))

-- | /O(N*logN)/ Pack vector of key values, on key duplication prefer right one.
packVectorR :: Ord k => V.Vector (k, v) -> FlatMap k v
{-# INLINE packVectorR #-}
packVectorR :: Vector (k, v) -> FlatMap k v
packVectorR Vector (k, v)
kvs = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (((k, v) -> (k, v) -> Bool) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
(==) (k -> k -> Bool) -> ((k, v) -> k) -> (k, v) -> (k, v) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) (((k, v) -> (k, v) -> Ordering) -> Vector (k, v) -> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
(a -> a -> Ordering) -> v a -> v a
V.mergeSortBy (k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (k -> k -> Ordering)
-> ((k, v) -> k) -> (k, v) -> (k, v) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (k, v) -> k
forall a b. (a, b) -> a
fst) Vector (k, v)
kvs))

-- | /O(logN)/ Binary search on flat map.
lookup :: Ord k => k -> FlatMap k v -> Maybe v
{-# INLINABLE lookup #-}
lookup :: k -> FlatMap k v -> Maybe v
lookup k
_  (FlatMap (V.Vector SmallArray (k, v)
_ Int
_ Int
0)) = Maybe v
forall a. Maybe a
Nothing
lookup k
k' (FlatMap (V.Vector SmallArray (k, v)
arr Int
s Int
l)) = Int -> Int -> Maybe v
go Int
s (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  where
    go :: Int -> Int -> Maybe v
go !Int
i !Int
j
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j =
            case SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
i of (k
k, v
v)  | k
k k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k'  -> v -> Maybe v
forall a. a -> Maybe a
Just v
v
                                                      | Bool
otherwise -> Maybe v
forall a. Maybe a
Nothing
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
j = Maybe v
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let mid :: Int
mid = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
                (k
k, v
v)  = SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
mid
            in case k
k' k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k of Ordering
LT -> Int -> Int -> Maybe v
go Int
i (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                      Ordering
GT -> Int -> Int -> Maybe v
go (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j
                                      Ordering
_  -> v -> Maybe v
forall a. a -> Maybe a
Just v
v

-- | /O(N)/ Insert new key value into map, replace old one if key exists.
insert :: Ord k => k -> v -> FlatMap k v -> FlatMap k v
{-# INLINE insert #-}
insert :: k -> v -> FlatMap k v -> FlatMap k v
insert k
k v
v (FlatMap vec :: Vector (k, v)
vec@(V.Vector SmallArray (k, v)
arr Int
s Int
l)) =
    case Vector (k, v) -> k -> Either Int Int
forall k v. Ord k => Vector (k, v) -> k -> Either Int Int
binarySearch Vector (k, v)
vec k
k of
        Left Int
i -> Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Int
-> (forall s. MArr (IArray Vector) s (k, v) -> ST s ())
-> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (\ MArr (IArray Vector) s (k, v)
marr -> do
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
0 SmallArray (k, v)
arr Int
s Int
i
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
i (k
k, v
v)
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
l) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallArray (k, v)
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)))
        Right Int
i -> Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (SmallArray (k, v) -> Int -> Int -> Vector (k, v)
forall a. SmallArray a -> Int -> Int -> Vector a
V.Vector ((forall s. ST s (SmallArray (k, v))) -> SmallArray (k, v)
forall a. (forall s. ST s a) -> a
runST (do
            let arr' :: SmallArray (k, v)
arr' = SmallArray (k, v) -> Int -> Int -> SmallArray (k, v)
forall a. SmallArray a -> Int -> Int -> SmallArray a
A.cloneSmallArray SmallArray (k, v)
arr Int
s Int
l
            SmallMutableArray s (k, v)
marr <- SmallArray (k, v)
-> ST s (SmallMutableArray (PrimState (ST s)) (k, v))
forall (m :: * -> *) a.
PrimMonad m =>
SmallArray a -> m (SmallMutableArray (PrimState m) a)
A.unsafeThawSmallArray SmallArray (k, v)
arr'
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
i (k
k, v
v)
            SmallMutableArray (PrimState (ST s)) (k, v)
-> ST s (SmallArray (k, v))
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> m (SmallArray a)
A.unsafeFreezeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr)) Int
0 Int
l)

-- | /O(N)/ Delete a key value pair by key.
delete :: Ord k => k -> FlatMap k v -> FlatMap k v
{-# INLINE delete #-}
delete :: k -> FlatMap k v -> FlatMap k v
delete k
k m :: FlatMap k v
m@(FlatMap vec :: Vector (k, v)
vec@(V.Vector SmallArray (k, v)
arr Int
s Int
l)) =
    case Vector (k, v) -> k -> Either Int Int
forall k v. Ord k => Vector (k, v) -> k -> Either Int Int
binarySearch Vector (k, v)
vec k
k of
        Left Int
_ -> FlatMap k v
m
        Right Int
i -> Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Vector (k, v) -> FlatMap k v) -> Vector (k, v) -> FlatMap k v
forall a b. (a -> b) -> a -> b
$ Int
-> (forall s. MArr (IArray Vector) s (k, v) -> ST s ())
-> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (\ MArr (IArray Vector) s (k, v)
marr -> do
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
iInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
0 SmallArray (k, v)
arr Int
s Int
i
            let i' :: Int
i' = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
            Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i'Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
l) (ST s () -> ST s ()) -> ST s () -> ST s ()
forall a b. (a -> b) -> a -> b
$ SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
i SmallArray (k, v)
arr (Int
i'Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'))

-- | /O(N)/ Modify a value by key.
--
-- The value is evaluated to WHNF before writing into map.
adjust' :: Ord k => (v -> v) -> k -> FlatMap k v -> FlatMap k v
{-# INLINE adjust' #-}
adjust' :: (v -> v) -> k -> FlatMap k v -> FlatMap k v
adjust' v -> v
f k
k m :: FlatMap k v
m@(FlatMap vec :: Vector (k, v)
vec@(V.Vector SmallArray (k, v)
arr Int
s Int
l)) =
    case Vector (k, v) -> k -> Either Int Int
forall k v. Ord k => Vector (k, v) -> k -> Either Int Int
binarySearch Vector (k, v)
vec k
k of
        Left Int
_ -> FlatMap k v
m
        Right Int
i -> Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Vector (k, v) -> FlatMap k v) -> Vector (k, v) -> FlatMap k v
forall a b. (a -> b) -> a -> b
$ Int
-> (forall s. MArr (IArray Vector) s (k, v) -> ST s ())
-> Vector (k, v)
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
V.create Int
l (\ MArr (IArray Vector) s (k, v)
marr -> do
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
0 SmallArray (k, v)
arr Int
s Int
l
            let !v' :: v
v' = v -> v
f ((k, v) -> v
forall a b. (a, b) -> b
snd (SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
A.indexSmallArray SmallArray (k, v)
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)))
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray (PrimState (ST s)) (k, v)
MArr (IArray Vector) s (k, v)
marr Int
i (k
k, v
v'))

-- | /O(n+m)/ Merge two 'FlatMap', prefer right value on key duplication.
merge :: forall k v. Ord k => FlatMap k v -> FlatMap k v -> FlatMap k v
{-# INLINE merge #-}
merge :: FlatMap k v -> FlatMap k v -> FlatMap k v
merge fmL :: FlatMap k v
fmL@(FlatMap (V.Vector SmallArray (k, v)
arrL Int
sL Int
lL)) fmR :: FlatMap k v
fmR@(FlatMap (V.Vector SmallArray (k, v)
arrR Int
sR Int
lR))
    | FlatMap k v -> Bool
forall k a. FlatMap k a -> Bool
null FlatMap k v
fmL = FlatMap k v
fmR
    | FlatMap k v -> Bool
forall k a. FlatMap k a -> Bool
null FlatMap k v
fmR = FlatMap k v
fmL
    | Bool
otherwise = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Int
-> (forall s. MArr (IArray Vector) s (k, v) -> ST s Int)
-> Vector (k, v)
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lR) (Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go Int
sL Int
sR Int
0))
  where
    endL :: Int
endL = Int
sL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lL
    endR :: Int
endR = Int
sR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lR
    go :: Int -> Int -> Int -> A.SmallMutableArray s (k, v) -> ST s Int
    go :: Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go !Int
i !Int
j !Int
k SmallMutableArray s (k, v)
marr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endL = do
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k SmallArray (k, v)
arrR Int
j (Int
lRInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j)
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lRInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j
        | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endR = do
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k SmallArray (k, v)
arrL Int
i (Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i
        | Bool
otherwise = do
            kvL :: (k, v)
kvL@(k
kL, v
_) <- SmallArray (k, v)
arrL SmallArray (k, v) -> Int -> ST s (k, v)
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
i
            kvR :: (k, v)
kvR@(k
kR, v
_) <- SmallArray (k, v)
arrR SmallArray (k, v) -> Int -> ST s (k, v)
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
j
            case k
kL k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
kR of Ordering
LT -> do SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k, v)
kvL
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, v)
marr
                                    Ordering
EQ -> do SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k, v)
kvR
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, v)
marr
                                    Ordering
_  -> do SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k, v)
kvR
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, v)
marr

-- | /O(n+m)/ Merge two 'FlatMap' with a merge function.
mergeWithKey' :: forall k v. Ord k => (k -> v -> v -> v) -> FlatMap k v -> FlatMap k v -> FlatMap k v
{-# INLINABLE mergeWithKey' #-}
mergeWithKey' :: (k -> v -> v -> v) -> FlatMap k v -> FlatMap k v -> FlatMap k v
mergeWithKey' k -> v -> v -> v
f fmL :: FlatMap k v
fmL@(FlatMap (V.Vector SmallArray (k, v)
arrL Int
sL Int
lL)) fmR :: FlatMap k v
fmR@(FlatMap (V.Vector SmallArray (k, v)
arrR Int
sR Int
lR))
    | FlatMap k v -> Bool
forall k a. FlatMap k a -> Bool
null FlatMap k v
fmL = FlatMap k v
fmR
    | FlatMap k v -> Bool
forall k a. FlatMap k a -> Bool
null FlatMap k v
fmR = FlatMap k v
fmL
    | Bool
otherwise = Vector (k, v) -> FlatMap k v
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Int
-> (forall s. MArr (IArray Vector) s (k, v) -> ST s Int)
-> Vector (k, v)
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
V.createN (Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lR) (Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go Int
sL Int
sR Int
0))
  where
    endL :: Int
endL = Int
sL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lL
    endR :: Int
endR = Int
sR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lR
    go :: Int -> Int -> Int -> A.SmallMutableArray s (k, v) -> ST s Int
    go :: Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go !Int
i !Int
j !Int
k SmallMutableArray s (k, v)
marr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endL = do
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k SmallArray (k, v)
arrR Int
j (Int
lRInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j)
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lRInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
j
        | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endR = do
            SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> SmallArray (k, v) -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k SmallArray (k, v)
arrL Int
i (Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
            Int -> ST s Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ST s Int) -> Int -> ST s Int
forall a b. (a -> b) -> a -> b
$! Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lLInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i
        | Bool
otherwise = do
            kvL :: (k, v)
kvL@(k
kL, v
vL) <- SmallArray (k, v)
arrL SmallArray (k, v) -> Int -> ST s (k, v)
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
i
            kvR :: (k, v)
kvR@(k
kR, v
vR) <- SmallArray (k, v)
arrR SmallArray (k, v) -> Int -> ST s (k, v)
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
j
            case k
kL k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
kR of Ordering
LT -> do SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k, v)
kvL
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, v)
marr
                                    Ordering
EQ -> do let !v' :: v
v' = k -> v -> v -> v
f k
kL v
vL v
vR
                                             SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k
kL, v
v')
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, v)
marr
                                    Ordering
_  -> do SmallMutableArray (PrimState (ST s)) (k, v)
-> Int -> (k, v) -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s (k, v)
SmallMutableArray (PrimState (ST s)) (k, v)
marr Int
k (k, v)
kvR
                                             Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
forall s.
Int -> Int -> Int -> SmallMutableArray s (k, v) -> ST s Int
go Int
i (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallMutableArray s (k, 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 :: (k -> v -> a -> a) -> a -> FlatMap k v -> a
{-# INLINE foldrWithKey #-}
foldrWithKey :: (k -> v -> a -> a) -> a -> FlatMap k v -> a
foldrWithKey k -> v -> a -> a
f a
a (FlatMap Vector (k, v)
vs) = ((k, v) -> a -> a) -> a -> Vector (k, v) -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((k -> v -> a -> a) -> (k, v) -> a -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> v -> a -> a
f) a
a Vector (k, 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 k is in ascending order.
foldlWithKey :: (a -> k -> v -> a) -> a -> FlatMap k v -> a
{-# INLINE foldlWithKey #-}
foldlWithKey :: (a -> k -> v -> a) -> a -> FlatMap k v -> a
foldlWithKey a -> k -> v -> a
f a
a (FlatMap Vector (k, v)
vs) = (a -> (k, v) -> a) -> a -> Vector (k, v) -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\ a
a' (k
k,v
v) -> a -> k -> v -> a
f a
a' k
k v
v) a
a Vector (k, 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 k is in descending order.
foldrWithKey' :: (k -> v -> a -> a) -> a -> FlatMap k v -> a
{-# INLINE foldrWithKey' #-}
foldrWithKey' :: (k -> v -> a -> a) -> a -> FlatMap k v -> a
foldrWithKey' k -> v -> a -> a
f a
a (FlatMap Vector (k, v)
vs) = ((k, v) -> a -> a) -> a -> Vector (k, v) -> a
forall (v :: * -> *) a b. Vec v a => (a -> b -> b) -> b -> v a -> b
V.foldr' ((k -> v -> a -> a) -> (k, v) -> a -> a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> v -> a -> a
f) a
a Vector (k, 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 k is in ascending order.
foldlWithKey' :: (a -> k -> v -> a) -> a -> FlatMap k v -> a
{-# INLINE foldlWithKey' #-}
foldlWithKey' :: (a -> k -> v -> a) -> a -> FlatMap k v -> a
foldlWithKey' a -> k -> v -> a
f a
a (FlatMap Vector (k, v)
vs) = (a -> (k, v) -> a) -> a -> Vector (k, v) -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
V.foldl' (\ a
a' (k
k,v
v) -> a -> k -> v -> a
f a
a' k
k v
v) a
a Vector (k, 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 => (k -> a -> t b) -> FlatMap k a -> t (FlatMap k b)
{-# INLINE traverseWithKey #-}
traverseWithKey :: (k -> a -> t b) -> FlatMap k a -> t (FlatMap k b)
traverseWithKey k -> a -> t b
f (FlatMap Vector (k, a)
vs) = Vector (k, b) -> FlatMap k b
forall k v. Vector (k, v) -> FlatMap k v
FlatMap (Vector (k, b) -> FlatMap k b)
-> t (Vector (k, b)) -> t (FlatMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((k, a) -> t (k, b)) -> Vector (k, a) -> t (Vector (k, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\ (k
k,a
v) -> (k
k,) (b -> (k, b)) -> t b -> t (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> a -> t b
f k
k a
v) Vector (k, 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 :: Ord k => V.Vector (k, v) -> k -> Either Int Int
{-# INLINABLE binarySearch #-}
binarySearch :: Vector (k, v) -> k -> Either Int Int
binarySearch (V.Vector SmallArray (k, v)
_ Int
_ Int
0) k
_   = Int -> Either Int Int
forall a b. a -> Either a b
Left Int
0
binarySearch (V.Vector SmallArray (k, v)
arr Int
s Int
l) !k
k' = Int -> Int -> Either Int Int
go Int
s (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  where
    go :: Int -> Int -> Either Int Int
go !Int
i !Int
j
        | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j =
            let (k
k, v
_)  = SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
i
            in case k
k' k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k of Ordering
LT -> Int -> Either Int Int
forall a b. a -> Either a b
Left Int
i
                                      Ordering
GT -> let !i' :: Int
i' = Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 in Int -> Either Int Int
forall a b. a -> Either a b
Left Int
i'
                                      Ordering
_  -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
j = Int -> Either Int Int
forall a b. a -> Either a b
Left Int
i
        | Bool
otherwise =
            let !mid :: Int
mid = (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
j) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
                (k
k, v
_)  = SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
mid
            in case k
k' k -> k -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` k
k of Ordering
LT -> Int -> Int -> Either Int Int
go Int
i (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
                                      Ordering
GT -> Int -> Int -> Either Int Int
go (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
j
                                      Ordering
_  -> Int -> Either Int Int
forall a b. b -> Either a b
Right Int
mid

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

-- | linear scan search from left to right, return the first one if exist.
linearSearch :: Ord k => V.Vector (k, v) -> k -> Maybe v
{-# INLINABLE linearSearch #-}
linearSearch :: Vector (k, v) -> k -> Maybe v
linearSearch (V.Vector SmallArray (k, v)
arr Int
s Int
l) !k
k' = Int -> Maybe v
go Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> Maybe v
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Maybe v
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let (k
k, v
v)  = SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
i
            in if k
k' k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then v -> Maybe v
forall a. a -> Maybe a
Just v
v else Int -> Maybe v
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | linear scan search from right to left, return the first one if exist.
linearSearchR :: Ord k => V.Vector (k, v) -> k -> Maybe v
{-# INLINABLE linearSearchR #-}
linearSearchR :: Vector (k, v) -> k -> Maybe v
linearSearchR (V.Vector SmallArray (k, v)
arr Int
s Int
l) !k
k' = Int -> Maybe v
go (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  where
    go :: Int -> Maybe v
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = Maybe v
forall a. Maybe a
Nothing
        | Bool
otherwise =
            let (k
k, v
v)  = SmallArray (k, v)
arr SmallArray (k, v) -> Int -> (k, v)
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
i
            in if k
k' k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k then v -> Maybe v
forall a. a -> Maybe a
Just v
v else Int -> Maybe v
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)