{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE BangPatterns #-}
{- OPTIONS_GHC -Wall #-}

-- | This is a port of the persistent vector from clojure to Haskell.
-- It is spine-strict and lazy in the elements.
--
-- The implementation is based on array mapped tries.  The complexity
-- bounds given are mostly O(1), but only if you are willing to accept
-- that the tree cannot have height greater than 7 on 32 bit systems
-- and maybe 8 on 64 bit systems.
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{- options_ghc -ddump-simpl #-}

module Data.Vector.Persistent (
  Vector,
  -- * Construction
  empty,
  singleton,
  snoc,
  fromList,
  append,
  -- * Queries
  null,
  length,
  -- * Indexing
  index,
  unsafeIndex,
  unsafeIndexA,
  unsafeIndex#,
  take,
  drop,
  splitAt,
  slice,
  -- ** Slicing Storage Management
  shrink,
  -- * Modification
  update,
  (//),
  -- * Folds
  foldr,
  foldr',
  foldl,
  foldl',
  -- * Transformations
  map,
  reverse,
  -- * Searches
  takeWhile,
  dropWhile,
  filter,
  partition
  ) where

import Prelude hiding
  ( null, length, tail, take
  , drop, map, foldr, foldl
  , reverse, splitAt, filter
  , takeWhile, dropWhile )

import qualified Control.Applicative as Ap
import Control.DeepSeq
import Data.Bits hiding (shiftR, shiftL)
import qualified Data.Foldable as F
import qualified Data.List as L
import Data.Semigroup as Sem
import qualified Data.Traversable as T
import Control.Applicative.Backwards

import Data.Vector.Persistent.Array ( Array )
import qualified Data.Vector.Persistent.Array as A
#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif

-- Note: using Int here doesn't give the full range of 32 bits on a 32
-- bit machine (it is fine on 64)

-- | Persistent vectors based on array mapped tries
data Vector a
  = RootNode
     { Vector a -> Int
vecSize :: !Int
     , Vector a -> Int
vecShift :: !Int
     , Vector a -> [a]
vecTail :: ![a]
     , Vector a -> Array (Vector_ a)
intVecPtrs :: !(Array (Vector_ a))
     }
  deriving Int -> Vector a -> ShowS
[Vector a] -> ShowS
Vector a -> String
(Int -> Vector a -> ShowS)
-> (Vector a -> String) -> ([Vector a] -> ShowS) -> Show (Vector a)
forall a. Show a => Int -> Vector a -> ShowS
forall a. Show a => [Vector a] -> ShowS
forall a. Show a => Vector a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector a] -> ShowS
$cshowList :: forall a. Show a => [Vector a] -> ShowS
show :: Vector a -> String
$cshow :: forall a. Show a => Vector a -> String
showsPrec :: Int -> Vector a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Vector a -> ShowS
Show

data Vector_ a
  = InternalNode
      { Vector_ a -> Array (Vector_ a)
intVecPtrs_ :: !(Array (Vector_ a))
      }
  | DataNode
      { Vector_ a -> Array a
dataVec :: !(Array a)
      }
  deriving Int -> Vector_ a -> ShowS
[Vector_ a] -> ShowS
Vector_ a -> String
(Int -> Vector_ a -> ShowS)
-> (Vector_ a -> String)
-> ([Vector_ a] -> ShowS)
-> Show (Vector_ a)
forall a. Show a => Int -> Vector_ a -> ShowS
forall a. Show a => [Vector_ a] -> ShowS
forall a. Show a => Vector_ a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector_ a] -> ShowS
$cshowList :: forall a. Show a => [Vector_ a] -> ShowS
show :: Vector_ a -> String
$cshow :: forall a. Show a => Vector_ a -> String
showsPrec :: Int -> Vector_ a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Vector_ a -> ShowS
Show

instance Eq a => Eq (Vector a) where
  == :: Vector a -> Vector a -> Bool
(==) = Vector a -> Vector a -> Bool
forall a. Eq a => Vector a -> Vector a -> Bool
pvEq

instance Eq a => Eq (Vector_ a) where
  == :: Vector_ a -> Vector_ a -> Bool
(==) = Vector_ a -> Vector_ a -> Bool
forall a. Eq a => Vector_ a -> Vector_ a -> Bool
pvEq_

instance Ord a => Ord (Vector a) where
  compare :: Vector a -> Vector a -> Ordering
compare = Vector a -> Vector a -> Ordering
forall a. Ord a => Vector a -> Vector a -> Ordering
pvCompare

instance Ord a => Ord (Vector_ a) where
  compare :: Vector_ a -> Vector_ a -> Ordering
compare = Vector_ a -> Vector_ a -> Ordering
forall a. Ord a => Vector_ a -> Vector_ a -> Ordering
pvCompare_

instance F.Foldable Vector where
  foldMap :: (a -> m) -> Vector a -> m
foldMap = (a -> m) -> Vector a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
T.foldMapDefault
  foldr :: (a -> b -> b) -> b -> Vector a -> b
foldr = (a -> b -> b) -> b -> Vector a -> b
forall a b. (a -> b -> b) -> b -> Vector a -> b
foldr
  foldl :: (b -> a -> b) -> b -> Vector a -> b
foldl = (b -> a -> b) -> b -> Vector a -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
foldl
#if MIN_VERSION_base(4,6,0)
  foldr' :: (a -> b -> b) -> b -> Vector a -> b
foldr' = (a -> b -> b) -> b -> Vector a -> b
forall a b. (a -> b -> b) -> b -> Vector a -> b
foldr'
  foldl' :: (b -> a -> b) -> b -> Vector a -> b
foldl' = (b -> a -> b) -> b -> Vector a -> b
forall b a. (b -> a -> b) -> b -> Vector a -> b
foldl'
#endif
#if MIN_VERSION_base(4,8,0)
  length :: Vector a -> Int
length = Vector a -> Int
forall a. Vector a -> Int
length
  null :: Vector a -> Bool
null = Vector a -> Bool
forall a. Vector a -> Bool
null
#endif

instance Functor Vector where
  fmap :: (a -> b) -> Vector a -> Vector b
fmap = (a -> b) -> Vector a -> Vector b
forall a b. (a -> b) -> Vector a -> Vector b
map

instance Sem.Semigroup (Vector a) where
  <> :: Vector a -> Vector a -> Vector a
(<>) = Vector a -> Vector a -> Vector a
forall a. Vector a -> Vector a -> Vector a
append

instance Monoid (Vector a) where
  mempty :: Vector a
mempty = Vector a
forall a. Vector a
empty
  -- Defined for compatibility with ghc 8.2
  mappend :: Vector a -> Vector a -> Vector a
mappend = Vector a -> Vector a -> Vector a
forall a. Semigroup a => a -> a -> a
(<>)

instance T.Traversable Vector where
  traverse :: (a -> f b) -> Vector a -> f (Vector b)
traverse = (a -> f b) -> Vector a -> f (Vector b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
pvTraverse

instance NFData a => NFData (Vector a) where
  rnf :: Vector a -> ()
rnf = Vector a -> ()
forall a. NFData a => Vector a -> ()
pvRnf

instance NFData a => NFData (Vector_ a) where
  rnf :: Vector_ a -> ()
rnf = Vector_ a -> ()
forall a. NFData a => Vector_ a -> ()
pvRnf_

shiftR :: Int -> Int -> Int
{-# INLINE shiftR #-}
shiftR :: Int -> Int -> Int
shiftR = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR

shiftL :: Int -> Int -> Int
{-# INLINE shiftL #-}
shiftL :: Int -> Int -> Int
shiftL = Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL

{-# INLINABLE pvEq #-}
pvEq :: Eq a => Vector a -> Vector a -> Bool
pvEq :: Vector a -> Vector a -> Bool
pvEq (RootNode Int
sz1 Int
sh1 [a]
t1 Array (Vector_ a)
v1) (RootNode Int
sz2 Int
sh2 [a]
t2 Array (Vector_ a)
v2) =
  Int
sz1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sz2 Bool -> Bool -> Bool
&& (Int
sz1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| (Int
sh1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sh2 Bool -> Bool -> Bool
&& [a]
t1 [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a]
t2 Bool -> Bool -> Bool
&& Array (Vector_ a)
v1 Array (Vector_ a) -> Array (Vector_ a) -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Vector_ a)
v2))

{-# INLINABLE pvEq_ #-}
pvEq_ :: Eq a => Vector_ a -> Vector_ a -> Bool
pvEq_ :: Vector_ a -> Vector_ a -> Bool
pvEq_ (DataNode Array a
a1) (DataNode Array a
a2) = Array a
a1 Array a -> Array a -> Bool
forall a. Eq a => a -> a -> Bool
== Array a
a2
pvEq_ (InternalNode Array (Vector_ a)
a1) (InternalNode Array (Vector_ a)
a2) = Array (Vector_ a)
a1 Array (Vector_ a) -> Array (Vector_ a) -> Bool
forall a. Eq a => a -> a -> Bool
== Array (Vector_ a)
a2
pvEq_ Vector_ a
_ Vector_ a
_ = Bool
False

{-# INLINABLE pvCompare #-}
pvCompare :: Ord a => Vector a -> Vector a -> Ordering
pvCompare :: Vector a -> Vector a -> Ordering
pvCompare (RootNode Int
sz1 Int
_ [a]
t1 Array (Vector_ a)
v1) (RootNode Int
sz2 Int
_ [a]
t2 Array (Vector_ a)
v2) =
  Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
sz1 Int
sz2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> if Int
sz1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Ordering
EQ else Array (Vector_ a) -> Array (Vector_ a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array (Vector_ a)
v1 Array (Vector_ a)
v2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
t1 [a]
t2

{-# INLINABLE pvCompare_ #-}
pvCompare_ :: Ord a => Vector_ a -> Vector_ a -> Ordering
pvCompare_ :: Vector_ a -> Vector_ a -> Ordering
pvCompare_ (DataNode Array a
a1) (DataNode Array a
a2) = Array a -> Array a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array a
a1 Array a
a2
pvCompare_ (InternalNode Array (Vector_ a)
a1) (InternalNode Array (Vector_ a)
a2) = Array (Vector_ a) -> Array (Vector_ a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Array (Vector_ a)
a1 Array (Vector_ a)
a2
pvCompare_ (DataNode Array a
_) (InternalNode Array (Vector_ a)
_) = Ordering
LT
pvCompare_ (InternalNode Array (Vector_ a)
_) (DataNode Array a
_) = Ordering
GT


{-# INLINABLE map #-}
-- | \( O(n) \) Map over the vector
map :: (a -> b) -> Vector a -> Vector b
map :: (a -> b) -> Vector a -> Vector b
map a -> b
f = Vector a -> Vector b
go
  where
    go :: Vector a -> Vector b
go (RootNode Int
sz Int
sh [a]
t Array (Vector_ a)
v) =
      let t' :: [b]
t' = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
L.map a -> b
f [a]
t
          v' :: Array (Vector_ b)
v' = (Vector_ a -> Vector_ b) -> Array (Vector_ a) -> Array (Vector_ b)
forall a b. (a -> b) -> Array a -> Array b
A.map Vector_ a -> Vector_ b
go_ Array (Vector_ a)
v
      in Int -> Int -> [b] -> Array (Vector_ b) -> Vector b
forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode Int
sz Int
sh [b]
t' Array (Vector_ b)
v'

    go_ :: Vector_ a -> Vector_ b
go_ (DataNode Array a
v) = Array b -> Vector_ b
forall a. Array a -> Vector_ a
DataNode ((a -> b) -> Array a -> Array b
forall a b. (a -> b) -> Array a -> Array b
A.map a -> b
f Array a
v)
    go_ (InternalNode Array (Vector_ a)
v) = Array (Vector_ b) -> Vector_ b
forall a. Array (Vector_ a) -> Vector_ a
InternalNode ((Vector_ a -> Vector_ b) -> Array (Vector_ a) -> Array (Vector_ b)
forall a b. (a -> b) -> Array a -> Array b
A.map Vector_ a -> Vector_ b
go_ Array (Vector_ a)
v)

{-# INLINE foldr #-}
-- | \( O(n) \) Right fold over the vector
foldr :: (a -> b -> b) -> b -> Vector a -> b
foldr :: (a -> b -> b) -> b -> Vector a -> b
foldr a -> b -> b
f = b -> Vector a -> b
go
  where
    go :: b -> Vector a -> b
go b
seed (RootNode Int
_ Int
_ [a]
t Array (Vector_ a)
as) = {-# SCC "gorRootNode" #-}
      let tseed :: b
tseed = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr a -> b -> b
f b
seed ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
t)
      in (Vector_ a -> b -> b) -> b -> Array (Vector_ a) -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr Vector_ a -> b -> b
go_ b
tseed Array (Vector_ a)
as
    go_ :: Vector_ a -> b -> b
go_ (DataNode Array a
a) b
seed = {-# SCC "gorDataNode" #-} (a -> b -> b) -> b -> Array a -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr a -> b -> b
f b
seed Array a
a
    go_ (InternalNode Array (Vector_ a)
as) b
seed = {-# SCC "gorInternalNode" #-}
      (Vector_ a -> b -> b) -> b -> Array (Vector_ a) -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr Vector_ a -> b -> b
go_ b
seed Array (Vector_ a)
as

-- | \( O(n) \) Strict right fold over the vector.
--
-- Note: Strict in the initial accumulator value.
foldr' :: (a -> b -> b) -> b -> Vector a -> b
{-# INLINE foldr' #-}
foldr' :: (a -> b -> b) -> b -> Vector a -> b
foldr' a -> b -> b
f = b -> Vector a -> b
go
  where
    go :: b -> Vector a -> b
go !b
seed (RootNode Int
_ Int
_ [a]
t Array (Vector_ a)
as) = {-# SCC "gorRootNode" #-}
      let !tseed :: b
tseed = (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f) b
seed [a]
t
      in (Vector_ a -> b -> b) -> b -> Array (Vector_ a) -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' Vector_ a -> b -> b
go_ b
tseed Array (Vector_ a)
as
    go_ :: Vector_ a -> b -> b
go_ (DataNode Array a
a) !b
seed = {-# SCC "gorDataNode" #-} (a -> b -> b) -> b -> Array a -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' a -> b -> b
f b
seed Array a
a
    go_ (InternalNode Array (Vector_ a)
as) !b
seed = {-# SCC "gorInternalNode" #-}
      (Vector_ a -> b -> b) -> b -> Array (Vector_ a) -> b
forall a b. (a -> b -> b) -> b -> Array a -> b
A.foldr' Vector_ a -> b -> b
go_ b
seed Array (Vector_ a)
as

-- | \( O(n) \) Left fold over the vector.
foldl :: (b -> a -> b) -> b -> Vector a -> b
{-# INLINE foldl #-}
foldl :: (b -> a -> b) -> b -> Vector a -> b
foldl b -> a -> b
f = b -> Vector a -> b
go
  where
    go :: b -> Vector a -> b
go b
seed (RootNode Int
_ Int
_ [a]
t Array (Vector_ a)
as) =
      let rseed :: b
rseed = (b -> Vector_ a -> b) -> b -> Array (Vector_ a) -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl b -> Vector_ a -> b
go_ b
seed Array (Vector_ a)
as
      in (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
rseed [a]
t

    go_ :: b -> Vector_ a -> b
go_ b
seed (DataNode Array a
a) = {-# SCC "golDataNode" #-} (b -> a -> b) -> b -> Array a -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl b -> a -> b
f b
seed Array a
a
    go_ b
seed (InternalNode Array (Vector_ a)
as) =
      (b -> Vector_ a -> b) -> b -> Array (Vector_ a) -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl b -> Vector_ a -> b
go_ b
seed Array (Vector_ a)
as

-- | \( O(n) \) Strict left fold over the vector.
--
-- Note: Strict in the initial accumulator value.
foldl' :: (b -> a -> b) -> b -> Vector a -> b
{-# INLINE foldl' #-}
foldl' :: (b -> a -> b) -> b -> Vector a -> b
foldl' b -> a -> b
f = b -> Vector a -> b
go
  where
    go :: b -> Vector a -> b
go !b
seed (RootNode Int
_ Int
_ [a]
t Array (Vector_ a)
as) =
      let !rseed :: b
rseed = (b -> Vector_ a -> b) -> b -> Array (Vector_ a) -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' b -> Vector_ a -> b
go_ b
seed Array (Vector_ a)
as
      in (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' b -> a -> b
f b
rseed ([a] -> [a]
forall a. [a] -> [a]
L.reverse [a]
t)
    go_ :: b -> Vector_ a -> b
go_ !b
seed (DataNode Array a
a) = {-# SCC "golDataNode" #-} (b -> a -> b) -> b -> Array a -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' b -> a -> b
f b
seed Array a
a
    go_ !b
seed (InternalNode Array (Vector_ a)
as) =
      (b -> Vector_ a -> b) -> b -> Array (Vector_ a) -> b
forall b a. (b -> a -> b) -> b -> Array a -> b
A.foldl' b -> Vector_ a -> b
go_ b
seed Array (Vector_ a)
as

{-# INLINE pvTraverse #-}
pvTraverse :: Ap.Applicative f => (a -> f b) -> Vector a -> f (Vector b)
pvTraverse :: (a -> f b) -> Vector a -> f (Vector b)
pvTraverse a -> f b
f = Vector a -> f (Vector b)
go
  where
    go :: Vector a -> f (Vector b)
go (RootNode Int
sz Int
sh [a]
t Array (Vector_ a)
as)
      | Int
sz Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Vector b -> f (Vector b)
forall (f :: * -> *) a. Applicative f => a -> f a
Ap.pure Vector b
forall a. Vector a
empty
      | Bool
otherwise = (Array (Vector_ b) -> [b] -> Vector b)
-> f (Array (Vector_ b)) -> f [b] -> f (Vector b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
Ap.liftA2 (\Array (Vector_ b)
as' [b]
t' -> Int -> Int -> [b] -> Array (Vector_ b) -> Vector b
forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode Int
sz Int
sh [b]
t' Array (Vector_ b)
as') ((Vector_ a -> f (Vector_ b))
-> Array (Vector_ a) -> f (Array (Vector_ b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverseArray Vector_ a -> f (Vector_ b)
go_ Array (Vector_ a)
as) (Backwards f [b] -> f [b]
forall k (f :: k -> *) (a :: k). Backwards f a -> f a
forwards (Backwards f [b] -> f [b]) -> Backwards f [b] -> f [b]
forall a b. (a -> b) -> a -> b
$ (a -> Backwards f b) -> [a] -> Backwards f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse (f b -> Backwards f b
forall k (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards (f b -> Backwards f b) -> (a -> f b) -> a -> Backwards f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) [a]
t)
    go_ :: Vector_ a -> f (Vector_ b)
go_ (DataNode Array a
a) = Array b -> Vector_ b
forall a. Array a -> Vector_ a
DataNode (Array b -> Vector_ b) -> f (Array b) -> f (Vector_ b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Ap.<$> (a -> f b) -> Array a -> f (Array b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverseArray a -> f b
f Array a
a
    go_ (InternalNode Array (Vector_ a)
as) = Array (Vector_ b) -> Vector_ b
forall a. Array (Vector_ a) -> Vector_ a
InternalNode (Array (Vector_ b) -> Vector_ b)
-> f (Array (Vector_ b)) -> f (Vector_ b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Ap.<$> (Vector_ a -> f (Vector_ b))
-> Array (Vector_ a) -> f (Array (Vector_ b))
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Array a -> f (Array b)
A.traverseArray Vector_ a -> f (Vector_ b)
go_ Array (Vector_ a)
as

-- | \( O(m) \) Append two 'Vector' instances
--
-- > append v1 v2
--
-- This operation is linear in the length of @v2@ (where @length v1 == n@ and @length v2 == m@).
append :: Vector a -> Vector a -> Vector a
append :: Vector a -> Vector a -> Vector a
append Vector a
v1 Vector a
v2
  | Vector a -> Bool
forall a. Vector a -> Bool
null Vector a
v1 = Vector a
v2
  | Vector a -> Bool
forall a. Vector a -> Bool
null Vector a
v2 = Vector a
v1
append Vector a
v1 Vector a
v2 = (Vector a -> a -> Vector a) -> Vector a -> Vector a -> Vector a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc Vector a
v1 Vector a
v2

{-# INLINABLE pvRnf #-}
pvRnf :: NFData a => Vector a -> ()
pvRnf :: Vector a -> ()
pvRnf (RootNode Int
_ Int
_ [a]
t Array (Vector_ a)
as) = Array (Vector_ a) -> ()
forall a. NFData a => a -> ()
rnf Array (Vector_ a)
as () -> () -> ()
`seq` [a] -> ()
forall a. NFData a => a -> ()
rnf [a]
t

{-# INLINABLE pvRnf_ #-}
pvRnf_ :: NFData a => Vector_ a -> ()
pvRnf_ :: Vector_ a -> ()
pvRnf_ (DataNode Array a
a) = Array a -> ()
forall a. NFData a => a -> ()
rnf Array a
a
pvRnf_ (InternalNode Array (Vector_ a)
a) = Array (Vector_ a) -> ()
forall a. NFData a => a -> ()
rnf Array (Vector_ a)
a

-- | \( O(1) \) The empty vector.
empty :: Vector a
empty :: Vector a
empty = Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode Int
0 Int
5 [] Array (Vector_ a)
forall a. Array a
A.empty

-- | \( O(1) \) Test to see if the vector is empty.
null :: Vector a -> Bool
null :: Vector a -> Bool
null Vector a
xs = Vector a -> Int
forall a. Vector a -> Int
length Vector a
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

-- | \( O(1) \) Get the length of the vector.
length :: Vector a -> Int
length :: Vector a -> Int
length RootNode { vecSize :: forall a. Vector a -> Int
vecSize = Int
s } = Int
s

-- | \( O(1) \) Bounds-checked indexing into a vector.
index :: Vector a -> Int -> Maybe a
index :: Vector a -> Int -> Maybe a
index Vector a
v Int
ix
  -- Check if the index is valid. This funny business uses a single test to
  -- determine whether ix is too small (negative) or too large (at least the
  -- length of the vector).
  | (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix :: Word) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector a -> Int
forall a. Vector a -> Int
length Vector a
v)
  = Vector a -> Int -> Maybe a
forall (f :: * -> *) a. Applicative f => Vector a -> Int -> f a
unsafeIndexA Vector a
v Int
ix
  | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

-- Index into a list from the rear.
--
-- revIx# [1..3] 0 = (# 3 #)
-- revIx# [1..3] 1 = (# 2 #)
-- revIx# [1..3] 2 = (# 1 #)
--
-- This is the same as reversing the list and then indexing
-- into it, but it doesn't need to allocate a reversed copy
-- of the list.
--
-- TODO: produce an error if the index is too large, instead of
-- just giving a wrong answer. This just requires a custom
-- version of `drop`.
revIx# :: [a] -> Int -> (# a #)
revIx# :: [a] -> Int -> (# a #)
revIx# [a]
xs Int
i = [a] -> [a] -> (# a #)
forall a b. [a] -> [b] -> (# a #)
go [a]
xs (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [a]
xs)
  where
    go :: [a] -> [b] -> (# a #)
    go :: [a] -> [b] -> (# a #)
go (a
a : [a]
_) [] = (# a
a #)
    go (a
_ : [a]
as) (b
_ : [b]
bs) = [a] -> [b] -> (# a #)
forall a b. [a] -> [b] -> (# a #)
go [a]
as [b]
bs
    go [a]
_ [b]
_ = String -> (# a #)
forall a. HasCallStack => String -> a
error String
"revIx#: Whoopsy!"

-- | \( O(1) \) Unchecked indexing into a vector.
--
-- Out-of-bounds indexing might not even crash—it will
-- usually just return nonsense values.
--
-- Note: the actual lookup is not performed until the result is forced.
-- This can cause a memory leak if the result of indexing is stored, unforced,
-- after the rest of the vector becomes garbage. To avoid this, use
-- 'unsafeIndexA' or 'unsafeIndex#' instead.
unsafeIndex :: Vector a -> Int -> a
unsafeIndex :: Vector a -> Int -> a
unsafeIndex Vector a
vec Int
ix
  | (# a
a #) <- Vector a -> Int -> (# a #)
forall a. Vector a -> Int -> (# a #)
unsafeIndex# Vector a
vec Int
ix
  = a
a

-- | \( O(1) \) Unchecked indexing into a vector in the context of an arbitrary
-- 'Ap.Applicative' functor. If the 'Ap.Applicative' is "strict" (such as 'IO',
-- (strict) @ST s@, (strict) @StateT@, or 'Maybe', but not @Identity@,
-- @ReaderT@, etc.), then the lookup is performed before the next action. This
-- avoids space leaks that can result from lazy uses of 'unsafeIndex'. See the
-- documentation for 'unsafeIndex#' for a custom 'Ap.Applicative' that can be
-- especially useful in conjunction with this function.
--
-- Note that out-of-bounds indexing might not even crash—it will usually just
-- return nonsense values.
unsafeIndexA :: Ap.Applicative f => Vector a -> Int -> f a
{-# INLINABLE unsafeIndexA #-}
unsafeIndexA :: Vector a -> Int -> f a
unsafeIndexA Vector a
vec Int
ix
  | (# a
a #) <- Vector a -> Int -> (# a #)
forall a. Vector a -> Int -> (# a #)
unsafeIndex# Vector a
vec Int
ix
  = a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
Ap.pure a
a

-- | \( O(1) \) Unchecked indexing into a vector.
--
-- Note that out-of-bounds indexing might not even crash—it will
-- usually just return nonsense values.
--
-- This function exists mostly because there is not, as yet, a well-known,
-- canonical, and convenient /lifted/ unary tuple. So we instead offer an
-- eager indexing function returning an /unlifted/ unary tuple. Users who
-- prefer to avoid such "low-level" features can do something like this:
--
-- @
-- data Solo a = Solo a deriving Functor
-- instance Applicative Solo where
--   pure = Solo
--   liftA2 f (Solo a) (Solo b) = Solo (f a b)
-- @
--
-- Now
--
-- @
-- unsafeIndexA :: Vector a -> Int -> Solo a
-- @
unsafeIndex# :: Vector a -> Int -> (# a #)
unsafeIndex# :: Vector a -> Int -> (# a #)
unsafeIndex# Vector a
vec Int
ix
  | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector a -> Int
forall a. Vector a -> Int
tailOffset Vector a
vec =
    (Vector a -> [a]
forall a. Vector a -> [a]
vecTail Vector a
vec) [a] -> Int -> (# a #)
forall a. [a] -> Int -> (# a #)
`revIx#` (Int
ix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f)
  | Bool
otherwise =
      let sh :: Int
sh = Vector a -> Int
forall a. Vector a -> Int
vecShift Vector a
vec
      in Int -> Vector_ a -> (# a #)
forall a. Int -> Vector_ a -> (# a #)
go (Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) (Array (Vector_ a) -> Int -> Vector_ a
forall a. Array a -> Int -> a
A.index (Vector a -> Array (Vector_ a)
forall a. Vector a -> Array (Vector_ a)
intVecPtrs Vector a
vec) (Int
ix Int -> Int -> Int
`shiftR` Int
sh))
  where
    go :: Int -> Vector_ a -> (# a #)
go Int
level Vector_ a
v
      | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Array a -> Int -> (# a #)
forall a. Array a -> Int -> (# a #)
A.index# (Vector_ a -> Array a
forall a. Vector_ a -> Array a
dataVec Vector_ a
v) (Int
ix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f)
      | Bool
otherwise =
        let nextVecIx :: Int
nextVecIx = (Int
ix Int -> Int -> Int
`shiftR` Int
level) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f
            v' :: Array (Vector_ a)
v' = Vector_ a -> Array (Vector_ a)
forall a. Vector_ a -> Array (Vector_ a)
intVecPtrs_ Vector_ a
v
        in Int -> Vector_ a -> (# a #)
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) (Array (Vector_ a) -> Int -> Vector_ a
forall a. Array a -> Int -> a
A.index Array (Vector_ a)
v' Int
nextVecIx)

-- | \( O(1) \) Construct a vector with a single element.
singleton :: a -> Vector a
singleton :: a -> Vector a
singleton a
elt =
  RootNode :: forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode { vecSize :: Int
vecSize = Int
1
           , vecShift :: Int
vecShift = Int
5
           , vecTail :: [a]
vecTail = [a
elt]
           , intVecPtrs :: Array (Vector_ a)
intVecPtrs = Array (Vector_ a)
forall a. Array a
A.empty
           }

-- | A helper to copy an array and add an element to the end.
arraySnoc :: Array a -> a -> Array a
arraySnoc :: Array a -> a -> Array a
arraySnoc !Array a
a a
elt = (forall s. ST s (MArray s a)) -> Array a
forall e. (forall s. ST s (MArray s e)) -> Array e
A.run ((forall s. ST s (MArray s a)) -> Array a)
-> (forall s. ST s (MArray s a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
  let alen :: Int
alen = Array a -> Int
forall a. Array a -> Int
A.length Array a
a
  MArray s a
a' <- Int -> ST s (MArray s a)
forall s a. Int -> ST s (MArray s a)
A.new_ (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
alen)
  Array a -> Int -> MArray s a -> Int -> Int -> ST s ()
forall e s. Array e -> Int -> MArray s e -> Int -> Int -> ST s ()
A.copy Array a
a Int
0 MArray s a
a' Int
0 Int
alen
  MArray s a -> Int -> a -> ST s ()
forall s a. MArray s a -> Int -> a -> ST s ()
A.write MArray s a
a' Int
alen a
elt
  MArray s a -> ST s (MArray s a)
forall (m :: * -> *) a. Monad m => a -> m a
return MArray s a
a'

-- | \( O(1) \) Append an element to the end of the vector.
snoc :: Vector a -> a -> Vector a
-- We break this up into two pieces. We let the common case inline:
-- that is the case of a nonempty vector with room in its tail.
-- The case of an empty vector isn't common enough to bother inlining,
-- and the case of a full tail is expensive anyway, so there's nothing
-- to be gained by inlining. The remaining question: do we actually
-- benefit from letting *any* of this inline? To be determined, but my
-- guess is a strong maybe.
snoc :: Vector a -> a -> Vector a
snoc v :: Vector a
v@RootNode { vecSize :: forall a. Vector a -> Int
vecSize = Int
sz, vecTail :: forall a. Vector a -> [a]
vecTail = [a]
t } a
elt
  -- Room in tail, and vector non-empty
  | Int
sz Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Vector a
v { vecTail :: [a]
vecTail = a
elt a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
t, vecSize :: Int
vecSize = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 }
  | Bool
otherwise = Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snocMain Vector a
v a
elt

snocMain :: Vector a -> a -> Vector a
{-# NOINLINE snocMain #-}
snocMain :: Vector a -> a -> Vector a
snocMain Vector a
v a
elt
  | Vector a -> Bool
forall a. Vector a -> Bool
null Vector a
v = a -> Vector a
forall a. a -> Vector a
singleton a
elt
snocMain v :: Vector a
v@RootNode { vecSize :: forall a. Vector a -> Int
vecSize = Int
sz, vecShift :: forall a. Vector a -> Int
vecShift = Int
sh, vecTail :: forall a. Vector a -> [a]
vecTail = [a]
t } a
elt
  -- Overflow current root
  | Int
sz Int -> Int -> Int
`shiftR` Int
5 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Int -> Int -> Int
`shiftL` Int
sh =
    RootNode :: forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode { vecSize :: Int
vecSize = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
             , vecShift :: Int
vecShift = Int
sh Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5
             , vecTail :: [a]
vecTail = [a
elt]
             , intVecPtrs :: Array (Vector_ a)
intVecPtrs =
                 let !np :: Vector_ a
np = Int -> [a] -> Vector_ a
forall a. Int -> [a] -> Vector_ a
newPath Int
sh [a]
t
                 in Int -> [Vector_ a] -> Array (Vector_ a)
forall a. Int -> [a] -> Array a
A.fromList Int
2 [ Array (Vector_ a) -> Vector_ a
forall a. Array (Vector_ a) -> Vector_ a
InternalNode (Vector a -> Array (Vector_ a)
forall a. Vector a -> Array (Vector_ a)
intVecPtrs Vector a
v)
                                 , Vector_ a
np
                                 ]
             }
  -- Insert into the tree
  | Bool
otherwise =
      RootNode :: forall a. Int -> Int -> [a] -> Array (Vector_ a) -> Vector a
RootNode { vecSize :: Int
vecSize = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
               , vecShift :: Int
vecShift = Int
sh
               , vecTail :: [a]
vecTail = [a
elt]
               , intVecPtrs :: Array (Vector_ a)
intVecPtrs = Int -> [a] -> Int -> Array (Vector_ a) -> Array (Vector_ a)
forall a.
Int -> [a] -> Int -> Array (Vector_ a) -> Array (Vector_ a)
pushTail Int
sz [a]
t Int
sh (Vector a -> Array (Vector_ a)
forall a. Vector a -> Array (Vector_ a)
intVecPtrs Vector a
v)
               }

-- | A recursive helper for 'snoc'.  This finds the place to add new
-- elements.
pushTail :: Int -> [a] -> Int -> Array (Vector_ a) -> Array (Vector_ a)
pushTail :: Int -> [a] -> Int -> Array (Vector_ a) -> Array (Vector_ a)
pushTail !Int
cnt [a]
t !Int
foo !Array (Vector_ a)
bar = Int -> Array (Vector_ a) -> Array (Vector_ a)
go Int
foo Array (Vector_ a)
bar
  where
    go :: Int -> Array (Vector_ a) -> Array (Vector_ a)
go !Int
level !Array (Vector_ a)
parent
      | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = Array (Vector_ a) -> Vector_ a -> Array (Vector_ a)
forall a. Array a -> a -> Array a
arraySnoc Array (Vector_ a)
parent (Vector_ a -> Array (Vector_ a)) -> Vector_ a -> Array (Vector_ a)
forall a b. (a -> b) -> a -> b
$! Array a -> Vector_ a
forall a. Array a -> Vector_ a
DataNode (Int -> [a] -> Array a
forall a. Int -> [a] -> Array a
A.fromListRev Int
32 [a]
t)
      | Int
subIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Array (Vector_ a) -> Int
forall a. Array a -> Int
A.length Array (Vector_ a)
parent =
        let nextVec :: Vector_ a
nextVec = Array (Vector_ a) -> Int -> Vector_ a
forall a. Array a -> Int -> a
A.index Array (Vector_ a)
parent Int
subIdx
            toInsert :: Array (Vector_ a)
toInsert = Int -> Array (Vector_ a) -> Array (Vector_ a)
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) (Vector_ a -> Array (Vector_ a)
forall a. Vector_ a -> Array (Vector_ a)
intVecPtrs_ Vector_ a
nextVec)
        in Array (Vector_ a) -> Int -> Vector_ a -> Array (Vector_ a)
forall e. Array e -> Int -> e -> Array e
A.update Array (Vector_ a)
parent Int
subIdx (Vector_ a -> Array (Vector_ a)) -> Vector_ a -> Array (Vector_ a)
forall a b. (a -> b) -> a -> b
$! Array (Vector_ a) -> Vector_ a
forall a. Array (Vector_ a) -> Vector_ a
InternalNode Array (Vector_ a)
toInsert
      | Bool
otherwise = Array (Vector_ a) -> Vector_ a -> Array (Vector_ a)
forall a. Array a -> a -> Array a
arraySnoc Array (Vector_ a)
parent (Vector_ a -> Array (Vector_ a)) -> Vector_ a -> Array (Vector_ a)
forall a b. (a -> b) -> a -> b
$! Int -> [a] -> Vector_ a
forall a. Int -> [a] -> Vector_ a
newPath (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) [a]
t
      where
        subIdx :: Int
subIdx = ((Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
`shiftR` Int
level) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f

-- | The other recursive helper for 'snoc'.  This one builds out a
-- sub-tree to the current depth.
newPath :: Int -> [a] -> Vector_ a
newPath :: Int -> [a] -> Vector_ a
newPath Int
level [a]
t
  | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Array a -> Vector_ a
forall a. Array a -> Vector_ a
DataNode (Int -> [a] -> Array a
forall a. Int -> [a] -> Array a
A.fromListRev Int
32 [a]
t)
  | Bool
otherwise = Array (Vector_ a) -> Vector_ a
forall a. Array (Vector_ a) -> Vector_ a
InternalNode (Array (Vector_ a) -> Vector_ a) -> Array (Vector_ a) -> Vector_ a
forall a b. (a -> b) -> a -> b
$ Vector_ a -> Array (Vector_ a)
forall a. a -> Array a
A.singleton (Vector_ a -> Array (Vector_ a)) -> Vector_ a -> Array (Vector_ a)
forall a b. (a -> b) -> a -> b
$! Int -> [a] -> Vector_ a
forall a. Int -> [a] -> Vector_ a
newPath (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) [a]
t

-- | Update a single element at @ix@ with new value @elt@.
updateList :: Int -> a -> [a] -> [a]
-- We do this pretty strictly to avoid building up thunks in the tail
-- and to release the replaced value promptly.
updateList :: Int -> a -> [a] -> [a]
updateList !Int
_ a
_ [] = []
updateList Int
0 a
x (a
_ : [a]
ys) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys
updateList Int
n a
x (a
y : [a]
ys) = (a
y a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$! Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
updateList (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) a
x [a]
ys

-- | \( O(1) \) Update a single element at @ix@ with new value @elt@ in @v@.
--
-- > update ix elt v
update :: Int -> a -> Vector a -> Vector a
update :: Int -> a -> Vector a -> Vector a
update Int
ix a
elt v :: Vector a
v@(RootNode { vecSize :: forall a. Vector a -> Int
vecSize = Int
sz, vecShift :: forall a. Vector a -> Int
vecShift = Int
sh, vecTail :: forall a. Vector a -> [a]
vecTail = [a]
t })
  -- Invalid index. This funny business uses a single test to determine whether
  -- ix is too small (negative) or too large (at least sz).
  | (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix :: Word) Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz = Vector a
v
  -- Item is in tail
  | Int
ix Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Vector a -> Int
forall a. Vector a -> Int
tailOffset Vector a
v =
    let tix :: Int
tix = Int
sz Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix
    in Vector a
v { vecTail :: [a]
vecTail = Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
updateList Int
tix a
elt [a]
t}
  -- Otherwise the item to be replaced is in the tree
  | Bool
otherwise = Vector a
v { intVecPtrs :: Array (Vector_ a)
intVecPtrs = Int -> Array (Vector_ a) -> Array (Vector_ a)
go Int
sh (Vector a -> Array (Vector_ a)
forall a. Vector a -> Array (Vector_ a)
intVecPtrs Vector a
v) }
  where
    go :: Int -> Array (Vector_ a) -> Array (Vector_ a)
go Int
level Array (Vector_ a)
vec
      -- At the data level, modify the vector and start propagating it up
      | Int
level Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 =
        let !dnode :: Vector_ a
dnode = Array a -> Vector_ a
forall a. Array a -> Vector_ a
DataNode (Array a -> Vector_ a) -> Array a -> Vector_ a
forall a b. (a -> b) -> a -> b
$ Array a -> Int -> a -> Array a
forall e. Array e -> Int -> e -> Array e
A.update (Vector_ a -> Array a
forall a. Vector_ a -> Array a
dataVec Vector_ a
vec') (Int
ix Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f) a
elt
        in Array (Vector_ a) -> Int -> Vector_ a -> Array (Vector_ a)
forall e. Array e -> Int -> e -> Array e
A.update Array (Vector_ a)
vec Int
vix Vector_ a
dnode
      -- In the tree, find the appropriate sub-array, call
      -- recursively, and re-allocate current array
      | Bool
otherwise =
          let !rnode :: Array (Vector_ a)
rnode = Int -> Array (Vector_ a) -> Array (Vector_ a)
go (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5) (Vector_ a -> Array (Vector_ a)
forall a. Vector_ a -> Array (Vector_ a)
intVecPtrs_ Vector_ a
vec')
          in Array (Vector_ a) -> Int -> Vector_ a -> Array (Vector_ a)
forall e. Array e -> Int -> e -> Array e
A.update Array (Vector_ a)
vec Int
vix (Array (Vector_ a) -> Vector_ a
forall a. Array (Vector_ a) -> Vector_ a
InternalNode Array (Vector_ a)
rnode)
      where
        vix :: Int
vix = (Int
ix Int -> Int -> Int
`shiftR` Int
level) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x1f
        vec' :: Vector_ a
vec' = Array (Vector_ a) -> Int -> Vector_ a
forall a. Array a -> Int -> a
A.index Array (Vector_ a)
vec Int
vix

-- | \( O(n) \) Bulk update.
--
-- > v // updates
--
-- For each @(index, element)@ pair in @updates@, modify @v@ such that
-- the @index@th position of @v@ is @element@.
-- Indices in @updates@ that are not in @v@ are ignored. The updates are
-- applied in order, so the last one at each index takes effegct.
(//) :: Vector a -> [(Int, a)] -> Vector a
-- Note: we fully apply foldl' to get everything to unbox.
// :: Vector a -> [(Int, a)] -> Vector a
(//) Vector a
vec = (Vector a -> (Int, a) -> Vector a)
-> Vector a -> [(Int, a)] -> Vector a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl' Vector a -> (Int, a) -> Vector a
forall a. Vector a -> (Int, a) -> Vector a
replaceElement Vector a
vec
  where
    replaceElement :: Vector a -> (Int, a) -> Vector a
replaceElement Vector a
v (Int
ix, a
a) = Int -> a -> Vector a -> Vector a
forall a. Int -> a -> Vector a -> Vector a
update Int
ix a
a Vector a
v

-- | The index of the first element of the tail of the vector (that is, the
-- *last* element of the list representing the tail). This is also the number
-- of elements stored in the array tree.
--
-- Caution: Only gives a sensible result if the vector is nonempty.
tailOffset :: Vector a -> Int
tailOffset :: Vector a -> Int
tailOffset Vector a
v = (Vector a -> Int
forall a. Vector a -> Int
length Vector a
v Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. ((-Int
1) Int -> Int -> Int
`shiftL` Int
5)

-- | \( O(n) \) Reverse a vector
reverse :: Vector a -> Vector a
{-# NOINLINE reverse #-}
reverse :: Vector a -> Vector a
reverse = (a -> Vector a -> Vector a) -> Vector a -> Vector a -> Vector a
forall a b. (a -> b -> b) -> b -> Vector a -> b
foldr' ((Vector a -> a -> Vector a) -> a -> Vector a -> Vector a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc) Vector a
forall a. Vector a
empty

-- | \( O(n) \) Filter according to the predicate.
filter :: (a -> Bool) -> Vector a -> Vector a
filter :: (a -> Bool) -> Vector a -> Vector a
filter a -> Bool
p = \ !Vector a
vec -> (Vector a -> a -> Vector a) -> Vector a -> Vector a -> Vector a
forall b a. (b -> a -> b) -> b -> Vector a -> b
foldl' Vector a -> a -> Vector a
go Vector a
forall a. Vector a
empty Vector a
vec
  where
    go :: Vector a -> a -> Vector a
go !Vector a
acc a
e = if a -> Bool
p a
e then Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc Vector a
acc a
e else Vector a
acc

-- | \( O(n) \) Return the elements that do and do not obey the predicate
partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
partition :: (a -> Bool) -> Vector a -> (Vector a, Vector a)
partition a -> Bool
p Vector a
v0 = case (TwoVec a -> a -> TwoVec a) -> TwoVec a -> Vector a -> TwoVec a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' TwoVec a -> a -> TwoVec a
go (Vector a -> Vector a -> TwoVec a
forall a. Vector a -> Vector a -> TwoVec a
TwoVec Vector a
forall a. Vector a
empty Vector a
forall a. Vector a
empty) Vector a
v0 of
  TwoVec Vector a
v1 Vector a
v2 -> (Vector a
v1, Vector a
v2)
  where
    go :: TwoVec a -> a -> TwoVec a
go (TwoVec Vector a
atrue Vector a
afalse) a
e =
      if a -> Bool
p a
e then Vector a -> Vector a -> TwoVec a
forall a. Vector a -> Vector a -> TwoVec a
TwoVec (Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc Vector a
atrue a
e) Vector a
afalse else Vector a -> Vector a -> TwoVec a
forall a. Vector a -> Vector a -> TwoVec a
TwoVec Vector a
atrue (Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc Vector a
afalse a
e)

data TwoVec a = TwoVec {-# UNPACK #-} !(Vector a) {-# UNPACK #-} !(Vector a)

-- | \( O(n) \) Construct a vector from a list
fromList :: [a] -> Vector a
fromList :: [a] -> Vector a
fromList = (Vector a -> a -> Vector a) -> Vector a -> [a] -> Vector a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Vector a -> a -> Vector a
forall a. Vector a -> a -> Vector a
snoc Vector a
forall a. Vector a
empty

-- | \( O(n) \) Take @n@ elements starting from the start of the 'Vector'
take :: Int -> Vector a -> Vector a
take :: Int -> Vector a -> Vector a
take Int
n Vector a
v = [a] -> Vector a
forall a. [a] -> Vector a
fromList (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
n (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector a
v))

-- | \( O(n) \) Drop @n@ elements starting from the start of the 'Vector'
drop :: Int -> Vector a -> Vector a
drop :: Int -> Vector a -> Vector a
drop Int
n Vector a
v = [a] -> Vector a
forall a. [a] -> Vector a
fromList (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop Int
n (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector a
v))

-- | \( O(n) \) Split the vector into two at the given index
--
-- Note that this function strictly computes both result vectors (once the tuple
-- itself is reduced to whnf)
splitAt :: Int -> Vector a -> (Vector a, Vector a)
splitAt :: Int -> Vector a -> (Vector a, Vector a)
splitAt Int
idx Vector a
v
  | ([a]
front_list, [a]
rear_list) <- Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
L.splitAt Int
idx (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector a
v)
  , !Vector a
front <- [a] -> Vector a
forall a. [a] -> Vector a
fromList [a]
front_list
  , !Vector a
rear <- [a] -> Vector a
forall a. [a] -> Vector a
fromList [a]
rear_list
  = (Vector a
front, Vector a
rear)

-- | \( O(n) \) Return a slice of @v@ of length @length@ starting at index
-- @start@.  The returned vector may have fewer than @length@ elements
-- if the bounds are off on either side (the start is negative or
-- length takes it past the end).
--
-- A slice of negative or zero length is the empty vector.
--
-- > slice start length v
slice :: Int -> Int -> Vector a -> Vector a
slice :: Int -> Int -> Vector a -> Vector a
slice Int
start Int
len Vector a
v = [a] -> Vector a
forall a. [a] -> Vector a
fromList (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.take Int
len (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
L.drop Int
start (Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Vector a
v)))

-- | \( O(1) \) Drop any unused space in the vector
--
-- NOTE: This is currently the identity
shrink :: Vector a -> Vector a
shrink :: Vector a -> Vector a
shrink = Vector a -> Vector a
forall a. a -> a
id

-- | \( O(n) \) Apply a predicate p to the vector, returning the longest prefix of elements that satisfy p.
takeWhile :: (a -> Bool) -> Vector a -> Vector a
takeWhile :: (a -> Bool) -> Vector a -> Vector a
takeWhile a -> Bool
p = [a] -> Vector a
forall a. [a] -> Vector a
fromList ([a] -> Vector a) -> (Vector a -> [a]) -> Vector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.takeWhile a -> Bool
p ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

-- | \( O(n) \) Returns the longest suffix after takeWhile p v.
dropWhile :: (a -> Bool) -> Vector a -> Vector a
dropWhile :: (a -> Bool) -> Vector a -> Vector a
dropWhile a -> Bool
p = [a] -> Vector a
forall a. [a] -> Vector a
fromList ([a] -> Vector a) -> (Vector a -> [a]) -> Vector a -> Vector a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhile a -> Bool
p ([a] -> [a]) -> (Vector a -> [a]) -> Vector a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList