{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module Basement.Block
( Block(..)
, MutableBlock(..)
, length
, unsafeThaw
, unsafeFreeze
, unsafeIndex
, thaw
, freeze
, copy
, unsafeCast
, cast
, empty
, create
, isPinned
, isMutablePinned
, singleton
, replicate
, index
, map
, foldl'
, foldr
, foldl1'
, foldr1
, cons
, snoc
, uncons
, unsnoc
, sub
, splitAt
, revSplitAt
, splitOn
, break
, breakEnd
, span
, elem
, all
, any
, find
, filter
, reverse
, sortBy
, intersperse
, createFromPtr
, unsafeCopyToPtr
, withPtr
) where
import GHC.Prim
import GHC.Types
import GHC.ST
import qualified Data.List
import Basement.Compat.Base
import Data.Proxy
import Basement.Compat.Primitive
import Basement.NonEmpty
import Basement.Types.OffsetSize
import Basement.Monad
import Basement.Exception
import Basement.PrimType
import qualified Basement.Block.Mutable as M
import Basement.Block.Mutable (Block(..), MutableBlock(..), new, unsafeThaw, unsafeFreeze)
import Basement.Block.Base
import Basement.Numerical.Additive
import Basement.Numerical.Subtractive
import Basement.Numerical.Multiplicative
import qualified Basement.Alg.Mutable as MutAlg
import qualified Basement.Alg.Class as Alg
import qualified Basement.Alg.PrimArray as Alg
instance (PrimMonad prim, st ~ PrimState prim, PrimType ty)
=> Alg.RandomAccess (MutableBlock ty st) prim ty where
read :: MutableBlock ty st -> Offset ty -> prim ty
read (MutableBlock MutableByteArray# st
mba) = forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead MutableByteArray# st
mba
write :: MutableBlock ty st -> Offset ty -> ty -> prim ()
write (MutableBlock MutableByteArray# st
mba) = forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# st
mba
instance (PrimType ty) => Alg.Indexable (Block ty) ty where
index :: Block ty -> Offset ty -> ty
index (Block ByteArray#
ba) = forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba
{-# INLINE index #-}
instance Alg.Indexable (Block Word8) Word64 where
index :: Block Word8 -> Offset Word64 -> Word64
index (Block ByteArray#
ba) = forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba
{-# INLINE index #-}
unsafeCopyToPtr :: forall ty prim . PrimMonad prim
=> Block ty
-> Ptr ty
-> prim ()
unsafeCopyToPtr :: forall ty (prim :: * -> *).
PrimMonad prim =>
Block ty -> Ptr ty -> prim ()
unsafeCopyToPtr (Block ByteArray#
blk) (Ptr Addr#
p) = 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#
blk Int#
0# Addr#
p (ByteArray# -> Int#
sizeofByteArray# ByteArray#
blk) State# (PrimState prim)
s1, () #)
create :: forall ty . PrimType ty
=> CountOf ty
-> (Offset ty -> ty)
-> Block ty
create :: forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block 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 a b. (a -> b) -> a -> b
$ do
MutableBlock ty s
mb <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
n
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
(Offset ty -> ty) -> MutableBlock ty (PrimState prim) -> prim ()
M.iterSet Offset ty -> ty
initializer MutableBlock ty s
mb
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
mb
createFromPtr :: PrimType ty
=> Ptr ty
-> CountOf ty
-> IO (Block ty)
createFromPtr :: forall ty. PrimType ty => Ptr ty -> CountOf ty -> IO (Block ty)
createFromPtr Ptr ty
p CountOf ty
sz = do
MutableBlock ty RealWorld
mb <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
sz
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Ptr ty
-> MutableBlock ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
M.copyFromPtr Ptr ty
p MutableBlock ty RealWorld
mb Offset ty
0 CountOf ty
sz
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty RealWorld
mb
singleton :: PrimType ty => ty -> Block ty
singleton :: forall ty. PrimType ty => ty -> Block ty
singleton ty
ty = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf ty
1 (forall a b. a -> b -> a
const ty
ty)
replicate :: PrimType ty => CountOf ty -> ty -> Block ty
replicate :: forall ty. PrimType ty => CountOf ty -> ty -> Block ty
replicate CountOf ty
sz ty
ty = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf ty
sz (forall a b. a -> b -> a
const ty
ty)
thaw :: (PrimMonad prim, PrimType ty) => Block ty -> prim (MutableBlock ty (PrimState prim))
thaw :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
thaw Block ty
array = do
MutableBlock ty (PrimState prim)
ma <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
M.unsafeNew PinnedStatus
Unpinned (forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
array)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
M.unsafeCopyBytesRO MutableBlock ty (PrimState prim)
ma Offset Word8
0 Block ty
array Offset Word8
0 (forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
array)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutableBlock ty (PrimState prim)
ma
{-# INLINE thaw #-}
freeze :: (PrimType ty, PrimMonad prim) => MutableBlock ty (PrimState prim) -> prim (Block ty)
freeze :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
freeze MutableBlock ty (PrimState prim)
ma = do
MutableBlock ty (PrimState prim)
ma' <- forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned CountOf Word8
len
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
M.unsafeCopyBytes MutableBlock ty (PrimState prim)
ma' Offset Word8
0 MutableBlock ty (PrimState prim)
ma Offset Word8
0 CountOf Word8
len
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
ma'
where
len :: CountOf Word8
len = forall ty st. MutableBlock ty st -> CountOf Word8
M.mutableLengthBytes MutableBlock ty (PrimState prim)
ma
copy :: PrimType ty => Block ty -> Block ty
copy :: forall ty. PrimType ty => Block ty -> Block ty
copy Block ty
array = forall a. (forall s. ST s a) -> a
runST (forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
thaw Block ty
array forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze)
index :: PrimType ty => Block ty -> Offset ty -> ty
index :: forall ty. PrimType ty => Block ty -> Offset ty -> ty
index Block 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 => Block ty -> Offset ty -> ty
unsafeIndex Block ty
array Offset ty
n
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
array
{-# INLINE index #-}
map :: (PrimType a, PrimType b) => (a -> b) -> Block a -> Block b
map :: forall a b.
(PrimType a, PrimType b) =>
(a -> b) -> Block a -> Block b
map a -> b
f Block a
a = forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf b
lenB (\Offset b
i -> a -> b
f forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block 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. PrimType ty => Block ty -> CountOf ty
length Block a
a)
foldr :: PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
foldr :: forall ty a. PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
foldr ty -> a -> a
f a
initialAcc Block ty
vec = Offset ty -> a
loop Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block 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 => Block ty -> Offset ty -> ty
unsafeIndex Block 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)
{-# SPECIALIZE [2] foldr :: (Word8 -> a -> a) -> a -> Block Word8 -> a #-}
foldl' :: PrimType ty => (a -> ty -> a) -> a -> Block ty -> a
foldl' :: forall ty a. PrimType ty => (a -> ty -> a) -> a -> Block ty -> a
foldl' a -> ty -> a
f a
initialAcc Block ty
vec = Offset ty -> a -> a
loop Offset ty
0 a
initialAcc
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
loop :: Offset ty -> a -> a
loop !Offset ty
i !a
acc
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = a
acc
| Bool
otherwise = Offset ty -> a -> a
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1) (a -> ty -> a
f a
acc (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
i))
{-# SPECIALIZE [2] foldl' :: (a -> Word8 -> a) -> a -> Block Word8 -> a #-}
foldl1' :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
foldl1' :: forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
foldl1' ty -> ty -> ty
f (NonEmpty Block ty
arr) = Offset ty -> ty -> ty
loop Offset ty
1 (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
arr Offset ty
0)
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
arr
loop :: Offset ty -> ty -> ty
loop !Offset ty
i !ty
acc
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = ty
acc
| Bool
otherwise = Offset ty -> ty -> ty
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1) (ty -> ty -> ty
f ty
acc (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
arr Offset ty
i))
{-# SPECIALIZE [3] foldl1' :: (Word8 -> Word8 -> Word8) -> NonEmpty (Block Word8) -> Word8 #-}
foldr1 :: PrimType ty => (ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
foldr1 :: forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
foldr1 ty -> ty -> ty
f NonEmpty (Block ty)
arr = let (Block ty
initialAcc, Block ty
rest) = forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
revSplitAt CountOf ty
1 forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> a
getNonEmpty NonEmpty (Block ty)
arr
in forall ty a. PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
foldr ty -> ty -> ty
f (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
initialAcc Offset ty
0) Block ty
rest
cons :: PrimType ty => ty -> Block ty -> Block ty
cons :: forall ty. PrimType ty => ty -> Block ty -> Block ty
cons ty
e Block ty
vec
| CountOf ty
len forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = forall ty. PrimType ty => ty -> Block ty
singleton ty
e
| Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableBlock ty s
muv <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
len forall a. Additive a => a -> a -> a
+ CountOf ty
1)
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
M.unsafeCopyElementsRO MutableBlock ty s
muv Offset ty
1 Block ty
vec Offset ty
0 CountOf ty
len
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
M.unsafeWrite MutableBlock ty s
muv Offset ty
0 ty
e
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
muv
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
snoc :: PrimType ty => Block ty -> ty -> Block ty
snoc :: forall ty. PrimType ty => Block ty -> ty -> Block ty
snoc Block ty
vec ty
e
| CountOf ty
len forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = forall ty. PrimType ty => ty -> Block ty
singleton ty
e
| Bool
otherwise = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableBlock ty s
muv <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
len forall a. Additive a => a -> a -> a
+ CountOf ty
1)
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
M.unsafeCopyElementsRO MutableBlock ty s
muv Offset ty
0 Block ty
vec Offset ty
0 CountOf ty
len
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
M.unsafeWrite MutableBlock ty s
muv (Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len) ty
e
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
muv
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
sub :: PrimType ty => Block ty -> Offset ty -> Offset ty -> Block ty
sub :: forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
blk Offset ty
start Offset ty
end
| Offset ty
start forall a. Ord a => a -> a -> Bool
>= Offset ty
end' = 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
MutableBlock ty s
dst <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new Difference (Offset ty)
newLen
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
M.unsafeCopyElementsRO MutableBlock ty s
dst Offset ty
0 Block ty
blk Offset ty
start Difference (Offset ty)
newLen
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
dst
where
newLen :: Difference (Offset ty)
newLen = Offset ty
end' forall a. Subtractive a => a -> a -> Difference a
- Offset ty
start
end' :: Offset ty
end' = forall a. Ord a => a -> a -> a
min (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
len) Offset ty
end
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
uncons :: PrimType ty => Block ty -> Maybe (ty, Block ty)
uncons :: forall ty. PrimType ty => Block ty -> Maybe (ty, Block ty)
uncons Block 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 => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
0, forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block 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. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
unsnoc :: PrimType ty => Block ty -> Maybe (Block ty, ty)
unsnoc :: forall ty. PrimType ty => Block ty -> Maybe (Block ty, ty)
unsnoc Block ty
vec = case forall ty. PrimType ty => Block ty -> CountOf ty
length Block 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
offset -> forall a. a -> Maybe a
Just (forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
vec Offset ty
0 Offset ty
lastElem, forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
lastElem)
where !lastElem :: Offset ty
lastElem = Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
offset
splitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt :: forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt CountOf ty
nbElems Block ty
blk
| CountOf ty
nbElems forall a. Ord a => a -> a -> Bool
<= CountOf ty
0 = (forall a. Monoid a => a
mempty, Block ty
blk)
| Just CountOf ty
nbTails <- forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk 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 a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableBlock ty s
left <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
nbElems
MutableBlock ty s
right <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
nbTails
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
M.unsafeCopyElementsRO MutableBlock ty s
left Offset ty
0 Block ty
blk Offset ty
0 CountOf ty
nbElems
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
M.unsafeCopyElementsRO MutableBlock ty s
right Offset ty
0 Block ty
blk (forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
nbElems) CountOf ty
nbTails
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
left forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
right
| Bool
otherwise = (Block ty
blk, forall a. Monoid a => a
mempty)
{-# SPECIALIZE [2] splitAt :: CountOf Word8 -> Block Word8 -> (Block Word8, Block Word8) #-}
revSplitAt :: PrimType ty => CountOf ty -> Block ty -> (Block ty, Block ty)
revSplitAt :: forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
revSplitAt CountOf ty
n Block ty
blk
| CountOf ty
n forall a. Ord a => a -> a -> Bool
<= CountOf ty
0 = (forall a. Monoid a => a
mempty, Block ty
blk)
| Just CountOf ty
nbElems <- forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
n = let (Block ty
x, Block ty
y) = forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt CountOf ty
nbElems Block ty
blk in (Block ty
y, Block ty
x)
| Bool
otherwise = (Block ty
blk, forall a. Monoid a => a
mempty)
break :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)
break :: forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
break ty -> Bool
predicate Block ty
blk = Offset ty -> (Block ty, Block ty)
findBreak Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
findBreak :: Offset ty -> (Block ty, Block ty)
findBreak !Offset ty
i
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = (Block ty
blk, forall a. Monoid a => a
mempty)
| ty -> Bool
predicate (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) = forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt (forall a. Offset a -> CountOf a
offsetAsSize Offset ty
i) Block ty
blk
| Bool
otherwise = Offset ty -> (Block ty, Block ty)
findBreak (Offset ty
i forall a. Additive a => a -> a -> a
+ Offset ty
1)
{-# INLINE findBreak #-}
{-# SPECIALIZE [2] break :: (Word8 -> Bool) -> Block Word8 -> (Block Word8, Block Word8) #-}
breakEnd :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)
breakEnd :: forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
breakEnd ty -> Bool
predicate Block ty
blk
| Offset ty
k forall a. Eq a => a -> a -> Bool
== forall {ty}. Offset ty
sentinel = (Block ty
blk, forall a. Monoid a => a
mempty)
| Bool
otherwise = forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt (forall a. Offset a -> CountOf a
offsetAsSize (Offset ty
kforall a. Additive a => a -> a -> a
+Offset ty
1)) Block ty
blk
where
!k :: Offset ty
k = forall container ty.
Indexable container ty =>
(ty -> Bool) -> container -> Offset ty -> Offset ty -> Offset ty
Alg.revFindIndexPredicate ty -> Bool
predicate Block ty
blk Offset ty
0 Offset ty
end
!end :: Offset ty
end = forall a. CountOf a -> Offset a
sizeAsOffset forall a b. (a -> b) -> a -> b
$ forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
{-# SPECIALIZE [2] breakEnd :: (Word8 -> Bool) -> Block Word8 -> (Block Word8, Block Word8) #-}
span :: PrimType ty => (ty -> Bool) -> Block ty -> (Block ty, Block ty)
span :: forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
span ty -> Bool
p = forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block 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)
elem :: PrimType ty => ty -> Block ty -> Bool
elem :: forall ty. PrimType ty => ty -> Block ty -> Bool
elem ty
v Block ty
blk = Offset ty -> Bool
loop Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
False
| forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i forall a. Eq a => a -> a -> Bool
== ty
v = Bool
True
| Bool
otherwise = Offset ty -> Bool
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
{-# SPECIALIZE [2] elem :: Word8 -> Block Word8 -> Bool #-}
all :: PrimType ty => (ty -> Bool) -> Block ty -> Bool
all :: forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
all ty -> Bool
p Block ty
blk = Offset ty -> Bool
loop Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
True
| ty -> Bool
p (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) = Offset ty -> Bool
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
| Bool
otherwise = Bool
False
{-# SPECIALIZE [2] all :: (Word8 -> Bool) -> Block Word8 -> Bool #-}
any :: PrimType ty => (ty -> Bool) -> Block ty -> Bool
any :: forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Bool
any ty -> Bool
p Block ty
blk = Offset ty -> Bool
loop Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
False
| ty -> Bool
p (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) = Bool
True
| Bool
otherwise = Offset ty -> Bool
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
{-# SPECIALIZE [2] any :: (Word8 -> Bool) -> Block Word8 -> Bool #-}
splitOn :: PrimType ty => (ty -> Bool) -> Block ty -> [Block ty]
splitOn :: forall ty. PrimType ty => (ty -> Bool) -> Block ty -> [Block ty]
splitOn ty -> Bool
predicate Block ty
blk
| CountOf ty
len forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = [forall a. Monoid a => a
mempty]
| Bool
otherwise = Offset ty -> Offset ty -> [Block ty]
go Offset ty
0 Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
go :: Offset ty -> Offset ty -> [Block ty]
go !Offset ty
prevIdx !Offset ty
idx
| Offset ty
idx forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = [forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
blk Offset ty
prevIdx Offset ty
idx]
| Bool
otherwise =
let e :: ty
e = forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk 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 =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
blk Offset ty
prevIdx Offset ty
idx forall a. a -> [a] -> [a]
: Offset ty -> Offset ty -> [Block ty]
go Offset ty
idx' Offset ty
idx'
else Offset ty -> Offset ty -> [Block ty]
go Offset ty
prevIdx Offset ty
idx'
find :: PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty
find :: forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Maybe ty
find ty -> Bool
predicate Block ty
vec = Offset ty -> Maybe ty
loop Offset ty
0
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block 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 => Block ty -> Offset ty -> ty
unsafeIndex Block 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)
filter :: PrimType ty => (ty -> Bool) -> Block ty -> Block ty
filter :: forall ty. PrimType ty => (ty -> Bool) -> Block ty -> Block ty
filter ty -> Bool
predicate Block ty
vec = forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
Data.List.filter ty -> Bool
predicate forall a b. (a -> b) -> a -> b
$ forall l. IsList l => l -> [Item l]
toList Block ty
vec
reverse :: forall ty . PrimType ty => Block ty -> Block ty
reverse :: forall ty. PrimType ty => Block ty -> Block ty
reverse Block ty
blk
| 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
MutableBlock ty s
mb <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
len
forall s. MutableBlock ty s -> ST s ()
go MutableBlock ty s
mb
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
mb
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
!endOfs :: Offset ty
endOfs = Offset ty
0 forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len
go :: MutableBlock ty s -> ST s ()
go :: forall s. MutableBlock ty s -> ST s ()
go MutableBlock ty s
mb = Offset ty -> Offset ty -> ST s ()
loop Offset ty
endOfs Offset ty
0
where
loop :: Offset ty -> Offset ty -> ST s ()
loop Offset ty
o Offset ty
i
| Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = 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 ()
unsafeWrite MutableBlock ty s
mb Offset ty
o' (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> Offset ty -> ST s ()
loop Offset ty
o' (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
where o' :: Offset ty
o' = forall a. Enum a => a -> a
pred Offset ty
o
sortBy :: PrimType ty => (ty -> ty -> Ordering) -> Block ty -> Block ty
sortBy :: forall ty.
PrimType ty =>
(ty -> ty -> Ordering) -> Block ty -> Block ty
sortBy ty -> ty -> Ordering
ford Block ty
vec
| 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
MutableBlock ty s
mblock <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
thaw Block ty
vec
forall (prim :: * -> *) container ty.
(PrimMonad prim, RandomAccess container prim ty) =>
(ty -> ty -> Ordering)
-> Offset ty -> CountOf ty -> container -> prim ()
MutAlg.inplaceSortBy ty -> ty -> Ordering
ford Offset ty
0 CountOf ty
len MutableBlock ty s
mblock
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
mblock
where len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
{-# SPECIALIZE [2] sortBy :: (Word8 -> Word8 -> Ordering) -> Block Word8 -> Block Word8 #-}
intersperse :: forall ty . PrimType ty => ty -> Block ty -> Block ty
intersperse :: forall ty. PrimType ty => ty -> Block ty -> Block ty
intersperse ty
sep Block ty
blk = case CountOf ty
len forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
1 of
Maybe (CountOf ty)
Difference (CountOf ty)
Nothing -> Block ty
blk
Just CountOf ty
0 -> Block ty
blk
Just CountOf ty
size -> forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
MutableBlock ty s
mb <- forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
lenforall a. Additive a => a -> a -> a
+CountOf ty
size)
forall s. MutableBlock ty s -> ST s ()
go MutableBlock ty s
mb
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
mb
where
!len :: CountOf ty
len = forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
go :: MutableBlock ty s -> ST s ()
go :: forall s. MutableBlock ty s -> ST s ()
go MutableBlock ty s
mb = Offset ty -> Offset ty -> ST s ()
loop Offset ty
0 Offset ty
0
where
loop :: Offset ty -> Offset ty -> ST s ()
loop !Offset ty
o !Offset ty
i
| (Offset ty
i 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) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
mb Offset ty
o (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i)
| Bool
otherwise = do
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
mb Offset ty
o (forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i)
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
mb (Offset ty
oforall a. Additive a => a -> a -> a
+Offset ty
1) ty
sep
Offset ty -> Offset ty -> ST s ()
loop (Offset ty
oforall a. Additive a => a -> a -> a
+Offset ty
2) (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
unsafeCast :: PrimType b => Block a -> Block b
unsafeCast :: forall b a. PrimType b => Block a -> Block b
unsafeCast (Block ByteArray#
ba) = forall ty. ByteArray# -> Block ty
Block ByteArray#
ba
cast :: forall a b . (PrimType a, PrimType b) => Block a -> Block b
cast :: forall a b. (PrimType a, PrimType b) => Block a -> Block b
cast blk :: Block a
blk@(Block ByteArray#
ba)
| CountOf Word8
aTypeSize forall a. Eq a => a -> a -> Bool
== CountOf Word8
bTypeSize Bool -> Bool -> Bool
|| CountOf Word8
bTypeSize forall a. Eq a => a -> a -> Bool
== CountOf Word8
1 = forall b a. PrimType b => Block a -> Block b
unsafeCast Block a
blk
| Int
missing forall a. Eq a => a -> a -> Bool
== Int
0 = forall b a. PrimType b => Block a -> Block b
unsafeCast Block a
blk
| 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
(CountOf Int
alen) = forall ty. Block ty -> CountOf Word8
lengthBytes Block a
blk
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)
missing :: Int
missing = Int
alen forall a. IDivisible a => a -> a -> a
`mod` Int
bs