-- |
-- Module      : Basement.UArray
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- An unboxed array of primitive types
--
-- All the cells in the array are in one chunk of contiguous
-- memory.
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
module Basement.UArray
    ( UArray(..)
    , PrimType(..)
    -- * methods
    , copy
    , unsafeCopyAtRO
    -- * internal methods
    -- , copyAddr
    , recast
    , unsafeRecast
    , length
    , freeze
    , unsafeFreeze
    , thaw
    , unsafeThaw
    -- * Creation
    , vFromListN
    , new
    , create
    , createFromIO
    , createFromPtr
    , sub
    , copyToPtr
    , withPtr
    , withMutablePtr
    , unsafeFreezeShrink
    , freezeShrink
    , fromBlock
    , toBlock
    -- * accessors
    , update
    , unsafeUpdate
    , unsafeIndex
    , unsafeIndexer
    , unsafeDewrap
    , unsafeRead
    , unsafeWrite
    -- * Functions
    , equalMemcmp
    , singleton
    , replicate
    , map
    , mapIndex
    , findIndex
    , revFindIndex
    , index
    , null
    , take
    , unsafeTake
    , drop
    , unsafeDrop
    , splitAt
    , revDrop
    , revTake
    , revSplitAt
    , splitOn
    , break
    , breakEnd
    , breakElem
    , breakLine
    , elem
    , indices
    , intersperse
    , span
    , spanEnd
    , cons
    , snoc
    , uncons
    , unsnoc
    , find
    , sortBy
    , filter
    , reverse
    , replace
    , foldr
    , foldl'
    , foldr1
    , foldl1'
    , all
    , any
    , isPrefixOf
    , isSuffixOf
    , foreignMem
    , fromForeignPtr
    , builderAppend
    , builderBuild
    , builderBuild_
    , toHexadecimal
    , toBase64Internal
    ) where

import           GHC.Prim
import           GHC.Types
import           GHC.Word
import           GHC.ST
import           GHC.Ptr
import           GHC.ForeignPtr (ForeignPtr)
import           Foreign.Marshal.Utils (copyBytes)
import           Basement.Compat.Base
import           Basement.Compat.Primitive
import           Data.Proxy
import           Basement.Types.OffsetSize
import           Basement.Compat.MonadTrans
import           Basement.NonEmpty
import           Basement.Monad
import           Basement.PrimType
import           Basement.FinalPtr
import           Basement.Exception
import           Basement.UArray.Base
import           Basement.Bits
import           Basement.Block (Block(..), MutableBlock(..))
import qualified Basement.Block as BLK
import qualified Basement.Block.Base as BLK (withPtr, unsafeWrite)
import           Basement.UArray.Mutable hiding (sub, copyToPtr)
import           Basement.Numerical.Additive
import           Basement.Numerical.Subtractive
import           Basement.Numerical.Multiplicative
import           Basement.MutableBuilder
import           Basement.Bindings.Memory (sysHsMemFindByteBa, sysHsMemFindByteAddr)
import qualified Basement.Compat.ExtList as List
import qualified Basement.Base16 as Base16
import qualified Basement.Alg.Mutable as Alg
import qualified Basement.Alg.Class as Alg
import qualified Basement.Alg.PrimArray as Alg

-- | Return the element at a specific index from an array.
--
-- If the index @n is out of bounds, an error is raised.
index :: PrimType ty => UArray ty -> Offset ty -> ty
index :: forall ty. PrimType ty => UArray ty -> Offset ty -> ty
index UArray ty
array Offset ty
n
    | forall ty. Offset ty -> CountOf ty -> Bool
isOutOfBound Offset ty
n CountOf ty
len = forall ty a. OutOfBoundOperation -> Offset ty -> CountOf ty -> a
outOfBound OutOfBoundOperation
OOB_Index Offset ty
n CountOf ty
len
    | Bool
otherwise          = forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
array Offset ty
n
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
array
{-# INLINE index #-}

foreignMem :: PrimType ty
           => FinalPtr ty -- ^ the start pointer with a finalizer
           -> CountOf ty  -- ^ the number of elements (in elements, not bytes)
           -> UArray ty
foreignMem :: forall ty. PrimType ty => FinalPtr ty -> CountOf ty -> UArray ty
foreignMem FinalPtr ty
fptr CountOf ty
nb = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
nb (forall ty. FinalPtr ty -> UArrayBackend ty
UArrayAddr FinalPtr ty
fptr)

-- | Create a foreign UArray from foreign memory and given offset/size
--
-- No check are performed to make sure this is valid, so this is unsafe.
--
-- This is particularly useful when dealing with foreign memory and
-- 'ByteString'
fromForeignPtr :: PrimType ty
               => (ForeignPtr ty, Int, Int) -- ForeignPtr, an offset in prim elements, a size in prim elements
               -> UArray ty
fromForeignPtr :: forall ty. PrimType ty => (ForeignPtr ty, Int, Int) -> UArray ty
fromForeignPtr (ForeignPtr ty
fptr, Int
ofs, Int
len) = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (forall ty. Int -> Offset ty
Offset Int
ofs) (forall ty. Int -> CountOf ty
CountOf Int
len) (forall ty. FinalPtr ty -> UArrayBackend ty
UArrayAddr forall a b. (a -> b) -> a -> b
$ forall a. ForeignPtr a -> FinalPtr a
toFinalPtrForeign ForeignPtr ty
fptr)


-- | Create a UArray from a Block
--
-- The block is still used by the uarray
fromBlock :: PrimType ty
          => Block ty
          -> UArray ty
fromBlock :: forall ty. PrimType ty => Block ty -> UArray ty
fromBlock Block ty
blk = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
0 (forall ty. PrimType ty => Block ty -> CountOf ty
BLK.length Block ty
blk) (forall ty. Block ty -> UArrayBackend ty
UArrayBA Block ty
blk)

-- | Allocate a new array with a fill function that has access to the elements of
--   the source array.
unsafeCopyFrom :: (PrimType a, PrimType b)
               => UArray a -- ^ Source array
               -> CountOf b -- ^ Length of the destination array
               -> (UArray a -> Offset a -> MUArray b s -> ST s ())
               -- ^ Function called for each element in the source array
               -> ST s (UArray b) -- ^ Returns the filled new array
unsafeCopyFrom :: forall a b s.
(PrimType a, PrimType b) =>
UArray a
-> CountOf b
-> (UArray a -> Offset a -> MUArray b s -> ST s ())
-> ST s (UArray b)
unsafeCopyFrom UArray a
v' CountOf b
newLen UArray a -> Offset a -> MUArray b s -> ST s ()
f = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf b
newLen forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Offset a -> MUArray b s -> ST s (MUArray b s)
fill Offset a
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze
  where len :: CountOf a
len = forall ty. UArray ty -> CountOf ty
length UArray a
v'
        fill :: Offset a -> MUArray b s -> ST s (MUArray b s)
fill Offset a
i MUArray b s
r'
            | Offset a
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf a
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure MUArray b s
r'
            | Bool
otherwise  = do UArray a -> Offset a -> MUArray b s -> ST s ()
f UArray a
v' Offset a
i MUArray b s
r'
                              Offset a -> MUArray b s -> ST s (MUArray b s)
fill (Offset a
i forall a. Additive a => a -> a -> a
+ Offset a
1) MUArray b s
r'

-- | Freeze a MUArray into a UArray by copying all the content is a pristine new buffer
--
-- The MUArray in parameter can be still be used after the call without
-- changing the resulting frozen data.
freeze :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> prim (UArray ty)
freeze :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> prim (UArray ty)
freeze MUArray ty (PrimState prim)
ma = do
    MUArray ty (PrimState prim)
ma' <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
len
    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty
-> MUArray ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
copyAt MUArray ty (PrimState prim)
ma' (forall ty. Int -> Offset ty
Offset Int
0) MUArray ty (PrimState prim)
ma (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
len
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty (PrimState prim)
ma'
  where len :: CountOf ty
len = forall ty st. PrimType ty => MUArray ty st -> CountOf ty
mutableLength MUArray ty (PrimState prim)
ma

-- | Just like 'freeze' but copy only the first n bytes
--
-- The size requested need to be smaller or equal to the length
-- of the MUArray, otherwise a Out of Bounds exception is raised
freezeShrink :: (PrimType ty, PrimMonad prim) => MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
freezeShrink :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
freezeShrink MUArray ty (PrimState prim)
ma CountOf ty
n = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CountOf ty
n forall a. Ord a => a -> a -> Bool
> forall ty st. PrimType ty => MUArray ty st -> CountOf ty
mutableLength MUArray ty (PrimState prim)
ma) forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty a.
PrimMonad prim =>
OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a
primOutOfBound OutOfBoundOperation
OOB_MemCopy (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
n) (forall ty st. PrimType ty => MUArray ty st -> CountOf ty
mutableLength MUArray ty (PrimState prim)
ma)
    MUArray ty (PrimState prim)
ma' <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
n
    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty
-> MUArray ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
copyAt MUArray ty (PrimState prim)
ma' (forall ty. Int -> Offset ty
Offset Int
0) MUArray ty (PrimState prim)
ma (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
n
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty (PrimState prim)
ma'

-- | Create a new array of size @n by settings each cells through the
-- function @f.
create :: forall ty . PrimType ty
       => CountOf ty           -- ^ the size of the array
       -> (Offset ty -> ty) -- ^ the function that set the value at the index
       -> UArray ty         -- ^ the array created
create :: forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> UArray ty
create CountOf ty
n Offset ty -> ty
initializer
    | CountOf ty
n forall a. Eq a => a -> a -> Bool
== CountOf ty
0    = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
n forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
(Offset ty -> ty)
-> MUArray ty (PrimState prim) -> prim (UArray ty)
iter Offset ty -> ty
initializer)
  where
    iter :: (PrimType ty, PrimMonad prim) => (Offset ty -> ty) -> MUArray ty (PrimState prim) -> prim (UArray ty)
    iter :: forall (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
(Offset ty -> ty)
-> MUArray ty (PrimState prim) -> prim (UArray ty)
iter Offset ty -> ty
f MUArray ty (PrimState prim)
ma = Offset ty -> prim (UArray ty)
loop Offset ty
0
      where
        loop :: Offset ty -> prim (UArray ty)
loop Offset ty
i
            | Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
n  = forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty (PrimState prim)
ma
            | Bool
otherwise = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty (PrimState prim)
ma Offset ty
i (Offset ty -> ty
f Offset ty
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> prim (UArray ty)
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
        {-# INLINE loop #-}
    {-# INLINE iter #-}

-- | Create a pinned array that is filled by a 'filler' function (typically an IO call like hGetBuf)
createFromIO :: PrimType ty
             => CountOf ty                  -- ^ the size of the array
             -> (Ptr ty -> IO (CountOf ty)) -- ^ filling function that
             -> IO (UArray ty)
createFromIO :: forall ty.
PrimType ty =>
CountOf ty -> (Ptr ty -> IO (CountOf ty)) -> IO (UArray ty)
createFromIO CountOf ty
size Ptr ty -> IO (CountOf ty)
filler
    | CountOf ty
size forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
    | Bool
otherwise = do
        MUArray ty RealWorld
mba <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
newPinned CountOf ty
size
        CountOf ty
r   <- forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr MUArray ty RealWorld
mba forall a b. (a -> b) -> a -> b
$ \Ptr ty
p -> Ptr ty -> IO (CountOf ty)
filler Ptr ty
p
        case CountOf ty
r of
            CountOf ty
0             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty -- make sure we don't keep our array referenced by using empty
            CountOf ty
_ | CountOf ty
r forall a. Ord a => a -> a -> Bool
< CountOf ty
0     -> forall a. HasCallStack => [Char] -> a
error [Char]
"filler returned negative number"
              | Bool
otherwise -> forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
unsafeFreezeShrink MUArray ty RealWorld
mba CountOf ty
r

-- | Freeze a chunk of memory pointed, of specific size into a new unboxed array
createFromPtr :: PrimType ty
              => Ptr ty
              -> CountOf ty
              -> IO (UArray ty)
createFromPtr :: forall ty. PrimType ty => Ptr ty -> CountOf ty -> IO (UArray ty)
createFromPtr Ptr ty
p CountOf ty
s = do
    MUArray ty RealWorld
ma <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
s
    forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Ptr ty -> CountOf ty -> MUArray ty (PrimState prim) -> prim ()
copyFromPtr Ptr ty
p CountOf ty
s MUArray ty RealWorld
ma
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty RealWorld
ma

-----------------------------------------------------------------------
-- higher level collection implementation
-----------------------------------------------------------------------

singleton :: PrimType ty => ty -> UArray ty
singleton :: forall ty. PrimType ty => ty -> UArray ty
singleton ty
ty = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> UArray ty
create CountOf ty
1 (forall a b. a -> b -> a
const ty
ty)

replicate :: PrimType ty => CountOf ty -> ty -> UArray ty
replicate :: forall ty. PrimType ty => CountOf ty -> ty -> UArray ty
replicate CountOf ty
sz ty
ty = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> UArray ty
create CountOf ty
sz (forall a b. a -> b -> a
const ty
ty)

-- | update an array by creating a new array with the updates.
--
-- the operation copy the previous array, modify it in place, then freeze it.
update :: PrimType ty
       => UArray ty
       -> [(Offset ty, ty)]
       -> UArray ty
update :: forall ty.
PrimType ty =>
UArray ty -> [(Offset ty, ty)] -> UArray ty
update UArray ty
array [(Offset ty, ty)]
modifiers = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
UArray ty -> prim (MUArray ty (PrimState prim))
thaw UArray ty
array forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {prim :: * -> *} {ty}.
(PrimMonad prim, PrimType ty) =>
[(Offset ty, ty)]
-> MUArray ty (PrimState prim) -> prim (UArray ty)
doUpdate [(Offset ty, ty)]
modifiers)
  where doUpdate :: [(Offset ty, ty)]
-> MUArray ty (PrimState prim) -> prim (UArray ty)
doUpdate [(Offset ty, ty)]
l MUArray ty (PrimState prim)
ma = [(Offset ty, ty)] -> prim (UArray ty)
loop [(Offset ty, ty)]
l
          where loop :: [(Offset ty, ty)] -> prim (UArray ty)
loop []         = forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty (PrimState prim)
ma
                loop ((Offset ty
i,ty
v):[(Offset ty, ty)]
xs) = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
write MUArray ty (PrimState prim)
ma Offset ty
i ty
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Offset ty, ty)] -> prim (UArray ty)
loop [(Offset ty, ty)]
xs
                {-# INLINE loop #-}
        {-# INLINE doUpdate #-}

unsafeUpdate :: PrimType ty
             => UArray ty
             -> [(Offset ty, ty)]
             -> UArray ty
unsafeUpdate :: forall ty.
PrimType ty =>
UArray ty -> [(Offset ty, ty)] -> UArray ty
unsafeUpdate UArray ty
array [(Offset ty, ty)]
modifiers = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
UArray ty -> prim (MUArray ty (PrimState prim))
thaw UArray ty
array forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {prim :: * -> *} {ty}.
(PrimMonad prim, PrimType ty) =>
[(Offset ty, ty)]
-> MUArray ty (PrimState prim) -> prim (UArray ty)
doUpdate [(Offset ty, ty)]
modifiers)
  where doUpdate :: [(Offset ty, ty)]
-> MUArray ty (PrimState prim) -> prim (UArray ty)
doUpdate [(Offset ty, ty)]
l MUArray ty (PrimState prim)
ma = [(Offset ty, ty)] -> prim (UArray ty)
loop [(Offset ty, ty)]
l
          where loop :: [(Offset ty, ty)] -> prim (UArray ty)
loop []         = forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty (PrimState prim)
ma
                loop ((Offset ty
i,ty
v):[(Offset ty, ty)]
xs) = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty (PrimState prim)
ma Offset ty
i ty
v forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Offset ty, ty)] -> prim (UArray ty)
loop [(Offset ty, ty)]
xs
                {-# INLINE loop #-}
        {-# INLINE doUpdate #-}

-- | Copy all the block content to the memory starting at the destination address
copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)
          => UArray ty -- ^ the source array to copy
          -> Ptr ty    -- ^ The destination address where the copy is going to start
          -> prim ()
copyToPtr :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
UArray ty -> Ptr ty -> prim ()
copyToPtr UArray ty
arr dst :: Ptr ty
dst@(Ptr Addr#
dst#) = forall (prim :: * -> *) ty a.
PrimMonad prim =>
(Block ty -> prim a)
-> (FinalPtr ty -> prim a) -> UArray ty -> prim a
onBackendPrim Block ty -> prim ()
copyBa FinalPtr ty -> prim ()
copyPtr UArray ty
arr
  where
    !(Offset os :: Int
os@(I# Int#
os#)) = forall a. PrimType a => Offset a -> Offset Word8
offsetInBytes forall a b. (a -> b) -> a -> b
$ forall ty. UArray ty -> Offset ty
offset UArray ty
arr
    !(CountOf szBytes :: Int
szBytes@(I# Int#
szBytes#)) = forall a. PrimType a => CountOf a -> CountOf Word8
sizeInBytes forall a b. (a -> b) -> a -> b
$ forall ty. UArray ty -> CountOf ty
length UArray ty
arr
    copyBa :: Block ty -> prim ()
copyBa (Block ByteArray#
ba) = forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> (# forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba Int#
os# Addr#
dst# Int#
szBytes# State# (PrimState prim)
s1, () #)
    copyPtr :: FinalPtr ty -> prim ()
copyPtr FinalPtr ty
fptr = forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr ty
fptr forall a b. (a -> b) -> a -> b
$ \Ptr ty
ptr -> forall a. Ptr a -> Ptr a -> Int -> IO ()
copyBytes Ptr ty
dst (Ptr ty
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
os) Int
szBytes

-- | Get a Ptr pointing to the data in the UArray.
--
-- Since a UArray is immutable, this Ptr shouldn't be
-- to use to modify the contents
--
-- If the UArray is pinned, then its address is returned as is,
-- however if it's unpinned, a pinned copy of the UArray is made
-- before getting the address.
withPtr :: forall ty prim a . (PrimMonad prim, PrimType ty)
        => UArray ty
        -> (Ptr ty -> prim a)
        -> prim a
withPtr :: forall ty (prim :: * -> *) a.
(PrimMonad prim, PrimType ty) =>
UArray ty -> (Ptr ty -> prim a) -> prim a
withPtr UArray ty
a Ptr ty -> prim a
f =
    forall (prim :: * -> *) ty a.
PrimMonad prim =>
(Block ty -> prim a)
-> (FinalPtr ty -> prim a) -> UArray ty -> prim a
onBackendPrim (\Block ty
blk  -> forall (prim :: * -> *) ty a.
PrimMonad prim =>
Block ty -> (Ptr ty -> prim a) -> prim a
BLK.withPtr  Block ty
blk  forall a b. (a -> b) -> a -> b
$ \Ptr ty
ptr -> Ptr ty -> prim a
f (Ptr ty
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
os))
                  (\FinalPtr ty
fptr -> forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr ty
fptr forall a b. (a -> b) -> a -> b
$ \Ptr ty
ptr -> Ptr ty -> prim a
f (Ptr ty
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
os))
                  UArray ty
a
  where
    !sz :: CountOf Word8
sz          = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)
    !(Offset Int
os) = forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz forall a b. (a -> b) -> a -> b
$ forall ty. UArray ty -> Offset ty
offset UArray ty
a
{-# INLINE withPtr #-}

-- | Recast an array of type a to an array of b
--
-- a and b need to have the same size otherwise this
-- raise an async exception
recast :: forall a b . (PrimType a, PrimType b) => UArray a -> UArray b
recast :: forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
recast UArray a
array
    | CountOf Word8
aTypeSize forall a. Eq a => a -> a -> Bool
== CountOf Word8
bTypeSize = forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast UArray a
array
    | Int
missing   forall a. Eq a => a -> a -> Bool
== Int
0         = forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast UArray a
array
    | Bool
otherwise = forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ RecastSourceSize -> RecastDestinationSize -> InvalidRecast
InvalidRecast
                      (Int -> RecastSourceSize
RecastSourceSize      Int
alen)
                      (Int -> RecastDestinationSize
RecastDestinationSize forall a b. (a -> b) -> a -> b
$ Int
alen forall a. Additive a => a -> a -> a
+ Int
missing)
  where
    aTypeSize :: CountOf Word8
aTypeSize = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
    bTypeSize :: CountOf Word8
bTypeSize@(CountOf Int
bs) = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
    (CountOf Int
alen) = forall a. PrimType a => CountOf a -> CountOf Word8
sizeInBytes (forall ty. UArray ty -> CountOf ty
length UArray a
array)
    missing :: Int
missing = Int
alen forall a. IDivisible a => a -> a -> a
`mod` Int
bs

-- | Unsafely recast an UArray containing 'a' to an UArray containing 'b'
--
-- The offset and size are converted from units of 'a' to units of 'b',
-- but no check are performed to make sure this is compatible.
--
-- use 'recast' if unsure.
unsafeRecast :: (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast :: forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast (UArray Offset a
start CountOf a
len UArrayBackend a
backend) = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (forall a b. (PrimType a, PrimType b) => Offset a -> Offset b
primOffsetRecast Offset a
start) (forall a b. (PrimType a, PrimType b) => CountOf a -> CountOf b
sizeRecast CountOf a
len) forall a b. (a -> b) -> a -> b
$
    case UArrayBackend a
backend of
        UArrayAddr FinalPtr a
fptr     -> forall ty. FinalPtr ty -> UArrayBackend ty
UArrayAddr (forall a b. FinalPtr a -> FinalPtr b
castFinalPtr FinalPtr a
fptr)
        UArrayBA (Block ByteArray#
ba) -> forall ty. Block ty -> UArrayBackend ty
UArrayBA (forall ty. ByteArray# -> Block ty
Block ByteArray#
ba)
{-# INLINE [1] unsafeRecast #-}
{-# SPECIALIZE [3] unsafeRecast :: PrimType a => UArray Word8 -> UArray a #-}

null :: UArray ty -> Bool
null :: forall ty. UArray ty -> Bool
null UArray ty
arr = forall ty. UArray ty -> CountOf ty
length UArray ty
arr forall a. Eq a => a -> a -> Bool
== CountOf ty
0

-- | Take a count of elements from the array and create an array with just those elements
take :: CountOf ty -> UArray ty -> UArray ty
take :: forall ty. CountOf ty -> UArray ty -> UArray ty
take CountOf ty
n arr :: UArray ty
arr@(UArray Offset ty
start CountOf ty
len UArrayBackend ty
backend)
    | CountOf ty
n forall a. Ord a => a -> a -> Bool
<= CountOf ty
0    = forall ty. UArray ty
empty
    | CountOf ty
n forall a. Ord a => a -> a -> Bool
>= CountOf ty
len  = UArray ty
arr
    | Bool
otherwise = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
start CountOf ty
n UArrayBackend ty
backend

unsafeTake :: CountOf ty -> UArray ty -> UArray ty
unsafeTake :: forall ty. CountOf ty -> UArray ty -> UArray ty
unsafeTake CountOf ty
sz (UArray Offset ty
start CountOf ty
_ UArrayBackend ty
ba) = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
start CountOf ty
sz UArrayBackend ty
ba

-- | Drop a count of elements from the array and return the new array minus those dropped elements
drop :: CountOf ty -> UArray ty -> UArray ty
drop :: forall ty. CountOf ty -> UArray ty -> UArray ty
drop CountOf ty
n arr :: UArray ty
arr@(UArray Offset ty
start CountOf ty
len UArrayBackend ty
backend)
    | CountOf ty
n forall a. Ord a => a -> a -> Bool
<= CountOf ty
0                             = UArray ty
arr
    | Just CountOf ty
newLen <- CountOf ty
len forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
n, CountOf ty
newLen forall a. Ord a => a -> a -> Bool
> CountOf ty
0 = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (Offset ty
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
n) CountOf ty
newLen UArrayBackend ty
backend
    | Bool
otherwise                          = forall ty. UArray ty
empty

unsafeDrop :: CountOf ty -> UArray ty -> UArray ty
unsafeDrop :: forall ty. CountOf ty -> UArray ty -> UArray ty
unsafeDrop CountOf ty
n (UArray Offset ty
start CountOf ty
sz UArrayBackend ty
backend) = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (Offset ty
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
n) (CountOf ty
sz forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` CountOf ty
n) UArrayBackend ty
backend

-- | Split an array into two, with a count of at most N elements in the first one
-- and the remaining in the other.
splitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)
splitAt :: forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
splitAt CountOf ty
nbElems arr :: UArray ty
arr@(UArray Offset ty
start CountOf ty
len UArrayBackend ty
backend)
    | CountOf ty
nbElems forall a. Ord a => a -> a -> Bool
<= CountOf ty
0                               = (forall ty. UArray ty
empty, UArray ty
arr)
    | Just CountOf ty
nbTails <- CountOf ty
len forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
nbElems, CountOf ty
nbTails forall a. Ord a => a -> a -> Bool
> CountOf ty
0 = (forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
start                         CountOf ty
nbElems UArrayBackend ty
backend
                                                   ,forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (Offset ty
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
nbElems) CountOf ty
nbTails UArrayBackend ty
backend)
    | Bool
otherwise                                  = (UArray ty
arr, forall ty. UArray ty
empty)


breakElem :: PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)
breakElem :: forall ty. PrimType ty => ty -> UArray ty -> (UArray ty, UArray ty)
breakElem !ty
ty arr :: UArray ty
arr@(UArray Offset ty
start CountOf ty
len UArrayBackend ty
backend)
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel = (UArray ty
arr, forall ty. UArray ty
empty)
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== Offset ty
start    = (forall ty. UArray ty
empty, UArray ty
arr)
    | Bool
otherwise     = (forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
start (forall a. Offset a -> CountOf a
offsetAsSize Offset ty
l1)       UArrayBackend ty
backend
                     , forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset ty
k     (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
len forall a. Subtractive a => a -> a -> Difference a
- Offset ty
l1) UArrayBackend ty
backend)
  where
    !k :: Offset ty
k = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
(Indexable container ty, Eq ty) =>
ty -> container -> Offset ty -> Offset ty -> Offset ty
Alg.findIndexElem ty
ty
    l1 :: Offset ty
l1 = Offset ty
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset ty
start
{-# NOINLINE [3] breakElem #-}
{-# RULES "breakElem Word8" [4] breakElem = breakElemByte #-}
{-# SPECIALIZE [3] breakElem :: Word32 -> UArray Word32 -> (UArray Word32, UArray Word32) #-}

breakElemByte :: Word8 -> UArray Word8 -> (UArray Word8, UArray Word8)
breakElemByte :: Word8 -> UArray Word8 -> (UArray Word8, UArray Word8)
breakElemByte !Word8
ty arr :: UArray Word8
arr@(UArray Offset Word8
start CountOf Word8
len UArrayBackend Word8
backend)
    | Offset Word8
k forall a. Eq a => a -> a -> Bool
== Offset Word8
end   = (UArray Word8
arr, forall ty. UArray ty
empty)
    | Offset Word8
k forall a. Eq a => a -> a -> Bool
== Offset Word8
start = (forall ty. UArray ty
empty, UArray Word8
arr)
    | Bool
otherwise  = ( forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset Word8
start (forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
k forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
start) UArrayBackend Word8
backend
                   , forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset Word8
k     (CountOf Word8
len forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` (forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
k forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` forall a. Offset a -> CountOf a
offsetAsSize Offset Word8
start)) UArrayBackend Word8
backend)
  where
    !end :: Offset Word8
end = Offset Word8
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
len
    !k :: Offset Word8
k = forall ty a. (Block ty -> a) -> (Ptr ty -> a) -> UArray ty -> a
onBackendPure Block Word8 -> Offset Word8
goBa Ptr Word8 -> Offset Word8
goAddr UArray Word8
arr
    goBa :: Block Word8 -> Offset Word8
goBa (Block ByteArray#
ba) = ByteArray# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8
sysHsMemFindByteBa ByteArray#
ba Offset Word8
start Offset Word8
end Word8
ty
    goAddr :: Ptr Word8 -> Offset Word8
goAddr (Ptr Addr#
addr) = Addr# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8
sysHsMemFindByteAddr Addr#
addr Offset Word8
start Offset Word8
end Word8
ty

-- | Similar to breakElem specialized to split on linefeed
--
-- it either returns:
-- * Left. no line has been found, and whether the last character is a CR
-- * Right, a line has been found with an optional CR, and it returns
--   the array of bytes on the left of the CR/LF, and the
--   the array of bytes on the right of the LF.
--
breakLine :: UArray Word8 -> Either Bool (UArray Word8, UArray Word8)
breakLine :: UArray Word8 -> Either Bool (UArray Word8, UArray Word8)
breakLine arr :: UArray Word8
arr@(UArray Offset Word8
start CountOf Word8
len UArrayBackend Word8
backend)
    | Offset Word8
end forall a. Eq a => a -> a -> Bool
== Offset Word8
start = forall a b. a -> Either a b
Left Bool
False
    | Offset Word8
k2 forall a. Eq a => a -> a -> Bool
== Offset Word8
end    = forall a b. a -> Either a b
Left (Offset Word8
k1 forall a. Eq a => a -> a -> Bool
/= Offset Word8
k2)
    | Bool
otherwise    = let newArray :: Offset Word8 -> CountOf Word8 -> UArray Word8
newArray Offset Word8
start' CountOf Word8
len' = if CountOf Word8
len' forall a. Eq a => a -> a -> Bool
== CountOf Word8
0 then forall ty. UArray ty
empty else forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray Offset Word8
start' CountOf Word8
len' UArrayBackend Word8
backend
                      in forall a b. b -> Either a b
Right (Offset Word8 -> CountOf Word8 -> UArray Word8
newArray Offset Word8
start (Offset Word8
k1forall a. Subtractive a => a -> a -> Difference a
-Offset Word8
start), Offset Word8 -> CountOf Word8 -> UArray Word8
newArray (Offset Word8
k2forall a. Additive a => a -> a -> a
+Offset Word8
1) (Offset Word8
end forall a. Subtractive a => a -> a -> Difference a
- (Offset Word8
k2forall a. Additive a => a -> a -> a
+Offset Word8
1)))
  where
    !end :: Offset Word8
end = Offset Word8
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
len
    -- return (offset of CR, offset of LF, whether the last element was a carriage return
    !(Offset Word8
k1, Offset Word8
k2) = forall ty a. (Block ty -> a) -> (Ptr ty -> a) -> UArray ty -> a
onBackendPure Block Word8 -> (Offset Word8, Offset Word8)
goBa Ptr Word8 -> (Offset Word8, Offset Word8)
goAddr UArray Word8
arr
    lineFeed :: Word8
lineFeed = Word8
0xa
    carriageReturn :: Word8
carriageReturn = Word8
0xd
    goBa :: Block Word8 -> (Offset Word8, Offset Word8)
goBa (Block ByteArray#
ba) =
        let k :: Offset Word8
k = ByteArray# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8
sysHsMemFindByteBa ByteArray#
ba Offset Word8
start Offset Word8
end Word8
lineFeed
            cr :: Bool
cr = Offset Word8
k forall a. Ord a => a -> a -> Bool
> Offset Word8
start Bool -> Bool -> Bool
&& forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba (Offset Word8
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
1) forall a. Eq a => a -> a -> Bool
== Word8
carriageReturn
         in (if Bool
cr then Offset Word8
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
1 else Offset Word8
k, Offset Word8
k)
    goAddr :: Ptr Word8 -> (Offset Word8, Offset Word8)
goAddr (Ptr Addr#
addr) =
        let k :: Offset Word8
k = Addr# -> Offset Word8 -> Offset Word8 -> Word8 -> Offset Word8
sysHsMemFindByteAddr Addr#
addr Offset Word8
start Offset Word8
end Word8
lineFeed
            cr :: Bool
cr = Offset Word8
k forall a. Ord a => a -> a -> Bool
> Offset Word8
start Bool -> Bool -> Bool
&& forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (Offset Word8
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
1) forall a. Eq a => a -> a -> Bool
== Word8
carriageReturn
         in (if Bool
cr then Offset Word8
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset Word8
1 else Offset Word8
k, Offset Word8
k)

-- inverse a CountOf that is specified from the end (e.g. take n elements from the end)
countFromStart :: UArray ty -> CountOf ty -> CountOf ty
countFromStart :: forall ty. UArray ty -> CountOf ty -> CountOf ty
countFromStart UArray ty
v sz :: CountOf ty
sz@(CountOf Int
sz')
    | CountOf ty
sz forall a. Ord a => a -> a -> Bool
>= CountOf ty
len = forall ty. Int -> CountOf ty
CountOf Int
0
    | Bool
otherwise = forall ty. Int -> CountOf ty
CountOf (Int
len' forall a. Subtractive a => a -> a -> Difference a
- Int
sz')
  where len :: CountOf ty
len@(CountOf Int
len') = forall ty. UArray ty -> CountOf ty
length UArray ty
v

-- | Take the N elements from the end of the array
revTake :: CountOf ty -> UArray ty -> UArray ty
revTake :: forall ty. CountOf ty -> UArray ty -> UArray ty
revTake CountOf ty
n UArray ty
v = forall ty. CountOf ty -> UArray ty -> UArray ty
drop (forall ty. UArray ty -> CountOf ty -> CountOf ty
countFromStart UArray ty
v CountOf ty
n) UArray ty
v

-- | Drop the N elements from the end of the array
revDrop :: CountOf ty -> UArray ty -> UArray ty
revDrop :: forall ty. CountOf ty -> UArray ty -> UArray ty
revDrop CountOf ty
n UArray ty
v = forall ty. CountOf ty -> UArray ty -> UArray ty
take (forall ty. UArray ty -> CountOf ty -> CountOf ty
countFromStart UArray ty
v CountOf ty
n) UArray ty
v

-- | Split an array at the N element from the end, and return
-- the last N elements in the first part of the tuple, and whatever first
-- elements remaining in the second
revSplitAt :: CountOf ty -> UArray ty -> (UArray ty, UArray ty)
revSplitAt :: forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
revSplitAt CountOf ty
n UArray ty
v = (forall ty. CountOf ty -> UArray ty -> UArray ty
drop CountOf ty
sz UArray ty
v, forall ty. CountOf ty -> UArray ty -> UArray ty
take CountOf ty
sz UArray ty
v) where sz :: CountOf ty
sz = forall ty. UArray ty -> CountOf ty -> CountOf ty
countFromStart UArray ty
v CountOf ty
n

splitOn :: PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]
splitOn :: forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> [UArray ty]
splitOn ty -> Bool
xpredicate UArray ty
ivec
    | CountOf ty
len forall a. Eq a => a -> a -> Bool
== CountOf ty
0  = [forall a. Monoid a => a
mempty]
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
UArray ty -> ((Offset ty -> ty) -> prim a) -> prim a
unsafeIndexer UArray ty
ivec (forall a s. a -> ST s a
pureST forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> [UArray ty]
go UArray ty
ivec ty -> Bool
xpredicate)
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
ivec
    go :: UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> [UArray ty]
go UArray ty
v ty -> Bool
predicate Offset ty -> ty
getIdx = Offset ty -> Offset ty -> [UArray ty]
loop Offset ty
0 Offset ty
0
      where
        loop :: Offset ty -> Offset ty -> [UArray ty]
loop !Offset ty
prevIdx !Offset ty
idx
            | Offset ty
idx forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = [forall ty.
PrimType ty =>
UArray ty -> Offset ty -> Offset ty -> UArray ty
sub UArray ty
v Offset ty
prevIdx Offset ty
idx]
            | Bool
otherwise    =
                let e :: ty
e = Offset ty -> ty
getIdx Offset ty
idx
                    idx' :: Offset ty
idx' = Offset ty
idx forall a. Additive a => a -> a -> a
+ Offset ty
1
                 in if ty -> Bool
predicate ty
e
                        then forall ty.
PrimType ty =>
UArray ty -> Offset ty -> Offset ty -> UArray ty
sub UArray ty
v Offset ty
prevIdx Offset ty
idx forall a. a -> [a] -> [a]
: Offset ty -> Offset ty -> [UArray ty]
loop Offset ty
idx' Offset ty
idx'
                        else Offset ty -> Offset ty -> [UArray ty]
loop Offset ty
prevIdx Offset ty
idx'
    {-# INLINE go #-}

sub :: PrimType ty => UArray ty -> Offset ty -> Offset ty -> UArray ty
sub :: forall ty.
PrimType ty =>
UArray ty -> Offset ty -> Offset ty -> UArray ty
sub (UArray Offset ty
start CountOf ty
len UArrayBackend ty
backend) Offset ty
startIdx Offset ty
expectedEndIdx
    | Offset ty
startIdx forall a. Ord a => a -> a -> Bool
>= Offset ty
endIdx = forall a. Monoid a => a
mempty
    | Bool
otherwise          = forall ty. Offset ty -> CountOf ty -> UArrayBackend ty -> UArray ty
UArray (Offset ty
start forall a. Additive a => a -> a -> a
+ Offset ty
startIdx) Difference (Offset ty)
newLen UArrayBackend ty
backend
  where
    newLen :: Difference (Offset ty)
newLen = Offset ty
endIdx forall a. Subtractive a => a -> a -> Difference a
- Offset ty
startIdx
    endIdx :: Offset ty
endIdx = forall a. Ord a => a -> a -> a
min Offset ty
expectedEndIdx (Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len)

findIndex :: PrimType ty => ty -> UArray ty -> Maybe (Offset ty)
findIndex :: forall ty. PrimType ty => ty -> UArray ty -> Maybe (Offset ty)
findIndex ty
ty UArray ty
arr
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel  = forall a. Maybe a
Nothing
    | Bool
otherwise      = forall a. a -> Maybe a
Just (Offset ty
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` forall ty. UArray ty -> Offset ty
offset UArray ty
arr)
  where
    !k :: Offset ty
k = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
(Indexable container ty, Eq ty) =>
ty -> container -> Offset ty -> Offset ty -> Offset ty
Alg.findIndexElem ty
ty
{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}

revFindIndex :: PrimType ty => ty -> UArray ty -> Maybe (Offset ty)
revFindIndex :: forall ty. PrimType ty => ty -> UArray ty -> Maybe (Offset ty)
revFindIndex ty
ty UArray ty
arr
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel = forall a. Maybe a
Nothing
    | Bool
otherwise     = forall a. a -> Maybe a
Just (Offset ty
k forall a. Offset a -> Offset a -> Offset a
`offsetSub` forall ty. UArray ty -> Offset ty
offset UArray ty
arr)
  where
    !k :: Offset ty
k = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
(Indexable container ty, Eq ty) =>
ty -> container -> Offset ty -> Offset ty -> Offset ty
Alg.revFindIndexElem ty
ty
{-# SPECIALIZE [3] revFindIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}

break :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
break :: forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
break ty -> Bool
predicate UArray ty
arr
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel = (UArray ty
arr, forall a. Monoid a => a
mempty)
    | Bool
otherwise     = forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
splitAt (Offset ty
k forall a. Subtractive a => a -> a -> Difference a
- forall ty. UArray ty -> Offset ty
offset UArray ty
arr) UArray ty
arr
  where
    !k :: Offset ty
k = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
Indexable container ty =>
(ty -> Bool) -> container -> Offset ty -> Offset ty -> Offset ty
Alg.findIndexPredicate ty -> Bool
predicate

{-
{-# SPECIALIZE [3] findIndex :: Word8 -> UArray Word8 -> Maybe (Offset Word8) #-}
    | len == 0  = (mempty, mempty)
    | otherwise = runST $ unsafeIndexer xv (go xv xpredicate)
  where
    !len = length xv
    go :: PrimType ty => UArray ty -> (ty -> Bool) -> (Offset ty -> ty) -> ST s (UArray ty, UArray ty)
    go v predicate getIdx = pure (findBreak $ Offset 0)
      where
        findBreak !i
            | i .==# len           = (v, mempty)
            | predicate (getIdx i) = splitAt (offsetAsSize i) v
            | otherwise            = findBreak (i + Offset 1)
        {-# INLINE findBreak #-}
    {-# INLINE go #-}
    -}
{-# NOINLINE [2] break #-}
{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}

{-
{-# RULES "break (== ty)" [3] forall (x :: forall ty . PrimType ty => ty) . break (== x) = breakElem x #-}
{-# RULES "break (ty ==)" [3] forall (x :: forall ty . PrimType ty => ty) . break (x ==) = breakElem x #-}
{-# RULES "break (== ty)" [3] forall (x :: Word8) . break (== x) = breakElem x #-}
-}

-- | Similar to break but start the search of the breakpoint from the end
--
-- > breakEnd (> 0) [1,2,3,0,0,0]
-- ([1,2,3], [0,0,0])
breakEnd :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
breakEnd :: forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
breakEnd ty -> Bool
predicate UArray ty
arr
    | Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel = (UArray ty
arr, forall a. Monoid a => a
mempty)
    | Bool
otherwise     = forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
splitAt ((Offset ty
kforall a. Additive a => a -> a -> a
+Offset ty
1) forall a. Subtractive a => a -> a -> Difference a
- forall ty. UArray ty -> Offset ty
offset UArray ty
arr) UArray ty
arr
  where
    !k :: Offset ty
k = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
Indexable container ty =>
(ty -> Bool) -> container -> Offset ty -> Offset ty -> Offset ty
Alg.revFindIndexPredicate ty -> Bool
predicate
{-# SPECIALIZE [3] breakEnd :: (Word8 -> Bool) -> UArray Word8 -> (UArray Word8, UArray Word8) #-}

elem :: PrimType ty => ty -> UArray ty -> Bool
elem :: forall ty. PrimType ty => ty -> UArray ty -> Bool
elem !ty
ty UArray ty
arr = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr (forall container ty.
(Indexable container ty, Eq ty) =>
ty -> container -> Offset ty -> Offset ty -> Offset ty
Alg.findIndexElem ty
ty) forall a. Eq a => a -> a -> Bool
/= forall {ty}. Offset ty
sentinel
{-# SPECIALIZE [2] elem :: Word8 -> UArray Word8 -> Bool #-}

intersperse :: forall ty . PrimType ty => ty -> UArray ty -> UArray ty
intersperse :: forall ty. PrimType ty => ty -> UArray ty -> UArray ty
intersperse ty
sep UArray ty
v = case CountOf ty
len forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
1 of
    Maybe (CountOf ty)
Difference (CountOf ty)
Nothing -> UArray ty
v
    Just CountOf ty
0 -> UArray ty
v
    Just CountOf ty
gaps -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ forall a b s.
(PrimType a, PrimType b) =>
UArray a
-> CountOf b
-> (UArray a -> Offset a -> MUArray b s -> ST s ())
-> ST s (UArray b)
unsafeCopyFrom UArray ty
v (CountOf ty
len forall a. Additive a => a -> a -> a
+ CountOf ty
gaps) forall s.
PrimType ty =>
UArray ty -> Offset ty -> MUArray ty s -> ST s ()
go
  where
    len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
v

    go :: PrimType ty => UArray ty -> Offset ty -> MUArray ty s -> ST s ()
    go :: forall s.
PrimType ty =>
UArray ty -> Offset ty -> MUArray ty s -> ST s ()
go UArray ty
oldV Offset ty
oldI MUArray ty s
newV
        | (Offset ty
oldI forall a. Additive a => a -> a -> a
+ Offset ty
1) forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty s
newV Offset ty
newI ty
e
        | Bool
otherwise           = do
            forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty s
newV Offset ty
newI ty
e
            forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty s
newV (Offset ty
newI forall a. Additive a => a -> a -> a
+ Offset ty
1) ty
sep
      where
        e :: ty
e = forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
oldV Offset ty
oldI
        newI :: Offset ty
newI = forall a n. (Additive a, IsNatural n) => n -> a -> a
scale (Word
2 :: Word) Offset ty
oldI

span :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
span :: forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
span ty -> Bool
p = forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
break (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ty -> Bool
p)

spanEnd :: PrimType ty => (ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
spanEnd :: forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
spanEnd ty -> Bool
p = forall ty.
PrimType ty =>
(ty -> Bool) -> UArray ty -> (UArray ty, UArray ty)
breakEnd (Bool -> Bool
not forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ty -> Bool
p)

map :: (PrimType a, PrimType b) => (a -> b) -> UArray a -> UArray b
map :: forall a b.
(PrimType a, PrimType b) =>
(a -> b) -> UArray a -> UArray b
map a -> b
f UArray a
a = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> UArray ty
create CountOf b
lenB (\Offset b
i -> a -> b
f forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray a
a (forall a b. Proxy (a -> b) -> Offset a -> Offset b
offsetCast forall {k} (t :: k). Proxy t
Proxy Offset b
i))
  where !lenB :: CountOf b
lenB = forall a b. Proxy (a -> b) -> CountOf a -> CountOf b
sizeCast (forall {k} (t :: k). Proxy t
Proxy :: Proxy (a -> b)) (forall ty. UArray ty -> CountOf ty
length UArray a
a)

mapIndex :: (PrimType a, PrimType b) => (Offset b -> a -> b) -> UArray a -> UArray b
mapIndex :: forall a b.
(PrimType a, PrimType b) =>
(Offset b -> a -> b) -> UArray a -> UArray b
mapIndex Offset b -> a -> b
f UArray a
a = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> UArray ty
create (forall a b. Proxy (a -> b) -> CountOf a -> CountOf b
sizeCast forall {k} (t :: k). Proxy t
Proxy forall a b. (a -> b) -> a -> b
$ forall ty. UArray ty -> CountOf ty
length UArray a
a) (\Offset b
i -> Offset b -> a -> b
f Offset b
i forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray a
a (forall a b. Proxy (a -> b) -> Offset a -> Offset b
offsetCast forall {k} (t :: k). Proxy t
Proxy Offset b
i))

cons :: PrimType ty => ty -> UArray ty -> UArray ty
cons :: forall ty. PrimType ty => ty -> UArray ty -> UArray ty
cons ty
e UArray ty
vec
    | CountOf ty
len forall a. Eq a => a -> a -> Bool
== forall ty. Int -> CountOf ty
CountOf Int
0 = forall ty. PrimType ty => ty -> UArray ty
singleton ty
e
    | Bool
otherwise     = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MUArray ty s
muv <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new (CountOf ty
len forall a. Additive a => a -> a -> a
+ CountOf ty
1)
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty s
muv Offset ty
1 UArray ty
vec Offset ty
0 CountOf ty
len
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty s
muv Offset ty
0 ty
e
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty s
muv
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
vec

snoc :: PrimType ty => UArray ty -> ty -> UArray ty
snoc :: forall ty. PrimType ty => UArray ty -> ty -> UArray ty
snoc UArray ty
vec ty
e
    | CountOf ty
len forall a. Eq a => a -> a -> Bool
== forall ty. Int -> CountOf ty
CountOf Int
0 = forall ty. PrimType ty => ty -> UArray ty
singleton ty
e
    | Bool
otherwise     = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MUArray ty s
muv <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new (CountOf ty
len forall a. Additive a => a -> a -> a
+ forall ty. Int -> CountOf ty
CountOf Int
1)
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty s
muv (forall ty. Int -> Offset ty
Offset Int
0) UArray ty
vec (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
len
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty s
muv (Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. UArray ty -> CountOf ty
length UArray ty
vec) ty
e
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty s
muv
  where
     !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
vec

uncons :: PrimType ty => UArray ty -> Maybe (ty, UArray ty)
uncons :: forall ty. PrimType ty => UArray ty -> Maybe (ty, UArray ty)
uncons UArray ty
vec
    | CountOf ty
nbElems forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = forall a. Maybe a
Nothing
    | Bool
otherwise    = forall a. a -> Maybe a
Just (forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
vec Offset ty
0, forall ty.
PrimType ty =>
UArray ty -> Offset ty -> Offset ty -> UArray ty
sub UArray ty
vec Offset ty
1 (Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
nbElems))
  where
    !nbElems :: CountOf ty
nbElems = forall ty. UArray ty -> CountOf ty
length UArray ty
vec

unsnoc :: PrimType ty => UArray ty -> Maybe (UArray ty, ty)
unsnoc :: forall ty. PrimType ty => UArray ty -> Maybe (UArray ty, ty)
unsnoc UArray ty
vec = case forall ty. UArray ty -> CountOf ty
length UArray ty
vec forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
1 of
    Maybe (CountOf ty)
Difference (CountOf ty)
Nothing -> forall a. Maybe a
Nothing
    Just CountOf ty
newLen -> forall a. a -> Maybe a
Just (forall ty.
PrimType ty =>
UArray ty -> Offset ty -> Offset ty -> UArray ty
sub UArray ty
vec Offset ty
0 Offset ty
lastElem, forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
vec Offset ty
lastElem)
                     where !lastElem :: Offset ty
lastElem = Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
newLen

find :: PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty
find :: forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Maybe ty
find ty -> Bool
predicate UArray ty
vec = Offset ty -> Maybe ty
loop Offset ty
0
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
vec
    loop :: Offset ty -> Maybe ty
loop Offset ty
i
        | Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = forall a. Maybe a
Nothing
        | Bool
otherwise  =
            let e :: ty
e = forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
vec Offset ty
i
             in if ty -> Bool
predicate ty
e then forall a. a -> Maybe a
Just ty
e else Offset ty -> Maybe ty
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)

sortBy :: forall ty . PrimType ty => (ty -> ty -> Ordering) -> UArray ty -> UArray ty
sortBy :: forall ty.
PrimType ty =>
(ty -> ty -> Ordering) -> UArray ty -> UArray ty
sortBy ty -> ty -> Ordering
ford UArray ty
vec = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MUArray ty s
mvec <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
UArray ty -> prim (MUArray ty (PrimState prim))
thaw UArray ty
vec
    forall (prim :: * -> *) ty a.
PrimMonad prim =>
(MutableBlock ty (PrimState prim) -> prim a)
-> (FinalPtr ty -> prim a) -> MUArray ty (PrimState prim) -> prim a
onMutableBackend forall s. MutableBlock ty s -> ST s ()
goNative (\FinalPtr ty
fptr -> forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr ty
fptr forall s. Ptr ty -> ST s ()
goAddr) MUArray ty s
mvec
    forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty s
mvec
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
vec
    !start :: Offset ty
start = forall ty. UArray ty -> Offset ty
offset UArray ty
vec

    goNative :: MutableBlock ty s -> ST s ()
    goNative :: forall s. MutableBlock ty s -> ST s ()
goNative MutableBlock ty s
mb = forall (prim :: * -> *) container ty.
(PrimMonad prim, RandomAccess container prim ty) =>
(ty -> ty -> Ordering)
-> Offset ty -> CountOf ty -> container -> prim ()
Alg.inplaceSortBy ty -> ty -> Ordering
ford Offset ty
start CountOf ty
len MutableBlock ty s
mb
    goAddr :: Ptr ty -> ST s ()
    goAddr :: forall s. Ptr ty -> ST s ()
goAddr (Ptr Addr#
addr) = forall (prim :: * -> *) container ty.
(PrimMonad prim, RandomAccess container prim ty) =>
(ty -> ty -> Ordering)
-> Offset ty -> CountOf ty -> container -> prim ()
Alg.inplaceSortBy ty -> ty -> Ordering
ford Offset ty
start CountOf ty
len (forall a. Addr# -> Ptr a
Ptr Addr#
addr :: Ptr ty)
{-# SPECIALIZE [3] sortBy :: (Word8 -> Word8 -> Ordering) -> UArray Word8 -> UArray Word8 #-}

filter :: forall ty . PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty
filter :: forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> UArray ty
filter ty -> Bool
predicate UArray ty
arr = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    (CountOf ty
newLen, MUArray ty s
ma) <- forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
CountOf ty
-> (MutableBlock ty (PrimState prim) -> prim a)
-> prim (a, MUArray ty (PrimState prim))
newNative (forall ty. UArray ty -> CountOf ty
length UArray ty
arr) forall a b. (a -> b) -> a -> b
$ \(MutableBlock MutableByteArray# (PrimState (ST s))
mba) ->
            forall (prim :: * -> *) ty a.
PrimMonad prim =>
(Block ty -> prim a)
-> (FinalPtr ty -> prim a) -> UArray ty -> prim a
onBackendPrim (\Block ty
block -> forall (prim :: * -> *) ty container.
(PrimMonad prim, PrimType ty, Indexable container ty) =>
(ty -> Bool)
-> MutableByteArray# (PrimState prim)
-> container
-> Offset ty
-> Offset ty
-> prim (CountOf ty)
Alg.filter ty -> Bool
predicate MutableByteArray# (PrimState (ST s))
mba Block ty
block Offset ty
start Offset ty
end)
                          (\FinalPtr ty
fptr -> forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr ty
fptr forall a b. (a -> b) -> a -> b
$ \ptr :: Ptr ty
ptr@(Ptr !Addr#
_) ->
                                        forall (prim :: * -> *) ty container.
(PrimMonad prim, PrimType ty, Indexable container ty) =>
(ty -> Bool)
-> MutableByteArray# (PrimState prim)
-> container
-> Offset ty
-> Offset ty
-> prim (CountOf ty)
Alg.filter ty -> Bool
predicate MutableByteArray# (PrimState (ST s))
mba Ptr ty
ptr Offset ty
start Offset ty
end)
                          UArray ty
arr
    forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
unsafeFreezeShrink MUArray ty s
ma CountOf ty
newLen
  where
    !len :: CountOf ty
len   = forall ty. UArray ty -> CountOf ty
length UArray ty
arr
    !start :: Offset ty
start = forall ty. UArray ty -> Offset ty
offset UArray ty
arr
    !end :: Offset ty
end   = Offset ty
start forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len

reverse :: forall ty . PrimType ty => UArray ty -> UArray ty
reverse :: forall ty. PrimType ty => UArray ty -> UArray ty
reverse UArray ty
a
    | CountOf ty
len forall a. Eq a => a -> a -> Bool
== CountOf ty
0  = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MUArray ty s
a <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty
-> (MutableBlock ty (PrimState prim) -> prim ())
-> prim (MUArray ty (PrimState prim))
newNative_ CountOf ty
len forall a b. (a -> b) -> a -> b
$ \MutableBlock ty (PrimState (ST s))
mba -> forall (prim :: * -> *) ty a.
PrimMonad prim =>
(Block ty -> prim a)
-> (FinalPtr ty -> prim a) -> UArray ty -> prim a
onBackendPrim (forall s. MutableBlock ty s -> Block ty -> ST s ()
goNative MutableBlock ty (PrimState (ST s))
mba)
                                                    (\FinalPtr ty
fptr -> forall (prim :: * -> *) p a.
PrimMonad prim =>
FinalPtr p -> (Ptr p -> prim a) -> prim a
withFinalPtr FinalPtr ty
fptr forall a b. (a -> b) -> a -> b
$ forall s. MutableBlock ty s -> Ptr ty -> ST s ()
goAddr MutableBlock ty (PrimState (ST s))
mba)
                                                    UArray ty
a
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray ty s
a
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
a
    !end :: Offset ty
end = Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len
    !start :: Offset ty
start = forall ty. UArray ty -> Offset ty
offset UArray ty
a
    !endI :: Offset ty
endI = forall a. CountOf a -> Offset a
sizeAsOffset ((Offset ty
start forall a. Additive a => a -> a -> a
+ Offset ty
end) forall a. Subtractive a => a -> a -> Difference a
- forall ty. Int -> Offset ty
Offset Int
1)

    goNative :: MutableBlock ty s -> Block ty -> ST s ()
    goNative :: forall s. MutableBlock ty s -> Block ty -> ST s ()
goNative !MutableBlock ty s
ma (Block !ByteArray#
ba) = Offset ty -> ST s ()
loop Offset ty
0
      where
        loop :: Offset ty -> ST s ()
loop !Offset ty
i
            | Offset ty
i forall a. Eq a => a -> a -> Bool
== Offset ty
end  = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock ty s
ma Offset ty
i (forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba (forall a. CountOf a -> Offset a
sizeAsOffset (Offset ty
endI forall a. Subtractive a => a -> a -> Difference a
- Offset ty
i))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> ST s ()
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
    goAddr :: MutableBlock ty s -> Ptr ty -> ST s ()
    goAddr :: forall s. MutableBlock ty s -> Ptr ty -> ST s ()
goAddr !MutableBlock ty s
ma (Ptr Addr#
addr) = Offset ty -> ST s ()
loop Offset ty
0
      where
        loop :: Offset ty -> ST s ()
loop !Offset ty
i
            | Offset ty
i forall a. Eq a => a -> a -> Bool
== Offset ty
end  = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
BLK.unsafeWrite MutableBlock ty s
ma Offset ty
i (forall ty. PrimType ty => Addr# -> Offset ty -> ty
primAddrIndex Addr#
addr (forall a. CountOf a -> Offset a
sizeAsOffset (Offset ty
endI forall a. Subtractive a => a -> a -> Difference a
- Offset ty
i))) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> ST s ()
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
{-# SPECIALIZE [3] reverse :: UArray Word8 -> UArray Word8 #-}
{-# SPECIALIZE [3] reverse :: UArray Word32 -> UArray Word32 #-}
{-# SPECIALIZE [3] reverse :: UArray Char -> UArray Char #-}

-- Finds where are the insertion points when we search for a `needle`
-- within an `haystack`.
-- Throws an error in case `needle` is empty.
indices :: PrimType ty => UArray ty -> UArray ty -> [Offset ty]
indices :: forall ty. PrimType ty => UArray ty -> UArray ty -> [Offset ty]
indices UArray ty
needle UArray ty
hy
  | CountOf ty
needleLen forall a. Ord a => a -> a -> Bool
<= CountOf ty
0 = forall a. HasCallStack => [Char] -> a
error [Char]
"Basement.UArray.indices: needle is empty."
  | Bool
otherwise = case CountOf ty
haystackLen forall a. Ord a => a -> a -> Bool
< CountOf ty
needleLen of
                  Bool
True  -> []
                  Bool
False -> Offset ty -> [Offset ty] -> [Offset ty]
go (forall ty. Int -> Offset ty
Offset Int
0) []
  where
    !haystackLen :: CountOf ty
haystackLen = forall ty. UArray ty -> CountOf ty
length UArray ty
hy

    !needleLen :: CountOf ty
needleLen = forall ty. UArray ty -> CountOf ty
length UArray ty
needle

    go :: Offset ty -> [Offset ty] -> [Offset ty]
go Offset ty
currentOffset [Offset ty]
ipoints
      | (Offset ty
currentOffset forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
needleLen) forall a. Ord a => a -> a -> Bool
> (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
haystackLen) = [Offset ty]
ipoints
      | Bool
otherwise =
        let matcher :: UArray ty
matcher = forall ty. CountOf ty -> UArray ty -> UArray ty
take CountOf ty
needleLen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall ty. CountOf ty -> UArray ty -> UArray ty
drop (forall a. Offset a -> CountOf a
offsetAsSize Offset ty
currentOffset) forall a b. (a -> b) -> a -> b
$ UArray ty
hy
        in case UArray ty
matcher forall a. Eq a => a -> a -> Bool
== UArray ty
needle of
             -- TODO: Move away from right-appending as it's gonna be slow.
             Bool
True  -> Offset ty -> [Offset ty] -> [Offset ty]
go (Offset ty
currentOffset forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
needleLen) ([Offset ty]
ipoints forall a. Semigroup a => a -> a -> a
<> [Offset ty
currentOffset])
             Bool
False -> Offset ty -> [Offset ty] -> [Offset ty]
go (Offset ty
currentOffset forall a. Additive a => a -> a -> a
+ Offset ty
1) [Offset ty]
ipoints

-- | Replace all the occurrencies of `needle` with `replacement` in
-- the `haystack` string.
replace :: PrimType ty => UArray ty -> UArray ty -> UArray ty -> UArray ty
replace :: forall ty.
PrimType ty =>
UArray ty -> UArray ty -> UArray ty -> UArray ty
replace (UArray ty
needle :: UArray ty) UArray ty
replacement UArray ty
haystack = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    case forall ty. UArray ty -> Bool
null UArray ty
needle of
      Bool
True -> forall a. HasCallStack => [Char] -> a
error [Char]
"Basement.UArray.replace: empty needle"
      Bool
False -> do
        let insertionPoints :: [Offset ty]
insertionPoints = forall ty. PrimType ty => UArray ty -> UArray ty -> [Offset ty]
indices UArray ty
needle UArray ty
haystack
        let !(CountOf Int
occs) = forall a. [a] -> CountOf a
List.length [Offset ty]
insertionPoints
        let !newLen :: CountOf ty
newLen         = CountOf ty
haystackLen forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` (forall {ty} {ty}. CountOf ty -> Int -> CountOf ty
multBy CountOf ty
needleLen Int
occs) forall a. Additive a => a -> a -> a
+ (forall {ty} {ty}. CountOf ty -> Int -> CountOf ty
multBy CountOf ty
replacementLen Int
occs)
        MUArray ty s
ms <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
newLen
        forall (prim :: * -> *).
PrimMonad prim =>
MUArray ty (PrimState prim)
-> Offset ty -> Offset ty -> [Offset ty] -> prim (UArray ty)
loop MUArray ty s
ms (forall ty. Int -> Offset ty
Offset Int
0) (forall ty. Int -> Offset ty
Offset Int
0) [Offset ty]
insertionPoints
  where

    multBy :: CountOf ty -> Int -> CountOf ty
multBy (CountOf Int
x) Int
y = forall ty. Int -> CountOf ty
CountOf (Int
x forall a. Multiplicative a => a -> a -> a
* Int
y)

    !needleLen :: CountOf ty
needleLen = forall ty. UArray ty -> CountOf ty
length UArray ty
needle

    !replacementLen :: CountOf ty
replacementLen = forall ty. UArray ty -> CountOf ty
length UArray ty
replacement

    !haystackLen :: CountOf ty
haystackLen = forall ty. UArray ty -> CountOf ty
length UArray ty
haystack

    -- Go through each insertion point and copy things over.
    -- We keep around the offset to the original string to
    -- be able to copy bytes which didn't change.
    loop :: PrimMonad prim
         => MUArray ty (PrimState prim)
         -> Offset ty
         -> Offset ty
         -> [Offset ty]
         -> prim (UArray ty)
    loop :: forall (prim :: * -> *).
PrimMonad prim =>
MUArray ty (PrimState prim)
-> Offset ty -> Offset ty -> [Offset ty] -> prim (UArray ty)
loop MUArray ty (PrimState prim)
mba Offset ty
currentOffset Offset ty
offsetInOriginalString [] = do
      -- Finalise the string
      let !unchangedDataLen :: Difference (Offset ty)
unchangedDataLen = forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
haystackLen forall a. Subtractive a => a -> a -> Difference a
- Offset ty
offsetInOriginalString
      forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty (PrimState prim)
mba Offset ty
currentOffset UArray ty
haystack Offset ty
offsetInOriginalString Difference (Offset ty)
unchangedDataLen
      forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> prim (UArray ty)
freeze MUArray ty (PrimState prim)
mba
    loop MUArray ty (PrimState prim)
mba Offset ty
currentOffset Offset ty
offsetInOriginalString (Offset ty
x:[Offset ty]
xs) = do
        -- 1. Copy from the old string.
        let !unchangedDataLen :: Difference (Offset ty)
unchangedDataLen = (Offset ty
x forall a. Subtractive a => a -> a -> Difference a
- Offset ty
offsetInOriginalString)
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty (PrimState prim)
mba Offset ty
currentOffset UArray ty
haystack Offset ty
offsetInOriginalString Difference (Offset ty)
unchangedDataLen
        let !newOffset :: Offset ty
newOffset = Offset ty
currentOffset forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` Difference (Offset ty)
unchangedDataLen
        -- 2. Copy the replacement.
        forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty (PrimState prim)
mba Offset ty
newOffset UArray ty
replacement (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
replacementLen
        let !offsetInOriginalString' :: Offset ty
offsetInOriginalString' = Offset ty
offsetInOriginalString forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` Difference (Offset ty)
unchangedDataLen forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
needleLen
        forall (prim :: * -> *).
PrimMonad prim =>
MUArray ty (PrimState prim)
-> Offset ty -> Offset ty -> [Offset ty] -> prim (UArray ty)
loop MUArray ty (PrimState prim)
mba (Offset ty
newOffset forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
replacementLen) Offset ty
offsetInOriginalString' [Offset ty]
xs
{-# SPECIALIZE [3] replace :: UArray Word8 -> UArray Word8 -> UArray Word8 -> UArray Word8 #-}

foldr :: PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a
foldr :: forall ty a. PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a
foldr ty -> a -> a
f a
initialAcc UArray ty
vec = Offset ty -> a
loop Offset ty
0
  where
    !len :: CountOf ty
len = forall ty. UArray ty -> CountOf ty
length UArray ty
vec
    loop :: Offset ty -> a
loop Offset ty
i
        | Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = a
initialAcc
        | Bool
otherwise  = forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
vec Offset ty
i ty -> a -> a
`f` Offset ty -> a
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)

foldl' :: PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a
foldl' :: forall ty a. PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a
foldl' a -> ty -> a
f a
initialAcc UArray ty
arr = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr (forall container ty a.
Indexable container ty =>
(a -> ty -> a) -> a -> container -> Offset ty -> Offset ty -> a
Alg.foldl a -> ty -> a
f a
initialAcc)
{-# SPECIALIZE [3] foldl' :: (a -> Word8 -> a) -> a -> UArray Word8 -> a #-}

foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
foldl1' :: forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
foldl1' ty -> ty -> ty
f (NonEmpty UArray ty
arr) = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr (forall container ty.
Indexable container ty =>
(ty -> ty -> ty) -> container -> Offset ty -> Offset ty -> ty
Alg.foldl1 ty -> ty -> ty
f)
{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (UArray Word8) -> Word8 #-}

foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
foldr1 :: forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
foldr1 ty -> ty -> ty
f NonEmpty (UArray ty)
arr = let (UArray ty
initialAcc, UArray ty
rest) = forall ty. CountOf ty -> UArray ty -> (UArray ty, UArray ty)
revSplitAt CountOf ty
1 forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
getNonEmpty NonEmpty (UArray ty)
arr
               in forall ty a. PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a
foldr ty -> ty -> ty
f (forall ty. PrimType ty => UArray ty -> Offset ty -> ty
unsafeIndex UArray ty
initialAcc Offset ty
0) UArray ty
rest

all :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool
all :: forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
all ty -> Bool
predicate UArray ty
arr = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
Indexable container ty =>
(ty -> Bool) -> container -> Offset ty -> Offset ty -> Bool
Alg.all ty -> Bool
predicate
{-# SPECIALIZE [3] all :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}

any :: PrimType ty => (ty -> Bool) -> UArray ty -> Bool
any :: forall ty. PrimType ty => (ty -> Bool) -> UArray ty -> Bool
any ty -> Bool
predicate UArray ty
arr = forall ty a.
PrimType ty =>
UArray ty
-> (forall container.
    Indexable container ty =>
    container -> Offset ty -> Offset ty -> a)
-> a
onBackendPure' UArray ty
arr forall a b. (a -> b) -> a -> b
$ forall container ty.
Indexable container ty =>
(ty -> Bool) -> container -> Offset ty -> Offset ty -> Bool
Alg.any ty -> Bool
predicate
{-# SPECIALIZE [3] any :: (Word8 -> Bool) -> UArray Word8 -> Bool #-}

builderAppend :: (PrimType ty, PrimMonad state) => ty -> Builder (UArray ty) (MUArray ty) ty state err ()
builderAppend :: forall ty (state :: * -> *) err.
(PrimType ty, PrimMonad state) =>
ty -> Builder (UArray ty) (MUArray ty) ty state err ()
builderAppend ty
v = forall collection (mutCollection :: * -> *) step (state :: * -> *)
       err a.
State
  (Offset step,
   BuildingState collection mutCollection step (PrimState state),
   Maybe err)
  state
  a
-> Builder collection mutCollection step state err a
Builder forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> State s m a
State forall a b. (a -> b) -> a -> b
$ \(Offset ty
i, BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st, Maybe err
e) ->
    if forall a. Offset a -> CountOf a
offsetAsSize Offset ty
i forall a. Eq a => a -> a -> Bool
== forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> CountOf step
chunkSize BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st
        then do
            UArray ty
cur      <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze (forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state
-> mutCollection state
curChunk BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st)
            MUArray ty (PrimState state)
newChunk <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new (forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> CountOf step
chunkSize BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st)
            forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray ty (PrimState state)
newChunk Offset ty
0 ty
v
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), (forall ty. Int -> Offset ty
Offset Int
1, BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st { prevChunks :: [UArray ty]
prevChunks     = UArray ty
cur forall a. a -> [a] -> [a]
: forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> [collection]
prevChunks BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st
                                    , prevChunksSize :: CountOf ty
prevChunksSize = forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> CountOf step
chunkSize BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st forall a. Additive a => a -> a -> a
+ forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> CountOf step
prevChunksSize BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st
                                    , curChunk :: MUArray ty (PrimState state)
curChunk       = MUArray ty (PrimState state)
newChunk
                                    }, Maybe err
e))
        else do
            forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite (forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state
-> mutCollection state
curChunk BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st) Offset ty
i ty
v
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ((), (Offset ty
i forall a. Additive a => a -> a -> a
+ Offset ty
1, BuildingState (UArray ty) (MUArray ty) ty (PrimState state)
st, Maybe err
e))

builderBuild :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m err () -> m (Either err (UArray ty))
builderBuild :: forall ty (m :: * -> *) err.
(PrimType ty, PrimMonad m) =>
Int
-> Builder (UArray ty) (MUArray ty) ty m err ()
-> m (Either err (UArray ty))
builderBuild Int
sizeChunksI Builder (UArray ty) (MUArray ty) ty m err ()
ab
    | Int
sizeChunksI forall a. Ord a => a -> a -> Bool
<= Int
0 = forall ty (m :: * -> *) err.
(PrimType ty, PrimMonad m) =>
Int
-> Builder (UArray ty) (MUArray ty) ty m err ()
-> m (Either err (UArray ty))
builderBuild Int
64 Builder (UArray ty) (MUArray ty) ty m err ()
ab
    | Bool
otherwise        = do
        MUArray ty (PrimState m)
first      <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
sizeChunks
        (Offset ty
i, BuildingState (UArray ty) (MUArray ty) ty (PrimState m)
st, Maybe err
e) <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. State s m a -> s -> m (a, s)
runState (forall collection (mutCollection :: * -> *) step (state :: * -> *)
       err a.
Builder collection mutCollection step state err a
-> State
     (Offset step,
      BuildingState collection mutCollection step (PrimState state),
      Maybe err)
     state
     a
runBuilder Builder (UArray ty) (MUArray ty) ty m err ()
ab) (forall ty. Int -> Offset ty
Offset Int
0, forall collection (mutCollection :: * -> *) step state.
[collection]
-> CountOf step
-> mutCollection state
-> CountOf step
-> BuildingState collection mutCollection step state
BuildingState [] (forall ty. Int -> CountOf ty
CountOf Int
0) MUArray ty (PrimState m)
first CountOf ty
sizeChunks, forall a. Maybe a
Nothing)
        case Maybe err
e of
          Just err
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. a -> Either a b
Left err
err)
          Maybe err
Nothing -> do
            UArray ty
cur <- forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MUArray ty (PrimState prim) -> CountOf ty -> prim (UArray ty)
unsafeFreezeShrink (forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state
-> mutCollection state
curChunk BuildingState (UArray ty) (MUArray ty) ty (PrimState m)
st) (forall a. Offset a -> CountOf a
offsetAsSize Offset ty
i)
            -- Build final array
            let totalSize :: CountOf ty
totalSize = forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> CountOf step
prevChunksSize BuildingState (UArray ty) (MUArray ty) ty (PrimState m)
st forall a. Additive a => a -> a -> a
+ forall a. Offset a -> CountOf a
offsetAsSize Offset ty
i
            UArray ty
bytes <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf ty
totalSize forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *} {ty}.
(PrimMonad f, PrimType ty) =>
CountOf ty
-> [UArray ty]
-> MUArray ty (PrimState f)
-> f (MUArray ty (PrimState f))
fillFromEnd CountOf ty
totalSize (UArray ty
cur forall a. a -> [a] -> [a]
: forall collection (mutCollection :: * -> *) step state.
BuildingState collection mutCollection step state -> [collection]
prevChunks BuildingState (UArray ty) (MUArray ty) ty (PrimState m)
st) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze
            forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. b -> Either a b
Right UArray ty
bytes)
  where
      sizeChunks :: CountOf ty
sizeChunks = forall ty. Int -> CountOf ty
CountOf Int
sizeChunksI

      fillFromEnd :: CountOf ty
-> [UArray ty]
-> MUArray ty (PrimState f)
-> f (MUArray ty (PrimState f))
fillFromEnd CountOf ty
_    []     MUArray ty (PrimState f)
mua = forall (f :: * -> *) a. Applicative f => a -> f a
pure MUArray ty (PrimState f)
mua
      fillFromEnd !CountOf ty
end (UArray ty
x:[UArray ty]
xs) MUArray ty (PrimState f)
mua = do
          let sz :: CountOf ty
sz = forall ty. UArray ty -> CountOf ty
length UArray ty
x
          let start :: CountOf ty
start = CountOf ty
end forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` CountOf ty
sz
          forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim)
-> Offset ty -> UArray ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyAtRO MUArray ty (PrimState f)
mua (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
start) UArray ty
x (forall ty. Int -> Offset ty
Offset Int
0) CountOf ty
sz
          CountOf ty
-> [UArray ty]
-> MUArray ty (PrimState f)
-> f (MUArray ty (PrimState f))
fillFromEnd CountOf ty
start [UArray ty]
xs MUArray ty (PrimState f)
mua

builderBuild_ :: (PrimType ty, PrimMonad m) => Int -> Builder (UArray ty) (MUArray ty) ty m () () -> m (UArray ty)
builderBuild_ :: forall ty (m :: * -> *).
(PrimType ty, PrimMonad m) =>
Int -> Builder (UArray ty) (MUArray ty) ty m () () -> m (UArray ty)
builderBuild_ Int
sizeChunksI Builder (UArray ty) (MUArray ty) ty m () ()
ab = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\() -> forall a. [Char] -> a
internalError [Char]
"impossible output") forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall ty (m :: * -> *) err.
(PrimType ty, PrimMonad m) =>
Int
-> Builder (UArray ty) (MUArray ty) ty m err ()
-> m (Either err (UArray ty))
builderBuild Int
sizeChunksI Builder (UArray ty) (MUArray ty) ty m () ()
ab

toHexadecimal :: PrimType ty => UArray ty -> UArray Word8
toHexadecimal :: forall ty. PrimType ty => UArray ty -> UArray Word8
toHexadecimal UArray ty
ba
    | CountOf Word8
len forall a. Eq a => a -> a -> Bool
== forall ty. Int -> CountOf ty
CountOf Int
0 = forall a. Monoid a => a
mempty
    | Bool
otherwise     = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MUArray Word8 s
ma <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new (CountOf Word8
len forall a n. (Additive a, IsNatural n) => n -> a -> a
`scale` CountOf Word8
2)
        forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
UArray ty -> ((Offset ty -> ty) -> prim a) -> prim a
unsafeIndexer UArray Word8
b8 (forall s. MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
go MUArray Word8 s
ma)
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray Word8 s
ma
  where
    b8 :: UArray Word8
b8 = forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast UArray ty
ba
    !len :: CountOf Word8
len = forall ty. UArray ty -> CountOf ty
length UArray Word8
b8
    !endOfs :: Offset Word8
endOfs = forall ty. Int -> Offset ty
Offset Int
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
len

    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
    go :: forall s. MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
go !MUArray Word8 s
ma !Offset Word8 -> Word8
getAt = Offset Word8 -> Offset Word8 -> ST s ()
loop Offset Word8
0 Offset Word8
0
      where
        loop :: Offset Word8 -> Offset Word8 -> ST s ()
loop !Offset Word8
dIdx !Offset Word8
sIdx
            | Offset Word8
sIdx forall a. Eq a => a -> a -> Bool
== Offset Word8
endOfs = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise      = do
                let !(W8# !Word8#
w)       = Offset Word8 -> Word8
getAt Offset Word8
sIdx
                    !(# Word8#
wHi, Word8#
wLo #) = Word8# -> (# Word8#, Word8# #)
Base16.unsafeConvertByte Word8#
w
                forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma Offset Word8
dIdx     (Word8# -> Word8
W8# Word8#
wHi)
                forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma (Offset Word8
dIdxforall a. Additive a => a -> a -> a
+Offset Word8
1) (Word8# -> Word8
W8# Word8#
wLo)
                Offset Word8 -> Offset Word8 -> ST s ()
loop (Offset Word8
dIdx forall a. Additive a => a -> a -> a
+ Offset Word8
2) (Offset Word8
sIdxforall a. Additive a => a -> a -> a
+Offset Word8
1)

toBase64Internal :: PrimType ty => Addr# -> UArray ty -> Bool -> UArray Word8
toBase64Internal :: forall ty.
PrimType ty =>
Addr# -> UArray ty -> Bool -> UArray Word8
toBase64Internal Addr#
table UArray ty
src Bool
padded
    | CountOf Word8
len forall a. Eq a => a -> a -> Bool
== forall ty. Int -> CountOf ty
CountOf Int
0 = forall a. Monoid a => a
mempty
    | Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
        MUArray Word8 s
ma <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MUArray ty (PrimState prim))
new CountOf Word8
dstLen
        forall (prim :: * -> *) ty a.
(PrimMonad prim, PrimType ty) =>
UArray ty -> ((Offset ty -> ty) -> prim a) -> prim a
unsafeIndexer UArray Word8
b8 (forall s. MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
go MUArray Word8 s
ma)
        forall (prim :: * -> *) ty.
PrimMonad prim =>
MUArray ty (PrimState prim) -> prim (UArray ty)
unsafeFreeze MUArray Word8 s
ma
  where
    b8 :: UArray Word8
b8 = forall a b. (PrimType a, PrimType b) => UArray a -> UArray b
unsafeRecast UArray ty
src
    !len :: CountOf Word8
len = forall ty. UArray ty -> CountOf ty
length UArray Word8
b8
    !dstLen :: CountOf Word8
dstLen = Bool -> CountOf Word8 -> CountOf Word8
outputLengthBase64 Bool
padded CountOf Word8
len
    !endOfs :: Offset Word8
endOfs = forall ty. Int -> Offset ty
Offset Int
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
len
    !dstEndOfs :: Offset Word8
dstEndOfs = forall ty. Int -> Offset ty
Offset Int
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
dstLen

    go :: MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
    go :: forall s. MUArray Word8 s -> (Offset Word8 -> Word8) -> ST s ()
go !MUArray Word8 s
ma !Offset Word8 -> Word8
getAt = Offset Word8 -> Offset Word8 -> ST s ()
loop Offset Word8
0 Offset Word8
0
      where
        eqChar :: Word8
eqChar = Word8
0x3d :: Word8

        loop :: Offset Word8 -> Offset Word8 -> ST s ()
loop !Offset Word8
sIdx !Offset Word8
dIdx
            | Offset Word8
sIdx forall a. Eq a => a -> a -> Bool
== Offset Word8
endOfs = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
padded forall a b. (a -> b) -> a -> b
$ do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
1 forall a. Ord a => a -> a -> Bool
<= Offset Word8
dstEndOfs) forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma Offset Word8
dIdx Word8
eqChar
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
2 forall a. Eq a => a -> a -> Bool
== Offset Word8
dstEndOfs) forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
1) Word8
eqChar
            | Bool
otherwise = do
                let !b2Idx :: Offset Word8
b2Idx = Offset Word8
sIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
1
                    !b3Idx :: Offset Word8
b3Idx = Offset Word8
sIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
2

                    !b2Available :: Bool
b2Available = Offset Word8
b2Idx forall a. Ord a => a -> a -> Bool
< Offset Word8
endOfs
                    !b3Available :: Bool
b3Available = Offset Word8
b3Idx forall a. Ord a => a -> a -> Bool
< Offset Word8
endOfs

                    !b1 :: Word8
b1 = Offset Word8 -> Word8
getAt Offset Word8
sIdx
                    !b2 :: Word8
b2 = if Bool
b2Available then Offset Word8 -> Word8
getAt Offset Word8
b2Idx else Word8
0
                    !b3 :: Word8
b3 = if Bool
b3Available then Offset Word8 -> Word8
getAt Offset Word8
b3Idx else Word8
0

                    (Word8
w,Word8
x,Word8
y,Word8
z) = Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 Addr#
table Word8
b1 Word8
b2 Word8
b3

                    sNextIncr :: Int
sNextIncr = Int
1 forall a. Additive a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Bool
b2Available forall a. Additive a => a -> a -> a
+ forall a. Enum a => a -> Int
fromEnum Bool
b3Available
                    dNextIncr :: Int
dNextIncr = Int
1 forall a. Additive a => a -> a -> a
+ Int
sNextIncr

                forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma Offset Word8
dIdx Word8
w
                forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
1) Word8
x

                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b2Available forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
2) Word8
y
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b3Available forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MUArray ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MUArray Word8 s
ma (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
3) Word8
z

                Offset Word8 -> Offset Word8 -> ST s ()
loop (Offset Word8
sIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
sNextIncr) (Offset Word8
dIdx forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` forall ty. Int -> CountOf ty
CountOf Int
dNextIncr)

outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8
outputLengthBase64 :: Bool -> CountOf Word8 -> CountOf Word8
outputLengthBase64 Bool
padding (CountOf Int
inputLenInt) = CountOf Word8
outputLength
  where
    outputLength :: CountOf Word8
outputLength = if Bool
padding then forall ty. Int -> CountOf ty
CountOf Int
lenWithPadding else forall ty. Int -> CountOf ty
CountOf Int
lenWithoutPadding
    lenWithPadding :: Int
lenWithPadding
        | Int
m forall a. Eq a => a -> a -> Bool
== Int
0    = Int
4 forall a. Multiplicative a => a -> a -> a
* Int
d
        | Bool
otherwise = Int
4 forall a. Multiplicative a => a -> a -> a
* (Int
d forall a. Additive a => a -> a -> a
+ Int
1)
    lenWithoutPadding :: Int
lenWithoutPadding
        | Int
m forall a. Eq a => a -> a -> Bool
== Int
0    = Int
4 forall a. Multiplicative a => a -> a -> a
* Int
d
        | Bool
otherwise = Int
4 forall a. Multiplicative a => a -> a -> a
* Int
d forall a. Additive a => a -> a -> a
+ Int
m forall a. Additive a => a -> a -> a
+ Int
1
    (Int
d,Int
m) = Int
inputLenInt forall a. IDivisible a => a -> a -> (a, a)
`divMod` Int
3

convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 :: Addr# -> Word8 -> Word8 -> Word8 -> (Word8, Word8, Word8, Word8)
convert3 Addr#
table Word8
a Word8
b Word8
c =
    let !w :: Word8
w = Word8
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
2
        !x :: Word8
x = ((Word8
a forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
4) forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x30) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
b forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
4)
        !y :: Word8
y = ((Word8
b forall bits. BitOps bits => bits -> CountOf Bool -> bits
.<<. CountOf Bool
2) forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x3c) forall bits. BitOps bits => bits -> bits -> bits
.|. (Word8
c forall bits. BitOps bits => bits -> CountOf Bool -> bits
.>>. CountOf Bool
6)
        !z :: Word8
z = Word8
c forall bits. BitOps bits => bits -> bits -> bits
.&. Word8
0x3f
     in (Word8 -> Word8
idx Word8
w, Word8 -> Word8
idx Word8
x, Word8 -> Word8
idx Word8
y, Word8 -> Word8
idx Word8
z)
  where
    idx :: Word8 -> Word8
    idx :: Word8 -> Word8
idx (W8# Word8#
i) = Word8# -> Word8
W8# (Addr# -> Int# -> Word8#
indexWord8OffAddr# Addr#
table (Word# -> Int#
word2Int# (Word8# -> Word#
word8ToWord# Word8#
i)))

isPrefixOf :: PrimType ty => UArray ty -> UArray ty -> Bool
isPrefixOf :: forall ty. PrimType ty => UArray ty -> UArray ty -> Bool
isPrefixOf UArray ty
pre UArray ty
arr
    | CountOf ty
pLen forall a. Ord a => a -> a -> Bool
> CountOf ty
pArr = Bool
False
    | Bool
otherwise   = UArray ty
pre forall a. Eq a => a -> a -> Bool
== forall ty. CountOf ty -> UArray ty -> UArray ty
unsafeTake CountOf ty
pLen UArray ty
arr
  where
    !pLen :: CountOf ty
pLen = forall ty. UArray ty -> CountOf ty
length UArray ty
pre
    !pArr :: CountOf ty
pArr = forall ty. UArray ty -> CountOf ty
length UArray ty
arr
{-# SPECIALIZE [3] isPrefixOf :: UArray Word8 -> UArray Word8 -> Bool #-}

isSuffixOf :: PrimType ty => UArray ty -> UArray ty -> Bool
isSuffixOf :: forall ty. PrimType ty => UArray ty -> UArray ty -> Bool
isSuffixOf UArray ty
suffix UArray ty
arr
    | CountOf ty
pLen forall a. Ord a => a -> a -> Bool
> CountOf ty
pArr = Bool
False
    | Bool
otherwise   = UArray ty
suffix forall a. Eq a => a -> a -> Bool
== forall ty. CountOf ty -> UArray ty -> UArray ty
revTake CountOf ty
pLen UArray ty
arr
  where
    !pLen :: CountOf ty
pLen = forall ty. UArray ty -> CountOf ty
length UArray ty
suffix
    !pArr :: CountOf ty
pArr = forall ty. UArray ty -> CountOf ty
length UArray ty
arr
{-# SPECIALIZE [3] isSuffixOf :: UArray Word8 -> UArray Word8 -> Bool #-}