{-|
Module      : Z.Data.Vector.Base
Description : Fast boxed and unboxed 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 unified vector interface. Conceptually a vector is simply a slice of an array, for example this is the definition of boxed vector:

@
data Vector a = Vector !(SmallArray a)   !Int    !Int
                     -- payload           offset  length
@

The 'Vec' class unified different type of vectors, and this module provide operation over 'Vec' instances, with all the internal structures. Be careful on modifying internal slices, otherwise segmentation fault await.

-}

module Z.Data.Vector.Base (
  -- * The Vec typeclass
    Vec(..)
  , pattern Vec
  , arrVec
  , indexMaybe
  -- * Boxed and unboxed vector type
  , Vector(..)
  , PrimVector(..)
  -- ** Word8 vector
  , Bytes, packASCII
  -- * Creating utilities
  , create, create', creating, creating', createN, createN2
  , empty, singleton, copy
  -- * Conversion between list
  , pack, packN, packN', packR, packRN, packRN'
  , unpack, unpackR
  -- * Basic interface
  , null
  , length
  , append
  , map, map', imap', traverseVec, traverseWithIndex, traverseVec_, traverseWithIndex_
  , foldl', ifoldl', foldl1', foldl1Maybe'
  , foldr', ifoldr', foldr1', foldr1Maybe'
    -- ** Special folds
  , concat, concatMap
  , maximum, minimum, maximumMaybe, minimumMaybe
  , sum
  , count
  , product, product'
  , all, any
  -- * Building vector
  -- ** Accumulating maps
  , mapAccumL
  , mapAccumR
  -- ** Generating and unfolding vector
  , replicate
  , cycleN
  , unfoldr
  , unfoldrN
  -- * Searching by equality
  , elem, notElem, elemIndex
  -- * Misc
  , IPair(..), mapIPair', fromIPair, toIPair
  , defaultInitSize
  , chunkOverhead
  , defaultChunkSize
  , smallChunkSize
  , VectorException(..)
  , errorEmptyVector
  , errorOutRange
  , castVector
  -- * C FFI
  , c_strcmp
  , c_memchr
  , c_memrchr
  , c_strlen
  , c_ascii_validate_addr
  , c_fnv_hash_addr
  , c_fnv_hash_ba
 ) where

import           Control.DeepSeq
import           Control.Exception
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Char                      (ord)
import qualified Data.Foldable                  as F
import           Data.Kind                      (Type)
import           Data.Hashable                  (Hashable(..))
import           Data.Hashable.Lifted           (Hashable1(..), hashWithSalt1)
import qualified Data.List                      as List
import           Data.List.NonEmpty       (NonEmpty ((:|)))
import           Data.Maybe
import qualified Data.CaseInsensitive           as CI
import           Data.Primitive
import           Data.Primitive.Ptr
import           Data.Semigroup                 (Semigroup (..))
import qualified Data.Traversable               as T
import           Foreign.C
import           GHC.Exts
import           GHC.Stack
import           GHC.CString
import           GHC.Word
import           Prelude                        hiding (concat, concatMap,
                                                elem, notElem, null, length, map,
                                                foldl, foldl1, foldr, foldr1,
                                                maximum, minimum, product, sum,
                                                all, any, replicate, traverse)
import           Test.QuickCheck.Arbitrary      (Arbitrary(..), CoArbitrary(..))
import           Test.QuickCheck.Gen            (chooseInt)
import           Text.Read                      (Read(..))
import           System.IO.Unsafe               (unsafeDupablePerformIO)

import           Z.Data.Array
import           Z.Data.ASCII                   (toLower)

-- | Typeclass for box and unboxed vectors, which are created by slicing arrays.
--
-- Instead of providing a generalized vector with polymorphric array field, we use this typeclass
-- so that instances use concrete array type can unpack their array payload.
--
-- Vector types, e.g. 'Vector','PrimVector'... are obivious instances, with O(1) 'toArr' and
-- 'fromArr', which convert slices to (array, offset, length) tuple back and forth.
--
-- Array types can also be instances of this class, e.g. 'Array', 'PrimArray'..., in this case
-- 'toArr' will always return offset 0 and whole array length, and 'fromArr' is O(n) 'copyArr'.
class (Arr (IArray v) a) => Vec v a where
    -- | Vector's immutable array type
    type IArray v :: Type -> Type
    -- | Get underline array and slice range(offset and length).
    toArr :: v a -> (IArray v a, Int, Int)
    -- | Create a vector by slicing an array(with offset and length).
    fromArr :: IArray v a -> Int -> Int -> v a

-- | Construct a 'Vec' by slicing a whole array.
arrVec :: Vec v a => IArray v a -> v a
{-# INLINE arrVec #-}
arrVec :: IArray v a -> v a
arrVec IArray v a
arr = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr Int
0 (IArray v a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr IArray v a
arr)

instance Vec Array a where
    type IArray Array = Array
    {-# INLINE toArr #-}
    toArr :: Array a -> (IArray Array a, Int, Int)
toArr Array a
arr = (Array a
IArray Array a
arr, Int
0, Array a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr Array a
arr)
    {-# INLINE fromArr #-}
    fromArr :: IArray Array a -> Int -> Int -> Array a
fromArr = IArray Array a -> Int -> Int -> Array a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
fromArray

instance Vec SmallArray a where
    type IArray SmallArray = SmallArray
    {-# INLINE toArr #-}
    toArr :: SmallArray a -> (IArray SmallArray a, Int, Int)
toArr SmallArray a
arr = (SmallArray a
IArray SmallArray a
arr, Int
0, SmallArray a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr SmallArray a
arr)
    {-# INLINE fromArr #-}
    fromArr :: IArray SmallArray a -> Int -> Int -> SmallArray a
fromArr = IArray SmallArray a -> Int -> Int -> SmallArray a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
fromArray

instance Prim a => Vec PrimArray a where
    type IArray PrimArray = PrimArray
    {-# INLINE toArr #-}
    toArr :: PrimArray a -> (IArray PrimArray a, Int, Int)
toArr PrimArray a
arr = (PrimArray a
IArray PrimArray a
arr, Int
0, PrimArray a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr PrimArray a
arr)
    {-# INLINE fromArr #-}
    fromArr :: IArray PrimArray a -> Int -> Int -> PrimArray a
fromArr = IArray PrimArray a -> Int -> Int -> PrimArray a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
fromArray

instance PrimUnlifted a => Vec UnliftedArray a where
    type IArray UnliftedArray = UnliftedArray
    {-# INLINE toArr #-}
    toArr :: UnliftedArray a -> (IArray UnliftedArray a, Int, Int)
toArr UnliftedArray a
arr = (UnliftedArray a
IArray UnliftedArray a
arr, Int
0, UnliftedArray a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr UnliftedArray a
arr)
    {-# INLINE fromArr #-}
    fromArr :: IArray UnliftedArray a -> Int -> Int -> UnliftedArray a
fromArr = IArray UnliftedArray a -> Int -> Int -> UnliftedArray a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
fromArray

fromArray :: Arr arr a => arr a -> Int -> Int -> arr a
{-# INLINE fromArray #-}
fromArray :: arr a -> Int -> Int -> arr a
fromArray arr a
arr Int
offset Int
len | Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& arr a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr arr a
arr Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len = arr a
arr
                         | Bool
otherwise = arr a -> Int -> Int -> arr a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> Int -> arr a
cloneArr arr a
arr Int
offset Int
len

-- | A pattern synonyms for matching the underline array, offset and length.
--
-- This is a bidirectional pattern synonyms, but very unsafe if not use properly.
-- Make sure your slice is within array's bounds!
pattern Vec :: Vec v a => IArray v a -> Int -> Int -> v a
pattern $bVec :: IArray v a -> Int -> Int -> v a
$mVec :: forall r (v :: * -> *) a.
Vec v a =>
v a -> (IArray v a -> Int -> Int -> r) -> (Void# -> r) -> r
Vec arr s l <- (toArr -> (arr,s,l)) where
        Vec IArray v a
arr Int
s Int
l = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr Int
s Int
l

-- | /O(1)/ Index vector's element.
--
-- Return 'Nothing' if index is out of bounds.
--
indexMaybe :: Vec v a => v a -> Int -> Maybe a
{-# INLINE indexMaybe #-}
indexMaybe :: v a -> Int -> Maybe a
indexMaybe (Vec IArray v a
arr Int
s Int
l) Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = Maybe a
forall a. Maybe a
Nothing
                           | Bool
otherwise       = IArray v a
arr IArray v a -> Int -> Maybe a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
`indexArrM` (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)

--------------------------------------------------------------------------------
-- | Boxed vector
--
data Vector a = Vector
    {-# UNPACK #-} !(SmallArray a)  -- ^ payload
    {-# UNPACK #-} !Int             -- ^ offset
    {-# UNPACK #-} !Int             -- ^ length

instance Vec Vector a where
    type IArray Vector = SmallArray
    {-# INLINE toArr #-}
    toArr :: Vector a -> (IArray Vector a, Int, Int)
toArr (Vector SmallArray a
arr Int
s Int
l) = (SmallArray a
IArray Vector a
arr, Int
s, Int
l)
    {-# INLINE fromArr #-}
    fromArr :: IArray Vector a -> Int -> Int -> Vector a
fromArr = IArray Vector a -> Int -> Int -> Vector a
forall a. SmallArray a -> Int -> Int -> Vector a
Vector

instance IsList (Vector a) where
    type Item (Vector a) = a
    {-# INLINE fromList #-}
    fromList :: [Item (Vector a)] -> Vector a
fromList = [Item (Vector a)] -> Vector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack
    {-# INLINE toList #-}
    toList :: Vector a -> [Item (Vector a)]
toList = Vector a -> [Item (Vector a)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack
    {-# INLINE fromListN #-}
    fromListN :: Int -> [Item (Vector a)] -> Vector a
fromListN = Int -> [Item (Vector a)] -> Vector a
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packN

instance Eq a => Eq (Vector a) where
    {-# INLINABLE (==) #-}
    Vector a
v1 == :: Vector a -> Vector a -> Bool
== Vector a
v2 = Vector a -> Vector a -> Bool
forall a. Eq a => Vector a -> Vector a -> Bool
eqVector Vector a
v1 Vector a
v2

eqVector :: Eq a => Vector a -> Vector a -> Bool
{-# INLINE eqVector #-}
eqVector :: Vector a -> Vector a -> Bool
eqVector (Vector SmallArray a
baA Int
sA Int
lA) (Vector SmallArray a
baB Int
sB Int
lB)
    | SmallArray a
baA SmallArray a -> SmallArray a -> Bool
forall (arr :: * -> *) a. Arr arr a => arr a -> arr a -> Bool
`sameArr` SmallArray a
baB =
        if Int
sA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sB then Int
lA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lB else Int
lA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lB Bool -> Bool -> Bool
&& Int -> Int -> Bool
go Int
sA Int
sB
    | Bool
otherwise = Int
lA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lB Bool -> Bool -> Bool
&& Int -> Int -> Bool
go Int
sA Int
sB
  where
    !endA :: Int
endA = Int
sA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lA
    go :: Int -> Int -> Bool
go !Int
i !Int
j
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endA = Bool
True
        | Bool
otherwise =
            (SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
baA Int
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
baB Int
j) Bool -> Bool -> Bool
&& Int -> Int -> Bool
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)

instance Ord a => Ord (Vector a) where
    {-# INLINABLE compare #-}
    compare :: Vector a -> Vector a -> Ordering
compare = Vector a -> Vector a -> Ordering
forall a. Ord a => Vector a -> Vector a -> Ordering
compareVector

compareVector :: Ord a => Vector a -> Vector a -> Ordering
{-# INLINE compareVector #-}
compareVector :: Vector a -> Vector a -> Ordering
compareVector (Vector SmallArray a
baA Int
sA Int
lA) (Vector SmallArray a
baB Int
sB Int
lB)
    | SmallArray a
baA SmallArray a -> SmallArray a -> Bool
forall (arr :: * -> *) a. Arr arr a => arr a -> arr a -> Bool
`sameArr` SmallArray a
baB = if Int
sA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sB then Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB else Int -> Int -> Ordering
go Int
sA Int
sB
    | Bool
otherwise = Int -> Int -> Ordering
go Int
sA Int
sB
  where
    !endA :: Int
endA = Int
sA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lA
    !endB :: Int
endB = Int
sB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lB
    go :: Int -> Int -> Ordering
go !Int
i !Int
j | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endA  = Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB
             | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endB  = Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB
             | Bool
otherwise = let o :: Ordering
o = SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
baA Int
i a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` SmallArray a -> Int -> a
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray a
baB Int
j
                           in case Ordering
o of Ordering
EQ -> Int -> Int -> Ordering
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)
                                        Ordering
x  -> Ordering
x

instance Semigroup (Vector a) where
    {-# INLINE (<>) #-}
    <> :: Vector a -> Vector a -> Vector a
(<>)    = Vector a -> Vector a -> Vector a
forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
append
    {-# INLINE sconcat #-}
    sconcat :: NonEmpty (Vector a) -> Vector a
sconcat (Vector a
b:|[Vector a]
bs) = [Vector a] -> Vector a
forall (v :: * -> *) a. Vec v a => [v a] -> v a
concat (Vector a
bVector a -> [Vector a] -> [Vector a]
forall a. a -> [a] -> [a]
:[Vector a]
bs)
    {-# INLINE stimes #-}
    stimes :: b -> Vector a -> Vector a
stimes  = b -> Vector a -> Vector a
forall (v :: * -> *) a x. (Vec v a, Integral x) => x -> v a -> v a
_cycleN

instance Monoid (Vector a) where
    {-# INLINE mempty #-}
    mempty :: Vector a
mempty  = Vector a
forall (v :: * -> *) a. Vec v a => v a
empty
    {-# INLINE mappend #-}
    mappend :: Vector a -> Vector a -> Vector a
mappend = Vector a -> Vector a -> Vector a
forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
append
    {-# INLINE mconcat #-}
    mconcat :: [Vector a] -> Vector a
mconcat = [Vector a] -> Vector a
forall (v :: * -> *) a. Vec v a => [v a] -> v a
concat

instance NFData a => NFData (Vector a) where
    {-# INLINE rnf #-}
    rnf :: Vector a -> ()
rnf (Vector SmallArray a
arr Int
s Int
l) = Int -> ()
go Int
s
      where
        !end :: Int
end = Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l
        go :: Int -> ()
go !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end   = case SmallArray a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' SmallArray a
arr Int
i of (# a
x #) -> a
x a -> () -> ()
`seq` Int -> ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
              | Bool
otherwise = ()

instance (Show a) => Show (Vector a) where
    showsPrec :: Int -> Vector a -> ShowS
showsPrec Int
p Vector a
v = Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (Vector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack Vector a
v)

instance (Read a) => Read (Vector a) where
    readPrec :: ReadPrec (Vector a)
readPrec = [a] -> Vector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([a] -> Vector a) -> ReadPrec [a] -> ReadPrec (Vector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec

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

instance F.Foldable Vector where
    {-# INLINE foldr' #-}
    foldr' :: (a -> b -> b) -> b -> Vector a -> b
foldr' = (a -> b -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b. Vec v a => (a -> b -> b) -> b -> v a -> b
foldr'
    {-# INLINE foldr #-}
    foldr :: (a -> b -> b) -> b -> Vector a -> b
foldr a -> b -> b
f b
acc = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr a -> b -> b
f b
acc ([a] -> b) -> (Vector a -> [a]) -> Vector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack
    {-# INLINE foldl' #-}
    foldl' :: (b -> a -> b) -> b -> Vector a -> b
foldl' = (b -> a -> b) -> b -> Vector a -> b
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl'
    {-# INLINE foldl #-}
    foldl :: (b -> a -> b) -> b -> Vector a -> b
foldl b -> a -> b
f b
acc = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr ((b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f) b
acc ([a] -> b) -> (Vector a -> [a]) -> Vector a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpackR
    {-# INLINE toList #-}
    toList :: Vector a -> [a]
toList = Vector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack
    {-# INLINE null #-}
    null :: Vector a -> Bool
null = Vector a -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
null
    {-# INLINE length #-}
    length :: Vector a -> Int
length = Vector a -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
length
    {-# INLINE elem #-}
    elem :: a -> Vector a -> Bool
elem = a -> Vector a -> Bool
forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Bool
elem
    {-# INLINE maximum #-}
    maximum :: Vector a -> a
maximum = Vector a -> a
forall (v :: * -> *) a. (Vec v a, Ord a, HasCallStack) => v a -> a
maximum
    {-# INLINE minimum #-}
    minimum :: Vector a -> a
minimum = Vector a -> a
forall (v :: * -> *) a. (Vec v a, Ord a, HasCallStack) => v a -> a
minimum
    {-# INLINE product #-}
    product :: Vector a -> a
product = Vector a -> a
forall (v :: * -> *) a. (Vec v a, Num a) => v a -> a
product
    {-# INLINE sum #-}
    sum :: Vector a -> a
sum = Vector a -> a
forall (v :: * -> *) a. (Vec v a, Num a) => v a -> a
sum

instance T.Traversable Vector where
    {-# INLINE traverse #-}
    traverse :: (a -> f b) -> Vector a -> f (Vector b)
traverse = (a -> f b) -> Vector a -> f (Vector b)
forall (v :: * -> *) a (u :: * -> *) b (f :: * -> *).
(Vec v a, Vec u b, Applicative f) =>
(a -> f b) -> v a -> f (u b)
traverseVec

instance Arbitrary a => Arbitrary (Vector a) where
    arbitrary :: Gen (Vector a)
arbitrary = do
        [a]
vs <- Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
        let l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
vs
        Int
s <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
l)
        Int
l' <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s)
        Vector a -> Gen (Vector a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector a -> Gen (Vector a)) -> Vector a -> Gen (Vector a)
forall a b. (a -> b) -> a -> b
$ IArray Vector a -> Int -> Int -> Vector a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr ([a] -> SmallArray a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack [a]
vs) Int
s Int
l'
    shrink :: Vector a -> [Vector a]
shrink Vector a
v = [a] -> Vector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([a] -> Vector a) -> [[a]] -> [Vector a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink (Vector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack Vector a
v)

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

instance Hashable a => Hashable (Vector a) where
    {-# INLINE hashWithSalt #-}
    hashWithSalt :: Int -> Vector a -> Int
hashWithSalt = Int -> Vector a -> Int
forall (f :: * -> *) a.
(Hashable1 f, Hashable a) =>
Int -> f a -> Int
hashWithSalt1

instance Hashable1 Vector where
    {-# INLINE liftHashWithSalt #-}
    liftHashWithSalt :: (Int -> a -> Int) -> Int -> Vector a -> Int
liftHashWithSalt Int -> a -> Int
h Int
salt0 (Vector SmallArray a
arr Int
s Int
l) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt (Int -> Int -> Int
go Int
salt0 Int
s) Int
l
      where
        !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
        go :: Int -> Int -> Int
go !Int
salt !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = Int
salt
            | Bool
otherwise = Int -> Int -> Int
go (Int -> a -> Int
h Int
salt (SmallArray a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
indexArr SmallArray a
arr Int
i)) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Traverse vector and gather result in another vector,
traverseVec :: (Vec v a, Vec u b, Applicative f) => (a -> f b) -> v a -> f (u b)
{-# INLINE [1] traverseVec #-}
{-# RULES "traverseVec/ST" forall f. traverseVec f = traverseWithIndexST (const f) #-}
{-# RULES "traverseVec/IO" forall f. traverseVec f = traverseWithIndexIO (const f) #-}
traverseVec :: (a -> f b) -> v a -> f (u b)
traverseVec a -> f b
f v a
v = Int -> [b] -> u b
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packN (v a -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
length v a
v) ([b] -> u b) -> f [b] -> f (u b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> [a] -> f [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f (v a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack v a
v)

-- | Traverse vector and gather result in another vector,
traverseWithIndex :: (Vec v a, Vec u b, Applicative f) => (Int -> a -> f b) -> v a -> f (u b)
{-# INLINE [1] traverseWithIndex #-}
{-# RULES "traverseWithIndex/ST" traverseWithIndex = traverseWithIndexST #-}
{-# RULES "traverseWithIndex/IO" traverseWithIndex = traverseWithIndexIO #-}
traverseWithIndex :: (Int -> a -> f b) -> v a -> f (u b)
traverseWithIndex Int -> a -> f b
f v a
v = Int -> [b] -> u b
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packN (v a -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
length v a
v) ([b] -> u b) -> f [b] -> f (u b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> a -> f b) -> [Int] -> [a] -> f [b]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> a -> f b
f [Int
0..] (v a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack v a
v)

traverseWithIndexST :: forall v u a b s. (Vec v a, Vec u b) => (Int -> a -> ST s b) -> v a -> ST s (u b)
{-# INLINE traverseWithIndexST #-}
traverseWithIndexST :: (Int -> a -> ST s b) -> v a -> ST s (u b)
traverseWithIndexST Int -> a -> ST s b
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = u b -> ST s (u b)
forall (m :: * -> *) a. Monad m => a -> m a
return u b
forall (v :: * -> *) a. Vec v a => v a
empty
    | Bool
otherwise = do
        MArr (IArray u) s b
marr <- Int -> ST s (MArr (IArray u) s b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l
        MArr (IArray u) s b -> Int -> ST s ()
go MArr (IArray u) s b
marr Int
0
        IArray u b
ba <- MArr (IArray u) s b -> ST s (IArray u b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray u) s b
marr
        u b -> ST s (u b)
forall (m :: * -> *) a. Monad m => a -> m a
return (u b -> ST s (u b)) -> u b -> ST s (u b)
forall a b. (a -> b) -> a -> b
$! IArray u b -> Int -> Int -> u b
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray u b
ba Int
0 Int
l
  where
    go :: MArr (IArray u) s b -> Int -> ST s ()
    go :: MArr (IArray u) s b -> Int -> ST s ()
go !MArr (IArray u) s b
marr !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            a
x <- IArray v a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray v a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
            MArr (IArray u) s b -> Int -> b -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray u) s b
marr Int
i (b -> ST s ()) -> ST s b -> ST s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> a -> ST s b
f Int
i a
x
            MArr (IArray u) s b -> Int -> ST s ()
go MArr (IArray u) s b
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

traverseWithIndexIO :: forall v u a b. (Vec v a, Vec u b) => (Int -> a -> IO b) -> v a -> IO (u b)
{-# INLINE traverseWithIndexIO #-}
traverseWithIndexIO :: (Int -> a -> IO b) -> v a -> IO (u b)
traverseWithIndexIO Int -> a -> IO b
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = u b -> IO (u b)
forall (m :: * -> *) a. Monad m => a -> m a
return u b
forall (v :: * -> *) a. Vec v a => v a
empty
    | Bool
otherwise = do
        MArr (IArray u) RealWorld b
marr <- Int -> IO (MArr (IArray u) RealWorld b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
l
        MArr (IArray u) RealWorld b -> Int -> IO ()
go MArr (IArray u) RealWorld b
marr Int
0
        IArray u b
ba <- MArr (IArray u) RealWorld b -> IO (IArray u b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray u) RealWorld b
marr
        u b -> IO (u b)
forall (m :: * -> *) a. Monad m => a -> m a
return (u b -> IO (u b)) -> u b -> IO (u b)
forall a b. (a -> b) -> a -> b
$! IArray u b -> Int -> Int -> u b
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray u b
ba Int
0 Int
l
  where
    go :: MArr (IArray u) RealWorld b -> Int -> IO ()
    go :: MArr (IArray u) RealWorld b -> Int -> IO ()
go !MArr (IArray u) RealWorld b
marr !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            a
x <- IArray v a -> Int -> IO a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray v a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
            MArr (IArray u) RealWorld b -> Int -> b -> IO ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray u) RealWorld b
marr Int
i (b -> IO ()) -> IO b -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> a -> IO b
f Int
i a
x
            MArr (IArray u) RealWorld b -> Int -> IO ()
go MArr (IArray u) RealWorld b
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Traverse vector without gathering result.
traverseVec_ :: (Vec v a, Applicative f) => (a -> f b) -> v a -> f ()
{-# INLINE traverseVec_ #-}
traverseVec_ :: (a -> f b) -> v a -> f ()
traverseVec_ a -> f b
f (Vec IArray v a
arr Int
s Int
l) = Int -> f ()
go Int
s
  where
    end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> f ()
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = a -> f b
f (IArray v a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
indexArr IArray v a
arr Int
i) f b -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> f ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Traverse vector with index.
traverseWithIndex_ :: (Vec v a, Applicative f) => (Int -> a -> f b) -> v a -> f ()
{-# INLINE traverseWithIndex_ #-}
traverseWithIndex_ :: (Int -> a -> f b) -> v a -> f ()
traverseWithIndex_ Int -> a -> f b
f (Vec IArray v a
arr Int
s Int
l) = Int -> f ()
go Int
s
  where
    end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> f ()
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise = Int -> a -> f b
f (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s) (IArray v a -> Int -> a
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> a
indexArr IArray v a
arr Int
i) f b -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> f ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

--------------------------------------------------------------------------------
-- | Primitive vector
--
data PrimVector a = PrimVector
    {-# UNPACK #-} !(PrimArray a)   -- ^ payload
    {-# UNPACK #-} !Int             -- ^ offset in elements of type a rather than in bytes
    {-# UNPACK #-} !Int             -- ^ length in elements of type a rather than in bytes

instance Prim a => Vec PrimVector a where
    type IArray PrimVector = PrimArray
    {-# INLINE toArr #-}
    toArr :: PrimVector a -> (IArray PrimVector a, Int, Int)
toArr (PrimVector PrimArray a
arr Int
s Int
l) = (PrimArray a
IArray PrimVector a
arr, Int
s, Int
l)
    {-# INLINE fromArr #-}
    fromArr :: IArray PrimVector a -> Int -> Int -> PrimVector a
fromArr = IArray PrimVector a -> Int -> Int -> PrimVector a
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector

instance (Prim a, Eq a) => Eq (PrimVector a) where
    {-# INLINE (==) #-}
    == :: PrimVector a -> PrimVector a -> Bool
(==) = PrimVector a -> PrimVector a -> Bool
forall a. Prim a => PrimVector a -> PrimVector a -> Bool
eqPrimVector

eqPrimVector :: forall a. Prim a => PrimVector a -> PrimVector a -> Bool
{-# INLINE eqPrimVector #-}
eqPrimVector :: PrimVector a -> PrimVector a -> Bool
eqPrimVector (PrimVector (PrimArray ByteArray#
baA#) (I# Int#
sA#) Int
lA)
             (PrimVector (PrimArray ByteArray#
baB#) (I# Int#
sB#) Int
lB)
    = -- we use memcmp for all primitive vector, ghc emit code to test
      -- pointer equality so we don't have to do it manually here
      Int
lA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lB Bool -> Bool -> Bool
&&
        Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
baA# (Int#
sA# Int# -> Int# -> Int#
*# Int#
siz#) ByteArray#
baB# (Int#
sB# Int# -> Int# -> Int#
*# Int#
siz#) Int#
n#)
  where
    !siz :: Int
siz@(I# Int#
siz#) = a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)
    !(I# Int#
n#) = Int
lAInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
siz

instance (Prim a, Ord a) => Ord (PrimVector a) where
    {-# INLINE compare #-}
    compare :: PrimVector a -> PrimVector a -> Ordering
compare = PrimVector a -> PrimVector a -> Ordering
forall a.
(Prim a, Ord a) =>
PrimVector a -> PrimVector a -> Ordering
comparePrimVector

comparePrimVector :: (Prim a, Ord a) => PrimVector a -> PrimVector a -> Ordering
{-# INLINE comparePrimVector #-}
comparePrimVector :: PrimVector a -> PrimVector a -> Ordering
comparePrimVector (PrimVector PrimArray a
baA Int
sA Int
lA) (PrimVector PrimArray a
baB Int
sB Int
lB)
    | PrimArray a
baA PrimArray a -> PrimArray a -> Bool
forall (arr :: * -> *) a. Arr arr a => arr a -> arr a -> Bool
`sameArr` PrimArray a
baB = if Int
sA Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sB then Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB else Int -> Int -> Ordering
go Int
sA Int
sB
    | Bool
otherwise = Int -> Int -> Ordering
go Int
sA Int
sB
  where
    !endA :: Int
endA = Int
sA Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lA
    !endB :: Int
endB = Int
sB Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lB
    go :: Int -> Int -> Ordering
go !Int
i !Int
j | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endA  = Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB
             | Int
j Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
endB  = Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB
             | Bool
otherwise = let o :: Ordering
o = PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
baA Int
i a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
baB Int
j
                           in case Ordering
o of Ordering
EQ -> Int -> Int -> Ordering
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)
                                        Ordering
x  -> Ordering
x

-- | This is an INCOHERENT instance, compare binary data using SIMD.
instance {-# INCOHERENT #-} Ord Bytes where
    {-# INLINE compare #-}
    compare :: Bytes -> Bytes -> Ordering
compare = Bytes -> Bytes -> Ordering
compareBytes

compareBytes :: PrimVector Word8 -> PrimVector Word8 -> Ordering
{-# INLINE compareBytes #-}
compareBytes :: Bytes -> Bytes -> Ordering
compareBytes (PrimVector (PrimArray ByteArray#
baA#) (I# Int#
sA#) Int
lA)
             (PrimVector (PrimArray ByteArray#
baB#) (I# Int#
sB#) Int
lB) =
    let !(I# Int#
n#) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
lA Int
lB
        r :: Int
r = Int# -> Int
I# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
baA# Int#
sA# ByteArray#
baB# Int#
sB# Int#
n#)
    in case Int
r Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
0 of
        Ordering
EQ  -> Int
lA Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
lB
        Ordering
x  -> Ordering
x

instance Prim a => Semigroup (PrimVector a) where
    {-# INLINE (<>) #-}
    <> :: PrimVector a -> PrimVector a -> PrimVector a
(<>)    = PrimVector a -> PrimVector a -> PrimVector a
forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
append
    {-# INLINE sconcat #-}
    sconcat :: NonEmpty (PrimVector a) -> PrimVector a
sconcat (PrimVector a
b:|[PrimVector a]
bs) = [PrimVector a] -> PrimVector a
forall (v :: * -> *) a. Vec v a => [v a] -> v a
concat (PrimVector a
bPrimVector a -> [PrimVector a] -> [PrimVector a]
forall a. a -> [a] -> [a]
:[PrimVector a]
bs)
    {-# INLINE stimes #-}
    stimes :: b -> PrimVector a -> PrimVector a
stimes  = b -> PrimVector a -> PrimVector a
forall (v :: * -> *) a x. (Vec v a, Integral x) => x -> v a -> v a
_cycleN

instance Prim a => Monoid (PrimVector a) where
    {-# INLINE mempty #-}
    mempty :: PrimVector a
mempty  = PrimVector a
forall (v :: * -> *) a. Vec v a => v a
empty
    {-# INLINE mappend #-}
    mappend :: PrimVector a -> PrimVector a -> PrimVector a
mappend = PrimVector a -> PrimVector a -> PrimVector a
forall (v :: * -> *) a. Vec v a => v a -> v a -> v a
append
    {-# INLINE mconcat #-}
    mconcat :: [PrimVector a] -> PrimVector a
mconcat = [PrimVector a] -> PrimVector a
forall (v :: * -> *) a. Vec v a => [v a] -> v a
concat

instance NFData (PrimVector a) where
    {-# INLINE rnf #-}
    rnf :: PrimVector a -> ()
rnf PrimVector{} = ()

instance (Prim a, Show a) => Show (PrimVector a) where
    showsPrec :: Int -> PrimVector a -> ShowS
showsPrec Int
p PrimVector a
v = Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p (PrimVector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack PrimVector a
v)

instance (Prim a, Read a) => Read (PrimVector a) where
    readPrec :: ReadPrec (PrimVector a)
readPrec = [a] -> PrimVector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([a] -> PrimVector a) -> ReadPrec [a] -> ReadPrec (PrimVector a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec [a]
forall a. Read a => ReadPrec a
readPrec

instance (Prim a, Arbitrary a) => Arbitrary (PrimVector a) where
    arbitrary :: Gen (PrimVector a)
arbitrary = do
        [a]
vs <- Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
        let l :: Int
l = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length [a]
vs
        Int
s <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
l)
        Int
l' <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s)
        PrimVector a -> Gen (PrimVector a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PrimVector a -> Gen (PrimVector a))
-> PrimVector a -> Gen (PrimVector a)
forall a b. (a -> b) -> a -> b
$ IArray PrimVector a -> Int -> Int -> PrimVector a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr ([a] -> PrimArray a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack [a]
vs) Int
s Int
l'
    shrink :: PrimVector a -> [PrimVector a]
shrink PrimVector a
v = [a] -> PrimVector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([a] -> PrimVector a) -> [[a]] -> [PrimVector a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink (PrimVector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack PrimVector a
v)

instance (Prim a, CoArbitrary a) => CoArbitrary (PrimVector a) where
    coarbitrary :: PrimVector a -> Gen b -> Gen b
coarbitrary = [a] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ([a] -> Gen b -> Gen b)
-> (PrimVector a -> [a]) -> PrimVector a -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimVector a -> [a]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack

instance (Hashable a, Prim a) => Hashable (PrimVector a) where
    {-# INLINE hashWithSalt #-}
    hashWithSalt :: Int -> PrimVector a -> Int
hashWithSalt = Int -> PrimVector a -> Int
forall a. (Hashable a, Prim a) => Int -> PrimVector a -> Int
hashWithSaltPrimVector

hashWithSaltPrimVector :: (Hashable a, Prim a) => Int -> PrimVector a -> Int
{-# INLINE hashWithSaltPrimVector #-}
hashWithSaltPrimVector :: Int -> PrimVector a -> Int
hashWithSaltPrimVector Int
salt0 (PrimVector PrimArray a
arr Int
s Int
l) = Int -> Int -> Int
go Int
salt0 Int
s
  where
    -- we don't do a final hash with length to keep consistent with Bytes's instance
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> Int -> Int
go !Int
salt !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = Int
salt
        | Bool
otherwise = Int -> Int -> Int
go (Int -> a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
indexPrimArray PrimArray a
arr Int
i)) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | This is an INCOHERENT instance, hash binary data using FNV-1a
--
-- Note this is different from @Vector Word8@ or @[Word8]@ which use FNV-1.
instance {-# INCOHERENT #-} Hashable Bytes where
    {-# INLINE hashWithSalt #-}
    hashWithSalt :: Int -> Bytes -> Int
hashWithSalt = Int -> Bytes -> Int
hashWithSaltBytes

hashWithSaltBytes :: Int -> Bytes -> Int
{-# INLINE hashWithSaltBytes #-}
hashWithSaltBytes :: Int -> Bytes -> Int
hashWithSaltBytes Int
salt (PrimVector (PrimArray ByteArray#
ba#) Int
s Int
l) =
    IO Int -> Int
forall a. IO a -> a
unsafeDupablePerformIO (ByteArray# -> Int -> Int -> Int -> IO Int
c_fnv_hash_ba ByteArray#
ba# Int
s Int
l Int
salt)

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

-- | 'Bytes' is just primitive word8 vectors.
type Bytes = PrimVector Word8

-- | This instance use 'packASCII', which may silently chop bytes, use it with ASCII literals only.
instance a ~ Word8 => IsString (PrimVector a) where
    {-# INLINE fromString #-}
    fromString :: String -> PrimVector a
fromString = String -> PrimVector a
String -> Bytes
packASCII

instance Prim a => IsList (PrimVector a) where
    type Item (PrimVector a) = a
    {-# INLINE fromList #-}
    fromList :: [Item (PrimVector a)] -> PrimVector a
fromList = [Item (PrimVector a)] -> PrimVector a
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack
    {-# INLINE toList #-}
    toList :: PrimVector a -> [Item (PrimVector a)]
toList = PrimVector a -> [Item (PrimVector a)]
forall (v :: * -> *) a. Vec v a => v a -> [a]
unpack
    {-# INLINE fromListN #-}
    fromListN :: Int -> [Item (PrimVector a)] -> PrimVector a
fromListN = Int -> [Item (PrimVector a)] -> PrimVector a
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packN

-- | This instance assume ASCII encoded bytes
instance CI.FoldCase Bytes where
    {-# INLINE foldCase #-}
    foldCase :: Bytes -> Bytes
foldCase = (Word8 -> Word8) -> Bytes -> Bytes
forall (u :: * -> *) (v :: * -> *) a b.
(Vec u a, Vec v b) =>
(a -> b) -> u a -> v b
map Word8 -> Word8
toLower

-- | /O(n)/, pack an ASCII 'String', multi-bytes char WILL BE CHOPPED!
packASCII :: String -> Bytes
{-# INLINE CONLIKE [0] packASCII #-}
{-# RULES
    "packASCII/packASCIIAddr" forall addr . packASCII (unpackCString# addr) = packASCIIAddr addr
  #-}
packASCII :: String -> Bytes
packASCII = [Word8] -> Bytes
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([Word8] -> Bytes) -> (String -> [Word8]) -> String -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord)

packASCIIAddr :: Addr# -> Bytes
{-# INLINE packASCIIAddr #-}
packASCIIAddr :: Addr# -> Bytes
packASCIIAddr Addr#
addr0# = Addr# -> Bytes
go Addr#
addr0#
  where
    len :: Int
len = CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> (IO CSize -> CSize) -> IO CSize -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO CSize -> CSize
forall a. IO a -> a
unsafeDupablePerformIO (IO CSize -> Int) -> IO CSize -> Int
forall a b. (a -> b) -> a -> b
$ Addr# -> IO CSize
c_strlen Addr#
addr0#
    go :: Addr# -> Bytes
go Addr#
addr# = (forall s. ST s Bytes) -> Bytes
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Bytes) -> Bytes)
-> (forall s. ST s Bytes) -> Bytes
forall a b. (a -> b) -> a -> b
$ do
        MutablePrimArray s Word8
marr <- Int -> ST s (MutablePrimArray (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
Int -> m (MutablePrimArray (PrimState m) a)
newPrimArray Int
len
        MutablePrimArray (PrimState (ST s)) Word8
-> Int -> Ptr Word8 -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> Ptr a -> Int -> m ()
copyPtrToMutablePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
marr Int
0 (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
addr#) Int
len
        PrimArray Word8
arr <- MutablePrimArray (PrimState (ST s)) Word8 -> ST s (PrimArray Word8)
forall (m :: * -> *) a.
PrimMonad m =>
MutablePrimArray (PrimState m) a -> m (PrimArray a)
unsafeFreezePrimArray MutablePrimArray s Word8
MutablePrimArray (PrimState (ST s)) Word8
marr
        Bytes -> ST s Bytes
forall (m :: * -> *) a. Monad m => a -> m a
return (PrimArray Word8 -> Int -> Int -> Bytes
forall a. PrimArray a -> Int -> Int -> PrimVector a
PrimVector PrimArray Word8
arr Int
0 Int
len)


--------------------------------------------------------------------------------
-- Basic creating

-- | Create a vector with size N.
--
create :: Vec v a
       => Int                                   -- ^ length in elements of type @a@
       -> (forall s. MArr (IArray v) s a -> ST s ())   -- ^ initialization function
       -> v a
{-# INLINE create #-}
create :: Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
n0 forall s. MArr (IArray v) s a -> ST s ()
fill = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do
        let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
        MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
        MArr (IArray v) s a -> ST s ()
forall s. MArr (IArray v) s a -> ST s ()
fill MArr (IArray v) s a
marr
        IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr
        v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
n)

-- | Create a vector with a initial size N array (which may not be the final array).
--
create' :: Vec v a
        => Int
        -- ^ length in elements of type @a@
        -> (forall s. MArr (IArray v) s a -> ST s (IPair (MArr (IArray v) s a)))
        -- ^ initialization function return a result size and array, the result must start from index 0
        -> v a
{-# INLINE create' #-}
create' :: Int
-> (forall s.
    MArr (IArray v) s a -> ST s (IPair (MArr (IArray v) s a)))
-> v a
create' Int
n0 forall s. MArr (IArray v) s a -> ST s (IPair (MArr (IArray v) s a))
fill = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do
        let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
        MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
        IPair Int
n' MArr (IArray v) s a
marr' <- MArr (IArray v) s a -> ST s (IPair (MArr (IArray v) s a))
forall s. MArr (IArray v) s a -> ST s (IPair (MArr (IArray v) s a))
fill MArr (IArray v) s a
marr
        MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
marr' Int
n'
        IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
        v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
n')

-- | Create a vector with a initial size N array, return both the vector and
-- the monadic result during creating.
--
-- The result is not demanded strictly while the returned vector will be in normal form.
-- It this is not desired, use @return $!@ idiom in your initialization function.
creating :: Vec v a
         => Int  -- length in elements of type @a@
         -> (forall s. MArr (IArray v) s a -> ST s b)  -- ^ initialization function
         -> (b, v a)
{-# INLINE creating #-}
creating :: Int -> (forall s. MArr (IArray v) s a -> ST s b) -> (b, v a)
creating Int
n0 forall s. MArr (IArray v) s a -> ST s b
fill = (forall s. ST s (b, v a)) -> (b, v a)
forall a. (forall s. ST s a) -> a
runST (do
        let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
        MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
        b
b <- MArr (IArray v) s a -> ST s b
forall s. MArr (IArray v) s a -> ST s b
fill MArr (IArray v) s a
marr
        IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr
        let !v :: v a
v = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
n
        (b, v a) -> ST s (b, v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, v a
v))

-- | Create a vector with a initial size N array (which may not be the final array),
-- return both the vector and the monadic result during creating.
--
-- The result is not demanded strictly while the returned vector will be in normal form.
-- It this is not desired, use @return $!@ idiom in your initialization function.
creating' :: Vec v a
         => Int  -- length in elements of type @a@
         -> (forall s. MArr (IArray v) s a -> ST s (b, (IPair (MArr (IArray v) s a))))  -- ^ initialization function
         -> (b, v a)
{-# INLINE creating' #-}
creating' :: Int
-> (forall s.
    MArr (IArray v) s a -> ST s (b, IPair (MArr (IArray v) s a)))
-> (b, v a)
creating' Int
n0 forall s.
MArr (IArray v) s a -> ST s (b, IPair (MArr (IArray v) s a))
fill = (forall s. ST s (b, v a)) -> (b, v a)
forall a. (forall s. ST s a) -> a
runST (do
        let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
        MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
        (b
b, IPair Int
n' MArr (IArray v) s a
marr') <- MArr (IArray v) s a -> ST s (b, IPair (MArr (IArray v) s a))
forall s.
MArr (IArray v) s a -> ST s (b, IPair (MArr (IArray v) s a))
fill MArr (IArray v) s a
marr
        MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
marr' Int
n'
        IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
        let !v :: v a
v = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
n'
        (b, v a) -> ST s (b, v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, v a
v))

-- | Create a vector up to a specific length.
--
-- If the initialization function return a length larger than initial size,
-- an 'IndexOutOfVectorRange' will be raised.
--
createN :: (Vec v a, HasCallStack)
        => Int                                  -- ^ length's upper bound
        -> (forall s. MArr (IArray v) s a -> ST s Int) -- ^ initialization function which return the actual length
        -> v a
{-# INLINE createN #-}
createN :: Int -> (forall s. MArr (IArray v) s a -> ST s Int) -> v a
createN Int
n0 forall s. MArr (IArray v) s a -> ST s Int
fill = (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do
        let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
        MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
        Int
l' <- MArr (IArray v) s a -> ST s Int
forall s. MArr (IArray v) s a -> ST s Int
fill MArr (IArray v) s a
marr
        MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
marr Int
l'
        IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr
        if Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n
        then v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
l'
        else Int -> ST s (v a)
forall a. HasCallStack => Int -> a
errorOutRange Int
l')

-- | Create two vector up to a specific length.
--
-- If the initialization function return lengths larger than initial sizes,
-- an 'IndexOutOfVectorRange' will be raised.
--
createN2 :: (Vec v a, Vec u b, HasCallStack)
         => Int
         -> Int
         -> (forall s. MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int,Int))
         -> (v a, u b)
{-# INLINE createN2 #-}
createN2 :: Int
-> Int
-> (forall s.
    MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int, Int))
-> (v a, u b)
createN2 Int
n0 Int
n1 forall s.
MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int, Int)
fill = (forall s. ST s (v a, u b)) -> (v a, u b)
forall a. (forall s. ST s a) -> a
runST (do
        let n0' :: Int
n0' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n0
            n1' :: Int
n1' = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 Int
n1
        MArr (IArray v) s a
mba0 <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n0'
        MArr (IArray u) s b
mba1 <- Int -> ST s (MArr (IArray u) s b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n1'
        (Int
l0, Int
l1) <- MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int, Int)
forall s.
MArr (IArray v) s a -> MArr (IArray u) s b -> ST s (Int, Int)
fill MArr (IArray v) s a
mba0 MArr (IArray u) s b
mba1
        MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
mba0 Int
l0
        MArr (IArray u) s b -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray u) s b
mba1 Int
l1
        IArray v a
ba0 <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
mba0
        IArray u b
ba1 <- MArr (IArray u) s b -> ST s (IArray u b)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray u) s b
mba1
        if (Int
l0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n0)
        then if (Int
l1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n1)
            then let !v1 :: v a
v1 = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba0 Int
0 Int
l0
                     !v2 :: u b
v2 = IArray u b -> Int -> Int -> u b
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray u b
ba1 Int
0 Int
l1
                 in (v a, u b) -> ST s (v a, u b)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a
v1, u b
v2)
            else Int -> ST s (v a, u b)
forall a. HasCallStack => Int -> a
errorOutRange Int
l1
        else Int -> ST s (v a, u b)
forall a. HasCallStack => Int -> a
errorOutRange Int
l0)

-- | /O(1)/. The empty vector.
--
empty :: Vec v a => v a
empty :: v a
empty = IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
Vec IArray v a
forall (arr :: * -> *) a. Arr arr a => arr a
emptyArr Int
0 Int
0

-- | /O(1)/. Single element vector.
singleton :: Vec v a => a -> v a
{-# INLINE singleton #-}
singleton :: a -> v a
singleton a
c = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
1 (\ MArr (IArray v) s a
marr -> MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
0 a
c)

-- | /O(n)/. Copy a vector from slice.
--
copy :: Vec v a => v a -> v a
{-# INLINE copy #-}
copy :: v a -> v a
copy (Vec IArray v a
ba Int
s Int
l) = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l (\ MArr (IArray v) s a
marr -> MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
0 IArray v a
ba Int
s Int
l)

--------------------------------------------------------------------------------
-- Conversion between list
--
-- | /O(n)/ Convert a list into a vector
--
-- Alias for @'packN' 'defaultInitSize'@.
--
pack :: Vec v a => [a] -> v a
{-# INLINE pack #-}
pack :: [a] -> v a
pack = Int -> [a] -> v a
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packN Int
defaultInitSize

-- | /O(n)/ Convert a list into a vector with an approximate size.
--
-- If the list's length is large than the size given, we simply double the buffer size
-- and continue building.
--
-- This function is a /good consumer/ in the sense of build/foldr fusion.
--
packN :: forall v a. Vec v a => Int -> [a] -> v a
{-# INLINE packN #-}
packN :: Int -> [a] -> v a
packN Int
n0 = \ [a]
ws0 -> (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 Int
n0
                              MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
                              (IPair Int
i MArr (IArray v) s a
marr') <- (IPair (MArr (IArray v) s a)
 -> a -> ST s (IPair (MArr (IArray v) s a)))
-> IPair (MArr (IArray v) s a)
-> [a]
-> ST s (IPair (MArr (IArray v) s a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
forall s.
IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair Int
0 MArr (IArray v) s a
marr) [a]
ws0
                              MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
marr' Int
i
                              IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
                              v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
i)
  where
    -- It's critical that this function get specialized and unboxed
    -- Keep an eye on its core!
    go :: IPair (MArr (IArray v) s a) -> a -> ST s (IPair (MArr (IArray v) s a))
    go :: IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (IPair Int
i MArr (IArray v) s a
marr) !a
x = do
        Int
n <- MArr (IArray v) s a -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m Int
sizeofMutableArr MArr (IArray v) s a
marr
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
        then do MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
marr)
        else do let !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1
                !MArr (IArray v) s a
marr' <- MArr (IArray v) s a -> Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m (MArr arr s a)
resizeMutableArr MArr (IArray v) s a
marr Int
n'
                MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr' Int
i a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
marr')

-- | /O(n)/ Convert a list into a vector with given size.
--
-- If the list's length is large than the size given, we drop the rest elements.
--
-- This function is a /good consumer/ in the sense of build/foldr fusion.
--
packN' :: forall v a. Vec v a => Int -> [a] -> v a
{-# INLINE packN' #-}
packN' :: Int -> [a] -> v a
packN' Int
n = \ [a]
ws0 -> (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
                              (IPair Int
i MArr (IArray v) s a
marr') <- (IPair (MArr (IArray v) s a)
 -> a -> ST s (IPair (MArr (IArray v) s a)))
-> IPair (MArr (IArray v) s a)
-> [a]
-> ST s (IPair (MArr (IArray v) s a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
forall s.
IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair Int
0 MArr (IArray v) s a
marr) [a]
ws0
                              MArr (IArray v) s a -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> m ()
shrinkMutableArr MArr (IArray v) s a
marr' Int
i
                              IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
                              v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
0 Int
i)
  where
    -- It's critical that this function get specialized and unboxed
    -- Keep an eye on its core!
    go :: IPair (MArr (IArray v) s a) -> a -> ST s (IPair (MArr (IArray v) s a))
    go :: IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (IPair Int
i MArr (IArray v) s a
marr) !a
x = do
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
        then do MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s a
marr)
        else IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair Int
i MArr (IArray v) s a
marr)

-- | /O(n)/ Alias for @'packRN' 'defaultInitSize'@.
--
packR :: Vec v a => [a] -> v a
{-# INLINE packR #-}
packR :: [a] -> v a
packR = Int -> [a] -> v a
forall (v :: * -> *) a. Vec v a => Int -> [a] -> v a
packRN Int
defaultInitSize

-- | /O(n)/ 'packN' in reverse order.
--
-- This function is a /good consumer/ in the sense of build/foldr fusion.
--
packRN :: forall v a. Vec v a => Int -> [a] -> v a
{-# INLINE packRN #-}
packRN :: Int -> [a] -> v a
packRN Int
n0 = \ [a]
ws0 -> (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do let n :: Int
n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
4 Int
n0
                               MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
                               (IPair Int
i MArr (IArray v) s a
marr') <- (IPair (MArr (IArray v) s a)
 -> a -> ST s (IPair (MArr (IArray v) s a)))
-> IPair (MArr (IArray v) s a)
-> [a]
-> ST s (IPair (MArr (IArray v) s a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
forall s.
IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MArr (IArray v) s a
marr) [a]
ws0
                               IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
                               let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                   n' :: Int
n' = IArray v a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr IArray v a
ba
                               v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
i' (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'))
  where
    go :: IPair (MArr (IArray v) s a) -> a -> ST s (IPair (MArr (IArray v) s a))
    go :: IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (IPair Int
i MArr (IArray v) s a
marr) !a
x = do
        Int
n <- MArr (IArray v) s a -> ST s Int
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m Int
sizeofMutableArr MArr (IArray v) s a
marr
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then do MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MArr (IArray v) s a
marr)
        else do let !n' :: Int
n' = Int
n Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
1  -- double the buffer
                !MArr (IArray v) s a
marr' <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n'
                MArr (IArray v) s a
-> Int -> MArr (IArray v) s a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> MArr arr s a -> Int -> Int -> m ()
copyMutableArr MArr (IArray v) s a
marr' Int
n MArr (IArray v) s a
marr Int
0 Int
n
                MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
2) MArr (IArray v) s a
marr')

-- | /O(n)/ 'packN'' in reverse order.
--
-- >>> packRN' 3 [1,2,3,4,5]
-- >>> [3,2,1]
--
-- This function is a /good consumer/ in the sense of build/foldr fusion.
--
packRN' :: forall v a. Vec v a => Int -> [a] -> v a
{-# INLINE packRN' #-}
packRN' :: Int -> [a] -> v a
packRN' Int
n = \ [a]
ws0 -> (forall s. ST s (v a)) -> v a
forall a. (forall s. ST s a) -> a
runST (do MArr (IArray v) s a
marr <- Int -> ST s (MArr (IArray v) s a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
Int -> m (MArr arr s a)
newArr Int
n
                               (IPair Int
i MArr (IArray v) s a
marr') <- (IPair (MArr (IArray v) s a)
 -> a -> ST s (IPair (MArr (IArray v) s a)))
-> IPair (MArr (IArray v) s a)
-> [a]
-> ST s (IPair (MArr (IArray v) s a))
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
forall s.
IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MArr (IArray v) s a
marr) [a]
ws0
                               IArray v a
ba <- MArr (IArray v) s a -> ST s (IArray v a)
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> m (arr a)
unsafeFreezeArr MArr (IArray v) s a
marr'
                               let i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                                   n' :: Int
n' = IArray v a -> Int
forall (arr :: * -> *) a. Arr arr a => arr a -> Int
sizeofArr IArray v a
ba
                               v a -> ST s (v a)
forall (m :: * -> *) a. Monad m => a -> m a
return (v a -> ST s (v a)) -> v a -> ST s (v a)
forall a b. (a -> b) -> a -> b
$! IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
ba Int
i' (Int
n'Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i'))
  where
    go :: IPair (MArr (IArray v) s a) -> a -> ST s (IPair (MArr (IArray v) s a))
    go :: IPair (MArr (IArray v) s a)
-> a -> ST s (IPair (MArr (IArray v) s a))
go (IPair Int
i MArr (IArray v) s a
marr) !a
x = do
        if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
        then do MArr (IArray v) s a -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s a
marr Int
i a
x
                IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MArr (IArray v) s a
marr)
        else IPair (MArr (IArray v) s a) -> ST s (IPair (MArr (IArray v) s a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> MArr (IArray v) s a -> IPair (MArr (IArray v) s a)
forall a. Int -> a -> IPair a
IPair Int
i MArr (IArray v) s a
marr)

-- | /O(n)/ Convert vector to a list.
--
-- Unpacking is done lazily. i.e. we will retain reference to the array until all element are consumed.
--
-- This function is a /good producer/ in the sense of build/foldr fusion.
unpack :: Vec v a => v a -> [a]
{-# INLINE [1] unpack #-}
unpack :: v a -> [a]
unpack (Vec IArray v a
ba Int
s Int
l) = Int -> [a]
go Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> [a]
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = []
        | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
ba Int
idx of (# a
x #) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

unpackFB :: Vec v a => v a -> (a -> r -> r) -> r -> r
{-# INLINE [0] unpackFB #-}
unpackFB :: v a -> (a -> r -> r) -> r -> r
unpackFB (Vec IArray v a
ba Int
s Int
l) a -> r -> r
k r
z = Int -> r
go Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> r
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = r
z
        | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
ba Int
idx of (# a
x #) -> a
x a -> r -> r
`k` Int -> r
go (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

{-# RULES
"unpack" [~1] forall v . unpack v = build (\ k z -> unpackFB v k z)
"unpackFB" [1] forall v . unpackFB v (:) [] = unpack v
 #-}

-- | /O(n)/ Convert vector to a list in reverse order.
--
-- This function is a /good producer/ in the sense of build/foldr fusion.
unpackR :: Vec v a => v a -> [a]
{-# INLINE [1] unpackR #-}
unpackR :: v a -> [a]
unpackR (Vec IArray v a
ba Int
s Int
l) = Int -> [a]
go (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> [a]
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = []
        | Bool
otherwise =
            case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
ba Int
idx of (# a
x #) -> a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Int -> [a]
go (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

unpackRFB :: Vec v a => v a -> (a -> r -> r) -> r -> r
{-# INLINE [0] unpackRFB #-}
unpackRFB :: v a -> (a -> r -> r) -> r -> r
unpackRFB (Vec IArray v a
ba Int
s Int
l) a -> r -> r
k r
z = Int -> r
go (Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  where
    go :: Int -> r
go !Int
idx
        | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s = r
z
        | Bool
otherwise =
            case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
ba Int
idx of (# a
x #) -> a
x a -> r -> r
`k` Int -> r
go (Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

{-# RULES
"unpackR" [~1] forall v . unpackR v = build (\ k z -> unpackRFB v k z)
"unpackRFB" [1] forall v . unpackRFB v (:) [] = unpackR v
 #-}

--------------------------------------------------------------------------------
-- Basic interface
--
-- |  /O(1)/ The length of a vector.
length :: Vec v a => v a -> Int
{-# INLINE length #-}
length :: v a -> Int
length (Vec IArray v a
_ Int
_ Int
l) = Int
l

-- | /O(1)/ Test whether a vector is empty.
null :: Vec v a => v a -> Bool
{-# INLINE null #-}
null :: v a -> Bool
null v a
v = v a -> Int
forall (v :: * -> *) a. Vec v a => v a -> Int
length v a
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0

-- | /O(m+n)/
--
-- There's no need to guard empty vector because we guard them for you, so
-- appending empty vectors are no-ops.
append :: Vec v a => v a -> v a -> v a
{-# INLINE append #-}
append :: v a -> v a -> v a
append (Vec IArray v a
_ Int
_ Int
0) v a
b                    = v a
b
append v a
a                (Vec IArray v a
_ Int
_ Int
0)     = v a
a
append (Vec IArray v a
baA Int
sA Int
lA) (Vec IArray v a
baB Int
sB Int
lB) = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create (Int
lAInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lB) ((forall s. MArr (IArray v) s a -> ST s ()) -> v a)
-> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall a b. (a -> b) -> a -> b
$ \ MArr (IArray v) s a
marr -> do
    MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
0  IArray v a
baA Int
sA Int
lA
    MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
lA IArray v a
baB Int
sB Int
lB

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

-- | Mapping between vectors (possiblely with two different vector types).
--
-- NOTE, the result vector contain thunks in lifted 'Vector' case, use 'map''
-- if that's not desired.
--
-- For 'PrimVector', 'map' and 'map'' are same, since 'PrimVector's never
-- store thunks.
map :: forall u v a b. (Vec u a, Vec v b) => (a -> b) -> u a -> v b
{-# INLINE map #-}
map :: (a -> b) -> u a -> v b
map a -> b
f (Vec IArray u a
arr Int
s Int
l) = Int -> (forall s. MArr (IArray v) s b -> ST s ()) -> v b
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l (Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go Int
0)
  where
    go :: Int -> MArr (IArray v) s b -> ST s ()
    go :: Int -> MArr (IArray v) s b -> ST s ()
go !Int
i !MArr (IArray v) s b
marr | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = do
                    a
x <- IArray u a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray u a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s); MArr (IArray v) s b -> Int -> b -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s b
marr Int
i (a -> b
f a
x);
                    Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s b
marr

-- | Mapping between vectors (possiblely with two different vector types).
--
-- This is the strict version map. Note that the 'Functor' instance of lifted
-- 'Vector' is defined with 'map' to statisfy laws, which this strict version
-- breaks (@map' id arrayContainsBottom /= arrayContainsBottom @).
map' :: forall u v a b. (Vec u a, Vec v b) => (a -> b) -> u a -> v b
{-# INLINE map' #-}
map' :: (a -> b) -> u a -> v b
map' a -> b
f (Vec IArray u a
arr Int
s Int
l) = Int -> (forall s. MArr (IArray v) s b -> ST s ()) -> v b
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l (Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go Int
0)
  where
    go :: Int -> MArr (IArray v) s b -> ST s ()
    go :: Int -> MArr (IArray v) s b -> ST s ()
go !Int
i !MArr (IArray v) s b
marr | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = do
                    a
x <- IArray u a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray u a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
                    let !v :: b
v = a -> b
f a
x in MArr (IArray v) s b -> Int -> b -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s b
marr Int
i b
v
                    Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s b
marr
               | Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Strict mapping with index.
--
imap' :: forall u v a b. (Vec u a, Vec v b) => (Int -> a -> b) -> u a -> v b
{-# INLINE imap' #-}
imap' :: (Int -> a -> b) -> u a -> v b
imap' Int -> a -> b
f (Vec IArray u a
arr Int
s Int
l) = Int -> (forall s. MArr (IArray v) s b -> ST s ()) -> v b
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l (Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go Int
0)
  where
    go :: Int -> MArr (IArray v) s b -> ST s ()
    go :: Int -> MArr (IArray v) s b -> ST s ()
go !Int
i !MArr (IArray v) s b
marr | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
l = do
                    a
x <- IArray u a -> Int -> ST s a
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray u a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
s)
                    let !v :: b
v = Int -> a -> b
f Int
i a
x in MArr (IArray v) s b -> Int -> b -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s b
marr Int
i b
v
                    Int -> MArr (IArray v) s b -> ST s ()
forall s. Int -> MArr (IArray v) s b -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s b
marr
               | Bool
otherwise = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

--------------------------------------------------------------------------------
--
-- Strict folds
--

-- | Strict left to right fold.
foldl' :: Vec v a => (b -> a -> b) -> b -> v a -> b
{-# INLINE foldl' #-}
foldl' :: (b -> a -> b) -> b -> v a -> b
foldl' b -> a -> b
f b
z (Vec IArray v a
arr Int
s Int
l) = b -> Int -> b
go b
z Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    -- tail recursive; traverses array left to right
    go :: b -> Int -> b
go !b
acc !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end  = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> b -> Int -> b
go (b -> a -> b
f b
acc a
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               | Bool
otherwise = b
acc

-- | Strict left to right fold with index.
ifoldl' :: Vec v a => (b -> Int ->  a -> b) -> b -> v a -> b
{-# INLINE ifoldl' #-}
ifoldl' :: (b -> Int -> a -> b) -> b -> v a -> b
ifoldl' b -> Int -> a -> b
f b
z (Vec IArray v a
arr Int
s Int
l) = b -> Int -> b
go b
z Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: b -> Int -> b
go !b
acc !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end  = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> b -> Int -> b
go (b -> Int -> a -> b
f b
acc Int
i a
x) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
               | Bool
otherwise = b
acc

-- | Strict left to right fold using first element as the initial value.
--
-- Throw 'EmptyVector' if vector is empty.
foldl1' :: forall v a. (Vec v a, HasCallStack) => (a -> a -> a) -> v a -> a
{-# INLINE foldl1' #-}
foldl1' :: (a -> a -> a) -> v a -> a
foldl1' a -> a -> a
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = a
forall a. HasCallStack => a
errorEmptyVector
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
s of
                    (# a
x0 #) -> (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
f a
x0 (IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: v a)

-- | Strict left to right fold using first element as the initial value.
--   return 'Nothing' when vector is empty.
foldl1Maybe' :: forall v a. Vec v a => (a -> a -> a) -> v a -> Maybe a
{-# INLINE foldl1Maybe' #-}
foldl1Maybe' :: (a -> a -> a) -> v a -> Maybe a
foldl1Maybe' a -> a -> a
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
s of
                    (# a
x0 #) -> let !r :: a
r = (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
f a
x0 (IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: v a)
                                in a -> Maybe a
forall a. a -> Maybe a
Just a
r

-- | Strict right to left fold
foldr' :: Vec v a => (a -> b -> b) -> b -> v a -> b
{-# INLINE foldr' #-}
foldr' :: (a -> b -> b) -> b -> v a -> b
foldr' a -> b -> b
f b
z (Vec IArray v a
arr Int
s Int
l) = b -> Int -> b
go b
z (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
    -- tail recursive; traverses array right to left
    go :: b -> Int -> b
go !b
acc !Int
i | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s    = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> b -> Int -> b
go (a -> b -> b
f a
x b
acc) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
               | Bool
otherwise = b
acc

-- | Strict right to left fold with index
--
-- NOTE: the index is counting from 0, not backwards
ifoldr' :: Vec v a => (Int -> a -> b -> b) -> b -> v a -> b
{-# INLINE ifoldr' #-}
ifoldr' :: (Int -> a -> b -> b) -> b -> v a -> b
ifoldr' Int -> a -> b -> b
f b
z (Vec IArray v a
arr Int
s Int
l) = b -> Int -> Int -> b
go b
z (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Int
0
  where
    go :: b -> Int -> Int -> b
go !b
acc !Int
i !Int
k | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
s    = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                    (# a
x #) -> b -> Int -> Int -> b
go (Int -> a -> b -> b
f Int
k a
x b
acc) (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                  | Bool
otherwise = b
acc

-- | Strict right to left fold using last element as the initial value.
--
-- Throw 'EmptyVector' if vector is empty.
foldr1' :: forall v a. (Vec v a, HasCallStack) => (a -> a -> a) -> v a -> a
{-# INLINE foldr1' #-}
foldr1' :: (a -> a -> a) -> v a -> a
foldr1' a -> a -> a
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = a
forall a. HasCallStack => a
errorEmptyVector
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
                    (# a
x0 #) -> (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
f a
x0 (IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: v a)

-- | Strict right to left fold using last element as the initial value,
--   return 'Nothing' when vector is empty.
foldr1Maybe' :: forall v a. Vec v a => (a -> a -> a) -> v a -> Maybe a
{-# INLINE foldr1Maybe' #-}
foldr1Maybe' :: (a -> a -> a) -> v a -> Maybe a
foldr1Maybe' a -> a -> a
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) of
                    (# a
x0 #) -> let !r :: a
r = (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
f a
x0 (IArray v a -> Int -> Int -> v a
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
fromArr IArray v a
arr Int
s (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) :: v a)
                                in a -> Maybe a
forall a. a -> Maybe a
Just a
r

--------------------------------------------------------------------------------
--
-- Special folds
--
-- | /O(n)/ Concatenate a list of vector.
--
-- Note: 'concat' have to force the entire list to filter out empty vector and calculate
-- the length for allocation.
concat :: forall v a . Vec v a => [v a] -> v a
{-# INLINE concat #-}
concat :: [v a] -> v a
concat [v a
v] = v a
v  -- shortcut common case in Parser
concat [v a]
vs = case Int -> Int -> [v a] -> (Int, Int)
pre Int
0 Int
0 [v a]
vs of
    (Int
1, Int
_) -> let Just v a
v = (v a -> Bool) -> [v a] -> Maybe (v a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (Bool -> Bool
not (Bool -> Bool) -> (v a -> Bool) -> v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v a -> Bool
forall (v :: * -> *) a. Vec v a => v a -> Bool
null) [v a]
vs in v a
v -- there must be a not null vector
    (Int
_, Int
l) -> Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
l ([v a] -> Int -> MArr (IArray v) s a -> ST s ()
forall s. [v a] -> Int -> MArr (IArray v) s a -> ST s ()
go [v a]
vs Int
0)
  where
    -- pre scan to decide if we really need to copy and calculate total length
    -- we don't accumulate another result list, since it's rare to got empty
    pre :: Int -> Int -> [v a] -> (Int, Int)
    pre :: Int -> Int -> [v a] -> (Int, Int)
pre !Int
nacc !Int
lacc [] = (Int
nacc, Int
lacc)
    pre !Int
nacc !Int
lacc (Vec IArray v a
_ Int
_ Int
l:[v a]
vs')
        | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Int -> Int -> [v a] -> (Int, Int)
pre Int
nacc Int
lacc [v a]
vs'
        | Bool
otherwise = Int -> Int -> [v a] -> (Int, Int)
pre (Int
naccInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lacc) [v a]
vs'

    go :: [v a] -> Int -> MArr (IArray v) s a -> ST s ()
    go :: [v a] -> Int -> MArr (IArray v) s a -> ST s ()
go [] !Int
_ !MArr (IArray v) s a
_                  = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    go (Vec IArray v a
ba Int
s Int
l:[v a]
vs') !Int
i !MArr (IArray v) s a
marr = do Bool -> ST s () -> ST s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0) (MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
i IArray v a
ba Int
s Int
l)
                                      [v a] -> Int -> MArr (IArray v) s a -> ST s ()
forall s. [v a] -> Int -> MArr (IArray v) s a -> ST s ()
go [v a]
vs' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) MArr (IArray v) s a
marr

-- | Map a function over a vector and concatenate the results
concatMap :: Vec v a => (a -> v a) -> v a -> v a
{-# INLINE concatMap #-}
concatMap :: (a -> v a) -> v a -> v a
concatMap a -> v a
f = [v a] -> v a
forall (v :: * -> *) a. Vec v a => [v a] -> v a
concat ([v a] -> v a) -> (v a -> [v a]) -> v a -> v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [v a] -> [v a]) -> [v a] -> v a -> [v a]
forall (v :: * -> *) a b. Vec v a => (a -> b -> b) -> b -> v a -> b
foldr' ((:) (v a -> [v a] -> [v a]) -> (a -> v a) -> a -> [v a] -> [v a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v a
f) []

-- | /O(n)/ 'maximum' returns the maximum value from a vector
--
-- It's defined with 'foldl1'', an 'EmptyVector' exception will be thrown
-- in the case of an empty vector.
maximum :: (Vec v a, Ord a, HasCallStack) => v a -> a
{-# INLINE maximum #-}
maximum :: v a -> a
maximum = (a -> a -> a) -> v a -> a
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
(a -> a -> a) -> v a -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max

-- | /O(n)/ 'maximum' returns the maximum value from a vector,
--   return 'Nothing' in the case of an empty vector.
maximumMaybe :: (Vec v a, Ord a) => v a -> Maybe a
{-# INLINE maximumMaybe #-}
maximumMaybe :: v a -> Maybe a
maximumMaybe = (a -> a -> a) -> v a -> Maybe a
forall (v :: * -> *) a. Vec v a => (a -> a -> a) -> v a -> Maybe a
foldl1Maybe' a -> a -> a
forall a. Ord a => a -> a -> a
max

-- | /O(n)/ 'minimum' returns the minimum value from a 'vector'
--
-- An 'EmptyVector' exception will be thrown in the case of an empty vector.
minimum :: (Vec v a, Ord a, HasCallStack) => v a -> a
{-# INLINE minimum #-}
minimum :: v a -> a
minimum = (a -> a -> a) -> v a -> a
forall (v :: * -> *) a.
(Vec v a, HasCallStack) =>
(a -> a -> a) -> v a -> a
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min

-- | /O(n)/ 'minimum' returns the minimum value from a vector,
--   return 'Nothing' in the case of an empty vector.
minimumMaybe :: (Vec v a, Ord a) => v a -> Maybe a
{-# INLINE minimumMaybe #-}
minimumMaybe :: v a -> Maybe a
minimumMaybe = (a -> a -> a) -> v a -> Maybe a
forall (v :: * -> *) a. Vec v a => (a -> a -> a) -> v a -> Maybe a
foldl1Maybe' a -> a -> a
forall a. Ord a => a -> a -> a
min

-- | /O(n)/ 'product' returns the product value from a vector
product :: (Vec v a, Num a) => v a -> a
{-# INLINE product #-}
product :: v a -> a
product = (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1

-- | /O(n)/ 'product' returns the product value from a vector
--
-- This function will shortcut on zero. Note this behavior change the semantics
-- for lifted vector: @product [1,0,undefined] /= product' [1,0,undefined]@.
product' :: (Vec v a, Num a, Eq a) => v a -> a
{-# INLINE product' #-}
product' :: v a -> a
product' (Vec IArray v a
arr Int
s Int
l) = a -> Int -> a
go a
1 Int
s
  where
    !end :: Int
end = Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l
    go :: a -> Int -> a
go !a
acc !Int
i | a
acc a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0  = a
0
               | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = a
acc
               | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> a -> Int -> a
go (a
acca -> a -> a
forall a. Num a => a -> a -> a
*a
x) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | /O(n)/ Applied to a predicate and a vector, 'any' determines
-- if any elements of the vector satisfy the predicate.
any :: Vec v a => (a -> Bool) -> v a -> Bool
{-# INLINE any #-}
any :: (a -> Bool) -> v a -> Bool
any a -> Bool
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Bool
False
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
s of
                    (# a
x0 #) -> Bool -> Int -> Bool
go (a -> Bool
f a
x0) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  where
    !end :: Int
end = Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l
    go :: Bool -> Int -> Bool
go !Bool
acc !Int
i | Bool
acc       = Bool
True
               | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = Bool
acc
               | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> Bool -> Int -> Bool
go (Bool
acc Bool -> Bool -> Bool
|| a -> Bool
f a
x) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | /O(n)/ Applied to a predicate and a vector, 'all' determines
-- if all elements of the vector satisfy the predicate.
all :: Vec v a => (a -> Bool) -> v a -> Bool
{-# INLINE all #-}
all :: (a -> Bool) -> v a -> Bool
all a -> Bool
f (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = Bool
True
    | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
s of
                    (# a
x0 #) -> Bool -> Int -> Bool
go (a -> Bool
f a
x0) (Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  where
    !end :: Int
end = Int
sInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l
    go :: Bool -> Int -> Bool
go !Bool
acc !Int
i | Bool -> Bool
not Bool
acc   = Bool
False
               | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = Bool
acc
               | Bool
otherwise = case IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i of
                                (# a
x #) -> Bool -> Int -> Bool
go (Bool
acc Bool -> Bool -> Bool
&& a -> Bool
f a
x) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | /O(n)/ 'sum' returns the sum value from a 'vector'
sum :: (Vec v a, Num a) => v a -> a
{-# INLINE sum #-}
sum :: v a -> a
sum = (a -> a -> a) -> a -> v a -> a
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

-- | /O(n)/ 'count' returns count of an element from a 'vector'
count :: (Vec v a, Eq a) => a -> v a -> Int
{-# INLINE count #-}
count :: a -> v a -> Int
count a
w = (Int -> a -> Int) -> Int -> v a -> Int
forall (v :: * -> *) a b. Vec v a => (b -> a -> b) -> b -> v a -> b
foldl' (\ Int
acc a
x -> if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w then Int
accInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
acc) Int
0

--------------------------------------------------------------------------------
-- Accumulating maps

-- | The 'mapAccumL' function behaves like a combination of 'map' and
-- 'foldl'; it applies a function to each element of a vector,
-- passing an accumulating parameter from left to right, and returning a
-- final value of this accumulator together with the new list.
--
-- Note, this function will only force the result tuple, not the elements inside,
-- to prevent creating thunks during 'mapAccumL', `seq` your accumulator and result
-- with the result tuple.
--
mapAccumL :: forall u v a b c. (Vec u b, Vec v c) => (a -> b -> (a, c)) -> a -> u b -> (a, v c)
{-# INLINE mapAccumL #-}
mapAccumL :: (a -> b -> (a, c)) -> a -> u b -> (a, v c)
mapAccumL a -> b -> (a, c)
f a
z (Vec IArray u b
ba Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = (a
z, v c
forall (v :: * -> *) a. Vec v a => v a
empty)
    | Bool
otherwise = Int -> (forall s. MArr (IArray v) s c -> ST s a) -> (a, v c)
forall (v :: * -> *) a b.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s b) -> (b, v a)
creating Int
l (a -> Int -> MArr (IArray v) s c -> ST s a
forall s. a -> Int -> MArr (IArray v) s c -> ST s a
go a
z Int
s)
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: a -> Int -> MArr (IArray v) s c -> ST s a
    go :: a -> Int -> MArr (IArray v) s c -> ST s a
go a
acc !Int
i !MArr (IArray v) s c
marr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
        | Bool
otherwise = do
            b
x <- IArray u b -> Int -> ST s b
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray u b
ba Int
i
            let (a
acc', c
c) = a
acc a -> b -> (a, c)
`f` b
x
            MArr (IArray v) s c -> Int -> c -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s c
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s) c
c
            a -> Int -> MArr (IArray v) s c -> ST s a
forall s. a -> Int -> MArr (IArray v) s c -> ST s a
go a
acc' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s c
marr

-- | The 'mapAccumR' function behaves like a combination of 'map' and
-- 'foldr'; it applies a function to each element of a vector,
-- passing an accumulating parameter from right to left, and returning a
-- final value of this accumulator together with the new vector.
--
-- The same strictness property with 'mapAccumL' applys to 'mapAccumR' too.
--
mapAccumR :: forall u v a b c. (Vec u b, Vec v c) => (a -> b -> (a, c)) -> a -> u b -> (a, v c)
{-# INLINE mapAccumR #-}
mapAccumR :: (a -> b -> (a, c)) -> a -> u b -> (a, v c)
mapAccumR a -> b -> (a, c)
f a
z (Vec IArray u b
ba Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = (a
z, v c
forall (v :: * -> *) a. Vec v a => v a
empty)
    | Bool
otherwise = Int -> (forall s. MArr (IArray v) s c -> ST s a) -> (a, v c)
forall (v :: * -> *) a b.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s b) -> (b, v a)
creating Int
l (a -> Int -> MArr (IArray v) s c -> ST s a
forall s. a -> Int -> MArr (IArray v) s c -> ST s a
go a
z (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 :: a -> Int ->  MArr (IArray v) s c -> ST s a
    go :: a -> Int -> MArr (IArray v) s c -> ST s a
go a
acc !Int
i !MArr (IArray v) s c
marr
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s     = a -> ST s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc
        | Bool
otherwise = do
            b
x <- IArray u b -> Int -> ST s b
forall (arr :: * -> *) a (m :: * -> *).
(Arr arr a, Monad m) =>
arr a -> Int -> m a
indexArrM IArray u b
ba Int
i
            let (a
acc', c
c) = a
acc a -> b -> (a, c)
`f` b
x
            MArr (IArray v) s c -> Int -> c -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s c
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
s) c
c
            a -> Int -> MArr (IArray v) s c -> ST s a
forall s. a -> Int -> MArr (IArray v) s c -> ST s a
go a
acc' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) MArr (IArray v) s c
marr

--------------------------------------------------------------------------------
--  Generating and unfolding vector.
--
-- | /O(n)/ 'replicate' @n x@ is a vector of length @n@ with @x@
-- the value of every element.
--
-- Note: 'replicate' will not force the element in boxed vector case.
replicate :: (Vec v a) => Int -> a -> v a
{-# INLINE replicate #-}
replicate :: Int -> a -> v a
replicate Int
n a
x | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0    = v a
forall (v :: * -> *) a. Vec v a => v a
empty
              | Bool
otherwise = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
n (\ MArr (IArray v) s a
marr -> MArr (IArray v) s a -> Int -> Int -> a -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> Int -> a -> m ()
setArr MArr (IArray v) s a
marr Int
0 Int
n a
x)

-- | /O(n*m)/ 'cycleN' a vector n times.
cycleN :: forall v a. Vec v a => Int -> v a -> v a
{-# INLINE cycleN #-}
cycleN :: Int -> v a -> v a
cycleN = Int -> v a -> v a
forall (v :: * -> *) a x. (Vec v a, Integral x) => x -> v a -> v a
_cycleN

-- | /O(n*m)/ 'cycleN''s polymorphic type version
_cycleN :: forall v a x. (Vec v a, Integral x) => x -> v a -> v a
{-# INLINE _cycleN #-}
_cycleN :: x -> v a -> v a
_cycleN x
n (Vec IArray v a
arr Int
s Int
l)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = v a
forall (v :: * -> *) a. Vec v a => v a
empty
    | Bool
otherwise = Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
forall (v :: * -> *) a.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s ()) -> v a
create Int
end (Int -> MArr (IArray v) s a -> ST s ()
forall s. Int -> MArr (IArray v) s a -> ST s ()
go Int
0)
  where
    !end :: Int
end = x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
l
    go :: Int -> MArr (IArray v) s a -> ST s ()
    go :: Int -> MArr (IArray v) s a -> ST s ()
go !Int
i !MArr (IArray v) s a
marr | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end  = () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                | Bool
otherwise = MArr (IArray v) s a -> Int -> IArray v a -> Int -> Int -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> arr a -> Int -> Int -> m ()
copyArr MArr (IArray v) s a
marr Int
i IArray v a
arr Int
s Int
l ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MArr (IArray v) s a -> ST s ()
forall s. Int -> MArr (IArray v) s a -> ST s ()
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l) MArr (IArray v) s a
marr

-- | /O(n)/, where /n/ is the length of the result.  The 'unfoldr'
-- function is analogous to the List \'unfoldr\'.  'unfoldr' builds a
-- vector from a seed value. The function takes the element and
-- returns 'Nothing' if it is done producing the vector or returns
-- 'Just' @(a,b)@, in which case, @a@ is the next byte in the string,
-- and @b@ is the seed value for further production.
--
-- Examples:
--
-- >    unfoldr (\x -> if x <= 5 then Just (x, x + 1) else Nothing) 0
-- > == pack [0, 1, 2, 3, 4, 5]
--
unfoldr :: Vec u b => (a -> Maybe (b, a)) -> a -> u b
{-# INLINE unfoldr #-}
unfoldr :: (a -> Maybe (b, a)) -> a -> u b
unfoldr a -> Maybe (b, a)
f = [b] -> u b
forall (v :: * -> *) a. Vec v a => [a] -> v a
pack ([b] -> u b) -> (a -> [b]) -> a -> u b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe (b, a)) -> a -> [b]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr a -> Maybe (b, a)
f

-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a vector from a seed
-- value.  However, the length of the result is limited by the first
-- argument to 'unfoldrN'.  This function is more efficient than 'unfoldr'
-- when the maximum length of the result is known.
--
-- The following equation relates 'unfoldrN' and 'unfoldr':
--
-- > fst (unfoldrN n f s) == take n (unfoldr f s)
--
unfoldrN :: forall v a b. Vec v b => Int -> (a -> Maybe (b, a)) -> a -> (v b, Maybe a)
{-# INLINE unfoldrN #-}
unfoldrN :: Int -> (a -> Maybe (b, a)) -> a -> (v b, Maybe a)
unfoldrN Int
n a -> Maybe (b, a)
f
    | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0     = \ a
z -> (v b
forall (v :: * -> *) a. Vec v a => v a
empty, a -> Maybe a
forall a. a -> Maybe a
Just a
z)
    | Bool
otherwise = \ a
z ->
        let ((Maybe a
r, Int
len), Vec IArray v b
arr Int
_ Int
_) = Int
-> (forall s. MArr (IArray v) s b -> ST s (Maybe a, Int))
-> ((Maybe a, Int), v b)
forall (v :: * -> *) a b.
Vec v a =>
Int -> (forall s. MArr (IArray v) s a -> ST s b) -> (b, v a)
creating @v Int
n (a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
forall s. a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
go a
z Int
0)
        in (IArray v b -> Int -> Int -> v b
forall (v :: * -> *) a. Vec v a => IArray v a -> Int -> Int -> v a
Vec IArray v b
arr Int
0 Int
len, Maybe a
r)
  where
    go :: a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
    go :: a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
go !a
acc !Int
i !MArr (IArray v) s b
marr
      | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i    = (Maybe a, Int) -> ST s (Maybe a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
acc, Int
i)
      | Bool
otherwise = case a -> Maybe (b, a)
f a
acc of
          Maybe (b, a)
Nothing        -> (Maybe a, Int) -> ST s (Maybe a, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
forall a. Maybe a
Nothing, Int
i)
          Just (b
x, a
acc') -> do MArr (IArray v) s b -> Int -> b -> ST s ()
forall (arr :: * -> *) a (m :: * -> *) s.
(Arr arr a, PrimMonad m, PrimState m ~ s) =>
MArr arr s a -> Int -> a -> m ()
writeArr MArr (IArray v) s b
marr Int
i b
x
                               a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
forall s. a -> Int -> MArr (IArray v) s b -> ST s (Maybe a, Int)
go a
acc' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) MArr (IArray v) s b
marr

--------------------------------------------------------------------------------
-- Searching by equality

-- | /O(n)/ 'elem' test if given element is in given vector.
elem :: (Vec v a, Eq a) => a -> v a -> Bool
{-# INLINE elem #-}
elem :: a -> v a -> Bool
elem a
x = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> (v a -> Maybe Int) -> v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v a -> Maybe Int
forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Maybe Int
elemIndex a
x

-- | /O(n)/ 'not . elem'
notElem ::  (Vec v a, Eq a) => a -> v a -> Bool
{-# INLINE notElem #-}
notElem :: a -> v a -> Bool
notElem a
x = Bool -> Bool
not (Bool -> Bool) -> (v a -> Bool) -> v a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> v a -> Bool
forall (v :: * -> *) a. (Vec v a, Eq a) => a -> v a -> Bool
elem a
x

-- | /O(n)/ The 'elemIndex' function returns the index of the first
-- element in the given vector which is equal to the query
-- element, or 'Nothing' if there is no such element.
elemIndex :: (Vec v a, Eq a) => a -> v a -> Maybe Int
{-# INLINE [1] elemIndex #-}
{-# RULES "elemIndex/Bytes" elemIndex = elemIndexBytes #-}
elemIndex :: a -> v a -> Maybe Int
elemIndex a
w (Vec IArray v a
arr Int
s Int
l) = Int -> Maybe Int
go Int
s
  where
    !end :: Int
end = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l
    go :: Int -> Maybe Int
go !Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
end = Maybe Int
forall a. Maybe a
Nothing
        | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
w   = let !i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s in Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i'
        | Bool
otherwise = Int -> Maybe Int
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
        where (# a
x #) = IArray v a -> Int -> (# a #)
forall (arr :: * -> *) a. Arr arr a => arr a -> Int -> (# a #)
indexArr' IArray v a
arr Int
i

-- | /O(n)/ Special 'elemIndex' for 'Bytes' using @memchr(3)@
--
-- On most platforms @memchr(3)@ is a highly optimized byte searching
-- function, thus we make a special binding for it.
--
-- A rewrite rule @elemIndex = elemIndexBytes@ is also included.
elemIndexBytes :: Word8 -> Bytes -> Maybe Int
{-# INLINE elemIndexBytes #-}
elemIndexBytes :: Word8 -> Bytes -> Maybe Int
elemIndexBytes Word8
w (PrimVector (PrimArray ByteArray#
ba#) Int
s Int
l) =
    case Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteArray# -> Int -> Word8 -> Int -> Int
c_memchr ByteArray#
ba# Int
s Word8
w Int
l) of
        -1 -> Maybe Int
forall a. Maybe a
Nothing
        Int
r  -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
r

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

-- | Pair type to help GHC unpack in some loops, useful when write fast folds.
data IPair a = IPair { IPair a -> Int
ifst :: {-# UNPACK #-}!Int, IPair a -> a
isnd :: a } deriving (Int -> IPair a -> ShowS
[IPair a] -> ShowS
IPair a -> String
(Int -> IPair a -> ShowS)
-> (IPair a -> String) -> ([IPair a] -> ShowS) -> Show (IPair a)
forall a. Show a => Int -> IPair a -> ShowS
forall a. Show a => [IPair a] -> ShowS
forall a. Show a => IPair a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IPair a] -> ShowS
$cshowList :: forall a. Show a => [IPair a] -> ShowS
show :: IPair a -> String
$cshow :: forall a. Show a => IPair a -> String
showsPrec :: Int -> IPair a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> IPair a -> ShowS
Show, IPair a -> IPair a -> Bool
(IPair a -> IPair a -> Bool)
-> (IPair a -> IPair a -> Bool) -> Eq (IPair a)
forall a. Eq a => IPair a -> IPair a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IPair a -> IPair a -> Bool
$c/= :: forall a. Eq a => IPair a -> IPair a -> Bool
== :: IPair a -> IPair a -> Bool
$c== :: forall a. Eq a => IPair a -> IPair a -> Bool
Eq, Eq (IPair a)
Eq (IPair a)
-> (IPair a -> IPair a -> Ordering)
-> (IPair a -> IPair a -> Bool)
-> (IPair a -> IPair a -> Bool)
-> (IPair a -> IPair a -> Bool)
-> (IPair a -> IPair a -> Bool)
-> (IPair a -> IPair a -> IPair a)
-> (IPair a -> IPair a -> IPair a)
-> Ord (IPair a)
IPair a -> IPair a -> Bool
IPair a -> IPair a -> Ordering
IPair a -> IPair a -> IPair a
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 a. Ord a => Eq (IPair a)
forall a. Ord a => IPair a -> IPair a -> Bool
forall a. Ord a => IPair a -> IPair a -> Ordering
forall a. Ord a => IPair a -> IPair a -> IPair a
min :: IPair a -> IPair a -> IPair a
$cmin :: forall a. Ord a => IPair a -> IPair a -> IPair a
max :: IPair a -> IPair a -> IPair a
$cmax :: forall a. Ord a => IPair a -> IPair a -> IPair a
>= :: IPair a -> IPair a -> Bool
$c>= :: forall a. Ord a => IPair a -> IPair a -> Bool
> :: IPair a -> IPair a -> Bool
$c> :: forall a. Ord a => IPair a -> IPair a -> Bool
<= :: IPair a -> IPair a -> Bool
$c<= :: forall a. Ord a => IPair a -> IPair a -> Bool
< :: IPair a -> IPair a -> Bool
$c< :: forall a. Ord a => IPair a -> IPair a -> Bool
compare :: IPair a -> IPair a -> Ordering
$ccompare :: forall a. Ord a => IPair a -> IPair a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (IPair a)
Ord)

instance (Arbitrary v) => Arbitrary (IPair v) where
    arbitrary :: Gen (IPair v)
arbitrary = (Int, v) -> IPair v
forall a. (Int, a) -> IPair a
toIPair ((Int, v) -> IPair v) -> Gen (Int, v) -> Gen (IPair v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Int, v)
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: IPair v -> [IPair v]
shrink IPair v
v = (Int, v) -> IPair v
forall a. (Int, a) -> IPair a
toIPair ((Int, v) -> IPair v) -> [(Int, v)] -> [IPair v]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, v) -> [(Int, v)]
forall a. Arbitrary a => a -> [a]
shrink (IPair v -> (Int, v)
forall a. IPair a -> (Int, a)
fromIPair IPair v
v)

instance (CoArbitrary v) => CoArbitrary (IPair v) where
    coarbitrary :: IPair v -> Gen b -> Gen b
coarbitrary = (Int, v) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ((Int, v) -> Gen b -> Gen b)
-> (IPair v -> (Int, v)) -> IPair v -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPair v -> (Int, v)
forall a. IPair a -> (Int, a)
fromIPair

instance Functor IPair where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> IPair a -> IPair b
fmap a -> b
f (IPair Int
i a
v) = Int -> b -> IPair b
forall a. Int -> a -> IPair a
IPair Int
i (a -> b
f a
v)

instance NFData a => NFData (IPair a) where
    {-# INLINE rnf #-}
    rnf :: IPair a -> ()
rnf (IPair Int
_ a
a) = a -> ()
forall a. NFData a => a -> ()
rnf a
a

-- | Unlike 'Functor' instance, this mapping evaluate value inside 'IPair' strictly.
mapIPair' :: (a -> b) -> IPair a -> IPair b
{-# INLINE mapIPair' #-}
mapIPair' :: (a -> b) -> IPair a -> IPair b
mapIPair' a -> b
f (IPair Int
i a
v) = let !v' :: b
v' = a -> b
f a
v in Int -> b -> IPair b
forall a. Int -> a -> IPair a
IPair Int
i b
v'

fromIPair :: IPair a -> (Int, a)
{-# INLINE fromIPair #-}
fromIPair :: IPair a -> (Int, a)
fromIPair (IPair Int
i a
v) = (Int
i, a
v)

toIPair :: (Int, a) -> IPair a
{-# INLINE toIPair #-}
toIPair :: (Int, a) -> IPair a
toIPair (Int
i, a
v) = Int -> a -> IPair a
forall a. Int -> a -> IPair a
IPair Int
i a
v

-- | The chunk size used for I\/O. Currently set to @16k - chunkOverhead@
defaultChunkSize :: Int
{-# INLINE defaultChunkSize #-}
defaultChunkSize :: Int
defaultChunkSize = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead

-- | The recommended chunk size. Currently set to @4k - chunkOverhead@.
smallChunkSize :: Int
{-# INLINE smallChunkSize #-}
smallChunkSize :: Int
smallChunkSize = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
chunkOverhead

-- | The memory management overhead. Currently this is tuned for GHC only.
chunkOverhead :: Int
{-# INLINE chunkOverhead #-}
chunkOverhead :: Int
chunkOverhead = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int -> Int
forall a. Prim a => a -> Int
sizeOf (Int
forall a. HasCallStack => a
undefined :: Int)

-- | @defaultInitSize = 30@, used as initialize size when packing list of unknown size.
defaultInitSize :: Int
{-# INLINE defaultInitSize #-}
defaultInitSize :: Int
defaultInitSize = Int
30

-- | All exception can be throw by using 'Vec'.
data VectorException = IndexOutOfVectorRange {-# UNPACK #-} !Int CallStack
                     | EmptyVector CallStack
                    deriving Int -> VectorException -> ShowS
[VectorException] -> ShowS
VectorException -> String
(Int -> VectorException -> ShowS)
-> (VectorException -> String)
-> ([VectorException] -> ShowS)
-> Show VectorException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VectorException] -> ShowS
$cshowList :: [VectorException] -> ShowS
show :: VectorException -> String
$cshow :: VectorException -> String
showsPrec :: Int -> VectorException -> ShowS
$cshowsPrec :: Int -> VectorException -> ShowS
Show
instance Exception VectorException

errorEmptyVector :: HasCallStack => a
{-# INLINE errorEmptyVector #-}
errorEmptyVector :: a
errorEmptyVector = VectorException -> a
forall a e. Exception e => e -> a
throw (CallStack -> VectorException
EmptyVector CallStack
HasCallStack => CallStack
callStack)

errorOutRange :: HasCallStack => Int -> a
{-# INLINE errorOutRange #-}
errorOutRange :: Int -> a
errorOutRange Int
i = VectorException -> a
forall a e. Exception e => e -> a
throw (Int -> CallStack -> VectorException
IndexOutOfVectorRange Int
i CallStack
HasCallStack => CallStack
callStack)

-- | Cast between vectors
castVector :: (Vec v a, Cast a b) => v a -> v b
castVector :: v a -> v b
castVector = v a -> v b
unsafeCoerce#

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

foreign import ccall unsafe "string.h strcmp"
    c_strcmp :: Addr# -> Addr# -> IO CInt

foreign import ccall unsafe "string.h strlen"
    c_strlen :: Addr# -> IO CSize

foreign import ccall unsafe "text.h ascii_validate_addr"
    c_ascii_validate_addr :: Addr# -> Int -> IO Int

foreign import ccall unsafe "bytes.h hs_fnv_hash_addr"
    c_fnv_hash_addr :: Addr# -> Int -> Int -> IO Int

foreign import ccall unsafe "bytes.h hs_fnv_hash"
    c_fnv_hash_ba :: ByteArray# -> Int -> Int -> Int -> IO Int

-- HsInt hs_memchr(uint8_t *a, HsInt aoff, uint8_t b, HsInt n);
foreign import ccall unsafe "hs_memchr" c_memchr ::
    ByteArray# -> Int -> Word8 -> Int -> Int

-- HsInt hs_memrchr(uint8_t *a, HsInt aoff, uint8_t b, HsInt n);
foreign import ccall unsafe "hs_memrchr" c_memrchr ::
    ByteArray# -> Int -> Word8 -> Int -> Int