{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE UnboxedTuples #-}

-- This module wraps the operations in the primitive package so that
-- bounds checks can be toggled on during the build for debugging
-- purposes. It exports the entire API for the three array types
-- needed, and adds wrappers for the operations that are unchecked in
-- the base library.
--
-- Checking is toggled using the `arraychecks` flag.
module Unison.Runtime.Array
  ( module EPA,
    byteArrayToList,
    readArray,
    writeArray,
    copyArray,
    traverseArrayIO,
    copyMutableArray,
    cloneMutableArray,
    readByteArray,
    writeByteArray,
    indexByteArray,
    copyByteArray,
    copyMutableByteArray,
    moveByteArray,
    readPrimArray,
    writePrimArray,
    indexPrimArray,
    byteArrayToShortByteString,
    withMutableByteArrayContents,
  )
where

import Control.Exception (evaluate)
import Control.Monad.Primitive
import Data.ByteString.Short
import Data.Kind (Constraint, Type)
import Data.Primitive.Array as EPA hiding
  ( cloneMutableArray,
    copyArray,
    copyMutableArray,
    readArray,
    writeArray,
  )
import Data.Primitive.Array qualified as PA
import Data.Primitive.ByteArray as EPA hiding
  ( copyByteArray,
    copyMutableByteArray,
    indexByteArray,
    moveByteArray,
    readByteArray,
    writeByteArray,
  )
import Data.Primitive.ByteArray qualified as PA
import Data.Primitive.PrimArray as EPA hiding
  ( indexPrimArray,
    readPrimArray,
    writePrimArray,
  )
import Data.Primitive.PrimArray qualified as PA
import Data.Primitive.Types
import Data.Word (Word8)
-- For `withMutableByteArrayContents`
import GHC.Exts
  ( State#,
    UnliftedType,
    keepAlive#,
    unsafeCoerce#,
  )
import GHC.IsList (toList)

#ifdef ARRAY_CHECK
import GHC.Stack

type CheckCtx :: Constraint
type CheckCtx = HasCallStack

type MA = MutableArray
type MBA = MutableByteArray
type A = Array
type BA = ByteArray

-- check index mutable array
checkIMArray
  :: CheckCtx
  => String
  -> (MA s a -> Int -> r)
  -> MA s a -> Int -> r
checkIMArray name f arr i
  | i < 0 || sizeofMutableArray arr <= i
  = error $ name ++ " unsafe check out of bounds: " ++ show i
  | otherwise = f arr i
{-# inline checkIMArray #-}

-- check copy array
checkCArray
  :: CheckCtx
  => String
  -> (MA s a -> Int -> A a -> Int -> Int -> r)
  -> MA s a -> Int -> A a -> Int -> Int -> r
checkCArray name f dst d src s l
  | d < 0
  || s < 0
  || sizeofMutableArray dst < d + l
  || sizeofArray src < s + l
  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
  | otherwise = f dst d src s l
{-# inline checkCArray #-}

-- check copy mutable array
checkCMArray
  :: CheckCtx
  => String
  -> (MA s a -> Int -> MA s a -> Int -> Int -> r)
  -> MA s a -> Int -> MA s a -> Int -> Int -> r
checkCMArray name f dst d src s l
  | d < 0
  || s < 0
  || sizeofMutableArray dst < d + l
  || sizeofMutableArray src < s + l
  = error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
  | otherwise = f dst d src s l
{-# inline checkCMArray #-}

-- check range mutable array
checkRMArray
  :: CheckCtx
  => String
  -> (MA s a -> Int -> Int -> r)
  -> MA s a -> Int -> Int -> r
checkRMArray name f arr o l
  | o < 0 || sizeofMutableArray arr < o+l
  = error $ name ++ "unsafe check out of bounds: " ++ show (o, l)
  | otherwise = f arr o l
{-# inline checkRMArray #-}

-- check index byte array
checkIBArray
  :: CheckCtx
  => Prim a
  => String
  -> a
  -> (ByteArray -> Int -> r)
  -> ByteArray -> Int -> r
checkIBArray name a f arr i
  | i < 0 || sizeofByteArray arr `quot` sizeOf a <= i
  = error $ name ++ " unsafe check out of bounds: " ++ show i
  | otherwise = f arr i
{-# inline checkIBArray #-}

-- check index mutable byte array
checkIMBArray
  :: CheckCtx
  => Prim a
  => PrimMonad m
  => String
  -> a
  -> (MutableByteArray (PrimState m) -> Int ->  m r)
  -> MutableByteArray (PrimState m) -> Int ->  m r
checkIMBArray name a f arr i = do
  sz <- getSizeofMutableByteArray arr
  if (i < 0 || sz `quot` sizeOf a <= i)
     then error $ name ++ " unsafe check out of bounds: " ++ show i
     else f arr i
{-# inline checkIMBArray #-}

-- check write mutable byte array
checkWMBArray
  :: CheckCtx
  => Prim a
  => PrimMonad m
  => String
  -> (MutableByteArray (PrimState m) -> Int -> a -> m r)
  -> MutableByteArray (PrimState m) -> Int -> a -> m r
checkWMBArray name f arr i a = do
  sz <- getSizeofMutableByteArray arr
  if (i < 0 || sz `quot` sizeOf a <= i)
     then error $ name ++ " unsafe check out of bounds: " ++ show i
     else f arr i a
{-# inline checkWMBArray #-}


-- check copy byte array
checkCBArray
  :: CheckCtx
  => PrimMonad m
  => String
  -> (MBA (PrimState m) -> Int -> BA -> Int -> Int -> m r)
  -> MBA (PrimState m) -> Int -> BA -> Int -> Int -> m r
checkCBArray name f dst d src s l = do
  szd <- getSizeofMutableByteArray dst
  if (d < 0
      || s < 0
      || szd < d + l
      || sizeofByteArray src < s + l
      ) then error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
      else f dst d src s l
{-# inline checkCBArray #-}

-- check copy mutable byte array
checkCMBArray
  :: CheckCtx
  => PrimMonad m
  => String
  -> (MBA (PrimState m) -> Int -> MBA (PrimState m) -> Int -> Int -> m r)
  -> MBA (PrimState m) -> Int -> MBA (PrimState m) -> Int -> Int -> m r
checkCMBArray name f dst d src s l = do
  szd <- getSizeofMutableByteArray dst
  szs <- getSizeofMutableByteArray src
  if ( d < 0
      || s < 0
      || szd < d + l
      || szs < s + l
    ) then error $ name ++ " unsafe check out of bounds: " ++ show (d, s, l)
      else f dst d src s l
{-# inline checkCMBArray #-}

-- check index prim array
checkIPArray
  :: CheckCtx
  => Prim a
  => String
  -> (PrimArray a -> Int -> r)
  -> PrimArray a -> Int -> r
checkIPArray name f arr i
  | i < 0 || sizeofPrimArray arr <= i
  = error $ name ++ " unsafe check out of bounds: " ++ show i
  | otherwise = f arr i
{-# inline checkIPArray #-}

-- check index mutable prim array
checkIMPArray
  :: CheckCtx
  => PrimMonad m
  => Prim a
  => String
  -> (MutablePrimArray (PrimState m) a -> Int -> m r)
  -> MutablePrimArray (PrimState m) a -> Int -> m r
checkIMPArray name f arr i = do
  asz <- getSizeofMutablePrimArray arr
  if (i < 0 || asz <= i)
     then error $ name ++ " unsafe check out of bounds: " ++ show i
     else f arr i
{-# inline checkIMPArray #-}

-- check write mutable prim array
checkWMPArray
  :: CheckCtx
  => PrimMonad m
  => Prim a
  => String
  -> (MutablePrimArray (PrimState m) a -> Int -> a -> m r)
  -> MutablePrimArray (PrimState m) a -> Int -> a -> m r
checkWMPArray name f arr i a = do
  asz <- getSizeofMutablePrimArray arr
  if (i < 0 || asz <= i)
    then error $ name ++ " unsafe check out of bounds: " ++ show i
    else f arr i a
{-# inline checkWMPArray #-}


#else
type CheckCtx :: Constraint
type CheckCtx = ()

checkIMArray, checkIMPArray, checkWMPArray, checkIPArray :: String -> r -> r
checkCArray, checkCMArray, checkRMArray :: String -> r -> r
checkIMArray :: forall r. String -> r -> r
checkIMArray String
_ = r -> r
forall a. a -> a
id
checkIMPArray :: forall r. String -> r -> r
checkIMPArray String
_ = r -> r
forall a. a -> a
id
checkWMPArray :: forall r. String -> r -> r
checkWMPArray String
_ = r -> r
forall a. a -> a
id
checkCArray :: forall r. String -> r -> r
checkCArray String
_ = r -> r
forall a. a -> a
id
checkCMArray :: forall r. String -> r -> r
checkCMArray String
_ = r -> r
forall a. a -> a
id
checkRMArray :: forall r. String -> r -> r
checkRMArray String
_ = r -> r
forall a. a -> a
id
checkIPArray :: forall r. String -> r -> r
checkIPArray String
_ = r -> r
forall a. a -> a
id

checkIBArray, checkIMBArray:: String -> a -> r -> r
checkCBArray, checkCMBArray :: String -> r -> r
checkIBArray :: forall a r. String -> a -> r -> r
checkIBArray String
_ a
_ = r -> r
forall a. a -> a
id
checkIMBArray :: forall a r. String -> a -> r -> r
checkIMBArray String
_ a
_ = r -> r
forall a. a -> a
id
checkCBArray :: forall r. String -> r -> r
checkCBArray String
_ = r -> r
forall a. a -> a
id
checkCMBArray :: forall r. String -> r -> r
checkCMBArray String
_ = r -> r
forall a. a -> a
id

checkWMBArray :: String -> r -> r
checkWMBArray :: forall r. String -> r -> r
checkWMBArray String
_ = r -> r
forall a. a -> a
id
#endif

readArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableArray (PrimState m) a ->
  Int ->
  m a
readArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> m a
readArray = String
-> (MutableArray (PrimState m) a -> Int -> m a)
-> MutableArray (PrimState m) a
-> Int
-> m a
forall r. String -> r -> r
checkIMArray String
"readArray" MutableArray (PrimState m) a -> Int -> m a
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> m a
PA.readArray
{-# INLINE readArray #-}

writeArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableArray (PrimState m) a ->
  Int ->
  a ->
  m ()
writeArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m) =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray = String
-> (MutableArray (PrimState m) a -> Int -> a -> m ())
-> MutableArray (PrimState m) a
-> Int
-> a
-> m ()
forall r. String -> r -> r
checkIMArray String
"writeArray" MutableArray (PrimState m) a -> Int -> a -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
PA.writeArray
{-# INLINE writeArray #-}

copyArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableArray (PrimState m) a ->
  Int ->
  Array a ->
  Int ->
  Int ->
  m ()
copyArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray = String
-> (MutableArray (PrimState m) a
    -> Int -> Array a -> Int -> Int -> m ())
-> MutableArray (PrimState m) a
-> Int
-> Array a
-> Int
-> Int
-> m ()
forall r. String -> r -> r
checkCArray String
"copyArray" MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
PA.copyArray
{-# INLINE copyArray #-}

cloneMutableArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableArray (PrimState m) a ->
  Int ->
  Int ->
  m (MutableArray (PrimState m) a)
cloneMutableArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
cloneMutableArray = String
-> (MutableArray (PrimState m) a
    -> Int -> Int -> m (MutableArray (PrimState m) a))
-> MutableArray (PrimState m) a
-> Int
-> Int
-> m (MutableArray (PrimState m) a)
forall r. String -> r -> r
checkRMArray String
"cloneMutableArray" MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Int -> m (MutableArray (PrimState m) a)
PA.cloneMutableArray
{-# INLINE cloneMutableArray #-}

copyMutableArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableArray (PrimState m) a ->
  Int ->
  MutableArray (PrimState m) a ->
  Int ->
  Int ->
  m ()
copyMutableArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m) =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
copyMutableArray = String
-> (MutableArray (PrimState m) a
    -> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ())
-> MutableArray (PrimState m) a
-> Int
-> MutableArray (PrimState m) a
-> Int
-> Int
-> m ()
forall r. String -> r -> r
checkCMArray String
"copyMutableArray" MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> MutableArray (PrimState m) a -> Int -> Int -> m ()
PA.copyMutableArray
{-# INLINE copyMutableArray #-}

readByteArray ::
  forall a m.
  (CheckCtx) =>
  (PrimMonad m) =>
  (Prim a) =>
  MutableByteArray (PrimState m) ->
  Int ->
  m a
readByteArray :: forall a (m :: * -> *).
(CheckCtx, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray = forall a r. String -> a -> r -> r
checkIMBArray @a String
"readByteArray" a
forall a. HasCallStack => a
undefined MutableByteArray (PrimState m) -> Int -> m a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
PA.readByteArray
{-# INLINE readByteArray #-}

writeByteArray ::
  forall a m.
  (CheckCtx) =>
  (PrimMonad m) =>
  (Prim a) =>
  MutableByteArray (PrimState m) ->
  Int ->
  a ->
  m ()
writeByteArray :: forall a (m :: * -> *).
(CheckCtx, PrimMonad m, Prim a) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray = String
-> (MutableByteArray (PrimState m) -> Int -> a -> m ())
-> MutableByteArray (PrimState m)
-> Int
-> a
-> m ()
forall r. String -> r -> r
checkWMBArray String
"writeByteArray" MutableByteArray (PrimState m) -> Int -> a -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
PA.writeByteArray
{-# INLINE writeByteArray #-}

indexByteArray ::
  forall a.
  (CheckCtx) =>
  (Prim a) =>
  ByteArray ->
  Int ->
  a
indexByteArray :: forall a. (CheckCtx, Prim a) => ByteArray -> Int -> a
indexByteArray = forall a r. String -> a -> r -> r
checkIBArray @a String
"indexByteArray" a
forall a. HasCallStack => a
undefined ByteArray -> Int -> a
forall a. Prim a => ByteArray -> Int -> a
PA.indexByteArray
{-# INLINE indexByteArray #-}

copyByteArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableByteArray (PrimState m) ->
  Int ->
  ByteArray ->
  Int ->
  Int ->
  m ()
copyByteArray :: forall (m :: * -> *).
(CheckCtx, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
copyByteArray = String
-> (MutableByteArray (PrimState m)
    -> Int -> ByteArray -> Int -> Int -> m ())
-> MutableByteArray (PrimState m)
-> Int
-> ByteArray
-> Int
-> Int
-> m ()
forall r. String -> r -> r
checkCBArray String
"copyByteArray" MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> ByteArray -> Int -> Int -> m ()
PA.copyByteArray
{-# INLINE copyByteArray #-}

copyMutableByteArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableByteArray (PrimState m) ->
  Int ->
  MutableByteArray (PrimState m) ->
  Int ->
  Int ->
  m ()
copyMutableByteArray :: forall (m :: * -> *).
(CheckCtx, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
copyMutableByteArray = String
-> (MutableByteArray (PrimState m)
    -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ())
-> MutableByteArray (PrimState m)
-> Int
-> MutableByteArray (PrimState m)
-> Int
-> Int
-> m ()
forall r. String -> r -> r
checkCMBArray String
"copyMutableByteArray" MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PA.copyMutableByteArray
{-# INLINE copyMutableByteArray #-}

moveByteArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  MutableByteArray (PrimState m) ->
  Int ->
  MutableByteArray (PrimState m) ->
  Int ->
  Int ->
  m ()
moveByteArray :: forall (m :: * -> *).
(CheckCtx, PrimMonad m) =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
moveByteArray = String
-> (MutableByteArray (PrimState m)
    -> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ())
-> MutableByteArray (PrimState m)
-> Int
-> MutableByteArray (PrimState m)
-> Int
-> Int
-> m ()
forall r. String -> r -> r
checkCMBArray String
"moveByteArray" MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m)
-> Int -> MutableByteArray (PrimState m) -> Int -> Int -> m ()
PA.moveByteArray
{-# INLINE moveByteArray #-}

readPrimArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  (Prim a) =>
  MutablePrimArray (PrimState m) a ->
  Int ->
  m a
readPrimArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> m a
readPrimArray = String
-> (MutablePrimArray (PrimState m) a -> Int -> m a)
-> MutablePrimArray (PrimState m) a
-> Int
-> m a
forall r. String -> r -> r
checkIMPArray String
"readPrimArray" MutablePrimArray (PrimState m) a -> Int -> m a
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> m a
PA.readPrimArray
{-# INLINE readPrimArray #-}

writePrimArray ::
  (CheckCtx) =>
  (PrimMonad m) =>
  (Prim a) =>
  MutablePrimArray (PrimState m) a ->
  Int ->
  a ->
  m ()
writePrimArray :: forall (m :: * -> *) a.
(CheckCtx, PrimMonad m, Prim a) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
writePrimArray = String
-> (MutablePrimArray (PrimState m) a -> Int -> a -> m ())
-> MutablePrimArray (PrimState m) a
-> Int
-> a
-> m ()
forall r. String -> r -> r
checkWMPArray String
"writePrimArray" MutablePrimArray (PrimState m) a -> Int -> a -> m ()
forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutablePrimArray (PrimState m) a -> Int -> a -> m ()
PA.writePrimArray
{-# INLINE writePrimArray #-}

indexPrimArray ::
  (CheckCtx) =>
  (Prim a) =>
  PrimArray a ->
  Int ->
  a
indexPrimArray :: forall a. (CheckCtx, Prim a) => PrimArray a -> Int -> a
indexPrimArray = String -> (PrimArray a -> Int -> a) -> PrimArray a -> Int -> a
forall r. String -> r -> r
checkIPArray String
"indexPrimArray" PrimArray a -> Int -> a
forall a. Prim a => PrimArray a -> Int -> a
PA.indexPrimArray
{-# INLINE indexPrimArray #-}

byteArrayToList :: ByteArray -> [Word8]
byteArrayToList :: ByteArray -> [Word8]
byteArrayToList = ByteArray -> [Word8]
ByteArray -> [Item ByteArray]
forall l. IsList l => l -> [Item l]
toList

traverseArrayIO :: (a -> IO b) -> Array a -> IO (Array b)
traverseArrayIO :: forall a b. (a -> IO b) -> Array a -> IO (Array b)
traverseArrayIO a -> IO b
f Array a
src = do
  MutableArray RealWorld b
dst <- Int -> b -> IO (MutableArray (PrimState IO) b)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
sz (String -> b
forall a. HasCallStack => String -> a
error String
"traverseArray: impossible")
  let fill :: Int -> IO (Array b)
fill Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
sz = do
            MutableArray (PrimState IO) b -> Int -> b -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
PA.writeArray MutableArray RealWorld b
MutableArray (PrimState IO) b
dst Int
i (b -> IO ()) -> IO b -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> IO b
forall a. a -> IO a
evaluate (b -> IO b) -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> IO b
f (a -> IO b) -> IO a -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Array a -> Int -> IO a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
src Int
i
            Int -> IO (Array b)
fill (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        | Bool
otherwise = MutableArray (PrimState IO) b -> IO (Array b)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray RealWorld b
MutableArray (PrimState IO) b
dst
  Int -> IO (Array b)
fill Int
0
  where
    sz :: Int
sz = Array a -> Int
forall a. Array a -> Int
sizeofArray Array a
src
{-# INLINE traverseArrayIO #-}

byteArrayToShortByteString :: ByteArray -> ShortByteString
byteArrayToShortByteString :: ByteArray -> ShortByteString
byteArrayToShortByteString (ByteArray ByteArray#
ba) = ByteArray# -> ShortByteString
SBS ByteArray#
ba

-- Port from newer version of `primitive` than we rely on currently.
-- Replace with the upstream when dependencies are bumped.
withMutableByteArrayContents ::
  (PrimBase m) =>
  MutableByteArray (PrimState m) ->
  (Ptr Word8 -> m r) ->
  m r
withMutableByteArrayContents :: forall (m :: * -> *) r.
PrimBase m =>
MutableByteArray (PrimState m) -> (Ptr Word8 -> m r) -> m r
withMutableByteArrayContents arr :: MutableByteArray (PrimState m)
arr@(MutableByteArray MutableByteArray# (PrimState m)
arr#) Ptr Word8 -> m r
k =
  MutableByteArray# (PrimState m) -> m r -> m r
forall (m :: * -> *) (a :: UnliftedType) r.
PrimBase m =>
a -> m r -> m r
keepAliveUnlifted MutableByteArray# (PrimState m)
arr# (Ptr Word8 -> m r
k (MutableByteArray (PrimState m) -> Ptr Word8
forall s. MutableByteArray s -> Ptr Word8
mutableByteArrayContents MutableByteArray (PrimState m)
arr))
{-# INLINE withMutableByteArrayContents #-}

keepAliveUnlifted ::
  forall
    (m :: Type -> Type)
    (a :: UnliftedType)
    (r :: Type).
  (PrimBase m) =>
  a ->
  m r ->
  m r
keepAliveUnlifted :: forall (m :: * -> *) (a :: UnliftedType) r.
PrimBase m =>
a -> m r -> m r
keepAliveUnlifted a
x m r
k =
  (State# (PrimState m) -> (# State# (PrimState m), r #)) -> m r
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive \State# (PrimState m)
s -> a
-> State# (PrimState m)
-> (State# (PrimState m) -> (# State# (PrimState m), r #))
-> (# State# (PrimState m), r #)
forall (a :: UnliftedType) s b.
a
-> State# s -> (State# s -> (# State# s, b #)) -> (# State# s, b #)
keepAliveWrap a
x State# (PrimState m)
s (m r -> State# (PrimState m) -> (# State# (PrimState m), r #)
forall a.
m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
forall (m :: * -> *) a.
PrimBase m =>
m a -> State# (PrimState m) -> (# State# (PrimState m), a #)
internal m r
k)
{-# INLINE keepAliveUnlifted #-}

keepAliveWrap ::
  forall (a :: UnliftedType) (s :: Type) (b :: Type).
  a ->
  State# s ->
  (State# s -> (# State# s, b #)) ->
  (# State# s, b #)
keepAliveWrap :: forall (a :: UnliftedType) s b.
a
-> State# s -> (State# s -> (# State# s, b #)) -> (# State# s, b #)
keepAliveWrap a
x State# s
s State# s -> (# State# s, b #)
k = case a
-> State# RealWorld
-> (State# RealWorld -> (# State# RealWorld, b #))
-> (# State# RealWorld, b #)
forall a b. a -> State# RealWorld -> (State# RealWorld -> b) -> b
keepAlive# a
x (State# s -> State# RealWorld
s2rw State# s
s) State# RealWorld -> (# State# RealWorld, b #)
k# of
  (# State# RealWorld
s, b
b #) -> (# State# RealWorld -> State# s
rw2s State# RealWorld
s, b
b #)
  where
    rw2s :: State# RealWorld -> State# s
    rw2s :: State# RealWorld -> State# s
rw2s = State# RealWorld -> State# s
forall a b. a -> b
unsafeCoerce#

    s2rw :: State# s -> State# RealWorld
    s2rw :: State# s -> State# RealWorld
s2rw = State# s -> State# RealWorld
forall a b. a -> b
unsafeCoerce#

    k# :: State# RealWorld -> (# State# RealWorld, b #)
    k# :: State# RealWorld -> (# State# RealWorld, b #)
k# State# RealWorld
s = case State# s -> (# State# s, b #)
k (State# RealWorld -> State# s
rw2s State# RealWorld
s) of
      (# State# s
s, b
b #) -> (# State# s -> State# RealWorld
s2rw State# s
s, b
b #)
{-# INLINE keepAliveWrap #-}