{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Prim.Memory.Bytes
(
Bytes
, toByteArray#
, fromByteArray#
, cloneBytes
, emptyBytes
, eqBytes
, singletonBytes
, isEmptyBytes
, createBytes
, createBytes_
, createBytesST
, createBytesST_
, Pinned(..)
, isPinnedBytes
, isPinnedMBytes
, toPinnedBytes
, toPinnedMBytes
, relaxPinnedBytes
, relaxPinnedMBytes
, ensurePinnedBytes
, ensurePinnedMBytes
, MBytes
, toMutableByteArray#
, fromMutableByteArray#
, isSameBytes
, isSamePinnedBytes
, isSameMBytes
, indexOffBytes
, indexByteOffBytes
, byteCountBytes
, countBytes
, countRemBytes
, compareBytes
, compareByteOffBytes
, thawBytes
, freezeMBytes
, allocMBytes
, singletonMBytes
, allocPinnedMBytes
, allocAlignedMBytes
, allocUnpinnedMBytes
, callocMBytes
, callocAlignedMBytes
, shrinkMBytes
, resizeMBytes
, reallocMBytes
, coerceStateMBytes
, cloneMBytes
, withCloneMBytes
, withCloneMBytes_
, withCloneMBytesST
, withCloneMBytesST_
, loadListMBytes
, loadListMBytes_
, copyBytesToMBytes
, moveMBytesToMBytes
, getByteCountMBytes
, getCountMBytes
, getCountRemOfMBytes
, readOffMBytes
, readByteOffMBytes
, writeOffMBytes
, writeByteOffMBytes
, setMBytes
, zeroMBytes
, withPtrBytes
, withNoHaltPtrBytes
, withPtrMBytes
, withNoHaltPtrMBytes
, toPtrBytes
, toPtrMBytes
, toForeignPtrBytes
, toForeignPtrMBytes
, fromListBytes
, fromListBytesN
, fromListBytesN_
, appendBytes
, concatBytes
, toListBytes
, toListSlackBytes
, casMBytes
, casBoolMBytes
, casBoolFetchMBytes
, atomicReadMBytes
, atomicWriteMBytes
, atomicModifyMBytes
, atomicModifyMBytes_
, atomicBoolModifyFetchOldMBytes
, atomicModifyFetchOldMBytes
, atomicModifyFetchNewMBytes
, atomicAddFetchOldMBytes
, atomicAddFetchNewMBytes
, atomicSubFetchOldMBytes
, atomicSubFetchNewMBytes
, atomicAndFetchOldMBytes
, atomicAndFetchNewMBytes
, atomicNandFetchOldMBytes
, atomicNandFetchNewMBytes
, atomicOrFetchOldMBytes
, atomicOrFetchNewMBytes
, atomicXorFetchOldMBytes
, atomicXorFetchNewMBytes
, atomicNotFetchOldMBytes
, atomicNotFetchNewMBytes
, prefetchBytes0
, prefetchMBytes0
, prefetchBytes1
, prefetchMBytes1
, prefetchBytes2
, prefetchMBytes2
, prefetchBytes3
, prefetchMBytes3
, module Data.Prim
) where
import Control.Monad.ST
import Control.Prim.Monad
import Data.Maybe (fromMaybe)
import Data.Prim
import Data.Prim.Atomic
import Data.Prim.Memory.Internal
import Data.Prim.Memory.Bytes.Internal
import Foreign.Prim
toByteArray# :: Bytes p -> ByteArray#
toByteArray# (Bytes b#) = b#
fromByteArray# :: ByteArray# -> Bytes 'Inc
fromByteArray# = Bytes
toMutableByteArray# :: MBytes p s -> MutableByteArray# s
toMutableByteArray# (MBytes mb#) = mb#
fromMutableByteArray# :: MutableByteArray# s -> MBytes 'Inc s
fromMutableByteArray# = MBytes
isSameMBytes :: MBytes p1 s -> MBytes p2 s -> Bool
isSameMBytes (MBytes mb1#) (MBytes mb2#) = isTrue# (sameMutableByteArray# mb1# mb2#)
{-# INLINE isSameMBytes #-}
eqBytes :: Bytes p1 -> Bytes p2 -> Bool
eqBytes b1 b2 = isSameBytes b1 b2 || eqMem b1 b2
{-# INLINE eqBytes #-}
compareBytes :: Prim e => Bytes p1 -> Off e -> Bytes p2 -> Off e -> Count e -> Ordering
compareBytes (Bytes b1#) off1 (Bytes b2#) off2 c =
toOrdering# (compareByteArrays# b1# (fromOff# off1) b2# (fromOff# off2) (fromCount# c))
{-# INLINE compareBytes #-}
coerceStateMBytes :: MBytes p s' -> MBytes p s
coerceStateMBytes = unsafeCoerce#
emptyBytes :: Bytes p
emptyBytes = castPinnedBytes $ runST $ allocPinnedMBytes (0 :: Count Word8) >>= freezeMBytes
{-# INLINE emptyBytes #-}
isEmptyBytes :: Bytes p -> Bool
isEmptyBytes b = byteCountBytes b == 0
{-# INLINE isEmptyBytes #-}
singletonBytes :: forall e p. (Prim e, Typeable p) => e -> Bytes p
singletonBytes a = runST $ singletonMBytes a >>= freezeMBytes
{-# INLINE singletonBytes #-}
singletonMBytes :: forall e p m s. (Prim e, Typeable p, MonadPrim s m) => e -> m (MBytes p s)
singletonMBytes a = do
mb <- allocMBytes (1 :: Count e)
mb <$ writeOffMBytes mb 0 a
{-# INLINE singletonMBytes #-}
cloneBytes :: Typeable p => Bytes p -> Bytes p
cloneBytes b = runST $ thawBytes b >>= cloneMBytes >>= freezeMBytes
{-# INLINE cloneBytes #-}
cloneMBytes :: (MonadPrim s m, Typeable p) => MBytes p s -> m (MBytes p s)
cloneMBytes mb = do
n <- getCountMBytes mb
mb' <- allocMBytes (n :: Count Word8)
mb' <$ moveMBytesToMBytes mb 0 mb' 0 n
{-# INLINE cloneMBytes #-}
copyBytesToMBytes ::
(MonadPrim s m, Prim e) => Bytes ps -> Off e -> MBytes pd s -> Off e -> Count e -> m ()
copyBytesToMBytes (Bytes src#) srcOff (MBytes dst#) dstOff c =
prim_ $
copyByteArray# src# (fromOff# srcOff) dst# (fromOff# dstOff) (fromCount# c)
{-# INLINE copyBytesToMBytes #-}
moveMBytesToMBytes ::
(MonadPrim s m, Prim e) => MBytes ps s-> Off e -> MBytes pd s -> Off e -> Count e -> m ()
moveMBytesToMBytes (MBytes src#) srcOff (MBytes dst#) dstOff c =
prim_ (copyMutableByteArray# src# (fromOff# srcOff) dst# (fromOff# dstOff) (fromCount# c))
{-# INLINE moveMBytesToMBytes #-}
createBytes ::
forall p e b s m. (Prim e, Typeable p, MonadPrim s m)
=> Count e
-> (MBytes p s -> m b)
-> m (b, Bytes p)
createBytes n f = do
mb <- allocMBytes n
!res <- f mb
(,) res <$> freezeMBytes mb
{-# INLINE createBytes #-}
createBytes_ ::
forall p e b s m. (Prim e, Typeable p, MonadPrim s m)
=> Count e
-> (MBytes p s -> m b)
-> m (Bytes p)
createBytes_ n f = allocMBytes n >>= \mb -> f mb >> freezeMBytes mb
{-# INLINE createBytes_ #-}
createBytesST ::
forall p e b. (Prim e, Typeable p)
=> Count e
-> (forall s . MBytes p s -> ST s b)
-> (b, Bytes p)
createBytesST n f = runST $ createBytes n f
{-# INLINE createBytesST #-}
createBytesST_ ::
forall p e b. (Prim e, Typeable p)
=> Count e
-> (forall s. MBytes p s -> ST s b)
-> Bytes p
createBytesST_ n f = runST $ createBytes_ n f
{-# INLINE createBytesST_ #-}
callocMBytes :: (MonadPrim s m, Prim e, Typeable p) => Count e -> m (MBytes p s)
callocMBytes n = allocMBytes n >>= \mb -> mb <$ setMBytes mb 0 (toByteCount n) 0
{-# INLINE callocMBytes #-}
zeroMBytes :: MonadPrim s m => MBytes p s -> m ()
zeroMBytes mba@(MBytes mba#) = do
Count (I# n#) <- getByteCountMBytes mba
prim_ (setByteArray# mba# 0# n# 0#)
{-# INLINE zeroMBytes #-}
withCloneMBytes ::
(MonadPrim s m, Typeable p)
=> Bytes p
-> (MBytes p s -> m a)
-> m (a, Bytes p)
withCloneMBytes b f = do
mb <- cloneMBytes =<< thawBytes b
!res <- f mb
b' <- freezeMBytes mb
pure (res, b')
{-# INLINE withCloneMBytes #-}
withCloneMBytes_ ::
(MonadPrim s m, Typeable p)
=> Bytes p
-> (MBytes p s -> m a)
-> m (Bytes p)
withCloneMBytes_ b f = thawBytes b >>= cloneMBytes >>= \mb -> f mb >> freezeMBytes mb
{-# INLINE withCloneMBytes_ #-}
withCloneMBytesST ::
Typeable p => Bytes p -> (forall s. MBytes p s -> ST s a) -> (a, Bytes p)
withCloneMBytesST b f = runST $ withCloneMBytes b f
{-# INLINE withCloneMBytesST #-}
withCloneMBytesST_ ::
Typeable p => Bytes p -> (forall s. MBytes p s -> ST s a) -> Bytes p
withCloneMBytesST_ b f = runST $ withCloneMBytes_ b f
{-# INLINE withCloneMBytesST_ #-}
countRemBytes :: forall e p. Prim e => Bytes p -> (Count e, Count Word8)
countRemBytes = fromByteCountRem . byteCountBytes
{-# INLINE countRemBytes #-}
getCountRemOfMBytes ::
forall e p s m. (MonadPrim s m, Prim e)
=> MBytes p s
-> m (Count e, Count Word8)
getCountRemOfMBytes b = fromByteCountRem <$> getByteCountMBytes b
{-# INLINE getCountRemOfMBytes #-}
toListBytes :: Prim e => Bytes p -> [e]
toListBytes = toListMem
{-# INLINE toListBytes #-}
toListSlackBytes :: Prim e => Bytes p -> ([e], [Word8])
toListSlackBytes = toListSlackMem
{-# INLINE toListSlackBytes #-}
loadListMBytes :: (MonadPrim s m, Prim e) => [e] -> MBytes p s -> m Ordering
loadListMBytes ys mb = do
(c, slack) <- getCountRemOfMBytes mb
loadListMemN (countAsProxy ys c) slack ys mb
{-# INLINE loadListMBytes #-}
loadListMBytes_ :: (MonadPrim s m, Prim e) => [e] -> MBytes p s -> m ()
loadListMBytes_ ys mb = do
c <- getCountMBytes mb
loadListMemN_ (countAsProxy ys c) ys mb
{-# INLINE loadListMBytes_ #-}
fromListBytesN_ :: (Prim e, Typeable p) => Count e -> [e] -> Bytes p
fromListBytesN_ = fromListMemN_
{-# INLINE fromListBytesN_ #-}
fromListBytesN ::
(Prim e, Typeable p)
=> Count e
-> [e]
-> (Ordering, Bytes p)
fromListBytesN = fromListMemN
{-# INLINE fromListBytesN #-}
fromListBytes ::
forall e p. (Prim e, Typeable p)
=> [e]
-> Bytes p
fromListBytes = fromListMem
{-# INLINE fromListBytes #-}
appendBytes ::
Typeable p
=> Bytes p1
-> Bytes p2
-> Bytes p
appendBytes = appendMem
{-# INLINE appendBytes #-}
concatBytes :: Typeable p => [Bytes p'] -> Bytes p
concatBytes = concatMem
{-# INLINE concatBytes #-}
relaxPinnedBytes :: Bytes p -> Bytes 'Inc
relaxPinnedBytes = castPinnedBytes
relaxPinnedMBytes :: MBytes p e -> MBytes 'Inc e
relaxPinnedMBytes = castPinnedMBytes
ensurePinnedBytes :: Bytes p -> Bytes 'Pin
ensurePinnedBytes b = fromMaybe (convertMem b) (toPinnedBytes b)
{-# INLINE ensurePinnedBytes #-}
ensurePinnedMBytes :: MonadPrim s m => MBytes p s -> m (MBytes 'Pin s)
ensurePinnedMBytes mb =
case toPinnedMBytes mb of
Just pmb -> pure pmb
Nothing -> do
n8 :: Count Word8 <- getCountMBytes mb
pmb <- allocPinnedMBytes n8
pmb <$ moveMBytesToMBytes mb 0 pmb 0 n8
{-# INLINE ensurePinnedMBytes #-}
toPinnedBytes :: Bytes p -> Maybe (Bytes 'Pin)
toPinnedBytes (Bytes b#)
| isTrue# (isByteArrayPinned# b#) = Just (Bytes b#)
| otherwise = Nothing
{-# INLINE toPinnedBytes #-}
toPinnedMBytes :: MBytes p s -> Maybe (MBytes 'Pin s)
toPinnedMBytes (MBytes mb#)
| isTrue# (isMutableByteArrayPinned# mb#) = Just (MBytes mb#)
| otherwise = Nothing
{-# INLINE toPinnedMBytes #-}
casMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> e
-> e
-> m e
casMBytes (MBytes mba#) (Off (I# i#)) expected new = prim $ casMutableByteArray# mba# i# expected new
{-# INLINE casMBytes #-}
casBoolMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> e
-> e
-> m Bool
casBoolMBytes (MBytes mba#) (Off (I# i#)) expected new =
prim $ casBoolMutableByteArray# mba# i# expected new
{-# INLINE casBoolMBytes #-}
casBoolFetchMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> e
-> e
-> m (Bool, e)
casBoolFetchMBytes mb off expected new = do
isCasSucc <- casBoolMBytes mb off expected new
actual <-
if isCasSucc
then pure new
else readOffMBytes mb off
pure (isCasSucc, actual)
{-# INLINE casBoolFetchMBytes #-}
atomicReadMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> m e
atomicReadMBytes (MBytes mba#) (Off (I# i#)) =
prim $ atomicReadMutableByteArray# mba# i#
{-# INLINE atomicReadMBytes #-}
atomicWriteMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> e
-> m ()
atomicWriteMBytes (MBytes mba#) (Off (I# i#)) e =
prim_ $ atomicWriteMutableByteArray# mba# i# e
{-# INLINE atomicWriteMBytes #-}
atomicModifyMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> (e -> (e, b))
-> m b
atomicModifyMBytes (MBytes mba#) (Off (I# i#)) f =
prim $
atomicModifyMutableByteArray# mba# i# $ \a ->
case f a of
(a', b) -> (# a', b #)
{-# INLINE atomicModifyMBytes #-}
atomicModifyMBytes_ ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> (e -> e)
-> m ()
atomicModifyMBytes_ (MBytes mba#) (Off (I# i#)) f =
prim_ $ atomicModifyMutableByteArray_# mba# i# f
{-# INLINE atomicModifyMBytes_ #-}
atomicModifyFetchOldMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> (e -> e)
-> m e
atomicModifyFetchOldMBytes (MBytes mba#) (Off (I# i#)) f =
prim $ atomicModifyFetchOldMutableByteArray# mba# i# f
{-# INLINE atomicModifyFetchOldMBytes #-}
atomicBoolModifyFetchOldMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> (e -> e)
-> m e
atomicBoolModifyFetchOldMBytes (MBytes mba#) (Off (I# i#)) f =
prim $ atomicBoolModifyFetchOldMutableByteArray# mba# i# f
{-# INLINE atomicBoolModifyFetchOldMBytes #-}
atomicModifyFetchNewMBytes ::
(MonadPrim s m, Atomic e)
=> MBytes p s
-> Off e
-> (e -> e)
-> m e
atomicModifyFetchNewMBytes (MBytes mba#) (Off (I# i#)) f =
prim $ atomicModifyFetchNewMutableByteArray# mba# i# f
{-# INLINE atomicModifyFetchNewMBytes #-}
atomicAddFetchOldMBytes ::
(MonadPrim s m, AtomicCount e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicAddFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicAddFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicAddFetchOldMBytes #-}
atomicAddFetchNewMBytes ::
(MonadPrim s m, AtomicCount e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicAddFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicAddFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicAddFetchNewMBytes #-}
atomicSubFetchOldMBytes ::
(MonadPrim s m, AtomicCount e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicSubFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicSubFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicSubFetchOldMBytes #-}
atomicSubFetchNewMBytes ::
(MonadPrim s m, AtomicCount e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicSubFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicSubFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicSubFetchNewMBytes #-}
atomicAndFetchOldMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicAndFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicAndFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicAndFetchOldMBytes #-}
atomicAndFetchNewMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicAndFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicAndFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicAndFetchNewMBytes #-}
atomicNandFetchOldMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicNandFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicNandFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicNandFetchOldMBytes #-}
atomicNandFetchNewMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicNandFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicNandFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicNandFetchNewMBytes #-}
atomicOrFetchOldMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicOrFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicOrFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicOrFetchOldMBytes #-}
atomicOrFetchNewMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicOrFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicOrFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicOrFetchNewMBytes #-}
atomicXorFetchOldMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicXorFetchOldMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicXorFetchOldMutableByteArray# mba# i# a)
{-# INLINE atomicXorFetchOldMBytes #-}
atomicXorFetchNewMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> e
-> m e
atomicXorFetchNewMBytes (MBytes mba#) (Off (I# i#)) a =
prim (atomicXorFetchNewMutableByteArray# mba# i# a)
{-# INLINE atomicXorFetchNewMBytes #-}
atomicNotFetchOldMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> m e
atomicNotFetchOldMBytes (MBytes mba#) (Off (I# i#)) =
prim (atomicNotFetchOldMutableByteArray# mba# i#)
{-# INLINE atomicNotFetchOldMBytes #-}
atomicNotFetchNewMBytes ::
(MonadPrim s m, AtomicBits e)
=> MBytes p s
-> Off e
-> m e
atomicNotFetchNewMBytes (MBytes mba#) (Off (I# i#)) =
prim (atomicNotFetchNewMutableByteArray# mba# i#)
{-# INLINE atomicNotFetchNewMBytes #-}
prefetchBytes0 :: (MonadPrim s m, Prim e) => Bytes p -> Off e -> m ()
prefetchBytes0 (Bytes b#) off = prim_ (prefetchByteArray0# b# (fromOff# off))
{-# INLINE prefetchBytes0 #-}
prefetchMBytes0 :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> m ()
prefetchMBytes0 (MBytes mb#) off = prim_ (prefetchMutableByteArray0# mb# (fromOff# off))
{-# INLINE prefetchMBytes0 #-}
prefetchBytes1 :: (MonadPrim s m, Prim e) => Bytes p -> Off e -> m ()
prefetchBytes1 (Bytes b#) off = prim_ (prefetchByteArray1# b# (fromOff# off))
{-# INLINE prefetchBytes1 #-}
prefetchMBytes1 :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> m ()
prefetchMBytes1 (MBytes mb#) off = prim_ (prefetchMutableByteArray1# mb# (fromOff# off))
{-# INLINE prefetchMBytes1 #-}
prefetchBytes2 :: (MonadPrim s m, Prim e) => Bytes p -> Off e -> m ()
prefetchBytes2 (Bytes b#) off = prim_ (prefetchByteArray2# b# (fromOff# off))
{-# INLINE prefetchBytes2 #-}
prefetchMBytes2 :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> m ()
prefetchMBytes2 (MBytes mb#) off = prim_ (prefetchMutableByteArray2# mb# (fromOff# off))
{-# INLINE prefetchMBytes2 #-}
prefetchBytes3 :: (MonadPrim s m, Prim e) => Bytes p -> Off e -> m ()
prefetchBytes3 (Bytes b#) off = prim_ (prefetchByteArray3# b# (fromOff# off))
{-# INLINE prefetchBytes3 #-}
prefetchMBytes3 :: (MonadPrim s m, Prim e) => MBytes p s -> Off e -> m ()
prefetchMBytes3 (MBytes mb#) off = prim_ (prefetchMutableByteArray3# mb# (fromOff# off))
{-# INLINE prefetchMBytes3 #-}