{-# 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) = MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead MutableByteArray# st
MutableByteArray# (PrimState prim)
mba
write :: MutableBlock ty st -> Offset ty -> ty -> prim ()
write (MutableBlock MutableByteArray# st
mba) = MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# st
MutableByteArray# (PrimState prim)
mba
instance (PrimType ty) => Alg.Indexable (Block ty) ty where
index :: Block ty -> Offset ty -> ty
index (Block ByteArray#
ba) = ByteArray# -> Offset ty -> ty
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) = ByteArray# -> Offset Word64 -> Word64
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) = (State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ()
forall a.
(State# (PrimState prim) -> (# State# (PrimState prim), a #))
-> prim a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ())
-> (State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ()
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 ->
(# ByteArray#
-> Int#
-> Addr#
-> Int#
-> State# (PrimState prim)
-> State# (PrimState prim)
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = Block ty
forall a. Monoid a => a
mempty
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
mb <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
n
M.iterSet initializer mb
unsafeFreeze 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
mb <- CountOf ty -> IO (MutableBlock ty (PrimState IO))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
sz
M.copyFromPtr p mb 0 sz
unsafeFreeze mb
singleton :: PrimType ty => ty -> Block ty
singleton :: forall ty. PrimType ty => ty -> Block ty
singleton ty
ty = CountOf ty -> (Offset ty -> ty) -> Block ty
forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf ty
1 (ty -> Offset ty -> ty
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 = CountOf ty -> (Offset ty -> ty) -> Block ty
forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf ty
sz (ty -> Offset ty -> ty
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
ma <- PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
M.unsafeNew PinnedStatus
Unpinned (Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
array)
M.unsafeCopyBytesRO ma 0 array 0 (lengthBytes array)
pure 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
ma' <- PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned CountOf Word8
len
M.unsafeCopyBytes ma' 0 ma 0 len
unsafeFreeze ma'
where
len :: CountOf Word8
len = MutableBlock ty (PrimState prim) -> CountOf Word8
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 s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST (Block ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
thaw Block ty
array ST s (MutableBlock ty s)
-> (MutableBlock ty s -> ST s (Block ty)) -> ST s (Block ty)
forall a b. ST s a -> (a -> ST s b) -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutableBlock ty s -> ST s (Block ty)
MutableBlock ty (PrimState (ST s)) -> ST s (Block ty)
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
| Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
isOutOfBound Offset ty
n CountOf ty
len = OutOfBoundOperation -> Offset ty -> CountOf ty -> ty
forall ty a. OutOfBoundOperation -> Offset ty -> CountOf ty -> a
outOfBound OutOfBoundOperation
OOB_Index Offset ty
n CountOf ty
len
| Bool
otherwise = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
array Offset ty
n
where
!len :: CountOf ty
len = Block ty -> CountOf ty
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 = CountOf b -> (Offset b -> b) -> Block b
forall ty.
PrimType ty =>
CountOf ty -> (Offset ty -> ty) -> Block ty
create CountOf b
lenB (\Offset b
i -> a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Block a -> Offset a -> a
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block a
a (Proxy (b -> a) -> Offset b -> Offset a
forall a b. Proxy (a -> b) -> Offset a -> Offset b
offsetCast Proxy (b -> a)
forall {k} (t :: k). Proxy t
Proxy Offset b
i))
where !lenB :: CountOf b
lenB = Proxy (a -> b) -> CountOf a -> CountOf b
forall a b. Proxy (a -> b) -> CountOf a -> CountOf b
sizeCast (Proxy (a -> b)
forall {k} (t :: k). Proxy t
forall {a} {b}. Proxy (a -> b)
Proxy :: Proxy (a -> b)) (Block a -> CountOf a
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 = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
loop :: Offset ty -> a
loop !Offset ty
i
| Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = a
initialAcc
| Bool
otherwise = Block ty -> Offset ty -> ty
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
iOffset ty -> Offset ty -> Offset ty
forall 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 = Block ty -> CountOf ty
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 Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = a
acc
| Bool
otherwise = Offset ty -> a -> a
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1) (a -> ty -> a
f a
acc (Block ty -> Offset ty -> ty
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 (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
arr Offset ty
0)
where
!len :: CountOf ty
len = Block ty -> CountOf ty
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 Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = ty
acc
| Bool
otherwise = Offset ty -> ty -> ty
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1) (ty -> ty -> ty
f ty
acc (Block ty -> Offset ty -> ty
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) = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
revSplitAt CountOf ty
1 (Block ty -> (Block ty, Block ty))
-> Block ty -> (Block ty, Block ty)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Block ty) -> Block ty
forall a. NonEmpty a -> a
getNonEmpty NonEmpty (Block ty)
arr
in (ty -> ty -> ty) -> ty -> Block ty -> ty
forall ty a. PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
foldr ty -> ty -> ty
f (Block ty -> Offset ty -> ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = ty -> Block ty
forall ty. PrimType ty => ty -> Block ty
singleton ty
e
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
muv <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
len CountOf ty -> CountOf ty -> CountOf ty
forall a. Additive a => a -> a -> a
+ CountOf ty
1)
M.unsafeCopyElementsRO muv 1 vec 0 len
M.unsafeWrite muv 0 e
unsafeFreeze muv
where
!len :: CountOf ty
len = Block ty -> CountOf ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = ty -> Block ty
forall ty. PrimType ty => ty -> Block ty
singleton ty
e
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
muv <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
len CountOf ty -> CountOf ty -> CountOf ty
forall a. Additive a => a -> a -> a
+ CountOf ty
1)
M.unsafeCopyElementsRO muv 0 vec 0 len
M.unsafeWrite muv (0 `offsetPlusE` len) e
unsafeFreeze muv
where
!len :: CountOf ty
len = Block ty -> CountOf ty
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 Offset ty -> Offset ty -> Bool
forall a. Ord a => a -> a -> Bool
>= Offset ty
end' = Block ty
forall a. Monoid a => a
mempty
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
dst <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new Difference (Offset ty)
CountOf ty
newLen
M.unsafeCopyElementsRO dst 0 blk start newLen
unsafeFreeze dst
where
newLen :: Difference (Offset ty)
newLen = Offset ty
end' Offset ty -> Offset ty -> Difference (Offset ty)
forall a. Subtractive a => a -> a -> Difference a
- Offset ty
start
end' :: Offset ty
end' = Offset ty -> Offset ty -> Offset ty
forall a. Ord a => a -> a -> a
min (CountOf ty -> Offset ty
forall a. CountOf a -> Offset a
sizeAsOffset CountOf ty
len) Offset ty
end
!len :: CountOf ty
len = Block ty -> CountOf ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = Maybe (ty, Block ty)
forall a. Maybe a
Nothing
| Bool
otherwise = (ty, Block ty) -> Maybe (ty, Block ty)
forall a. a -> Maybe a
Just (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
0, Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
vec Offset ty
1 (Offset ty
0 Offset ty -> CountOf ty -> Offset ty
forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
nbElems))
where
!nbElems :: CountOf ty
nbElems = Block ty -> CountOf ty
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 Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec CountOf ty -> CountOf ty -> Difference (CountOf ty)
forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
1 of
Maybe (CountOf ty)
Difference (CountOf ty)
Nothing -> Maybe (Block ty, ty)
forall a. Maybe a
Nothing
Just CountOf ty
offset -> (Block ty, ty) -> Maybe (Block ty, ty)
forall a. a -> Maybe a
Just (Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
vec Offset ty
0 Offset ty
lastElem, Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
lastElem)
where !lastElem :: Offset ty
lastElem = Offset ty
0 Offset ty -> CountOf ty -> Offset ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Ord a => a -> a -> Bool
<= CountOf ty
0 = (Block ty
forall a. Monoid a => a
mempty, Block ty
blk)
| Just CountOf ty
nbTails <- Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk CountOf ty -> CountOf ty -> Difference (CountOf ty)
forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
nbElems, CountOf ty
nbTails CountOf ty -> CountOf ty -> Bool
forall a. Ord a => a -> a -> Bool
> CountOf ty
0 = (forall s. ST s (Block ty, Block ty)) -> (Block ty, Block ty)
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty, Block ty)) -> (Block ty, Block ty))
-> (forall s. ST s (Block ty, Block ty)) -> (Block ty, Block ty)
forall a b. (a -> b) -> a -> b
$ do
left <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
nbElems
right <- new nbTails
M.unsafeCopyElementsRO left 0 blk 0 nbElems
M.unsafeCopyElementsRO right 0 blk (sizeAsOffset nbElems) nbTails
(,) <$> unsafeFreeze left <*> unsafeFreeze right
| Bool
otherwise = (Block ty
blk, Block ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Ord a => a -> a -> Bool
<= CountOf ty
0 = (Block ty
forall a. Monoid a => a
mempty, Block ty
blk)
| Just CountOf ty
nbElems <- Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk CountOf ty -> CountOf ty -> Difference (CountOf ty)
forall a. Subtractive a => a -> a -> Difference a
- CountOf ty
n = let (Block ty
x, Block ty
y) = CountOf ty -> Block ty -> (Block ty, Block ty)
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, Block ty
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 = Block ty -> CountOf ty
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 Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = (Block ty
blk, Block ty
forall a. Monoid a => a
mempty)
| ty -> Bool
predicate (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt (Offset ty -> CountOf ty
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 Offset ty -> Offset ty -> Offset ty
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 Offset ty -> Offset ty -> Bool
forall a. Eq a => a -> a -> Bool
== Offset ty
forall {ty}. Offset ty
sentinel = (Block ty
blk, Block ty
forall a. Monoid a => a
mempty)
| Bool
otherwise = CountOf ty -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
CountOf ty -> Block ty -> (Block ty, Block ty)
splitAt (Offset ty -> CountOf ty
forall a. Offset a -> CountOf a
offsetAsSize (Offset ty
kOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1)) Block ty
blk
where
!k :: Offset ty
k = (ty -> Bool) -> Block ty -> Offset ty -> Offset ty -> Offset ty
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 = CountOf ty -> Offset ty
forall a. CountOf a -> Offset a
sizeAsOffset (CountOf ty -> Offset ty) -> CountOf ty -> Offset ty
forall a b. (a -> b) -> a -> b
$ Block ty -> CountOf ty
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 = (ty -> Bool) -> Block ty -> (Block ty, Block ty)
forall ty.
PrimType ty =>
(ty -> Bool) -> Block ty -> (Block ty, Block ty)
break (Bool -> Bool
not (Bool -> Bool) -> (ty -> Bool) -> ty -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
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 = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
False
| Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i ty -> ty -> Bool
forall a. Eq a => a -> a -> Bool
== ty
v = Bool
True
| Bool
otherwise = Offset ty -> Bool
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall 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 = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
True
| ty -> Bool
p (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) = Offset ty -> Bool
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall 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 = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
loop :: Offset ty -> Bool
loop !Offset ty
i
| Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Bool
False
| ty -> Bool
p (Block ty -> Offset ty -> ty
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
iOffset ty -> Offset ty -> Offset ty
forall 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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = [Block ty
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 = Block ty -> CountOf ty
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 Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = [Block ty -> Offset ty -> Offset ty -> Block ty
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 = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
idx
idx' :: Offset ty
idx' = Offset ty
idx Offset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+ Offset ty
1
in if ty -> Bool
predicate ty
e
then Block ty -> Offset ty -> Offset ty -> Block ty
forall ty.
PrimType ty =>
Block ty -> Offset ty -> Offset ty -> Block ty
sub Block ty
blk Offset ty
prevIdx Offset ty
idx Block ty -> [Block ty] -> [Block ty]
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 = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
vec
loop :: Offset ty -> Maybe ty
loop Offset ty
i
| Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = Maybe ty
forall a. Maybe a
Nothing
| Bool
otherwise =
let e :: ty
e = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
vec Offset ty
i
in if ty -> Bool
predicate ty
e then ty -> Maybe ty
forall a. a -> Maybe a
Just ty
e else Offset ty -> Maybe ty
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall 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 = [Item (Block ty)] -> Block ty
forall l. IsList l => [Item l] -> l
fromList ([Item (Block ty)] -> Block ty) -> [Item (Block ty)] -> Block ty
forall a b. (a -> b) -> a -> b
$ (Item (Block ty) -> Bool) -> [Item (Block ty)] -> [Item (Block ty)]
forall a. (a -> Bool) -> [a] -> [a]
Data.List.filter ty -> Bool
Item (Block ty) -> Bool
predicate ([Item (Block ty)] -> [Item (Block ty)])
-> [Item (Block ty)] -> [Item (Block ty)]
forall a b. (a -> b) -> a -> b
$ Block ty -> [Item (Block ty)]
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = Block ty
forall a. Monoid a => a
mempty
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
mb <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
len
go mb
unsafeFreeze mb
where
!len :: CountOf ty
len = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
!endOfs :: Offset ty
endOfs = Offset ty
0 Offset ty -> CountOf ty -> Offset ty
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 Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = () -> ST s ()
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = MutableBlock ty (PrimState (ST s)) -> Offset ty -> ty -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
MutableBlock ty (PrimState (ST s))
mb Offset ty
o' (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i) ST s () -> ST s () -> ST s ()
forall a b. ST s a -> ST s b -> ST s b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> Offset ty -> ST s ()
loop Offset ty
o' (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1)
where o' :: Offset ty
o' = Offset ty -> Offset ty
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 CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
0 = Block ty
forall a. Monoid a => a
mempty
| Bool
otherwise = (forall s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
mblock <- Block ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Block ty -> prim (MutableBlock ty (PrimState prim))
thaw Block ty
vec
MutAlg.inplaceSortBy ford 0 len mblock
unsafeFreeze mblock
where len :: CountOf ty
len = Block ty -> CountOf ty
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 CountOf ty -> CountOf ty -> Difference (CountOf ty)
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 s. ST s (Block ty)) -> Block ty
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ty)) -> Block ty)
-> (forall s. ST s (Block ty)) -> Block ty
forall a b. (a -> b) -> a -> b
$ do
mb <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (CountOf ty
lenCountOf ty -> CountOf ty -> CountOf ty
forall a. Additive a => a -> a -> a
+CountOf ty
size)
go mb
unsafeFreeze mb
where
!len :: CountOf ty
len = Block ty -> CountOf ty
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 Offset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+ Offset ty
1) Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = MutableBlock ty (PrimState (ST s)) -> Offset ty -> ty -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
MutableBlock ty (PrimState (ST s))
mb Offset ty
o (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i)
| Bool
otherwise = do
MutableBlock ty (PrimState (ST s)) -> Offset ty -> ty -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
MutableBlock ty (PrimState (ST s))
mb Offset ty
o (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
blk Offset ty
i)
MutableBlock ty (PrimState (ST s)) -> Offset ty -> ty -> ST s ()
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty s
MutableBlock ty (PrimState (ST s))
mb (Offset ty
oOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1) ty
sep
Offset ty -> Offset ty -> ST s ()
loop (Offset ty
oOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
2) (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall 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) = ByteArray# -> Block b
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 CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Word8
bTypeSize Bool -> Bool -> Bool
|| CountOf Word8
bTypeSize CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Word8
1 = Block a -> Block b
forall b a. PrimType b => Block a -> Block b
unsafeCast Block a
blk
| Int
missing Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Block a -> Block b
forall b a. PrimType b => Block a -> Block b
unsafeCast Block a
blk
| Bool
otherwise =
InvalidRecast -> Block b
forall a e. (?callStack::CallStack, Exception e) => e -> a
throw (InvalidRecast -> Block b) -> InvalidRecast -> Block b
forall a b. (a -> b) -> a -> b
$ RecastSourceSize -> RecastDestinationSize -> InvalidRecast
InvalidRecast (Int -> RecastSourceSize
RecastSourceSize Int
alen) (Int -> RecastDestinationSize
RecastDestinationSize (Int -> RecastDestinationSize) -> Int -> RecastDestinationSize
forall a b. (a -> b) -> a -> b
$ Int
alen Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
missing)
where
(CountOf Int
alen) = Block a -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block a
blk
aTypeSize :: CountOf Word8
aTypeSize = Proxy a -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)
bTypeSize :: CountOf Word8
bTypeSize@(CountOf Int
bs) = Proxy b -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy b
forall {k} (t :: k). Proxy t
Proxy :: Proxy b)
missing :: Int
missing = Int
alen Int -> Int -> Int
forall a. IDivisible a => a -> a -> a
`mod` Int
bs