{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module      : Data.Primitive.PVar.Unsafe
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Primitive.PVar.Unsafe
  ( PVar(..)
  -- * Creation
  , rawPVar
  , rawPinnedPVar
  , rawAlignedPinnedPVar
  , rawStorablePVar
  , rawAlignedStorablePVar
  -- * Access
  , peekPrim
  , pokePrim
  -- * Conversion
  , toPtrPVar
  , unsafeToPtrPVar
  , unsafeToForeignPtrPVar
  -- * Reset
  , zeroPVar
  -- * Unpacked opartions
  , sizeOfPVar#
  , alignmentPVar#
  , setPVar#
  -- * ByteArray
  -- ** Atomic operations
  , atomicModifyIntArray#
  , atomicModifyIntArray_#
  -- ** Memory copying
  , copyFromByteArrayPVar
  , copyFromMutableByteArrayPVar
  , copyPVarToMutableByteArray
  -- ** Check if memory is pinned
  , isByteArrayPinned
  , isMutableByteArrayPinned
  -- *** Primitive versions
  , isByteArrayPinned#
  , isMutableByteArrayPinned#
  -- * Helpers
  , showsType
  , unI#
  )
  where

import Control.Monad.Primitive (MonadPrim, primitive_)
import Data.Primitive.PVar.Internal
import Data.Primitive.ByteArray (ByteArray(..), MutableByteArray(..))
import Data.Primitive.Types
import GHC.Exts as Exts
import GHC.ForeignPtr
import Data.Typeable


-- | Convert `PVar` into a `ForeignPtr`, very unsafe if not backed by pinned memory.
--
-- @since 0.1.0
unsafeToForeignPtrPVar :: PVar a s -> ForeignPtr a
unsafeToForeignPtrPVar :: forall a s. PVar a s -> ForeignPtr a
unsafeToForeignPtrPVar pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mba#) =
  case PVar a s -> Ptr a
forall a s. PVar a s -> Ptr a
unsafeToPtrPVar PVar a s
pvar of
    Ptr Addr#
addr# -> Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (MutableByteArray# s -> MutableByteArray# RealWorld
forall a b. a -> b
unsafeCoerce# MutableByteArray# s
mba#))
{-# INLINE unsafeToForeignPtrPVar #-}



-- | Extract the address to the mutable variable, but only if it is backed by pinned
-- memory. It is unsafe because even for pinned memory memory can be deallocated if
-- associated `PVar` goes out of scope. Use `Data.Primitive.PVar.withPtrPVar` or
-- `Data.Primitive.PVar.toForeignPtr` instead.
--
-- @since 0.1.0
toPtrPVar :: PVar a s -> Maybe (Ptr a)
toPtrPVar :: forall a s. PVar a s -> Maybe (Ptr a)
toPtrPVar PVar a s
pvar
  | PVar a s -> Bool
forall a s. PVar a s -> Bool
isPinnedPVar PVar a s
pvar = Ptr a -> Maybe (Ptr a)
forall a. a -> Maybe a
Just (Ptr a -> Maybe (Ptr a)) -> Ptr a -> Maybe (Ptr a)
forall a b. (a -> b) -> a -> b
$ PVar a s -> Ptr a
forall a s. PVar a s -> Ptr a
unsafeToPtrPVar PVar a s
pvar
  | Bool
otherwise = Maybe (Ptr a)
forall a. Maybe a
Nothing
{-# INLINE toPtrPVar #-}

-- | Fill the contents of mutable variable with byte @c@
--
-- @since 0.1.0
setPVar# ::
     (MonadPrim s m, Prim a)
  => PVar a s
  -> Int# -- ^ Byte value to fill the `PVar` with
  -> m ()
setPVar# :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> Int# -> m ()
setPVar# pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mba#) Int#
a# =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (MutableByteArray# s -> Int# -> Int# -> Int# -> State# s -> State# s
forall d.
MutableByteArray# d -> Int# -> Int# -> Int# -> State# d -> State# d
Exts.setByteArray# MutableByteArray# s
mba# Int#
0# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar) Int#
a#)
{-# INLINE setPVar# #-}

-- | Reset contents of a mutable variable to zero.
--
-- @since 0.1.0
zeroPVar :: (MonadPrim s m, Prim a) => PVar a s -> m ()
zeroPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> m ()
zeroPVar PVar a s
pvar = PVar a s -> Int# -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> Int# -> m ()
setPVar# PVar a s
pvar Int#
0#
{-# INLINE zeroPVar #-}

-- | Copy the value from a mutable variable into a mutable array at the specified index. Index
-- of array is not checked and can result in an unchecked exception when incorrect
--
-- @since 0.1.0
copyPVarToMutableByteArray ::
     (MonadPrim s m, Prim a)
  => PVar a s
  -> MutableByteArray s
  -> Int -- ^ Offset in number of elements into the array
  -> m ()
copyPVarToMutableByteArray :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> MutableByteArray s -> Int -> m ()
copyPVarToMutableByteArray PVar a s
pvar MutableByteArray s
mba Int
offset =
  PVar a s -> MutableByteArray s -> Int -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> MutableByteArray s -> Int -> m ()
copyBytesPVarToMutableByteArray PVar a s
pvar MutableByteArray s
mba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* PVar a s -> Int
forall a s. Prim a => PVar a s -> Int
sizeOfPVar PVar a s
pvar)
{-# INLINE copyPVarToMutableByteArray #-}


-- | Copy the value from a frozen `ByteArray` into a mutable variable at specified
-- index. Index of array is not checked and can result in an unchecked exception when
-- incorrect
--
-- @since 0.1.0
copyFromByteArrayPVar ::
     (MonadPrim s m, Prim a)
  => ByteArray -- ^ Source array
  -> Int -- ^ Offset in number of elements into the array
  -> PVar a s
  -> m ()
copyFromByteArrayPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
ByteArray -> Int -> PVar a s -> m ()
copyFromByteArrayPVar ByteArray
ba Int
offset PVar a s
pvar =
  ByteArray -> Int -> PVar a s -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
ByteArray -> Int -> PVar a s -> m ()
copyBytesFromByteArrayPVar ByteArray
ba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* PVar a s -> Int
forall a s. Prim a => PVar a s -> Int
sizeOfPVar PVar a s
pvar) PVar a s
pvar
{-# INLINE copyFromByteArrayPVar #-}

-- | Copy the value from MutableByteArray at specified index into the mutable
-- variable. Index of array is not checked and can result in an unchecked exception when
-- incorrect
--
-- @since 0.1.0
copyFromMutableByteArrayPVar ::
     (MonadPrim s m, Prim a)
  => MutableByteArray s
  -> Int -- ^ Offset in number of elements into the array
  -> PVar a s
  -> m ()
copyFromMutableByteArrayPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
MutableByteArray s -> Int -> PVar a s -> m ()
copyFromMutableByteArrayPVar MutableByteArray s
mba Int
offset PVar a s
pvar =
  MutableByteArray s -> Int -> PVar a s -> m ()
forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
MutableByteArray s -> Int -> PVar a s -> m ()
copyBytesFromMutableByteArrayPVar MutableByteArray s
mba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
* PVar a s -> Int
forall a s. Prim a => PVar a s -> Int
sizeOfPVar PVar a s
pvar) PVar a s
pvar
{-# INLINE copyFromMutableByteArrayPVar #-}


-- | Copy the value from a mutable variable into a `MutableByteArray` at the specified
-- offset in number of bytes. Offset into the array is not checked and can result in an
-- unchecked exception when incorrect
--
-- @since 0.1.0
copyBytesPVarToMutableByteArray ::
     (MonadPrim s m, Prim a)
  => PVar a s
  -> MutableByteArray s
  -> Int -- ^ Offset in bytes into the array
  -> m ()
copyBytesPVarToMutableByteArray :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
PVar a s -> MutableByteArray s -> Int -> m ()
copyBytesPVarToMutableByteArray pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mbas#) (MutableByteArray MutableByteArray# s
mbad#) (I# Int#
offset#) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (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
mbas# Int#
0# MutableByteArray# s
mbad# Int#
offset# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar))
{-# INLINE copyBytesPVarToMutableByteArray #-}


-- | Copy the value from a frozen `ByteArray` at the specified offset in number of bytes
-- into a mutable variable. Offset into the array is not checked and can result in an
-- unchecked exception when incorrect
--
-- @since 0.1.0
copyBytesFromByteArrayPVar ::
     (MonadPrim s m, Prim a)
  => ByteArray -- ^ Source array
  -> Int -- ^ Offset in bytes into the array
  -> PVar a s
  -> m ()
copyBytesFromByteArrayPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
ByteArray -> Int -> PVar a s -> m ()
copyBytesFromByteArrayPVar (ByteArray ByteArray#
ba#) (I# Int#
offset#) pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mba#) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (ByteArray#
-> Int#
-> MutableByteArray# s
-> Int#
-> Int#
-> State# s
-> State# s
forall d.
ByteArray#
-> Int#
-> MutableByteArray# d
-> Int#
-> Int#
-> State# d
-> State# d
copyByteArray# ByteArray#
ba# Int#
offset# MutableByteArray# s
mba# Int#
0# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar))
{-# INLINE copyBytesFromByteArrayPVar #-}

-- | Copy the value from a `MutableByteArray` at an offset in bytes into the mutable
-- variable. Offset into the array is not checked and can result in an unchecked exception
-- when incorrect
--
-- @since 0.1.0
copyBytesFromMutableByteArrayPVar ::
     (MonadPrim s m, Prim a)
  => MutableByteArray s
  -> Int -- ^ Offset in bytes into the array
  -> PVar a s
  -> m ()
copyBytesFromMutableByteArrayPVar :: forall s (m :: * -> *) a.
(MonadPrim s m, Prim a) =>
MutableByteArray s -> Int -> PVar a s -> m ()
copyBytesFromMutableByteArrayPVar (MutableByteArray MutableByteArray# s
mbas#) (I# Int#
offset#) pvar :: PVar a s
pvar@(PVar MutableByteArray# s
mbad#) =
  (State# (PrimState m) -> State# (PrimState m)) -> m ()
forall (m :: * -> *).
PrimMonad m =>
(State# (PrimState m) -> State# (PrimState m)) -> m ()
primitive_ (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
mbas# Int#
offset# MutableByteArray# s
mbad# Int#
0# (PVar a s -> Int#
forall a s. Prim a => PVar a s -> Int#
sizeOfPVar# PVar a s
pvar))
{-# INLINE copyBytesFromMutableByteArrayPVar #-}


-- | Show the type name
showsType :: Typeable t => proxy t -> ShowS
showsType :: forall t (proxy :: * -> *). Typeable t => proxy t -> ShowS
showsType = TypeRep -> ShowS
showsTypeRep (TypeRep -> ShowS) -> (proxy t -> TypeRep) -> proxy t -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep


-- | Check whether or not the `ByteArray` is pinned.
--
-- /__Note__/ - This function uses GHC built-in functions for GHC 8.2 and newer, but for older
-- versions it fallsback onto custom implementation.
--
--  @since 0.1.1
isByteArrayPinned :: ByteArray -> Bool
isByteArrayPinned :: ByteArray -> Bool
isByteArrayPinned (ByteArray ByteArray#
arr#) = Int# -> Bool
isTrue# (ByteArray# -> Int#
isByteArrayPinned# ByteArray#
arr#)
{-# INLINE isByteArrayPinned #-}

-- | Check whether or not the `MutableByteArray` is pinned.
--
-- /__Note__/ - This function uses GHC built-in functions for GHC 8.2 and newer, but for older
-- versions it fallsback onto custom implementation.
--
--  @since 0.1.1
isMutableByteArrayPinned :: MutableByteArray s -> Bool
isMutableByteArrayPinned :: forall s. MutableByteArray s -> Bool
isMutableByteArrayPinned (MutableByteArray MutableByteArray# s
marr#) = Int# -> Bool
isTrue# (MutableByteArray# s -> Int#
forall d. MutableByteArray# d -> Int#
isMutableByteArrayPinned# MutableByteArray# s
marr#)
{-# INLINE isMutableByteArrayPinned #-}