{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples       #-}
module Basement.Block.Base
    ( Block(..)
    , MutableBlock(..)
    -- * Basic accessor
    , unsafeNew
    , unsafeThaw
    , unsafeFreeze
    , unsafeShrink
    , unsafeCopyElements
    , unsafeCopyElementsRO
    , unsafeCopyBytes
    , unsafeCopyBytesRO
    , unsafeCopyBytesPtr
    , unsafeRead
    , unsafeWrite
    , unsafeIndex
    -- * Properties
    , length
    , lengthBytes
    , isPinned
    , isMutablePinned
    , mutableLength
    , mutableLengthBytes
    -- * Other methods
    , empty
    , mutableEmpty
    , new
    , newPinned
    , withPtr
    , withMutablePtr
    , withMutablePtrHint
    , mutableWithPtr
    , unsafeRecast
    ) where

import           GHC.Prim
import           GHC.Types
import           GHC.ST
import           GHC.IO
import qualified Data.List
import           Basement.Compat.Base
import           Data.Proxy
import           Basement.Compat.Primitive
import           Basement.Compat.Semigroup
import           Basement.Bindings.Memory (sysHsMemcmpBaBa)
import           Basement.Types.OffsetSize
import           Basement.Monad
import           Basement.NormalForm
import           Basement.Numerical.Additive
import           Basement.PrimType

-- | A block of memory containing unpacked bytes representing values of type 'ty'
data Block ty = Block ByteArray#
    deriving (Typeable)

unsafeBlockPtr :: Block ty -> Ptr ty
unsafeBlockPtr :: Block ty -> Ptr ty
unsafeBlockPtr (Block ByteArray#
arrBa) = Addr# -> Ptr ty
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
arrBa)
{-# INLINE unsafeBlockPtr #-}

instance Data ty => Data (Block ty) where
    dataTypeOf :: Block ty -> DataType
dataTypeOf Block ty
_ = DataType
blockType
    toConstr :: Block ty -> Constr
toConstr Block ty
_   = [Char] -> Constr
forall a. HasCallStack => [Char] -> a
error [Char]
"toConstr"
    gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Block ty)
gunfold forall b r. Data b => c (b -> r) -> c r
_ forall r. r -> c r
_  = [Char] -> Constr -> c (Block ty)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"

blockType :: DataType
blockType :: DataType
blockType = [Char] -> DataType
mkNoRepType [Char]
"Basement.Block"

instance NormalForm (Block ty) where
    toNormalForm :: Block ty -> ()
toNormalForm (Block !ByteArray#
_) = ()
instance (PrimType ty, Show ty) => Show (Block ty) where
    show :: Block ty -> [Char]
show Block ty
v = [ty] -> [Char]
forall a. Show a => a -> [Char]
show (Block ty -> [Item (Block ty)]
forall l. IsList l => l -> [Item l]
toList Block ty
v)
instance (PrimType ty, Eq ty) => Eq (Block ty) where
    {-# SPECIALIZE instance Eq (Block Word8) #-}
    == :: Block ty -> Block ty -> Bool
(==) = Block ty -> Block ty -> Bool
forall ty. (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool
equal
instance (PrimType ty, Ord ty) => Ord (Block ty) where
    compare :: Block ty -> Block ty -> Ordering
compare = Block ty -> Block ty -> Ordering
forall ty.
(Ord ty, PrimType ty) =>
Block ty -> Block ty -> Ordering
internalCompare

instance PrimType ty => Semigroup (Block ty) where
    <> :: Block ty -> Block ty -> Block ty
(<>) = Block ty -> Block ty -> Block ty
forall ty. Block ty -> Block ty -> Block ty
append
instance PrimType ty => Monoid (Block ty) where
    mempty :: Block ty
mempty  = Block ty
forall ty. Block ty
empty
    mconcat :: [Block ty] -> Block ty
mconcat = [Block ty] -> Block ty
forall ty. [Block ty] -> Block ty
concat

instance PrimType ty => IsList (Block ty) where
    type Item (Block ty) = ty
    fromList :: [Item (Block ty)] -> Block ty
fromList = [Item (Block ty)] -> Block ty
forall ty. PrimType ty => [ty] -> Block ty
internalFromList
    toList :: Block ty -> [Item (Block ty)]
toList = Block ty -> [Item (Block ty)]
forall ty. PrimType ty => Block ty -> [ty]
internalToList

-- | A Mutable block of memory containing unpacked bytes representing values of type 'ty'
data MutableBlock ty st = MutableBlock (MutableByteArray# st)

isPinned :: Block ty -> PinnedStatus
isPinned :: Block ty -> PinnedStatus
isPinned (Block ByteArray#
ba) = Pinned# -> PinnedStatus
toPinnedStatus# (ByteArray# -> Pinned#
compatIsByteArrayPinned# ByteArray#
ba)

isMutablePinned :: MutableBlock s ty -> PinnedStatus
isMutablePinned :: MutableBlock s ty -> PinnedStatus
isMutablePinned (MutableBlock MutableByteArray# ty
mba) = Pinned# -> PinnedStatus
toPinnedStatus# (MutableByteArray# ty -> Pinned#
forall s. MutableByteArray# s -> Pinned#
compatIsMutableByteArrayPinned# MutableByteArray# ty
mba)

length :: forall ty . PrimType ty => Block ty -> CountOf ty
length :: Block ty -> CountOf ty
length (Block ByteArray#
ba) =
    case Proxy ty -> Int
forall ty. PrimType ty => Proxy ty -> Int
primShiftToBytes (Proxy ty
forall k (t :: k). Proxy t
Proxy :: Proxy ty) of
        Int
0           -> Int -> CountOf ty
forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba))
        (I# Pinned#
szBits) -> Int -> CountOf ty
forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (Pinned# -> Pinned# -> Pinned#
uncheckedIShiftRL# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba) Pinned#
szBits))
{-# INLINE[1] length #-}
{-# SPECIALIZE [2] length :: Block Word8 -> CountOf Word8 #-}

lengthBytes :: Block ty -> CountOf Word8
lengthBytes :: Block ty -> CountOf Word8
lengthBytes (Block ByteArray#
ba) = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (ByteArray# -> Pinned#
sizeofByteArray# ByteArray#
ba))
{-# INLINE[1] lengthBytes #-}

-- | Return the length of a Mutable Block
--
-- note: we don't allow resizing yet, so this can remain a pure function
mutableLength :: forall ty st . PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength :: MutableBlock ty st -> CountOf ty
mutableLength MutableBlock ty st
mb = CountOf Word8 -> CountOf ty
forall a b. (PrimType a, PrimType b) => CountOf a -> CountOf b
sizeRecast (CountOf Word8 -> CountOf ty) -> CountOf Word8 -> CountOf ty
forall a b. (a -> b) -> a -> b
$ MutableBlock ty st -> CountOf Word8
forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes MutableBlock ty st
mb
{-# INLINE[1] mutableLength #-}

mutableLengthBytes :: MutableBlock ty st -> CountOf Word8
mutableLengthBytes :: MutableBlock ty st -> CountOf Word8
mutableLengthBytes (MutableBlock MutableByteArray# st
mba) = Int -> CountOf Word8
forall ty. Int -> CountOf ty
CountOf (Pinned# -> Int
I# (MutableByteArray# st -> Pinned#
forall s. MutableByteArray# s -> Pinned#
sizeofMutableByteArray# MutableByteArray# st
mba))
{-# INLINE[1] mutableLengthBytes #-}

-- | Create an empty block of memory
empty :: Block ty
empty :: Block ty
empty = ByteArray# -> Block ty
forall ty. ByteArray# -> Block ty
Block ByteArray#
ba where !(Block ByteArray#
ba) = Block ()
empty_

empty_ :: Block ()
empty_ :: Block ()
empty_ = (forall s. ST s (Block ())) -> Block ()
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Block ())) -> Block ())
-> (forall s. ST s (Block ())) -> Block ()
forall a b. (a -> b) -> a -> b
$ (State# (PrimState (ST s))
 -> (# State# (PrimState (ST s)), Block () #))
-> ST s (Block ())
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState (ST s))
  -> (# State# (PrimState (ST s)), Block () #))
 -> ST s (Block ()))
-> (State# (PrimState (ST s))
    -> (# State# (PrimState (ST s)), Block () #))
-> ST s (Block ())
forall a b. (a -> b) -> a -> b
$ \State# (PrimState (ST s))
s1 ->
    case Pinned# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
0# State# s
State# (PrimState (ST s))
s1           of { (# State# s
s2, MutableByteArray# s
mba #) ->
    case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba State# s
s2 of { (# State# s
s3, ByteArray#
ba  #) ->
        (# State# s
State# (PrimState (ST s))
s3, ByteArray# -> Block ()
forall ty. ByteArray# -> Block ty
Block ByteArray#
ba #) }}

mutableEmpty :: PrimMonad prim => prim (MutableBlock ty (PrimState prim))
mutableEmpty :: prim (MutableBlock ty (PrimState prim))
mutableEmpty = (State# (PrimState prim)
 -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
 -> prim (MutableBlock ty (PrimState prim)))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 ->
    case Pinned#
-> State# (PrimState prim)
-> (# State# (PrimState prim),
      MutableByteArray# (PrimState prim) #)
forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
0# State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) ->
        (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }

-- | Return the element at a specific index from an array without bounds checking.
--
-- Reading from invalid memory can return unpredictable and invalid values.
-- use 'index' if unsure.
unsafeIndex :: forall ty . PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex :: Block ty -> Offset ty -> ty
unsafeIndex (Block ByteArray#
ba) Offset ty
n = ByteArray# -> Offset ty -> ty
forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba Offset ty
n
{-# SPECIALIZE unsafeIndex :: Block Word8 -> Offset Word8 -> Word8 #-}
{-# INLINE unsafeIndex #-}

-- | make a block from a list of elements.
internalFromList :: PrimType ty => [ty] -> Block ty
internalFromList :: [ty] -> Block ty
internalFromList [ty]
l = (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
    MutableBlock ty s
ma <- CountOf ty -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
CountOf ty -> prim (MutableBlock ty (PrimState prim))
new (Int -> CountOf ty
forall ty. Int -> CountOf ty
CountOf Int
len)
    Offset ty -> [ty] -> (Offset ty -> ty -> ST s ()) -> ST s ()
forall (m :: * -> *) t t a.
(Monad m, Additive t, Integral t) =>
t -> [t] -> (t -> t -> m a) -> m ()
iter Offset ty
forall a. Additive a => a
azero [ty]
l ((Offset ty -> ty -> ST s ()) -> ST s ())
-> (Offset ty -> ty -> ST s ()) -> ST s ()
forall a b. (a -> b) -> a -> b
$ \Offset ty
i ty
x -> 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))
ma Offset ty
i ty
x
    MutableBlock ty (PrimState (ST s)) -> ST s (Block ty)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
MutableBlock ty (PrimState (ST s))
ma
  where
    !len :: Int
len = [ty] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Data.List.length [ty]
l

    iter :: t -> [t] -> (t -> t -> m a) -> m ()
iter t
_  []     t -> t -> m a
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    iter !t
i (t
x:[t]
xs) t -> t -> m a
z = t -> t -> m a
z t
i t
x m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> t -> [t] -> (t -> t -> m a) -> m ()
iter (t
it -> t -> t
forall a. Additive a => a -> a -> a
+t
1) [t]
xs t -> t -> m a
z

-- | transform a block to a list.
internalToList :: forall ty . PrimType ty => Block ty -> [ty]
internalToList :: Block ty -> [ty]
internalToList blk :: Block ty
blk@(Block ByteArray#
ba)
    | CountOf ty
len CountOf ty -> CountOf ty -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf ty
forall a. Additive a => a
azero = []
    | Bool
otherwise    = Offset ty -> [ty]
loop Offset ty
forall a. Additive a => a
azero
  where
    !len :: CountOf ty
len = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
blk
    loop :: Offset ty -> [ty]
loop !Offset ty
i | Offset ty
i Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
len = []
            | Bool
otherwise  = ByteArray# -> Offset ty -> ty
forall ty. PrimType ty => ByteArray# -> Offset ty -> ty
primBaIndex ByteArray#
ba Offset ty
i ty -> [ty] -> [ty]
forall a. a -> [a] -> [a]
: Offset ty -> [ty]
loop (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1)

-- | Check if two blocks are identical
equal :: (PrimType ty, Eq ty) => Block ty -> Block ty -> Bool
equal :: Block ty -> Block ty -> Bool
equal Block ty
a Block ty
b
    | CountOf Word8
la CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= CountOf Word8
lb  = Bool
False
    | Bool
otherwise = Offset ty -> Bool
loop Offset ty
forall a. Additive a => a
azero
  where
    !la :: CountOf Word8
la = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
a
    !lb :: CountOf Word8
lb = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b
    lat :: CountOf ty
lat = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
a

    loop :: Offset ty -> Bool
loop !Offset ty
n | Offset ty
n Offset ty -> CountOf ty -> Bool
forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
lat = Bool
True
            | Bool
otherwise  = (Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
a Offset ty
n ty -> ty -> Bool
forall a. Eq a => a -> a -> Bool
== Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
b Offset ty
n) Bool -> Bool -> Bool
&& Offset ty -> Bool
loop (Offset ty
nOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
forall ty. Offset ty
o1)
    o1 :: Offset ty
o1 = Int -> Offset ty
forall ty. Int -> Offset ty
Offset (Pinned# -> Int
I# Pinned#
1#)
{-# RULES "Block/Eq/Word8" [3]
   forall (a :: Block Word8) b . equal a b = equalMemcmp a b #-}
{-# INLINEABLE [2] equal #-}
-- {-# SPECIALIZE equal :: Block Word8 -> Block Word8 -> Bool #-}

equalMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Bool
equalMemcmp :: Block ty -> Block ty -> Bool
equalMemcmp b1 :: Block ty
b1@(Block ByteArray#
a) b2 :: Block ty
b2@(Block ByteArray#
b)
    | CountOf Word8
la CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= CountOf Word8
lb  = Bool
False
    | Bool
otherwise = IO CInt -> CInt
forall a. IO a -> a
unsafeDupablePerformIO (ByteArray#
-> Offset Word8
-> ByteArray#
-> Offset Word8
-> CountOf Word8
-> IO CInt
sysHsMemcmpBaBa ByteArray#
a Offset Word8
0 ByteArray#
b Offset Word8
0 CountOf Word8
la) CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
0
  where
    la :: CountOf Word8
la = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b1
    lb :: CountOf Word8
lb = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b2
{-# SPECIALIZE equalMemcmp :: Block Word8 -> Block Word8 -> Bool #-}

-- | Compare 2 blocks
internalCompare :: (Ord ty, PrimType ty) => Block ty -> Block ty -> Ordering
internalCompare :: Block ty -> Block ty -> Ordering
internalCompare Block ty
a Block ty
b = Offset ty -> Ordering
loop Offset ty
forall a. Additive a => a
azero
  where
    !la :: CountOf ty
la = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
a
    !lb :: CountOf ty
lb = Block ty -> CountOf ty
forall ty. PrimType ty => Block ty -> CountOf ty
length Block ty
b
    !end :: Offset ty
end = CountOf ty -> Offset ty
forall a. CountOf a -> Offset a
sizeAsOffset (CountOf ty -> CountOf ty -> CountOf ty
forall a. Ord a => a -> a -> a
min CountOf ty
la CountOf ty
lb)
    loop :: Offset ty -> Ordering
loop !Offset ty
n
        | Offset ty
n Offset ty -> Offset ty -> Bool
forall a. Eq a => a -> a -> Bool
== Offset ty
end  = CountOf ty
la CountOf ty -> CountOf ty -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CountOf ty
lb
        | ty
v1 ty -> ty -> Bool
forall a. Eq a => a -> a -> Bool
== ty
v2  = Offset ty -> Ordering
loop (Offset ty
n Offset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+ Int -> Offset ty
forall ty. Int -> Offset ty
Offset (Pinned# -> Int
I# Pinned#
1#))
        | Bool
otherwise = ty
v1 ty -> ty -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` ty
v2
      where
        v1 :: ty
v1 = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
a Offset ty
n
        v2 :: ty
v2 = Block ty -> Offset ty -> ty
forall ty. PrimType ty => Block ty -> Offset ty -> ty
unsafeIndex Block ty
b Offset ty
n
{-# RULES "Block/Ord/Word8" [3] forall (a :: Block Word8) b . internalCompare a b = compareMemcmp a b #-}
{-# NOINLINE internalCompare #-}

compareMemcmp :: PrimMemoryComparable ty => Block ty -> Block ty -> Ordering
compareMemcmp :: Block ty -> Block ty -> Ordering
compareMemcmp b1 :: Block ty
b1@(Block ByteArray#
a) b2 :: Block ty
b2@(Block ByteArray#
b) =
    case IO CInt -> CInt
forall a. IO a -> a
unsafeDupablePerformIO (ByteArray#
-> Offset Word8
-> ByteArray#
-> Offset Word8
-> CountOf Word8
-> IO CInt
sysHsMemcmpBaBa ByteArray#
a Offset Word8
0 ByteArray#
b Offset Word8
0 CountOf Word8
sz) of
        CInt
0             -> CountOf Word8
la CountOf Word8 -> CountOf Word8 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` CountOf Word8
lb
        CInt
n | CInt
n CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
> CInt
0     -> Ordering
GT
          | Bool
otherwise -> Ordering
LT
  where
    la :: CountOf Word8
la = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b1
    lb :: CountOf Word8
lb = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b2
    sz :: CountOf Word8
sz = CountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Ord a => a -> a -> a
min CountOf Word8
la CountOf Word8
lb
{-# SPECIALIZE [3] compareMemcmp :: Block Word8 -> Block Word8 -> Ordering #-}

-- | Append 2 blocks together by creating a new bigger block
append :: Block ty -> Block ty -> Block ty
append :: Block ty -> Block ty -> Block ty
append Block ty
a Block ty
b
    | CountOf Word8
la CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Word8
forall a. Additive a => a
azero = Block ty
b
    | CountOf Word8
lb CountOf Word8 -> CountOf Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== CountOf Word8
forall a. Additive a => a
azero = Block ty
a
    | 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
        MutableBlock ty s
r  <- PinnedStatus
-> CountOf Word8 -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned (CountOf Word8
laCountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Additive a => a -> a -> a
+CountOf Word8
lb)
        MutableBlock ty (PrimState (ST s))
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> ST s ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty s
MutableBlock ty (PrimState (ST s))
r Offset Word8
0                 Block ty
a Offset Word8
0 CountOf Word8
la
        MutableBlock ty (PrimState (ST s))
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> ST s ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty s
MutableBlock ty (PrimState (ST s))
r (CountOf Word8 -> Offset Word8
forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
la) Block ty
b Offset Word8
0 CountOf Word8
lb
        MutableBlock ty (PrimState (ST s)) -> ST s (Block ty)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
MutableBlock ty (PrimState (ST s))
r
  where
    !la :: CountOf Word8
la = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
a
    !lb :: CountOf Word8
lb = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
b

concat :: forall ty . [Block ty] -> Block ty
concat :: [Block ty] -> Block ty
concat [Block ty]
original = (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
    MutableBlock ty s
r <- PinnedStatus
-> CountOf Word8 -> ST s (MutableBlock ty (PrimState (ST s)))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Unpinned CountOf Word8
total
    MutableBlock ty (PrimState (ST s))
-> Offset Word8 -> [Block ty] -> ST s ()
forall (f :: * -> *) ty.
PrimMonad f =>
MutableBlock ty (PrimState f) -> Offset Word8 -> [Block ty] -> f ()
goCopy MutableBlock ty s
MutableBlock ty (PrimState (ST s))
r Offset Word8
forall ty. Offset ty
zero [Block ty]
original
    MutableBlock ty (PrimState (ST s)) -> ST s (Block ty)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty s
MutableBlock ty (PrimState (ST s))
r
  where
    !total :: CountOf Word8
total = CountOf Word8 -> [Block ty] -> CountOf Word8
forall ty. CountOf Word8 -> [Block ty] -> CountOf Word8
size CountOf Word8
0 [Block ty]
original
    -- size
    size :: CountOf Word8 -> [Block ty] -> CountOf Word8
size !CountOf Word8
sz []     = CountOf Word8
sz
    size !CountOf Word8
sz (Block ty
x:[Block ty]
xs) = CountOf Word8 -> [Block ty] -> CountOf Word8
size (Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x CountOf Word8 -> CountOf Word8 -> CountOf Word8
forall a. Additive a => a -> a -> a
+ CountOf Word8
sz) [Block ty]
xs

    zero :: Offset ty
zero = Int -> Offset ty
forall ty. Int -> Offset ty
Offset Int
0

    goCopy :: MutableBlock ty (PrimState f) -> Offset Word8 -> [Block ty] -> f ()
goCopy MutableBlock ty (PrimState f)
r = Offset Word8 -> [Block ty] -> f ()
loop
      where
        loop :: Offset Word8 -> [Block ty] -> f ()
loop Offset Word8
_  []      = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        loop !Offset Word8
i (Block ty
x:[Block ty]
xs) = do
            MutableBlock ty (PrimState f)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> f ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState f)
r Offset Word8
i Block ty
x Offset Word8
forall ty. Offset ty
zero CountOf Word8
lx
            Offset Word8 -> [Block ty] -> f ()
loop (Offset Word8
i Offset Word8 -> CountOf Word8 -> Offset Word8
forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
lx) [Block ty]
xs
          where !lx :: CountOf Word8
lx = Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x

-- | Freeze a mutable block into a block.
--
-- If the mutable block is still use after freeze,
-- then the modification will be reflected in an unexpected
-- way in the Block.
unsafeFreeze :: PrimMonad prim => MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze :: MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze (MutableBlock MutableByteArray# (PrimState prim)
mba) = (State# (PrimState prim)
 -> (# State# (PrimState prim), Block ty #))
-> prim (Block ty)
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), Block ty #))
 -> prim (Block ty))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), Block ty #))
-> prim (Block ty)
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 ->
    case MutableByteArray# (PrimState prim)
-> State# (PrimState prim)
-> (# State# (PrimState prim), ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# (PrimState prim)
mba State# (PrimState prim)
s1 of
        (# State# (PrimState prim)
s2, ByteArray#
ba #) -> (# State# (PrimState prim)
s2, ByteArray# -> Block ty
forall ty. ByteArray# -> Block ty
Block ByteArray#
ba #)
{-# INLINE unsafeFreeze #-}

unsafeShrink :: PrimMonad prim => MutableBlock ty (PrimState prim) -> CountOf ty -> prim (MutableBlock ty (PrimState prim))
unsafeShrink :: MutableBlock ty (PrimState prim)
-> CountOf ty -> prim (MutableBlock ty (PrimState prim))
unsafeShrink (MutableBlock MutableByteArray# (PrimState prim)
mba) (CountOf (I# Pinned#
nsz)) = (State# (PrimState prim)
 -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
 -> prim (MutableBlock ty (PrimState prim)))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s ->
    case MutableByteArray# (PrimState prim)
-> Pinned# -> State# (PrimState prim) -> State# (PrimState prim)
forall d. MutableByteArray# d -> Pinned# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# (PrimState prim)
mba Pinned#
nsz State# (PrimState prim)
s of
        State# (PrimState prim)
s -> (# State# (PrimState prim)
s, MutableByteArray# (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #)

-- | Thaw an immutable block.
--
-- If the immutable block is modified, then the original immutable block will
-- be modified too, but lead to unexpected results when querying
unsafeThaw :: (PrimType ty, PrimMonad prim) => Block ty -> prim (MutableBlock ty (PrimState prim))
unsafeThaw :: Block ty -> prim (MutableBlock ty (PrimState prim))
unsafeThaw (Block ByteArray#
ba) = (State# (PrimState prim)
 -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
 -> prim (MutableBlock ty (PrimState prim)))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
st -> (# State# (PrimState prim)
st, MutableByteArray# (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock (ByteArray# -> MutableByteArray# (PrimState prim)
unsafeCoerce# ByteArray#
ba) #)

-- | Create a new mutable block of a specific size in bytes.
--
-- Note that no checks are made to see if the size in bytes is compatible with the size
-- of the underlaying element 'ty' in the block.
--
-- use 'new' if unsure
unsafeNew :: PrimMonad prim
          => PinnedStatus
          -> CountOf Word8
          -> prim (MutableBlock ty (PrimState prim))
unsafeNew :: PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
pinSt (CountOf (I# Pinned#
bytes)) = case PinnedStatus
pinSt of
    PinnedStatus
Unpinned -> (State# (PrimState prim)
 -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
 -> prim (MutableBlock ty (PrimState prim)))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> case Pinned#
-> State# (PrimState prim)
-> (# State# (PrimState prim),
      MutableByteArray# (PrimState prim) #)
forall d.
Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# Pinned#
bytes State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) -> (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }
    PinnedStatus
_        -> (State# (PrimState prim)
 -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState prim)
  -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
 -> prim (MutableBlock ty (PrimState prim)))
-> (State# (PrimState prim)
    -> (# State# (PrimState prim), MutableBlock ty (PrimState prim) #))
-> prim (MutableBlock ty (PrimState prim))
forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> case Pinned#
-> Pinned#
-> State# (PrimState prim)
-> (# State# (PrimState prim),
      MutableByteArray# (PrimState prim) #)
forall d.
Pinned#
-> Pinned# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray# Pinned#
bytes Pinned#
8# State# (PrimState prim)
s1 of { (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
mba #) -> (# State# (PrimState prim)
s2, MutableByteArray# (PrimState prim)
-> MutableBlock ty (PrimState prim)
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# (PrimState prim)
mba #) }

-- | Create a new unpinned mutable block of a specific N size of 'ty' elements
--
-- If the size exceeds a GHC-defined threshold, then the memory will be
-- pinned. To be certain about pinning status with small size, use 'newPinned'
new :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))
new :: CountOf ty -> prim (MutableBlock ty (PrimState prim))
new CountOf ty
n = 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 -> CountOf ty -> CountOf Word8
forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE (Proxy ty -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy ty
forall k (t :: k). Proxy t
Proxy :: Proxy ty)) CountOf ty
n)

-- | Create a new pinned mutable block of a specific N size of 'ty' elements
newPinned :: forall prim ty . (PrimMonad prim, PrimType ty) => CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned :: CountOf ty -> prim (MutableBlock ty (PrimState prim))
newPinned CountOf ty
n = PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned (CountOf Word8 -> CountOf ty -> CountOf Word8
forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE (Proxy ty -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy ty
forall k (t :: k). Proxy t
Proxy :: Proxy ty)) CountOf ty
n)

-- | Copy a number of elements from an array to another array with offsets
unsafeCopyElements :: forall prim ty . (PrimMonad prim, PrimType ty)
                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                   -> Offset ty                        -- ^ offset at destination
                   -> MutableBlock ty (PrimState prim) -- ^ source mutable block
                   -> Offset ty                        -- ^ offset at source
                   -> CountOf ty                          -- ^ number of elements to copy
                   -> prim ()
unsafeCopyElements :: MutableBlock ty (PrimState prim)
-> Offset ty
-> MutableBlock ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
unsafeCopyElements MutableBlock ty (PrimState prim)
dstMb Offset ty
destOffset MutableBlock ty (PrimState prim)
srcMb Offset ty
srcOffset CountOf ty
n = -- (MutableBlock dstMba) ed (MutableBlock srcBa) es n =
    MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
dstMb (CountOf Word8 -> Offset ty -> Offset Word8
forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
destOffset)
                    MutableBlock ty (PrimState prim)
srcMb (CountOf Word8 -> Offset ty -> Offset Word8
forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
srcOffset)
                    (CountOf Word8 -> CountOf ty -> CountOf Word8
forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE CountOf Word8
sz CountOf ty
n)
  where
    !sz :: CountOf Word8
sz = Proxy ty -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy ty
forall k (t :: k). Proxy t
Proxy :: Proxy ty)

unsafeCopyElementsRO :: forall prim ty . (PrimMonad prim, PrimType ty)
                     => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                     -> Offset ty                        -- ^ offset at destination
                     -> Block ty                         -- ^ source block
                     -> Offset ty                        -- ^ offset at source
                     -> CountOf ty                          -- ^ number of elements to copy
                     -> prim ()
unsafeCopyElementsRO :: MutableBlock ty (PrimState prim)
-> Offset ty -> Block ty -> Offset ty -> CountOf ty -> prim ()
unsafeCopyElementsRO MutableBlock ty (PrimState prim)
dstMb Offset ty
destOffset Block ty
srcMb Offset ty
srcOffset CountOf ty
n =
    MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState prim)
dstMb (CountOf Word8 -> Offset ty -> Offset Word8
forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
destOffset)
                      Block ty
srcMb (CountOf Word8 -> Offset ty -> Offset Word8
forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
srcOffset)
                      (CountOf Word8 -> CountOf ty -> CountOf Word8
forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE CountOf Word8
sz CountOf ty
n)
  where
    !sz :: CountOf Word8
sz = Proxy ty -> CountOf Word8
forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (Proxy ty
forall k (t :: k). Proxy t
Proxy :: Proxy ty)

-- | Copy a number of bytes from a MutableBlock to another MutableBlock with specific byte offsets
unsafeCopyBytes :: forall prim ty . PrimMonad prim
                => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                -> Offset Word8                     -- ^ offset at destination
                -> MutableBlock ty (PrimState prim) -- ^ source mutable block
                -> Offset Word8                     -- ^ offset at source
                -> CountOf Word8                       -- ^ number of elements to copy
                -> prim ()
unsafeCopyBytes :: MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (MutableBlock MutableByteArray# (PrimState prim)
srcBa) (Offset (I# Pinned#
s)) (CountOf (I# Pinned#
n)) =
    (State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ()
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)
st -> (# MutableByteArray# (PrimState prim)
-> Pinned#
-> MutableByteArray# (PrimState prim)
-> Pinned#
-> Pinned#
-> State# (PrimState prim)
-> State# (PrimState prim)
forall d.
MutableByteArray# d
-> Pinned#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# (PrimState prim)
srcBa Pinned#
s MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytes #-}

-- | Copy a number of bytes from a Block to a MutableBlock with specific byte offsets
unsafeCopyBytesRO :: forall prim ty . PrimMonad prim
                  => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                  -> Offset Word8                     -- ^ offset at destination
                  -> Block ty                         -- ^ source block
                  -> Offset Word8                     -- ^ offset at source
                  -> CountOf Word8                       -- ^ number of elements to copy
                  -> prim ()
unsafeCopyBytesRO :: MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (Block ByteArray#
srcBa) (Offset (I# Pinned#
s)) (CountOf (I# Pinned#
n)) =
    (State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ()
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)
st -> (# ByteArray#
-> Pinned#
-> MutableByteArray# (PrimState prim)
-> Pinned#
-> Pinned#
-> State# (PrimState prim)
-> State# (PrimState prim)
forall d.
ByteArray#
-> Pinned#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyByteArray# ByteArray#
srcBa Pinned#
s MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytesRO #-}

-- | Copy a number of bytes from a Ptr to a MutableBlock with specific byte offsets
unsafeCopyBytesPtr :: forall prim ty . PrimMonad prim
                   => MutableBlock ty (PrimState prim) -- ^ destination mutable block
                   -> Offset Word8                     -- ^ offset at destination
                   -> Ptr ty                           -- ^ source block
                   -> CountOf Word8                    -- ^ number of bytes to copy
                   -> prim ()
unsafeCopyBytesPtr :: MutableBlock ty (PrimState prim)
-> Offset Word8 -> Ptr ty -> CountOf Word8 -> prim ()
unsafeCopyBytesPtr (MutableBlock MutableByteArray# (PrimState prim)
dstMba) (Offset (I# Pinned#
d)) (Ptr Addr#
srcBa) (CountOf (I# Pinned#
n)) =
    (State# (PrimState prim) -> (# State# (PrimState prim), () #))
-> prim ()
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)
st -> (# Addr#
-> MutableByteArray# (PrimState prim)
-> Pinned#
-> Pinned#
-> State# (PrimState prim)
-> State# (PrimState prim)
forall d.
Addr#
-> MutableByteArray# d
-> Pinned#
-> Pinned#
-> State# d
-> State# d
copyAddrToByteArray# Addr#
srcBa MutableByteArray# (PrimState prim)
dstMba Pinned#
d Pinned#
n State# (PrimState prim)
st, () #)
{-# INLINE unsafeCopyBytesPtr #-}

-- | read from a cell in a mutable block without bounds checking.
--
-- Reading from invalid memory can return unpredictable and invalid values.
-- use 'read' if unsure.
unsafeRead :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
unsafeRead :: MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
unsafeRead (MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
i = MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> prim ty
primMbaRead MutableByteArray# (PrimState prim)
mba Offset ty
i
{-# INLINE unsafeRead #-}

-- | write to a cell in a mutable block without bounds checking.
--
-- Writing with invalid bounds will corrupt memory and your program will
-- become unreliable. use 'write' if unsure.
unsafeWrite :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite :: MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite (MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
i ty
v = MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableByteArray# (PrimState prim) -> Offset ty -> ty -> prim ()
primMbaWrite MutableByteArray# (PrimState prim)
mba Offset ty
i ty
v
{-# INLINE unsafeWrite #-}

-- | Get a Ptr pointing to the data in the Block.
--
-- Since a Block is immutable, this Ptr shouldn't be
-- to use to modify the contents
--
-- If the Block is pinned, then its address is returned as is,
-- however if it's unpinned, a pinned copy of the Block is made
-- before getting the address.
withPtr :: PrimMonad prim
        => Block ty
        -> (Ptr ty -> prim a)
        -> prim a
withPtr :: Block ty -> (Ptr ty -> prim a) -> prim a
withPtr x :: Block ty
x@(Block ByteArray#
ba) Ptr ty -> prim a
f
    | Block ty -> PinnedStatus
forall ty. Block ty -> PinnedStatus
isPinned Block ty
x PinnedStatus -> PinnedStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PinnedStatus
Pinned = Ptr ty -> prim a
f (Addr# -> Ptr ty
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba)) prim a -> prim () -> prim a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Block ty -> prim ()
forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
x
    | Bool
otherwise            = do
        Block ty
arr <- prim (Block ty)
makeTrampoline
        Ptr ty -> prim a
f (Block ty -> Ptr ty
forall ty. Block ty -> Ptr ty
unsafeBlockPtr Block ty
arr) prim a -> prim () -> prim a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Block ty -> prim ()
forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
arr
  where
    makeTrampoline :: prim (Block ty)
makeTrampoline = do
        MutableBlock ty (PrimState prim)
trampoline <- PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned (Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x)
        MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> Block ty
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytesRO MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 Block ty
x Offset Word8
0 (Block ty -> CountOf Word8
forall ty. Block ty -> CountOf Word8
lengthBytes Block ty
x)
        MutableBlock ty (PrimState prim) -> prim (Block ty)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
trampoline

touch :: PrimMonad prim => Block ty -> prim ()
touch :: Block ty -> prim ()
touch (Block ByteArray#
ba) =
    IO () -> prim ()
forall (prim :: * -> *) a. PrimMonad prim => IO a -> prim a
unsafePrimFromIO (IO () -> prim ()) -> IO () -> prim ()
forall a b. (a -> b) -> a -> b
$ (State# (PrimState IO) -> (# State# (PrimState IO), () #)) -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive ((State# (PrimState IO) -> (# State# (PrimState IO), () #))
 -> IO ())
-> (State# (PrimState IO) -> (# State# (PrimState IO), () #))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \State# (PrimState IO)
s -> case ByteArray# -> State# RealWorld -> State# RealWorld
forall a. a -> State# RealWorld -> State# RealWorld
touch# ByteArray#
ba State# RealWorld
State# (PrimState IO)
s of { State# RealWorld
s2 -> (# State# RealWorld
State# (PrimState IO)
s2, () #) }

unsafeRecast :: (PrimType t1, PrimType t2)
             => MutableBlock t1 st
             -> MutableBlock t2 st
unsafeRecast :: MutableBlock t1 st -> MutableBlock t2 st
unsafeRecast (MutableBlock MutableByteArray# st
mba) = MutableByteArray# st -> MutableBlock t2 st
forall ty st. MutableByteArray# st -> MutableBlock ty st
MutableBlock MutableByteArray# st
mba

-- | Use the 'Ptr' to a mutable block in a safer construct
--
-- If the block is not pinned, this is a _dangerous_ operation
mutableWithPtr :: PrimMonad prim
                => MutableBlock ty (PrimState prim)
                -> (Ptr ty -> prim a)
                -> prim a
mutableWithPtr :: MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
mutableWithPtr = MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
forall (prim :: * -> *) ty a.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr
{-# DEPRECATED mutableWithPtr "use withMutablePtr" #-}

-- | Create a pointer on the beginning of the MutableBlock
-- and call a function 'f'.
--
-- The mutable block can be mutated by the 'f' function
-- and the change will be reflected in the mutable block
--
-- If the mutable block is unpinned, a trampoline buffer
-- is created and the data is only copied when 'f' return.
--
-- it is all-in-all highly inefficient as this cause 2 copies
withMutablePtr :: PrimMonad prim
               => MutableBlock ty (PrimState prim)
               -> (Ptr ty -> prim a)
               -> prim a
withMutablePtr :: MutableBlock ty (PrimState prim) -> (Ptr ty -> prim a) -> prim a
withMutablePtr = Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
forall ty (prim :: * -> *) a.
PrimMonad prim =>
Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint Bool
False Bool
False


-- | Same as 'withMutablePtr' but allow to specify 2 optimisations
-- which is only useful when the MutableBlock is unpinned and need
-- a pinned trampoline to be called safely.
--
-- If skipCopy is True, then the first copy which happen before
-- the call to 'f', is skipped. The Ptr is now effectively
-- pointing to uninitialized data in a new mutable Block.
--
-- If skipCopyBack is True, then the second copy which happen after
-- the call to 'f', is skipped. Then effectively in the case of a
-- trampoline being used the memory changed by 'f' will not
-- be reflected in the original Mutable Block.
--
-- If using the wrong parameters, it will lead to difficult to
-- debug issue of corrupted buffer which only present themselves
-- with certain Mutable Block that happened to have been allocated
-- unpinned.
--
-- If unsure use 'withMutablePtr', which default to *not* skip
-- any copy.
withMutablePtrHint :: forall ty prim a . PrimMonad prim
                   => Bool -- ^ hint that the buffer doesn't need to have the same value as the mutable block when calling f
                   -> Bool -- ^ hint that the buffer is not supposed to be modified by call of f
                   -> MutableBlock ty (PrimState prim)
                   -> (Ptr ty -> prim a)
                   -> prim a
withMutablePtrHint :: Bool
-> Bool
-> MutableBlock ty (PrimState prim)
-> (Ptr ty -> prim a)
-> prim a
withMutablePtrHint Bool
skipCopy Bool
skipCopyBack MutableBlock ty (PrimState prim)
mb Ptr ty -> prim a
f
    | MutableBlock ty (PrimState prim) -> PinnedStatus
forall s ty. MutableBlock s ty -> PinnedStatus
isMutablePinned MutableBlock ty (PrimState prim)
mb PinnedStatus -> PinnedStatus -> Bool
forall a. Eq a => a -> a -> Bool
== PinnedStatus
Pinned = MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
mb
    | Bool
otherwise                    = do
        MutableBlock ty (PrimState prim)
trampoline <- PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
forall (prim :: * -> *) ty.
PrimMonad prim =>
PinnedStatus
-> CountOf Word8 -> prim (MutableBlock ty (PrimState prim))
unsafeNew PinnedStatus
Pinned CountOf Word8
vecSz
        Bool -> prim () -> prim ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
skipCopy (prim () -> prim ()) -> prim () -> prim ()
forall a b. (a -> b) -> a -> b
$
            MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 MutableBlock ty (PrimState prim)
mb Offset Word8
0 CountOf Word8
vecSz
        a
r <- MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
trampoline
        Bool -> prim () -> prim ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
skipCopyBack (prim () -> prim ()) -> prim () -> prim ()
forall a b. (a -> b) -> a -> b
$
            MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim)
-> Offset Word8
-> MutableBlock ty (PrimState prim)
-> Offset Word8
-> CountOf Word8
-> prim ()
unsafeCopyBytes MutableBlock ty (PrimState prim)
mb Offset Word8
0 MutableBlock ty (PrimState prim)
trampoline Offset Word8
0 CountOf Word8
vecSz
        a -> prim a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
  where
    vecSz :: CountOf Word8
vecSz = MutableBlock ty (PrimState prim) -> CountOf Word8
forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes MutableBlock ty (PrimState prim)
mb
    callWithPtr :: MutableBlock ty (PrimState prim) -> prim a
callWithPtr MutableBlock ty (PrimState prim)
pinnedMb = do
        Block ty
b <- MutableBlock ty (PrimState prim) -> prim (Block ty)
forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
pinnedMb
        Ptr ty -> prim a
f (Block ty -> Ptr ty
forall ty. Block ty -> Ptr ty
unsafeBlockPtr Block ty
b) prim a -> prim () -> prim a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Block ty -> prim ()
forall (prim :: * -> *) ty. PrimMonad prim => Block ty -> prim ()
touch Block ty
b