-- |
-- Module      : Basement.Block.Mutable
-- License     : BSD-style
-- Maintainer  : Haskell Foundation
--
-- A block of memory that contains elements of a type,
-- very similar to an unboxed array but with the key difference:
--
-- * It doesn't have slicing capability (no cheap take or drop)
-- * It consume less memory: 1 Offset, 1 CountOf, 1 Pinning status trimmed
-- * It's unpackable in any constructor
-- * It uses unpinned memory by default
--
-- It should be rarely needed in high level API, but
-- in lowlevel API or some data structure containing lots
-- of unboxed array that will benefit from optimisation.
--
-- Because it's unpinned, the blocks are compactable / movable,
-- at the expense of making them less friendly to interop with the C layer
-- as address.
--
-- Note that sadly the bytearray primitive type automatically create
-- a pinned bytearray if the size is bigger than a certain threshold
--
-- GHC Documentation associated:
--
-- includes/rts/storage/Block.h
--   * LARGE_OBJECT_THRESHOLD ((uint32_t)(BLOCK_SIZE * 8 / 10))
--   * BLOCK_SIZE   (1<<BLOCK_SHIFT)
--
-- includes/rts/Constant.h
--   * BLOCK_SHIFT  12
--
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples       #-}
module Basement.Block.Mutable
    ( Block(..)
    , MutableBlock(..)
    , mutableLengthSize
    , mutableLength
    , mutableLengthBytes
    , mutableWithPtr
    , withMutablePtr
    , withMutablePtrHint
    , new
    , newPinned
    , mutableEmpty
    , iterSet
    , read
    , write
    , unsafeNew
    , unsafeWrite
    , unsafeRead
    , unsafeFreeze
    , unsafeThaw
    , unsafeCopyElements
    , unsafeCopyElementsRO
    , unsafeCopyBytes
    , unsafeCopyBytesRO
    , unsafeCopyBytesPtr
    -- * Foreign
    , copyFromPtr
    , copyToPtr
    ) where

import           GHC.Prim
import           GHC.Types
import           Basement.Compat.Base
import           Data.Proxy
import           Basement.Exception
import           Basement.Types.OffsetSize
import           Basement.Monad
import           Basement.Numerical.Additive
import           Basement.PrimType
import           Basement.Block.Base

-- | Set all mutable block element to a value
iterSet :: (PrimType ty, PrimMonad prim)
        => (Offset ty -> ty)
        -> MutableBlock ty (PrimState prim)
        -> prim ()
iterSet :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
(Offset ty -> ty) -> MutableBlock ty (PrimState prim) -> prim ()
iterSet Offset ty -> ty
f MutableBlock ty (PrimState prim)
ma = Offset ty -> prim ()
loop Offset ty
0
  where
    !sz :: CountOf ty
sz = forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength MutableBlock ty (PrimState prim)
ma
    loop :: Offset ty -> prim ()
loop Offset ty
i
        | Offset ty
i forall ty. Offset ty -> CountOf ty -> Bool
.==# CountOf ty
sz = 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 (PrimState prim)
ma Offset ty
i (Offset ty -> ty
f Offset ty
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Offset ty -> prim ()
loop (Offset ty
iforall a. Additive a => a -> a -> a
+Offset ty
1)
    {-# INLINE loop #-}

mutableLengthSize :: PrimType ty => MutableBlock ty st -> CountOf ty
mutableLengthSize :: forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLengthSize = forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength
{-# DEPRECATED mutableLengthSize "use mutableLength" #-}

-- | read a cell in a mutable array.
--
-- If the index is out of bounds, an error is raised.
read :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
read :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
read MutableBlock ty (PrimState prim)
array Offset ty
n
    | forall ty. Offset ty -> CountOf ty -> Bool
isOutOfBound Offset ty
n CountOf ty
len = forall (prim :: * -> *) ty a.
PrimMonad prim =>
OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a
primOutOfBound OutOfBoundOperation
OOB_Read Offset ty
n CountOf ty
len
    | Bool
otherwise          = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> prim ty
unsafeRead MutableBlock ty (PrimState prim)
array Offset ty
n
  where len :: CountOf ty
len = forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLength MutableBlock ty (PrimState prim)
array
{-# INLINE read #-}

-- | Write to a cell in a mutable array.
--
-- If the index is out of bounds, an error is raised.
write :: (PrimMonad prim, PrimType ty) => MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
write :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
write MutableBlock ty (PrimState prim)
array Offset ty
n ty
val
    | forall ty. Offset ty -> CountOf ty -> Bool
isOutOfBound Offset ty
n CountOf ty
len = forall (prim :: * -> *) ty a.
PrimMonad prim =>
OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a
primOutOfBound OutOfBoundOperation
OOB_Write Offset ty
n CountOf ty
len
    | Bool
otherwise          = forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
MutableBlock ty (PrimState prim) -> Offset ty -> ty -> prim ()
unsafeWrite MutableBlock ty (PrimState prim)
array Offset ty
n ty
val
  where
    len :: CountOf ty
len = forall ty st. PrimType ty => MutableBlock ty st -> CountOf ty
mutableLengthSize MutableBlock ty (PrimState prim)
array
{-# INLINE write #-}

-- | Copy from a pointer, @count@ elements, into the Mutable Block at a starting offset @ofs@
--
-- if the source pointer is invalid (size or bad allocation), bad things will happen
--
copyFromPtr :: forall prim ty . (PrimMonad prim, PrimType ty)
            => Ptr ty                           -- ^ Source Ptr of 'ty' to start of memory
            -> MutableBlock ty (PrimState prim) -- ^ Destination mutable block
            -> Offset ty                        -- ^ Start offset in the destination mutable block
            -> CountOf ty                       -- ^ Number of 'ty' elements
            -> prim ()
copyFromPtr :: forall (prim :: * -> *) ty.
(PrimMonad prim, PrimType ty) =>
Ptr ty
-> MutableBlock ty (PrimState prim)
-> Offset ty
-> CountOf ty
-> prim ()
copyFromPtr src :: Ptr ty
src@(Ptr Addr#
src#) mb :: MutableBlock ty (PrimState prim)
mb@(MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
ofs CountOf ty
count
    | Offset Word8
end forall a. Ord a => a -> a -> Bool
> forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
arrSz = forall (prim :: * -> *) ty a.
PrimMonad prim =>
OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a
primOutOfBound OutOfBoundOperation
OOB_MemCopy Offset Word8
end CountOf Word8
arrSz
    | Bool
otherwise                = 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)
st -> (# forall d.
Addr#
-> MutableByteArray# d -> Int# -> Int# -> State# d -> State# d
copyAddrToByteArray# Addr#
src# MutableByteArray# (PrimState prim)
mba Int#
od# Int#
bytes# State# (PrimState prim)
st, () #)
  where
    end :: Offset Word8
end = Offset Word8
od forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
arrSz

    sz :: CountOf Word8
sz = forall ty. PrimType ty => Proxy ty -> CountOf Word8
primSizeInBytes (forall {k} (t :: k). Proxy t
Proxy :: Proxy ty)
    !arrSz :: CountOf Word8
arrSz@(CountOf (I# Int#
bytes#)) = forall ty. CountOf Word8 -> CountOf ty -> CountOf Word8
sizeOfE CountOf Word8
sz CountOf ty
count
    !od :: Offset Word8
od@(Offset (I# Int#
od#)) = forall ty. CountOf Word8 -> Offset ty -> Offset Word8
offsetOfE CountOf Word8
sz Offset ty
ofs

-- | Copy all the block content to the memory starting at the destination address
--
-- If the destination pointer is invalid (size or bad allocation), bad things will happen
copyToPtr :: forall ty prim . (PrimType ty, PrimMonad prim)
          => MutableBlock ty (PrimState prim) -- ^ The source mutable block to copy
          -> Offset ty                        -- ^ The source offset in the mutable block
          -> Ptr ty                           -- ^ The destination address where the copy is going to start
          -> CountOf ty                       -- ^ The number of bytes
          -> prim ()
copyToPtr :: forall ty (prim :: * -> *).
(PrimType ty, PrimMonad prim) =>
MutableBlock ty (PrimState prim)
-> Offset ty -> Ptr ty -> CountOf ty -> prim ()
copyToPtr mb :: MutableBlock ty (PrimState prim)
mb@(MutableBlock MutableByteArray# (PrimState prim)
mba) Offset ty
ofs dst :: Ptr ty
dst@(Ptr Addr#
dst#) CountOf ty
count
    | Offset Word8
srcEnd forall a. Ord a => a -> a -> Bool
> forall a. CountOf a -> Offset a
sizeAsOffset CountOf Word8
arrSz = forall (prim :: * -> *) ty a.
PrimMonad prim =>
OutOfBoundOperation -> Offset ty -> CountOf ty -> prim a
primOutOfBound OutOfBoundOperation
OOB_MemCopy Offset Word8
srcEnd CountOf Word8
arrSz
    | Bool
otherwise                = do
        Block ty
blk <- forall (prim :: * -> *) ty.
PrimMonad prim =>
MutableBlock ty (PrimState prim) -> prim (Block ty)
unsafeFreeze MutableBlock ty (PrimState prim)
mb
        let !(Block ByteArray#
ba) = Block ty
blk
        forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive forall a b. (a -> b) -> a -> b
$ \State# (PrimState prim)
s1 -> (# forall d.
ByteArray# -> Int# -> Addr# -> Int# -> State# d -> State# d
copyByteArrayToAddr# ByteArray#
ba Int#
os# Addr#
dst# Int#
szBytes# State# (PrimState prim)
s1, () #)
  where
    srcEnd :: Offset Word8
srcEnd = Offset Word8
os forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf Word8
arrSz
    !os :: Offset Word8
os@(Offset (I# Int#
os#)) = forall a. PrimType a => Offset a -> Offset Word8
offsetInBytes Offset ty
ofs
    !arrSz :: CountOf Word8
arrSz@(CountOf (I# Int#
szBytes#)) = forall ty st. MutableBlock ty st -> CountOf Word8
mutableLengthBytes MutableBlock ty (PrimState prim)
mb