{-|
Module      : Z.Data.Vector.FlatSet
Description : Fast set 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 value set based on sorted vector and binary search. It's particularly
suitable for small sized value collections such as deserializing intermediate representation.
But can also used in various place where insertion and deletion is rare but require fast elem.

-}

module Z.Data.Vector.FlatSet
  ( -- * FlatSet backed by sorted vector
    FlatSet, sortedValues, size, null, empty, map'
  , pack, packN, packR, packRN
  , unpack, unpackR, packVector, packVectorR
  , elem
  , delete
  , insert
  , merge
    -- * search on vectors
  , binarySearch
  ) where

import           Control.DeepSeq
import           Control.Monad
import           Control.Monad.ST
import qualified Data.Primitive.SmallArray  as A
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.Bits                   (unsafeShiftR)
import           Data.Data
import           Prelude hiding (elem, null)
import           Test.QuickCheck.Arbitrary (Arbitrary(..), CoArbitrary(..))

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

newtype FlatSet v = FlatSet { FlatSet v -> Vector v
sortedValues :: V.Vector v }
    deriving (Int -> FlatSet v -> ShowS
[FlatSet v] -> ShowS
FlatSet v -> String
(Int -> FlatSet v -> ShowS)
-> (FlatSet v -> String)
-> ([FlatSet v] -> ShowS)
-> Show (FlatSet v)
forall v. Show v => Int -> FlatSet v -> ShowS
forall v. Show v => [FlatSet v] -> ShowS
forall v. Show v => FlatSet v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlatSet v] -> ShowS
$cshowList :: forall v. Show v => [FlatSet v] -> ShowS
show :: FlatSet v -> String
$cshow :: forall v. Show v => FlatSet v -> String
showsPrec :: Int -> FlatSet v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> FlatSet v -> ShowS
Show, FlatSet v -> FlatSet v -> Bool
(FlatSet v -> FlatSet v -> Bool)
-> (FlatSet v -> FlatSet v -> Bool) -> Eq (FlatSet v)
forall v. Eq v => FlatSet v -> FlatSet v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FlatSet v -> FlatSet v -> Bool
$c/= :: forall v. Eq v => FlatSet v -> FlatSet v -> Bool
== :: FlatSet v -> FlatSet v -> Bool
$c== :: forall v. Eq v => FlatSet v -> FlatSet v -> Bool
Eq, Eq (FlatSet v)
Eq (FlatSet v)
-> (FlatSet v -> FlatSet v -> Ordering)
-> (FlatSet v -> FlatSet v -> Bool)
-> (FlatSet v -> FlatSet v -> Bool)
-> (FlatSet v -> FlatSet v -> Bool)
-> (FlatSet v -> FlatSet v -> Bool)
-> (FlatSet v -> FlatSet v -> FlatSet v)
-> (FlatSet v -> FlatSet v -> FlatSet v)
-> Ord (FlatSet v)
FlatSet v -> FlatSet v -> Bool
FlatSet v -> FlatSet v -> Ordering
FlatSet v -> FlatSet v -> FlatSet 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 (FlatSet v)
forall v. Ord v => FlatSet v -> FlatSet v -> Bool
forall v. Ord v => FlatSet v -> FlatSet v -> Ordering
forall v. Ord v => FlatSet v -> FlatSet v -> FlatSet v
min :: FlatSet v -> FlatSet v -> FlatSet v
$cmin :: forall v. Ord v => FlatSet v -> FlatSet v -> FlatSet v
max :: FlatSet v -> FlatSet v -> FlatSet v
$cmax :: forall v. Ord v => FlatSet v -> FlatSet v -> FlatSet v
>= :: FlatSet v -> FlatSet v -> Bool
$c>= :: forall v. Ord v => FlatSet v -> FlatSet v -> Bool
> :: FlatSet v -> FlatSet v -> Bool
$c> :: forall v. Ord v => FlatSet v -> FlatSet v -> Bool
<= :: FlatSet v -> FlatSet v -> Bool
$c<= :: forall v. Ord v => FlatSet v -> FlatSet v -> Bool
< :: FlatSet v -> FlatSet v -> Bool
$c< :: forall v. Ord v => FlatSet v -> FlatSet v -> Bool
compare :: FlatSet v -> FlatSet v -> Ordering
$ccompare :: forall v. Ord v => FlatSet v -> FlatSet v -> Ordering
$cp1Ord :: forall v. Ord v => Eq (FlatSet v)
Ord, Typeable, a -> FlatSet a -> Bool
FlatSet m -> m
FlatSet a -> [a]
FlatSet a -> Bool
FlatSet a -> Int
FlatSet a -> a
FlatSet a -> a
FlatSet a -> a
FlatSet a -> a
(a -> m) -> FlatSet a -> m
(a -> m) -> FlatSet a -> m
(a -> b -> b) -> b -> FlatSet a -> b
(a -> b -> b) -> b -> FlatSet a -> b
(b -> a -> b) -> b -> FlatSet a -> b
(b -> a -> b) -> b -> FlatSet a -> b
(a -> a -> a) -> FlatSet a -> a
(a -> a -> a) -> FlatSet a -> a
(forall m. Monoid m => FlatSet m -> m)
-> (forall m a. Monoid m => (a -> m) -> FlatSet a -> m)
-> (forall m a. Monoid m => (a -> m) -> FlatSet a -> m)
-> (forall a b. (a -> b -> b) -> b -> FlatSet a -> b)
-> (forall a b. (a -> b -> b) -> b -> FlatSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> FlatSet a -> b)
-> (forall b a. (b -> a -> b) -> b -> FlatSet a -> b)
-> (forall a. (a -> a -> a) -> FlatSet a -> a)
-> (forall a. (a -> a -> a) -> FlatSet a -> a)
-> (forall a. FlatSet a -> [a])
-> (forall a. FlatSet a -> Bool)
-> (forall a. FlatSet a -> Int)
-> (forall a. Eq a => a -> FlatSet a -> Bool)
-> (forall a. Ord a => FlatSet a -> a)
-> (forall a. Ord a => FlatSet a -> a)
-> (forall a. Num a => FlatSet a -> a)
-> (forall a. Num a => FlatSet a -> a)
-> Foldable FlatSet
forall a. Eq a => a -> FlatSet a -> Bool
forall a. Num a => FlatSet a -> a
forall a. Ord a => FlatSet a -> a
forall m. Monoid m => FlatSet m -> m
forall a. FlatSet a -> Bool
forall a. FlatSet a -> Int
forall a. FlatSet a -> [a]
forall a. (a -> a -> a) -> FlatSet a -> a
forall m a. Monoid m => (a -> m) -> FlatSet a -> m
forall b a. (b -> a -> b) -> b -> FlatSet a -> b
forall a b. (a -> b -> b) -> b -> FlatSet a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: FlatSet a -> a
$cproduct :: forall a. Num a => FlatSet a -> a
sum :: FlatSet a -> a
$csum :: forall a. Num a => FlatSet a -> a
minimum :: FlatSet a -> a
$cminimum :: forall a. Ord a => FlatSet a -> a
maximum :: FlatSet a -> a
$cmaximum :: forall a. Ord a => FlatSet a -> a
elem :: a -> FlatSet a -> Bool
$celem :: forall a. Eq a => a -> FlatSet a -> Bool
length :: FlatSet a -> Int
$clength :: forall a. FlatSet a -> Int
null :: FlatSet a -> Bool
$cnull :: forall a. FlatSet a -> Bool
toList :: FlatSet a -> [a]
$ctoList :: forall a. FlatSet a -> [a]
foldl1 :: (a -> a -> a) -> FlatSet a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FlatSet a -> a
foldr1 :: (a -> a -> a) -> FlatSet a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FlatSet a -> a
foldl' :: (b -> a -> b) -> b -> FlatSet a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FlatSet a -> b
foldl :: (b -> a -> b) -> b -> FlatSet a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FlatSet a -> b
foldr' :: (a -> b -> b) -> b -> FlatSet a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FlatSet a -> b
foldr :: (a -> b -> b) -> b -> FlatSet a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FlatSet a -> b
foldMap' :: (a -> m) -> FlatSet a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FlatSet a -> m
foldMap :: (a -> m) -> FlatSet a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FlatSet a -> m
fold :: FlatSet m -> m
$cfold :: forall m. Monoid m => FlatSet m -> m
Foldable)

instance T.Print v => T.Print (FlatSet v) where
    {-# INLINE toUTF8BuilderP #-}
    toUTF8BuilderP :: Int -> FlatSet v -> Builder ()
toUTF8BuilderP Int
p (FlatSet Vector 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 ()
"FlatSet{"
        Builder () -> (v -> Builder ()) -> Vector v -> Builder ()
forall (v :: * -> *) a.
Vec v a =>
Builder () -> (a -> Builder ()) -> v a -> Builder ()
T.intercalateVec Builder ()
T.comma v -> Builder ()
forall a. Print a => a -> Builder ()
T.toUTF8Builder Vector v
vec
        Char -> Builder ()
T.char7 Char
'}'

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

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

instance NFData v => NFData (FlatSet v) where
    {-# INLINE rnf #-}
    rnf :: FlatSet v -> ()
rnf (FlatSet Vector v
vs) = Vector v -> ()
forall a. NFData a => a -> ()
rnf Vector v
vs

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

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

size :: FlatSet v -> Int
{-# INLINE size #-}
size :: FlatSet v -> Int
size = Vector v -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
V.length (Vector v -> Int) -> (FlatSet v -> Vector v) -> FlatSet v -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet v -> Vector v
forall v. FlatSet v -> Vector v
sortedValues

null :: FlatSet v -> Bool
{-# INLINE null #-}
null :: FlatSet v -> Bool
null = Vector v -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
V.null (Vector v -> Bool) -> (FlatSet v -> Vector v) -> FlatSet v -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet v -> Vector v
forall v. FlatSet v -> Vector v
sortedValues

-- | Mapping values of within a set, the result size may change if there're duplicated values
-- after mapping.
map' :: forall v. Ord v => (v -> v) -> FlatSet v -> FlatSet v
{-# INLINE map' #-}
map' :: (v -> v) -> FlatSet v -> FlatSet v
map' v -> v
f (FlatSet Vector v
vs) = Vector v -> FlatSet v
forall v. Ord v => Vector v -> FlatSet v
packVector ((v -> v) -> Vector v -> Vector v
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
V.map' v -> v
f Vector v
vs :: V.Vector v)

-- | /O(1)/ empty flat set.
empty :: FlatSet v
{-# INLINE empty #-}
empty :: FlatSet v
empty = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet Vector v
forall (v :: * -> *) a. Vec v a => v a
V.empty

-- | /O(N*logN)/ Pack list of values, on duplication prefer left one.
pack :: Ord v => [v] -> FlatSet v
{-# INLINE pack #-}
pack :: [v] -> FlatSet v
pack [v]
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort ([v] -> Vector v
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [v]
vs)))

-- | /O(N*logN)/ Pack list of values with suggested size, on duplication prefer left one.
packN :: Ord v => Int -> [v] -> FlatSet v
{-# INLINE packN #-}
packN :: Int -> [v] -> FlatSet v
packN Int
n [v]
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort (Int -> [v] -> Vector v
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [v]
vs)))

-- | /O(N*logN)/ Pack list of values, on duplication prefer right one.
packR :: Ord v => [v] -> FlatSet v
{-# INLINE packR #-}
packR :: [v] -> FlatSet v
packR [v]
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort ([v] -> Vector v
forall (v :: * -> *) a. Vec v a => [a] -> v a
V.pack [v]
vs)))

-- | /O(N*logN)/ Pack list of values with suggested size, on duplication prefer right one.
packRN :: Ord v => Int -> [v] -> FlatSet v
{-# INLINE packRN #-}
packRN :: Int -> [v] -> FlatSet v
packRN Int
n [v]
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort (Int -> [v] -> Vector v
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
V.packN Int
n [v]
vs)))

-- | /O(N)/ Unpack a set of values to a list s in ascending order.
--
-- This function works with @foldr/build@ fusion in base.
unpack :: FlatSet v -> [v]
{-# INLINE unpack #-}
unpack :: FlatSet v -> [v]
unpack = Vector v -> [v]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpack (Vector v -> [v]) -> (FlatSet v -> Vector v) -> FlatSet v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet v -> Vector v
forall v. FlatSet v -> Vector v
sortedValues

-- | /O(N)/ Unpack a set of values to a list s in descending order.
--
-- This function works with @foldr/build@ fusion in base.
unpackR :: FlatSet v -> [v]
{-# INLINE unpackR #-}
unpackR :: FlatSet v -> [v]
unpackR = Vector v -> [v]
forall (v :: * -> *) a. Vec v a => v a -> [a]
V.unpackR (Vector v -> [v]) -> (FlatSet v -> Vector v) -> FlatSet v -> [v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlatSet v -> Vector v
forall v. FlatSet v -> Vector v
sortedValues

-- | /O(N*logN)/ Pack vector of values, on duplication prefer left one.
packVector :: Ord v => V.Vector v -> FlatSet v
{-# INLINE packVector #-}
packVector :: Vector v -> FlatSet v
packVector Vector v
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentLeft v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort Vector v
vs))

-- | /O(N*logN)/ Pack vector of values, on duplication prefer right one.
packVectorR :: Ord v => V.Vector v -> FlatSet v
{-# INLINE packVectorR #-}
packVectorR :: Vector v -> FlatSet v
packVectorR Vector v
vs = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet ((v -> v -> Bool) -> Vector v -> Vector v
forall (v :: * -> *) a. Vec v a => (a -> a -> Bool) -> v a -> v a
V.mergeDupAdjacentRight v -> v -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Vector v -> Vector v
forall (v :: * -> *) a. (Vec v a, Ord a) => v a -> v a
V.mergeSort Vector v
vs))

-- | /O(logN)/ Binary search on flat set.
elem :: Ord v => v -> FlatSet v -> Bool
{-# INLINE elem #-}
elem :: v -> FlatSet v -> Bool
elem v
v (FlatSet Vector v
vec) = case Vector v -> v -> Either Int Int
forall v. Ord v => Vector v -> v -> Either Int Int
binarySearch Vector v
vec v
v of Left Int
_ -> Bool
False
                                                  Either Int Int
_      -> Bool
True

-- | /O(N)/ Insert new value into set.
insert :: Ord v => v -> FlatSet v -> FlatSet v
{-# INLINE insert #-}
insert :: v -> FlatSet v -> FlatSet v
insert v
v m :: FlatSet v
m@(FlatSet vec :: Vector v
vec@(V.Vector SmallArray v
arr Int
s Int
l)) =
    case Vector v -> v -> Either Int Int
forall v. Ord v => Vector v -> v -> Either Int Int
binarySearch Vector v
vec v
v of
        Left Int
i -> Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet (Int -> (forall s. MArr (IArray Vector) s v -> ST s ()) -> Vector 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 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)) v
-> Int -> SmallArray 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)) v
MArr (IArray Vector) s v
marr Int
0 SmallArray v
arr Int
s Int
i
            SmallMutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray (PrimState (ST s)) v
MArr (IArray Vector) s v
marr Int
i 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)) v
-> Int -> SmallArray 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)) v
MArr (IArray Vector) s v
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) SmallArray 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
_ -> FlatSet v
m

-- | /O(N)/ Delete a value from set.
delete :: Ord v => v -> FlatSet v -> FlatSet v
{-# INLINE delete #-}
delete :: v -> FlatSet v -> FlatSet v
delete v
v m :: FlatSet v
m@(FlatSet vec :: Vector v
vec@(V.Vector SmallArray v
arr Int
s Int
l)) =
    case Vector v -> v -> Either Int Int
forall v. Ord v => Vector v -> v -> Either Int Int
binarySearch Vector v
vec v
v of
        Left Int
_ -> FlatSet v
m
        Right Int
i -> Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet (Vector v -> FlatSet v) -> Vector v -> FlatSet v
forall a b. (a -> b) -> a -> b
$ Int -> (forall s. MArr (IArray Vector) s v -> ST s ()) -> Vector 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 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)) v
-> Int -> SmallArray 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)) v
MArr (IArray Vector) s v
marr Int
0 SmallArray 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)) v
-> Int -> SmallArray 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)) v
MArr (IArray Vector) s v
marr Int
i SmallArray 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+m)/ Merge two 'FlatSet', prefer right value on value duplication.
merge :: forall v . Ord v => FlatSet v -> FlatSet v -> FlatSet v
{-# INLINE merge #-}
merge :: FlatSet v -> FlatSet v -> FlatSet v
merge fmL :: FlatSet v
fmL@(FlatSet (V.Vector SmallArray v
arrL Int
sL Int
lL)) fmR :: FlatSet v
fmR@(FlatSet (V.Vector SmallArray v
arrR Int
sR Int
lR))
    | FlatSet v -> Bool
forall a. FlatSet a -> Bool
null FlatSet v
fmL = FlatSet v
fmR
    | FlatSet v -> Bool
forall a. FlatSet a -> Bool
null FlatSet v
fmR = FlatSet v
fmL
    | Bool
otherwise = Vector v -> FlatSet v
forall v. Vector v -> FlatSet v
FlatSet (Int -> (forall s. MArr (IArray Vector) s v -> ST s Int) -> Vector 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 v -> ST s Int
forall s. Int -> Int -> Int -> SmallMutableArray s 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 v -> ST s Int
    go :: Int -> Int -> Int -> SmallMutableArray s v -> ST s Int
go !Int
i !Int
j !Int
k SmallMutableArray s v
marr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endL = do
            SmallMutableArray (PrimState (ST s)) v
-> Int -> SmallArray v -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s v
SmallMutableArray (PrimState (ST s)) v
marr Int
k SmallArray 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)) v
-> Int -> SmallArray v -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a
-> Int -> SmallArray a -> Int -> Int -> m ()
A.copySmallArray SmallMutableArray s v
SmallMutableArray (PrimState (ST s)) v
marr Int
k SmallArray 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
            v
vL <- SmallArray v
arrL SmallArray v -> Int -> ST s v
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
i
            v
vR <- SmallArray v
arrR SmallArray v -> Int -> ST s v
forall (m :: * -> *) a. Monad m => SmallArray a -> Int -> m a
`A.indexSmallArrayM` Int
j
            case v
vL v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` v
vR of Ordering
LT -> do SmallMutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s v
SmallMutableArray (PrimState (ST s)) v
marr Int
k v
vL
                                             Int -> Int -> Int -> SmallMutableArray s v -> ST s Int
forall s. Int -> Int -> Int -> SmallMutableArray s 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 v
marr
                                    Ordering
EQ -> do SmallMutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s v
SmallMutableArray (PrimState (ST s)) v
marr Int
k v
vR
                                             Int -> Int -> Int -> SmallMutableArray s v -> ST s Int
forall s. Int -> Int -> Int -> SmallMutableArray s 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 v
marr
                                    Ordering
_  -> do SmallMutableArray (PrimState (ST s)) v -> Int -> v -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
SmallMutableArray (PrimState m) a -> Int -> a -> m ()
A.writeSmallArray SmallMutableArray s v
SmallMutableArray (PrimState (ST s)) v
marr Int
k v
vR
                                             Int -> Int -> Int -> SmallMutableArray s v -> ST s Int
forall s. Int -> Int -> Int -> SmallMutableArray s 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 v
marr

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

-- | Find the value's index in the vector, if value exists return 'Right',
-- otherwise 'Left', i.e. the insert index
--
-- This function only works on ascending sorted vectors.
binarySearch :: Ord v => V.Vector v -> v -> Either Int Int
{-# INLINABLE binarySearch #-}
binarySearch :: Vector v -> v -> Either Int Int
binarySearch (V.Vector SmallArray v
_ Int
_ Int
0) v
_   = Int -> Either Int Int
forall a b. a -> Either a b
Left Int
0
binarySearch (V.Vector SmallArray v
arr Int
s0 Int
l) !v
v' = Int -> Int -> Either Int Int
go Int
s0 (Int
s0Int -> 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
s !Int
e
        | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
e =
            let v :: v
v = SmallArray v
arr SmallArray v -> Int -> v
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
s
            in case v
v' v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` v
v of Ordering
LT -> Int -> Either Int Int
forall a b. a -> Either a b
Left (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s0)
                                      Ordering
GT -> let !s' :: Int
s' = Int
sInt -> 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
s'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s0)
                                      Ordering
_  -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s0)
        | Int
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
e = Int -> Either Int Int
forall a b. a -> Either a b
Left Int
s
        | Bool
otherwise =
            let !mid :: Int
mid = (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
e) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
1
                v :: v
v = SmallArray v
arr SmallArray v -> Int -> v
forall a. SmallArray a -> Int -> a
`A.indexSmallArray` Int
mid
            in case v
v' v -> v -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` v
v of Ordering
LT -> Int -> Int -> Either Int Int
go Int
s (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
e
                                      Ordering
_  -> Int -> Either Int Int
forall a b. b -> Either a b
Right (Int
midInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s0)