{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Data.Prim.Memory.Bytes.Internal
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Prim.Memory.Bytes.Internal
  ( Bytes(..)
  , MBytes(..)
  , Pinned(..)
  , toByteArray#
  , fromByteArray#
  , toMutableByteArray#
  , fromMutableByteArray#
  , isSameBytes
  , isSamePinnedBytes
  , isSameMBytes
  , isPinnedBytes
  , isPinnedMBytes
  , castStateMBytes
  , castPinnedBytes
  , castPinnedMBytes
  , relaxPinnedBytes
  , relaxPinnedMBytes
  , toInconclusiveBytes
  , toInconclusiveMBytes
  , allocMBytes
  , allocPinnedMBytes
  , allocAlignedMBytes
  , allocUnpinnedMBytes
  , allocZeroPinnedMBytes
  , allocZeroAlignedMBytes
  , reallocMBytes
  , freezeMBytes
  , thawBytes
  , shrinkMBytes
  , resizeMBytes
  , indexOffBytes
  , indexByteOffBytes
  , compareByteOffBytes
  , byteCountBytes
  , countBytes
  , getCountMBytes
  , getByteCountMBytes
  , setMBytes
  , copyByteOffBytesToMBytes
  , moveByteOffMBytesToMBytes
  , readOffMBytes
  , readByteOffMBytes
  , writeOffMBytes
  , writeByteOffMBytes
  , toUArrayBytes
  , fromUArrayBytes
  , toUMArrayMBytes
  , fromUMArrayMBytes
  , toPtrBytes
  , toPtrMBytes
  , withPtrBytes
  , withPtrMBytes
  , withNoHaltPtrBytes
  , withNoHaltPtrMBytes
  , toForeignPtrBytes
  , toForeignPtrMBytes
  , castForeignPtrToBytes
  , onForeignPtrContents
  , byteStringConvertError
  ) where

import Control.DeepSeq
import Control.Prim.Monad
import Control.Prim.Monad.Unsafe
import Control.Prim.Eval
import Data.Prim
import Data.Prim.Array
import Data.Prim.Class
import Data.Typeable
import Foreign.Prim
import GHC.ForeignPtr
import Unsafe.Coerce
#if MIN_VERSION_base(4,14,0)
import Data.IORef
#endif

-- | In GHC there is a distinction between pinned and unpinned memory.
--
-- Pinned memory is such that when allocated, it is guaranteed not to move throughout the
-- lifetime of a program. In other words the address pointer that refers to allocated
-- bytes will not change until the associated `ByteArray#` or `MutableByteArray#` is no
-- longer referenced anywhere in the program at which point it gets garbage collected. On
-- the other hand unpinned memory can be moved around during GC, which helps to reduce
-- memory fragmentation.
--
-- Pinned/unpinnned choice during allocation is a bit of a lie, because when attempt is
-- made to allocate memory as unpinned, but requested size is a bit more than a certain
-- threshold (somewhere around 3KiB) it might still be allocated as pinned. Because of
-- that fact through out the "primal" universe there is a distinction between memory that
-- is either @`Pin`ned@ or @`Inc`onclusive@.
--
-- It is possible to use one of `Data.Prim.Memory.Bytes.toPinnedBytes` or
-- `Data.Prim.Memory.Bytes.toPinnedMBytes` to get a conclusive type.
--
-- @since 0.1.0
data Pinned
  = Pin -- ^ Pinned, which indicates that allocated memory will not move
  | Inc -- ^ Inconclusive, thus memory could be pinned or unpinned

-- | An immutable region of memory which was allocated either as pinned or unpinned.
--
-- Constructor is not exported for safety. Violating type level `Pinned` kind is very
-- dangerous. Type safe constructor `Data.Prim.Memory.Bytes.fromByteArray#` and unwrapper
-- `Data.Prim.Memory.Bytes.toByteArray#` should be used instead. As a backdoor, of course,
-- the actual constructor is available from @Data.Prim.Memory.Internal@
data Bytes (p :: Pinned) = Bytes ByteArray#
type role Bytes nominal

-- | Mutable region of memory which was allocated either as pinned or unpinned.
--
-- Constructor is not exported for safety. Violating type level `Pinned` kind is very
-- dangerous. Type safe constructor `Data.Prim.Memory.Bytes.fromMutableByteArray#` and
-- unwrapper `Data.Prim.Memory.Bytes.toMutableByteArray#` should be used instead. As a
-- backdoor, of course, the actual constructor is available in "Data.Prim.Memory.Internal"
-- module and specially unsafe function `castPinnedMBytes` was crafted.
data MBytes (p :: Pinned) s = MBytes (MutableByteArray# s)
type role MBytes nominal nominal


instance NFData (Bytes p) where
  rnf :: Bytes p -> ()
rnf (Bytes ByteArray#
_) = ()

instance NFData (MBytes p s) where
  rnf :: MBytes p s -> ()
rnf (MBytes MutableByteArray# s
_) = ()


-- | Unwrap `Bytes` to get the underlying `ByteArray#`.
--
-- @since 0.1.0
toByteArray# :: Bytes p -> ByteArray#
toByteArray# :: Bytes p -> ByteArray#
toByteArray# (Bytes ByteArray#
b#) = ByteArray#
b#

-- | Wrap `ByteArray#` into `Bytes`
--
-- @since 0.1.0
fromByteArray# :: ByteArray# -> Bytes 'Inc
fromByteArray# :: ByteArray# -> Bytes 'Inc
fromByteArray# = ByteArray# -> Bytes 'Inc
forall (p :: Pinned). ByteArray# -> Bytes p
Bytes

-- | Unwrap `MBytes` to get the underlying `MutableByteArray#`.
--
-- @since 0.1.0
toMutableByteArray# :: MBytes p s -> MutableByteArray# s
toMutableByteArray# :: MBytes p s -> MutableByteArray# s
toMutableByteArray# (MBytes MutableByteArray# s
mb#) = MutableByteArray# s
mb#

-- | Wrap `MutableByteArray#` into `MBytes`
--
-- @since 0.1.0
fromMutableByteArray# :: MutableByteArray# s -> MBytes 'Inc s
fromMutableByteArray# :: MutableByteArray# s -> MBytes 'Inc s
fromMutableByteArray# = MutableByteArray# s -> MBytes 'Inc s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes




---- Pure

compareByteOffBytes :: Prim e => Bytes p1 -> Off Word8 -> Bytes p2 -> Off Word8 -> Count e -> Ordering
compareByteOffBytes :: Bytes p1
-> Off Word8 -> Bytes p2 -> Off Word8 -> Count e -> Ordering
compareByteOffBytes (Bytes ByteArray#
b1#) (Off (I# Int#
off1#)) (Bytes ByteArray#
b2#) (Off (I# Int#
off2#)) Count e
c =
  Int# -> Ordering
toOrdering# (ByteArray# -> Int# -> ByteArray# -> Int# -> Int# -> Int#
compareByteArrays# ByteArray#
b1# Int#
off1# ByteArray#
b2# Int#
off2# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c))
{-# INLINE compareByteOffBytes #-}

indexOffBytes :: Prim e => Bytes p -> Off e -> e
indexOffBytes :: Bytes p -> Off e -> e
indexOffBytes (Bytes ByteArray#
ba#) (Off (I# Int#
i#)) = ByteArray# -> Int# -> e
forall a. Prim a => ByteArray# -> Int# -> a
indexByteArray# ByteArray#
ba# Int#
i#
{-# INLINE indexOffBytes #-}

indexByteOffBytes :: Prim e => Bytes p -> Off Word8 -> e
indexByteOffBytes :: Bytes p -> Off Word8 -> e
indexByteOffBytes (Bytes ByteArray#
ba#) (Off (I# Int#
i#)) = ByteArray# -> Int# -> e
forall a. Prim a => ByteArray# -> Int# -> a
indexByteOffByteArray# ByteArray#
ba# Int#
i#
{-# INLINE indexByteOffBytes #-}


---- Mutable


allocMBytes ::
     forall p e s m. (Typeable p, Prim e, MonadPrim s m)
  => Count e
  -> m (MBytes p s)
allocMBytes :: Count e -> m (MBytes p s)
allocMBytes Count e
c =
  case Maybe (p :~: 'Pin)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (p :~: 'Pin) of
    Just p :~: 'Pin
Refl -> Count e -> m (MBytes 'Pin s)
forall s (m :: * -> *) e.
(MonadPrim s m, Prim e) =>
Count e -> m (MBytes 'Pin s)
allocPinnedMBytes Count e
c
    Maybe (p :~: 'Pin)
_ ->
      case Maybe (p :~: 'Inc)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (p :~: 'Inc) of
        Just p :~: 'Inc
Refl -> Count e -> m (MBytes 'Inc s)
forall s (m :: * -> *) e.
(MonadPrim s m, Prim e) =>
Count e -> m (MBytes 'Inc s)
allocUnpinnedMBytes Count e
c
        Maybe (p :~: 'Inc)
Nothing ->
          String -> String -> m (MBytes p s)
forall a. String -> String -> a
errorImpossible
            String
"allocMBytes"
            (String -> m (MBytes p s)) -> String -> m (MBytes p s)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected 'Pinned' kind: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Proxy (Bytes p) -> String -> String
forall t (proxy :: * -> *).
Typeable t =>
proxy t -> String -> String
showsType (Proxy (Bytes p)
forall k (t :: k). Proxy t
Proxy :: Proxy (Bytes p)) String
"'."
{-# INLINE[0] allocMBytes #-}
{-# RULES
"allocUnpinnedMBytes" allocMBytes = allocUnpinnedMBytes
"allocPinnedMBytes" allocMBytes = allocPinnedMBytes
  #-}

allocUnpinnedMBytes :: (MonadPrim s m, Prim e) => Count e -> m (MBytes 'Inc s)
allocUnpinnedMBytes :: Count e -> m (MBytes 'Inc s)
allocUnpinnedMBytes Count e
c =
  (State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s))
-> (State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newByteArray# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c) State# s
s of
      (# State# s
s', MutableByteArray# s
ba# #) -> (# State# s
s', MutableByteArray# s -> MBytes 'Inc s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
ba# #)
{-# INLINE allocUnpinnedMBytes #-}


allocPinnedMBytes :: (MonadPrim s m, Prim e) => Count e -> m (MBytes 'Pin s)
allocPinnedMBytes :: Count e -> m (MBytes 'Pin s)
allocPinnedMBytes Count e
c =
  (State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s))
-> (State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d. Int# -> State# d -> (# State# d, MutableByteArray# d #)
newPinnedByteArray# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c) State# s
s of
      (# State# s
s', MutableByteArray# s
ba# #) -> (# State# s
s', MutableByteArray# s -> MBytes 'Pin s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
ba# #)
{-# INLINE allocPinnedMBytes #-}

allocAlignedMBytes ::
     forall e m s. (MonadPrim s m, Prim e)
  => Count e -- ^ Size in number of bytes
  -> m (MBytes 'Pin s)
allocAlignedMBytes :: Count e -> m (MBytes 'Pin s)
allocAlignedMBytes Count e
c =
  (State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s))
-> (State# s -> (# State# s, MBytes 'Pin s #)) -> m (MBytes 'Pin s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case Int# -> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
Int# -> Int# -> State# d -> (# State# d, MutableByteArray# d #)
newAlignedPinnedByteArray#
           (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c)
           (Proxy# e -> Int#
forall a. Prim a => Proxy# a -> Int#
alignment# (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e))
           State# s
s of
      (# State# s
s', MutableByteArray# s
ba# #) -> (# State# s
s', MutableByteArray# s -> MBytes 'Pin s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
ba# #)
{-# INLINE allocAlignedMBytes #-}


-- @since 0.3.0
allocZeroPinnedMBytes ::
     (MonadPrim s m, Prim e)
  => Count e -- ^ Size in number of bytes
  -> m (MBytes 'Pin s)
allocZeroPinnedMBytes :: Count e -> m (MBytes 'Pin s)
allocZeroPinnedMBytes Count e
n = Count e -> m (MBytes 'Pin s)
forall s (m :: * -> *) e.
(MonadPrim s m, Prim e) =>
Count e -> m (MBytes 'Pin s)
allocPinnedMBytes Count e
n m (MBytes 'Pin s)
-> (MBytes 'Pin s -> m (MBytes 'Pin s)) -> m (MBytes 'Pin s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MBytes 'Pin s
mb -> MBytes 'Pin s
mb MBytes 'Pin s -> m () -> m (MBytes 'Pin s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MBytes 'Pin s -> Off Word8 -> Count Word8 -> Word8 -> m ()
forall s (m :: * -> *) e (p :: Pinned).
(MonadPrim s m, Prim e) =>
MBytes p s -> Off e -> Count e -> e -> m ()
setMBytes MBytes 'Pin s
mb Off Word8
0 (Count e -> Count Word8
forall e. Prim e => Count e -> Count Word8
toByteCount Count e
n) Word8
0
{-# INLINE allocZeroPinnedMBytes #-}

-- @since 0.3.0
allocZeroAlignedMBytes ::
     (MonadPrim s m, Prim e)
  => Count e -- ^ Size in number of bytes
  -> m (MBytes 'Pin s)
allocZeroAlignedMBytes :: Count e -> m (MBytes 'Pin s)
allocZeroAlignedMBytes Count e
n = Count e -> m (MBytes 'Pin s)
forall e (m :: * -> *) s.
(MonadPrim s m, Prim e) =>
Count e -> m (MBytes 'Pin s)
allocAlignedMBytes Count e
n m (MBytes 'Pin s)
-> (MBytes 'Pin s -> m (MBytes 'Pin s)) -> m (MBytes 'Pin s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \MBytes 'Pin s
mb -> MBytes 'Pin s
mb MBytes 'Pin s -> m () -> m (MBytes 'Pin s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MBytes 'Pin s -> Off Word8 -> Count Word8 -> Word8 -> m ()
forall s (m :: * -> *) e (p :: Pinned).
(MonadPrim s m, Prim e) =>
MBytes p s -> Off e -> Count e -> e -> m ()
setMBytes MBytes 'Pin s
mb Off Word8
0 (Count e -> Count Word8
forall e. Prim e => Count e -> Count Word8
toByteCount Count e
n) Word8
0
{-# INLINE allocZeroAlignedMBytes #-}


getByteCountMBytes :: MonadPrim s m => MBytes p s -> m (Count Word8)
getByteCountMBytes :: MBytes p s -> m (Count Word8)
getByteCountMBytes (MBytes MutableByteArray# s
mba#) =
  (State# s -> (# State# s, Count Word8 #)) -> m (Count Word8)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Count Word8 #)) -> m (Count Word8))
-> (State# s -> (# State# s, Count Word8 #)) -> m (Count Word8)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableByteArray# s -> State# s -> (# State# s, Int# #)
forall d. MutableByteArray# d -> State# d -> (# State# d, Int# #)
getSizeofMutableByteArray# MutableByteArray# s
mba# State# s
s of
      (# State# s
s', Int#
n# #) -> (# State# s
s', Int -> Count Word8
forall e. Int -> Count e
Count (Int# -> Int
I# Int#
n#) #)
{-# INLINE getByteCountMBytes #-}

freezeMBytes :: MonadPrim s m => MBytes p s -> m (Bytes p)
freezeMBytes :: MBytes p s -> m (Bytes p)
freezeMBytes (MBytes MutableByteArray# s
mba#) =
  (State# s -> (# State# s, Bytes p #)) -> m (Bytes p)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, Bytes p #)) -> m (Bytes p))
-> (State# s -> (# State# s, Bytes p #)) -> m (Bytes p)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableByteArray# s -> State# s -> (# State# s, ByteArray# #)
forall d.
MutableByteArray# d -> State# d -> (# State# d, ByteArray# #)
unsafeFreezeByteArray# MutableByteArray# s
mba# State# s
s of
      (# State# s
s', ByteArray#
ba# #) -> (# State# s
s', ByteArray# -> Bytes p
forall (p :: Pinned). ByteArray# -> Bytes p
Bytes ByteArray#
ba# #)
{-# INLINE freezeMBytes #-}

thawBytes :: MonadPrim s m => Bytes p -> m (MBytes p s)
thawBytes :: Bytes p -> m (MBytes p s)
thawBytes (Bytes ByteArray#
ba#) =
  (State# s -> (# State# s, MBytes p s #)) -> m (MBytes p s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MBytes p s #)) -> m (MBytes p s))
-> (State# s -> (# State# s, MBytes p s #)) -> m (MBytes p s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)
forall s.
ByteArray# -> State# s -> (# State# s, MutableByteArray# s #)
unsafeThawByteArray# ByteArray#
ba# State# s
s of
      (# State# s
s', MutableByteArray# s
mba# #) -> (# State# s
s', MutableByteArray# s -> MBytes p s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
mba# #)
{-# INLINE thawBytes #-}

copyByteOffBytesToMBytes ::
     (MonadPrim s m, Prim e) => Bytes ps -> Off Word8 -> MBytes pd s -> Off Word8 -> Count e -> m ()
copyByteOffBytesToMBytes :: Bytes ps
-> Off Word8 -> MBytes pd s -> Off Word8 -> Count e -> m ()
copyByteOffBytesToMBytes (Bytes ByteArray#
src#) (Off (I# Int#
srcOff#)) (MBytes MutableByteArray# s
dst#) (Off (I# Int#
dstOff#)) Count e
c =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ ((State# s -> State# s) -> m ()) -> (State# s -> State# s) -> m ()
forall a b. (a -> b) -> a -> b
$ ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
src# Int#
srcOff# MutableByteArray# s
dst# Int#
dstOff# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c)
{-# INLINE copyByteOffBytesToMBytes #-}

moveByteOffMBytesToMBytes ::
     (MonadPrim s m, Prim e) => MBytes ps s-> Off Word8 -> MBytes pd s -> Off Word8 -> Count e -> m ()
moveByteOffMBytesToMBytes :: MBytes ps s
-> Off Word8 -> MBytes pd s -> Off Word8 -> Count e -> m ()
moveByteOffMBytesToMBytes (MBytes MutableByteArray# s
src#) (Off (I# Int#
srcOff#)) (MBytes MutableByteArray# s
dst#) (Off (I# Int#
dstOff#)) Count e
c =
  (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
MutableByteArray# d
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyMutableByteArray# MutableByteArray# s
src# Int#
srcOff# MutableByteArray# s
dst# Int#
dstOff# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c))
{-# INLINE moveByteOffMBytesToMBytes #-}


byteCountBytes :: Bytes p -> Count Word8
byteCountBytes :: Bytes p -> Count Word8
byteCountBytes (Bytes ByteArray#
ba#) = Int -> Count Word8
coerce (Int# -> Int
I# (ByteArray# -> Int#
sizeofByteArray# ByteArray#
ba#))
{-# INLINE byteCountBytes #-}


-- | Shrink mutable bytes to new specified count of elements. The new count must be less
-- than or equal to the current count as reported by `getCountMBytes`.
shrinkMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> Count e -> m ()
shrinkMBytes :: MBytes p s -> Count e -> m ()
shrinkMBytes (MBytes MutableByteArray# s
mb#) Count e
c = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> State# s -> State# s
forall d. MutableByteArray# d -> Int# -> State# d -> State# d
shrinkMutableByteArray# MutableByteArray# s
mb# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c))
{-# INLINE shrinkMBytes #-}


-- | Attempt to resize mutable bytes in place.
--
-- * New bytes might be allocated, with the copy of an old one.
-- * Old references should not be kept around to allow GC to claim it
-- * Old references should not be used to avoid undefined behavior
resizeMBytes ::
     (MonadPrim s m, Prim e) => MBytes p s -> Count e -> m (MBytes 'Inc s)
resizeMBytes :: MBytes p s -> Count e -> m (MBytes 'Inc s)
resizeMBytes (MBytes MutableByteArray# s
mb#) Count e
c =
  (State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s))
-> (State# s -> (# State# s, MBytes 'Inc s #)) -> m (MBytes 'Inc s)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    case MutableByteArray# s
-> Int# -> State# s -> (# State# s, MutableByteArray# s #)
forall d.
MutableByteArray# d
-> Int# -> State# d -> (# State# d, MutableByteArray# d #)
resizeMutableByteArray# MutableByteArray# s
mb# (Count e -> Int#
forall e. Prim e => Count e -> Int#
unCountBytes# Count e
c) State# s
s of
      (# State# s
s', MutableByteArray# s
mb'# #) -> (# State# s
s', MutableByteArray# s -> MBytes 'Inc s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
mb'# #)
{-# INLINE resizeMBytes #-}

reallocMBytes ::
     forall e p m s. (MonadPrim s m, Typeable p,  Prim e)
  => MBytes p s
  -> Count e
  -> m (MBytes p s)
reallocMBytes :: MBytes p s -> Count e -> m (MBytes p s)
reallocMBytes MBytes p s
mb Count e
c = do
  Count Word8
oldByteCount <- MBytes p s -> m (Count Word8)
forall s (m :: * -> *) (p :: Pinned).
MonadPrim s m =>
MBytes p s -> m (Count Word8)
getByteCountMBytes MBytes p s
mb
  let newByteCount :: Count Word8
newByteCount = Count e -> Count Word8
forall e. Prim e => Count e -> Count Word8
toByteCount Count e
c
  if Count Word8
newByteCount Count Word8 -> Count Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Count Word8
oldByteCount
    then MBytes p s
mb MBytes p s -> m () -> m (MBytes p s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Count Word8
newByteCount Count Word8 -> Count Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Count Word8
oldByteCount) (MBytes p s -> Count Word8 -> m ()
forall s (m :: * -> *) e (p :: Pinned).
(MonadPrim s m, Prim e) =>
MBytes p s -> Count e -> m ()
shrinkMBytes MBytes p s
mb Count Word8
newByteCount)
    else case Maybe (p :~: 'Pin)
forall k (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
eqT :: Maybe (p :~: 'Pin) of
           Just p :~: 'Pin
Refl -> do
             Bytes p
b <- MBytes p s -> m (Bytes p)
forall s (m :: * -> *) (p :: Pinned).
MonadPrim s m =>
MBytes p s -> m (Bytes p)
freezeMBytes MBytes p s
mb
             MBytes 'Pin s
mb' <- Count Word8 -> m (MBytes 'Pin s)
forall s (m :: * -> *) e.
(MonadPrim s m, Prim e) =>
Count e -> m (MBytes 'Pin s)
allocPinnedMBytes Count Word8
newByteCount
             MBytes 'Pin s
mb' MBytes 'Pin s -> m () -> m (MBytes 'Pin s)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bytes p
-> Off Word8 -> MBytes 'Pin s -> Off Word8 -> Count Word8 -> m ()
forall s (m :: * -> *) e (ps :: Pinned) (pd :: Pinned).
(MonadPrim s m, Prim e) =>
Bytes ps
-> Off Word8 -> MBytes pd s -> Off Word8 -> Count e -> m ()
copyByteOffBytesToMBytes Bytes p
b Off Word8
0 MBytes 'Pin s
mb' Off Word8
0 Count Word8
oldByteCount
           Maybe (p :~: 'Pin)
Nothing -> MBytes 'Inc s -> MBytes p s
forall (p' :: Pinned) s (p :: Pinned). MBytes p' s -> MBytes p s
castPinnedMBytes (MBytes 'Inc s -> MBytes p s)
-> m (MBytes 'Inc s) -> m (MBytes p s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MBytes p s -> Count Word8 -> m (MBytes 'Inc s)
forall s (m :: * -> *) e (p :: Pinned).
(MonadPrim s m, Prim e) =>
MBytes p s -> Count e -> m (MBytes 'Inc s)
resizeMBytes MBytes p s
mb Count Word8
newByteCount
{-# INLINABLE reallocMBytes #-}

castStateMBytes :: MBytes p s' -> MBytes p s
castStateMBytes :: MBytes p s' -> MBytes p s
castStateMBytes = MBytes p s' -> MBytes p s
forall a b. a -> b
unsafeCoerce

castPinnedBytes :: Bytes p' -> Bytes p
castPinnedBytes :: Bytes p' -> Bytes p
castPinnedBytes (Bytes ByteArray#
b#) = ByteArray# -> Bytes p
forall (p :: Pinned). ByteArray# -> Bytes p
Bytes ByteArray#
b#

castPinnedMBytes :: MBytes p' s -> MBytes p s
castPinnedMBytes :: MBytes p' s -> MBytes p s
castPinnedMBytes (MBytes MutableByteArray# s
b#) = MutableByteArray# s -> MBytes p s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
b#


relaxPinnedBytes :: Bytes 'Pin -> Bytes p
relaxPinnedBytes :: Bytes 'Pin -> Bytes p
relaxPinnedBytes = Bytes 'Pin -> Bytes p
forall (p' :: Pinned) (p :: Pinned). Bytes p' -> Bytes p
castPinnedBytes

relaxPinnedMBytes :: MBytes 'Pin e -> MBytes p e
relaxPinnedMBytes :: MBytes 'Pin e -> MBytes p e
relaxPinnedMBytes = MBytes 'Pin e -> MBytes p e
forall (p' :: Pinned) s (p :: Pinned). MBytes p' s -> MBytes p s
castPinnedMBytes

toInconclusiveBytes :: Bytes p -> Bytes 'Inc
toInconclusiveBytes :: Bytes p -> Bytes 'Inc
toInconclusiveBytes = Bytes p -> Bytes 'Inc
forall (p' :: Pinned) (p :: Pinned). Bytes p' -> Bytes p
castPinnedBytes

toInconclusiveMBytes :: MBytes p e -> MBytes 'Inc e
toInconclusiveMBytes :: MBytes p e -> MBytes 'Inc e
toInconclusiveMBytes = MBytes p e -> MBytes 'Inc e
forall (p' :: Pinned) s (p :: Pinned). MBytes p' s -> MBytes p s
castPinnedMBytes


-- | How many elements of type @a@ fits into bytes completely. In order to get a possible
-- count of leftover bytes use `countRemBytes`
countBytes :: Prim e => Bytes p -> Count e
countBytes :: Bytes p -> Count e
countBytes = Count Word8 -> Count e
forall e. Prim e => Count Word8 -> Count e
fromByteCount (Count Word8 -> Count e)
-> (Bytes p -> Count Word8) -> Bytes p -> Count e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes p -> Count Word8
forall (p :: Pinned). Bytes p -> Count Word8
byteCountBytes
{-# INLINE countBytes #-}

-- | How many elements of type @a@ fits into bytes completely. In order to get any number
-- of leftover bytes use `countRemBytes`
getCountMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> m (Count e)
getCountMBytes :: MBytes p s -> m (Count e)
getCountMBytes MBytes p s
b = Count Word8 -> Count e
forall e. Prim e => Count Word8 -> Count e
fromByteCount (Count Word8 -> Count e) -> m (Count Word8) -> m (Count e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MBytes p s -> m (Count Word8)
forall s (m :: * -> *) (p :: Pinned).
MonadPrim s m =>
MBytes p s -> m (Count Word8)
getByteCountMBytes MBytes p s
b
{-# INLINE getCountMBytes #-}

readOffMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> m e
readOffMBytes :: MBytes p s -> Off e -> m e
readOffMBytes (MBytes MutableByteArray# s
mba#) (Off (I# Int#
i#)) = (State# s -> (# State# s, e #)) -> m e
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readMutableByteArray# MutableByteArray# s
mba# Int#
i#)
{-# INLINE readOffMBytes #-}

readByteOffMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> Off Word8 -> m e
readByteOffMBytes :: MBytes p s -> Off Word8 -> m e
readByteOffMBytes (MBytes MutableByteArray# s
mba#) (Off (I# Int#
i#)) = (State# s -> (# State# s, e #)) -> m e
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim (MutableByteArray# s -> Int# -> State# s -> (# State# s, e #)
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> State# s -> (# State# s, a #)
readByteOffMutableByteArray# MutableByteArray# s
mba# Int#
i#)
{-# INLINE readByteOffMBytes #-}

writeOffMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> e -> m ()
writeOffMBytes :: MBytes p s -> Off e -> e -> m ()
writeOffMBytes (MBytes MutableByteArray# s
mba#) (Off (I# Int#
i#)) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeMutableByteArray# MutableByteArray# s
mba# Int#
i# e
a)
{-# INLINE writeOffMBytes #-}

writeByteOffMBytes :: (MonadPrim s m, Prim e) => MBytes p s -> Off Word8 -> e -> m ()
writeByteOffMBytes :: MBytes p s -> Off Word8 -> e -> m ()
writeByteOffMBytes (MBytes MutableByteArray# s
mba#) (Off (I# Int#
i#)) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> e -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> a -> State# s -> State# s
writeByteOffMutableByteArray# MutableByteArray# s
mba# Int#
i# e
a)
{-# INLINE writeByteOffMBytes #-}

isPinnedBytes :: Bytes p -> Bool
isPinnedBytes :: Bytes p -> Bool
isPinnedBytes (Bytes ByteArray#
b#) = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
b#)
{-# INLINE[0] isPinnedBytes #-}

isPinnedMBytes :: MBytes p d -> Bool
isPinnedMBytes :: MBytes p d -> Bool
isPinnedMBytes (MBytes MutableByteArray# d
mb#) = Int# -> Bool
isTrue# (MutableByteArray# d -> Int#
forall d. MutableByteArray# d -> Int#
isMutableByteArrayPinned# MutableByteArray# d
mb#)
{-# INLINE[0] isPinnedMBytes #-}

{-# RULES
"isPinnedBytes" forall (x :: Bytes 'Pin) . isPinnedBytes x = True
"isPinnedMBytes" forall (x :: MBytes 'Pin s) . isPinnedMBytes x = True
  #-}



setMBytes ::
     (MonadPrim s m, Prim e)
  => MBytes p s -- ^ Chunk of memory to fill
  -> Off e -- ^ Offset in number of elements
  -> Count e -- ^ Number of cells to fill
  -> e -- ^ A value to fill the cells with
  -> m ()
setMBytes :: MBytes p s -> Off e -> Count e -> e -> m ()
setMBytes (MBytes MutableByteArray# s
mba#) (Off (I# Int#
o#)) (Count (I# Int#
n#)) e
a = (State# s -> State# s) -> m ()
forall s (m :: * -> *).
MonadPrim s m =>
(State# s -> State# s) -> m ()
prim_ (MutableByteArray# s -> Int# -> Int# -> e -> State# s -> State# s
forall a s.
Prim a =>
MutableByteArray# s -> Int# -> Int# -> a -> State# s -> State# s
setMutableByteArray# MutableByteArray# s
mba# Int#
o# Int#
n# e
a)
{-# INLINE setMBytes #-}


-- | /O(1)/ - Cast an unboxed array into `Bytes`
--
-- @since 0.3.0
fromUArrayBytes :: UArray e -> Bytes 'Inc
fromUArrayBytes :: UArray e -> Bytes 'Inc
fromUArrayBytes (UArray ByteArray#
ba#) = ByteArray# -> Bytes 'Inc
fromByteArray# ByteArray#
ba#
{-# INLINE fromUArrayBytes #-}

-- | /O(1)/ - Cast `Bytes` into an unboxed array
--
-- @since 0.3.0
toUArrayBytes :: Bytes p -> UArray e
toUArrayBytes :: Bytes p -> UArray e
toUArrayBytes Bytes p
b = ByteArray# -> UArray e
forall e. ByteArray# -> UArray e
UArray (Bytes p -> ByteArray#
forall (p :: Pinned). Bytes p -> ByteArray#
toByteArray# Bytes p
b)
{-# INLINE toUArrayBytes #-}

-- | /O(1)/ - Cast a mutable unboxed array into `MBytes`
--
-- @since 0.3.0
fromUMArrayMBytes :: UMArray e s -> MBytes 'Inc s
fromUMArrayMBytes :: UMArray e s -> MBytes 'Inc s
fromUMArrayMBytes (UMArray MutableByteArray# s
a#) = MutableByteArray# s -> MBytes 'Inc s
forall s. MutableByteArray# s -> MBytes 'Inc s
fromMutableByteArray# MutableByteArray# s
a#
{-# INLINE fromUMArrayMBytes #-}

-- | /O(1)/ - Cast `MBytes` into a mutable unboxed array
--
-- @since 0.3.0
toUMArrayMBytes :: MBytes p s -> UMArray e s
toUMArrayMBytes :: MBytes p s -> UMArray e s
toUMArrayMBytes MBytes p s
mb = MutableByteArray# s -> UMArray e s
forall e s. MutableByteArray# s -> UMArray e s
UMArray (MBytes p s -> MutableByteArray# s
forall (p :: Pinned) s. MBytes p s -> MutableByteArray# s
toMutableByteArray# MBytes p s
mb)
{-# INLINE toUMArrayMBytes #-}



toPtrBytes :: Bytes 'Pin -> Ptr e
toPtrBytes :: Bytes 'Pin -> Ptr e
toPtrBytes (Bytes ByteArray#
ba#) = Addr# -> Ptr e
forall a. Addr# -> Ptr a
Ptr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#)
{-# INLINE toPtrBytes #-}

toPtrMBytes :: MBytes 'Pin s -> Ptr e
toPtrMBytes :: MBytes 'Pin s -> Ptr e
toPtrMBytes (MBytes MutableByteArray# s
mba#) = Addr# -> Ptr e
forall a. Addr# -> Ptr a
Ptr (MutableByteArray# s -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# s
mba#)
{-# INLINE toPtrMBytes #-}

-- | Pointer access to immutable `Bytes` should be for read only purposes, but it is
-- not enforced. Any mutation will break referential transparency
withPtrBytes :: MonadPrim s m => Bytes 'Pin -> (Ptr e -> m b) -> m b
withPtrBytes :: Bytes 'Pin -> (Ptr e -> m b) -> m b
withPtrBytes Bytes 'Pin
b Ptr e -> m b
f = do
  b
res <- Ptr e -> m b
f (Bytes 'Pin -> Ptr e
forall e. Bytes 'Pin -> Ptr e
toPtrBytes Bytes 'Pin
b)
  b
res b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bytes 'Pin -> m ()
forall s (m :: * -> *) a. MonadPrim s m => a -> m ()
touch Bytes 'Pin
b
{-# INLINE withPtrBytes #-}

-- | Same as `withPtrBytes`, but is suitable for actions that don't terminate
withNoHaltPtrBytes :: MonadUnliftPrim s m => Bytes 'Pin -> (Ptr e -> m b) -> m b
withNoHaltPtrBytes :: Bytes 'Pin -> (Ptr e -> m b) -> m b
withNoHaltPtrBytes Bytes 'Pin
b Ptr e -> m b
f = Bytes 'Pin -> m b -> m b
forall s (m :: * -> *) a b. MonadUnliftPrim s m => a -> m b -> m b
keepAlive Bytes 'Pin
b (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ Ptr e -> m b
f (Bytes 'Pin -> Ptr e
forall e. Bytes 'Pin -> Ptr e
toPtrBytes Bytes 'Pin
b)
{-# INLINE withNoHaltPtrBytes #-}

withPtrMBytes :: MonadPrim s m => MBytes 'Pin s -> (Ptr e -> m b) -> m b
withPtrMBytes :: MBytes 'Pin s -> (Ptr e -> m b) -> m b
withPtrMBytes MBytes 'Pin s
mb Ptr e -> m b
f = do
  b
res <- Ptr e -> m b
f (MBytes 'Pin s -> Ptr e
forall s e. MBytes 'Pin s -> Ptr e
toPtrMBytes MBytes 'Pin s
mb)
  b
res b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MBytes 'Pin s -> m ()
forall s (m :: * -> *) a. MonadPrim s m => a -> m ()
touch MBytes 'Pin s
mb
{-# INLINE withPtrMBytes #-}

withNoHaltPtrMBytes :: MonadUnliftPrim s m => MBytes 'Pin s -> (Ptr e -> m b) -> m b
withNoHaltPtrMBytes :: MBytes 'Pin s -> (Ptr e -> m b) -> m b
withNoHaltPtrMBytes MBytes 'Pin s
mb Ptr e -> m b
f = MBytes 'Pin s -> m b -> m b
forall s (m :: * -> *) a b. MonadUnliftPrim s m => a -> m b -> m b
keepAlive MBytes 'Pin s
mb (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ Ptr e -> m b
f (MBytes 'Pin s -> Ptr e
forall s e. MBytes 'Pin s -> Ptr e
toPtrMBytes MBytes 'Pin s
mb)
{-# INLINE withNoHaltPtrMBytes #-}

toForeignPtrBytes :: Bytes 'Pin -> ForeignPtr e
toForeignPtrBytes :: Bytes 'Pin -> ForeignPtr e
toForeignPtrBytes (Bytes ByteArray#
ba#) =
  Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (ByteArray# -> MutableByteArray# RealWorld
unsafeCoerce# ByteArray#
ba#))
{-# INLINE toForeignPtrBytes #-}


toForeignPtrMBytes :: MBytes 'Pin s -> ForeignPtr e
toForeignPtrMBytes :: MBytes 'Pin s -> ForeignPtr e
toForeignPtrMBytes (MBytes MutableByteArray# s
mba#) =
  Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (MutableByteArray# s -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# s
mba#) (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (MutableByteArray# s -> MutableByteArray# RealWorld
unsafeCoerce# MutableByteArray# s
mba#))
{-# INLINE toForeignPtrMBytes #-}


-- | This function will only cast a pointer that was allocated on Haskell heap and it is
-- cerain that the ForeignPtr has no finalizers associated with it.
castForeignPtrToBytes :: ForeignPtr e -> Either String (Bytes 'Pin)
castForeignPtrToBytes :: ForeignPtr e -> Either String (Bytes 'Pin)
castForeignPtrToBytes ForeignPtr e
fp =
  IO (Either String (Bytes 'Pin)) -> Either String (Bytes 'Pin)
forall a. IO a -> a
unsafePerformIO (IO (Either String (Bytes 'Pin)) -> Either String (Bytes 'Pin))
-> IO (Either String (Bytes 'Pin)) -> Either String (Bytes 'Pin)
forall a b. (a -> b) -> a -> b
$
  ForeignPtr e
-> (Addr#
    -> MutableByteArray# RealWorld
    -> IO Bool
    -> IO (Either String (Bytes 'Pin)))
-> (Addr# -> IO (Either String (Bytes 'Pin)))
-> IO (Either String (Bytes 'Pin))
forall (m :: * -> *) e a.
MonadPrim RealWorld m =>
ForeignPtr e
-> (Addr# -> MutableByteArray# RealWorld -> m Bool -> m a)
-> (Addr# -> m a)
-> m a
onForeignPtrContents ForeignPtr e
fp Addr#
-> MutableByteArray# RealWorld
-> IO Bool
-> IO (Either String (Bytes 'Pin))
forall (m :: * -> *) s (p :: Pinned).
MonadPrim s m =>
Addr#
-> MutableByteArray# s -> m Bool -> m (Either String (Bytes p))
checkConvert ((Addr# -> IO (Either String (Bytes 'Pin)))
 -> IO (Either String (Bytes 'Pin)))
-> (Addr# -> IO (Either String (Bytes 'Pin)))
-> IO (Either String (Bytes 'Pin))
forall a b. (a -> b) -> a -> b
$ \Addr#
_ ->
    Either String (Bytes 'Pin) -> IO (Either String (Bytes 'Pin))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String (Bytes 'Pin)
forall a b. a -> Either a b
Left String
"Cannot convert a C allocated pointer")
  where
    checkConvert :: Addr#
-> MutableByteArray# s -> m Bool -> m (Either String (Bytes p))
checkConvert Addr#
addr# MutableByteArray# s
mba# m Bool
checkFinalizers = do
      ba :: Bytes p
ba@(Bytes ByteArray#
ba#) <- MBytes p s -> m (Bytes p)
forall s (m :: * -> *) (p :: Pinned).
MonadPrim s m =>
MBytes p s -> m (Bytes p)
freezeMBytes (MutableByteArray# s -> MBytes p s
forall (p :: Pinned) s. MutableByteArray# s -> MBytes p s
MBytes MutableByteArray# s
mba#)
      if Int# -> Bool
isTrue# (ByteArray# -> Addr#
byteArrayContents# ByteArray#
ba# Addr# -> Addr# -> Int#
`eqAddr#` Addr#
addr#)
        then do
          Bool
hasFinilizers <- m Bool
checkFinalizers
          Either String (Bytes p) -> m (Either String (Bytes p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Bytes p) -> m (Either String (Bytes p)))
-> Either String (Bytes p) -> m (Either String (Bytes p))
forall a b. (a -> b) -> a -> b
$
            if Bool
hasFinilizers
              then String -> Either String (Bytes p)
forall a b. a -> Either a b
Left String
"MallocPtr has associated finalizers"
              else Bytes p -> Either String (Bytes p)
forall a b. b -> Either a b
Right Bytes p
ba
        else Either String (Bytes p) -> m (Either String (Bytes p))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Bytes p) -> m (Either String (Bytes p)))
-> Either String (Bytes p) -> m (Either String (Bytes p))
forall a b. (a -> b) -> a -> b
$
             String -> Either String (Bytes p)
forall a b. a -> Either a b
Left
               String
"ForeignPtr does not point to the beginning of the associated MutableByteArray#"
{-# INLINE castForeignPtrToBytes #-}


onForeignPtrContents ::
     MonadPrim RW m
  => ForeignPtr e
  -> (Addr# -> MutableByteArray# RW -> m Bool -> m a)
  -> (Addr# -> m a)
  -> m a
onForeignPtrContents :: ForeignPtr e
-> (Addr# -> MutableByteArray# RealWorld -> m Bool -> m a)
-> (Addr# -> m a)
-> m a
onForeignPtrContents (ForeignPtr Addr#
addr# ForeignPtrContents
contents) Addr# -> MutableByteArray# RealWorld -> m Bool -> m a
onHaskellPtr Addr# -> m a
onCPtr =
  case ForeignPtrContents
contents of
    PlainPtr MutableByteArray# RealWorld
mbaRW# -> Addr# -> MutableByteArray# RealWorld -> m Bool -> m a
onHaskellPtr Addr#
addr# MutableByteArray# RealWorld
mbaRW# (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
#if MIN_VERSION_base(4,14,0)
    MallocPtr MutableByteArray# RealWorld
mbaRW# IORef Finalizers
fref -> Addr# -> MutableByteArray# RealWorld -> m Bool -> m a
onHaskellPtr Addr#
addr# MutableByteArray# RealWorld
mbaRW# (m Bool -> m a) -> m Bool -> m a
forall a b. (a -> b) -> a -> b
$ do
      Finalizers
finilizers <- IO Finalizers -> m Finalizers
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO Finalizers -> m Finalizers) -> IO Finalizers -> m Finalizers
forall a b. (a -> b) -> a -> b
$ IORef Finalizers -> IO Finalizers
forall a. IORef a -> IO a
readIORef IORef Finalizers
fref
      Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! case Finalizers
finilizers of
        Finalizers
NoFinalizers         -> Bool
False
        HaskellFinalizers [IO ()]
fs -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$! [IO ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IO ()]
fs
        CFinalizers Weak# ()
_        -> Bool
True -- impossible case, but nevertheless
#else
    MallocPtr mbaRW# _ -> onHaskellPtr addr# mbaRW# (pure True)
#endif
    PlainForeignPtr IORef Finalizers
_ -> Addr# -> m a
onCPtr Addr#
addr#
{-# INLINE onForeignPtrContents #-}


-- | Check if two byte arrays refer to pinned memory and compare their pointers.
isSameBytes :: Bytes p1 -> Bytes p2 -> Bool
isSameBytes :: Bytes p1 -> Bytes p2 -> Bool
isSameBytes (Bytes ByteArray#
b1#) (Bytes ByteArray#
b2#) = Int# -> Bool
isTrue# (ByteArray# -> ByteArray# -> Int#
isSameByteArray# ByteArray#
b1# ByteArray#
b2#)
{-# INLINE[0] isSameBytes #-}
{-# RULES
"isSamePinnedBytes" isSameBytes = isSamePinnedBytes
  #-}

-- | Perform pointer equality on pinned `Bytes`.
isSamePinnedBytes :: Bytes 'Pin -> Bytes 'Pin -> Bool
isSamePinnedBytes :: Bytes 'Pin -> Bytes 'Pin -> Bool
isSamePinnedBytes Bytes 'Pin
pb1 Bytes 'Pin
pb2 = Bytes 'Pin -> Ptr Any
forall e. Bytes 'Pin -> Ptr e
toPtrBytes Bytes 'Pin
pb1 Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes 'Pin -> Ptr Any
forall e. Bytes 'Pin -> Ptr e
toPtrBytes Bytes 'Pin
pb2
{-# INLINE isSamePinnedBytes #-}


-- | Check if two mutable bytes pointers refer to the same memory
--
-- @since 0.1.0
isSameMBytes :: MBytes p1 s -> MBytes p2 s -> Bool
isSameMBytes :: MBytes p1 s -> MBytes p2 s -> Bool
isSameMBytes (MBytes MutableByteArray# s
mb1#) (MBytes MutableByteArray# s
mb2#) = Int# -> Bool
isTrue# (MutableByteArray# s -> MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> MutableByteArray# d -> Int#
sameMutableByteArray# MutableByteArray# s
mb1# MutableByteArray# s
mb2#)
{-# INLINE isSameMBytes #-}


byteStringConvertError :: String -> a
byteStringConvertError :: String -> a
byteStringConvertError String
msg = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Cannot convert 'ByteString'. " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
{-# NOINLINE byteStringConvertError #-}