{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
-- |
-- Module      : Data.Prim.Bytes.ForeignPtr
-- Copyright   : (c) Alexey Kuleshevich 2020
-- License     : BSD3
-- Maintainer  : Alexey Kuleshevich <alexey@kuleshevi.ch>
-- Stability   : experimental
-- Portability : non-portable
--
module Data.Prim.Memory.ForeignPtr
  ( PtrAccess(..)
    -- * ForeignPtr
  , ForeignPtr(..)
  , castForeignPtr
  , unsafeForeignPtrToPtr
  , ForeignPtrContents(..)
  -- * Pointer arithmetic
  , plusOffForeignPtr
  , plusByteOffForeignPtr
  , minusOffForeignPtr
  , minusOffRemForeignPtr
  , minusByteOffForeignPtr
  , withForeignPtr
  , withNoHaltForeignPtr
  -- ** PlainPtr
  , mallocPlainForeignPtr
  , mallocCountPlainForeignPtr
  , mallocCountPlainForeignPtrAligned
  , mallocByteCountPlainForeignPtr
  , mallocByteCountPlainForeignPtrAligned
  -- ** With Finalizers
  , finalizeForeignPtr
  -- *** Foreign finalizer
  , FinalizerPtr
  , newForeignPtr
  , newForeignPtr_
  , touchForeignPtr
  , mallocForeignPtr
  , mallocCountForeignPtr
  , mallocCountForeignPtrAligned
  , mallocByteCountForeignPtr
  , mallocByteCountForeignPtrAligned
  , addForeignPtrFinalizer
  -- *** With environment
  , FinalizerEnvPtr
  , newForeignPtrEnv
  , addForeignPtrFinalizerEnv
  -- *** Haskell finalizer
  , newConcForeignPtr
  , addForeignPtrConcFinalizer
  -- * Conversion
  -- ** Bytes
  , toForeignPtrBytes
  , toForeignPtrMBytes
  ) where

import Control.Prim.Monad
import Control.Prim.Eval
import Data.Prim
import Data.Prim.Class
import Data.Prim.Memory.Bytes.Internal (Bytes, MBytes(..), Pinned(..),
                                        toForeignPtrBytes, toForeignPtrMBytes,
                                        withNoHaltPtrBytes, withNoHaltPtrMBytes,
                                        withPtrBytes, withPtrMBytes)
import Data.Prim.Memory.ByteString
import qualified Foreign.ForeignPtr as GHC
import Foreign.Prim
import GHC.ForeignPtr (FinalizerEnvPtr, FinalizerPtr, ForeignPtr(..),
                       ForeignPtrContents(..), castForeignPtr,
                       unsafeForeignPtrToPtr)
import qualified GHC.ForeignPtr as GHC


-- | For memory allocated as pinned it is possible to operate on it with a `Ptr`. Any data
-- type that is backed by such memory can have a `PtrAccess` instance. The simplest way is
-- to convert it to a `ForeignPtr` and other functions will come for free.
class PtrAccess s p where
  -- | Convert to `ForeignPtr`.
  toForeignPtr :: MonadPrim s m => p -> m (ForeignPtr a)

  -- | Apply an action to the raw memory `Ptr` to which the data type point to. Type of data
  -- stored in memory is left ambiguous intentionaly, so that the user can choose how to
  -- treat the memory content.
  withPtrAccess :: MonadPrim s m => p -> (Ptr a -> m b) -> m b
  withPtrAccess p
p Ptr a -> m b
action = p -> m (ForeignPtr a)
forall s p (m :: * -> *) a.
(PtrAccess s p, MonadPrim s m) =>
p -> m (ForeignPtr a)
toForeignPtr p
p m (ForeignPtr a) -> (ForeignPtr a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForeignPtr a -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) e b.
MonadPrim s m =>
ForeignPtr e -> (Ptr e -> m b) -> m b
`withForeignPtr` Ptr a -> m b
action)
  {-# INLINE withPtrAccess #-}

  -- | See this GHC <https://gitlab.haskell.org/ghc/ghc/issues/17746 issue #17746> and
  -- related to it in order to get more insight why this is needed.
  withNoHaltPtrAccess :: MonadUnliftPrim s m => p -> (Ptr a -> m b) -> m b
  withNoHaltPtrAccess p
p Ptr a -> m b
action = p -> m (ForeignPtr a)
forall s p (m :: * -> *) a.
(PtrAccess s p, MonadPrim s m) =>
p -> m (ForeignPtr a)
toForeignPtr p
p m (ForeignPtr a) -> (ForeignPtr a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ForeignPtr a -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) e b.
MonadUnliftPrim s m =>
ForeignPtr e -> (Ptr e -> m b) -> m b
`withNoHaltForeignPtr` Ptr a -> m b
action)
  {-# INLINE withNoHaltPtrAccess #-}

instance PtrAccess RealWorld (ForeignPtr a) where
  toForeignPtr :: ForeignPtr a -> m (ForeignPtr a)
toForeignPtr = ForeignPtr a -> m (ForeignPtr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr a -> m (ForeignPtr a))
-> (ForeignPtr a -> ForeignPtr a)
-> ForeignPtr a
-> m (ForeignPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr a -> ForeignPtr a
coerce
  {-# INLINE toForeignPtr #-}

-- | Read-only access, but immutability is not enforced.
instance PtrAccess s ByteString where
  toForeignPtr :: ByteString -> m (ForeignPtr a)
toForeignPtr (PS ForeignPtr Word8
ps Int
s Int
_) = ForeignPtr a -> m (ForeignPtr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr Word8 -> ForeignPtr a
coerce ForeignPtr Word8
ps ForeignPtr a -> Off Word8 -> ForeignPtr a
forall e. ForeignPtr e -> Off Word8 -> ForeignPtr e
`plusByteOffForeignPtr` Int -> Off Word8
forall e. Int -> Off e
Off Int
s)
  {-# INLINE toForeignPtr #-}
  withPtrAccess :: ByteString -> (Ptr a -> m b) -> m b
withPtrAccess = ByteString -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadPrim s m =>
ByteString -> (Ptr a -> m b) -> m b
withPtrByteString
  {-# INLINE withPtrAccess #-}
  withNoHaltPtrAccess :: ByteString -> (Ptr a -> m b) -> m b
withNoHaltPtrAccess = ByteString -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
ByteString -> (Ptr a -> m b) -> m b
withNoHaltPtrByteString
  {-# INLINE withNoHaltPtrAccess #-}

instance PtrAccess s (MByteString s) where
  toForeignPtr :: MByteString s -> m (ForeignPtr a)
toForeignPtr MByteString s
mbs = ByteString -> m (ForeignPtr a)
forall s p (m :: * -> *) a.
(PtrAccess s p, MonadPrim s m) =>
p -> m (ForeignPtr a)
toForeignPtr (MByteString s -> ByteString
coerce MByteString s
mbs :: ByteString)
  {-# INLINE toForeignPtr #-}
  withPtrAccess :: MByteString s -> (Ptr a -> m b) -> m b
withPtrAccess MByteString s
mbs = ByteString -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadPrim s m =>
ByteString -> (Ptr a -> m b) -> m b
withPtrByteString (MByteString s -> ByteString
coerce MByteString s
mbs)
  {-# INLINE withPtrAccess #-}
  withNoHaltPtrAccess :: MByteString s -> (Ptr a -> m b) -> m b
withNoHaltPtrAccess MByteString s
mbs = ByteString -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
ByteString -> (Ptr a -> m b) -> m b
withNoHaltPtrByteString (MByteString s -> ByteString
coerce MByteString s
mbs)
  {-# INLINE withNoHaltPtrAccess #-}

-- | Read-only access, but immutability is not enforced.
instance PtrAccess s (Bytes 'Pin) where
  toForeignPtr :: Bytes 'Pin -> m (ForeignPtr a)
toForeignPtr = ForeignPtr a -> m (ForeignPtr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr a -> m (ForeignPtr a))
-> (Bytes 'Pin -> ForeignPtr a) -> Bytes 'Pin -> m (ForeignPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes 'Pin -> ForeignPtr a
forall e. Bytes 'Pin -> ForeignPtr e
toForeignPtrBytes
  {-# INLINE toForeignPtr #-}
  withPtrAccess :: Bytes 'Pin -> (Ptr a -> m b) -> m b
withPtrAccess = Bytes 'Pin -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadPrim s m =>
Bytes 'Pin -> (Ptr a -> m b) -> m b
withPtrBytes
  {-# INLINE withPtrAccess #-}
  withNoHaltPtrAccess :: Bytes 'Pin -> (Ptr a -> m b) -> m b
withNoHaltPtrAccess = Bytes 'Pin -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
Bytes 'Pin -> (Ptr a -> m b) -> m b
withNoHaltPtrBytes
  {-# INLINE withNoHaltPtrAccess #-}

instance PtrAccess s (MBytes 'Pin s) where
  toForeignPtr :: MBytes 'Pin s -> m (ForeignPtr a)
toForeignPtr = ForeignPtr a -> m (ForeignPtr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ForeignPtr a -> m (ForeignPtr a))
-> (MBytes 'Pin s -> ForeignPtr a)
-> MBytes 'Pin s
-> m (ForeignPtr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBytes 'Pin s -> ForeignPtr a
forall s e. MBytes 'Pin s -> ForeignPtr e
toForeignPtrMBytes
  {-# INLINE toForeignPtr #-}
  withPtrAccess :: MBytes 'Pin s -> (Ptr a -> m b) -> m b
withPtrAccess = MBytes 'Pin s -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadPrim s m =>
MBytes 'Pin s -> (Ptr a -> m b) -> m b
withPtrMBytes
  {-# INLINE withPtrAccess #-}
  withNoHaltPtrAccess :: MBytes 'Pin s -> (Ptr a -> m b) -> m b
withNoHaltPtrAccess = MBytes 'Pin s -> (Ptr a -> m b) -> m b
forall s (m :: * -> *) a b.
MonadUnliftPrim s m =>
MBytes 'Pin s -> (Ptr a -> m b) -> m b
withNoHaltPtrMBytes
  {-# INLINE withNoHaltPtrAccess #-}



-- | Apply an action to the raw pointer. It is unsafe to return the actual pointer back from
-- the action because memory itself might get garbage collected or cleaned up by
-- finalizers.
--
-- It is also important not to run non-terminating actions, because GHC can optimize away
-- the logic that runs after the action and GC will happen before the action get's a chance
-- to finish resulting in corrupt memory. Whenever you have an action that runs an infinite
-- loop or ends in an exception throwing, make sure to use `withNoHaltForeignPtr` instead.
withForeignPtr :: MonadPrim s m => ForeignPtr e -> (Ptr e -> m b) -> m b
withForeignPtr :: ForeignPtr e -> (Ptr e -> m b) -> m b
withForeignPtr (ForeignPtr Addr#
addr# ForeignPtrContents
ptrContents) Ptr e -> m b
f = do
  b
r <- Ptr e -> m b
f (Addr# -> Ptr e
forall a. Addr# -> Ptr a
Ptr Addr#
addr#)
  b
r b -> m () -> m b
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ForeignPtrContents -> m ()
forall s (m :: * -> *) a. MonadPrim s m => a -> m ()
touch ForeignPtrContents
ptrContents
{-# INLINE withForeignPtr #-}

-- | Same thing as `withForeignPtr` except it should be used for never ending actions. See
-- `withNoHaltPtrAccess` for more information on how this differes from `withForeignPtr`.
--
-- @since 0.1.0
withNoHaltForeignPtr ::
     MonadUnliftPrim s m => ForeignPtr e -> (Ptr e -> m b) -> m b
withNoHaltForeignPtr :: ForeignPtr e -> (Ptr e -> m b) -> m b
withNoHaltForeignPtr (ForeignPtr Addr#
addr# ForeignPtrContents
ptrContents) Ptr e -> m b
f =
  ForeignPtrContents -> m b -> m b
forall s (m :: * -> *) a b. MonadUnliftPrim s m => a -> m b -> m b
keepAlive ForeignPtrContents
ptrContents (m b -> m b) -> m b -> m b
forall a b. (a -> b) -> a -> b
$ Ptr e -> m b
f (Addr# -> Ptr e
forall a. Addr# -> Ptr a
Ptr Addr#
addr#)
{-# INLINE withNoHaltForeignPtr #-}

-- | Lifted version of `GHC.touchForeignPtr`.
touchForeignPtr :: MonadPrim s m => ForeignPtr e -> m ()
touchForeignPtr :: ForeignPtr e -> m ()
touchForeignPtr (ForeignPtr Addr#
_ ForeignPtrContents
contents) = ForeignPtrContents -> m ()
forall s (m :: * -> *) a. MonadPrim s m => a -> m ()
touch ForeignPtrContents
contents

-- | Lifted version of `GHC.newForeignPtr`.
newForeignPtr :: MonadPrim RW m => FinalizerPtr e -> Ptr e -> m (ForeignPtr e)
newForeignPtr :: FinalizerPtr e -> Ptr e -> m (ForeignPtr e)
newForeignPtr FinalizerPtr e
fin = IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Ptr e -> IO (ForeignPtr e)) -> Ptr e -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr e -> Ptr e -> IO (ForeignPtr e)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
GHC.newForeignPtr FinalizerPtr e
fin

-- | Lifted version of `GHC.newForeignPtrEnv`.
newForeignPtrEnv :: MonadPrim RW m => FinalizerEnvPtr env e -> Ptr env -> Ptr e -> m (ForeignPtr e)
newForeignPtrEnv :: FinalizerEnvPtr env e -> Ptr env -> Ptr e -> m (ForeignPtr e)
newForeignPtrEnv FinalizerEnvPtr env e
finEnv Ptr env
envPtr = IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Ptr e -> IO (ForeignPtr e)) -> Ptr e -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerEnvPtr env e -> Ptr env -> Ptr e -> IO (ForeignPtr e)
forall env a.
FinalizerEnvPtr env a -> Ptr env -> Ptr a -> IO (ForeignPtr a)
GHC.newForeignPtrEnv FinalizerEnvPtr env e
finEnv Ptr env
envPtr


-- | Lifted version of `GHC.newForeignPtr_`.
newForeignPtr_ :: MonadPrim RW m => Ptr e -> m (ForeignPtr e)
newForeignPtr_ :: Ptr e -> m (ForeignPtr e)
newForeignPtr_ = IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Ptr e -> IO (ForeignPtr e)) -> Ptr e -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr e -> IO (ForeignPtr e)
forall a. Ptr a -> IO (ForeignPtr a)
GHC.newForeignPtr_

-- | Simila to `GHC.mallocForeignPtr`, except it operates on `Prim`, instead of `Storable`.
mallocForeignPtr :: forall e m . (MonadPrim RW m, Prim e) => m (ForeignPtr e)
mallocForeignPtr :: m (ForeignPtr e)
mallocForeignPtr = Count e -> m (ForeignPtr e)
forall (m :: * -> *) e.
(MonadPrim RealWorld m, Prim e) =>
Count e -> m (ForeignPtr e)
mallocCountForeignPtrAligned (Count e
1 :: Count e)


-- | Similar to `Foreign.ForeignPtr.mallocForeignPtrArray`, except instead of `Storable` we
-- use `Prim`.
mallocCountForeignPtr :: (MonadPrim RW m, Prim e) => Count e -> m (ForeignPtr e)
mallocCountForeignPtr :: Count e -> m (ForeignPtr e)
mallocCountForeignPtr = IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Count e -> IO (ForeignPtr e)) -> Count e -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO (ForeignPtr e)
forall a. Int -> IO (ForeignPtr a)
GHC.mallocForeignPtrBytes (Int -> IO (ForeignPtr e))
-> (Count e -> Int) -> Count e -> IO (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count e -> Int
forall e. Prim e => Count e -> Int
unCountBytes

-- | Just like `mallocCountForeignPtr`, but memory is also aligned according to `Prim` instance
mallocCountForeignPtrAligned :: (MonadPrim RW m, Prim e) => Count e -> m (ForeignPtr e)
mallocCountForeignPtrAligned :: Count e -> m (ForeignPtr e)
mallocCountForeignPtrAligned Count e
count =
  IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> IO (ForeignPtr e) -> m (ForeignPtr e)
forall a b. (a -> b) -> a -> b
$ Int -> Int -> IO (ForeignPtr e)
forall a. Int -> Int -> IO (ForeignPtr a)
GHC.mallocForeignPtrAlignedBytes (Count e -> Int
coerce Count e
count) (Count e -> Int
forall (proxy :: * -> *) e. Prim e => proxy e -> Int
alignmentProxy Count e
count)

-- | Lifted version of `GHC.mallocForeignPtrBytes`.
mallocByteCountForeignPtr :: MonadPrim RW m => Count Word8 -> m (ForeignPtr e)
mallocByteCountForeignPtr :: Count Word8 -> m (ForeignPtr e)
mallocByteCountForeignPtr = IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Count Word8 -> IO (ForeignPtr e))
-> Count Word8
-> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IO (ForeignPtr e)
forall a. Int -> IO (ForeignPtr a)
GHC.mallocForeignPtrBytes (Int -> IO (ForeignPtr e))
-> (Count Word8 -> Int) -> Count Word8 -> IO (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count Word8 -> Int
coerce

-- | Lifted version of `GHC.mallocForeignPtrAlignedBytes`.
mallocByteCountForeignPtrAligned ::
     MonadPrim RW m
  => Count Word8 -- ^ Number of bytes to allocate
  -> Int -- ^ Alignment in bytes
  -> m (ForeignPtr e)
mallocByteCountForeignPtrAligned :: Count Word8 -> Int -> m (ForeignPtr e)
mallocByteCountForeignPtrAligned Count Word8
count =
  IO (ForeignPtr e) -> m (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO (ForeignPtr e) -> m (ForeignPtr e))
-> (Int -> IO (ForeignPtr e)) -> Int -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> IO (ForeignPtr e)
forall a. Int -> Int -> IO (ForeignPtr a)
GHC.mallocForeignPtrAlignedBytes (Count Word8 -> Int
coerce Count Word8
count)


-- | Lifted version of `GHC.addForeignPtrFinalizer`
addForeignPtrFinalizer :: MonadPrim RW m => FinalizerPtr e -> ForeignPtr e -> m ()
addForeignPtrFinalizer :: FinalizerPtr e -> ForeignPtr e -> m ()
addForeignPtrFinalizer FinalizerPtr e
fin = IO () -> m ()
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO () -> m ()) -> (ForeignPtr e -> IO ()) -> ForeignPtr e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerPtr e -> ForeignPtr e -> IO ()
forall a. FinalizerPtr a -> ForeignPtr a -> IO ()
GHC.addForeignPtrFinalizer FinalizerPtr e
fin


-- | Lifted version of `GHC.addForeignPtrFinalizerEnv`
addForeignPtrFinalizerEnv ::
     MonadPrim RW m => FinalizerEnvPtr env e -> Ptr env -> ForeignPtr e -> m ()
addForeignPtrFinalizerEnv :: FinalizerEnvPtr env e -> Ptr env -> ForeignPtr e -> m ()
addForeignPtrFinalizerEnv FinalizerEnvPtr env e
fin Ptr env
envPtr = IO () -> m ()
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO () -> m ()) -> (ForeignPtr e -> IO ()) -> ForeignPtr e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizerEnvPtr env e -> Ptr env -> ForeignPtr e -> IO ()
forall env a.
FinalizerEnvPtr env a -> Ptr env -> ForeignPtr a -> IO ()
GHC.addForeignPtrFinalizerEnv FinalizerEnvPtr env e
fin Ptr env
envPtr


-- | Similar to `GHC.mallocPlainForeignPtr`, except instead of `Storable` we use `Prim` and
-- we are not restricted to `IO`, since finalizers are not possible with `PlaintPtr`
mallocPlainForeignPtr ::
     forall e m s. (MonadPrim s m, Prim e)
  => m (ForeignPtr e)
mallocPlainForeignPtr :: m (ForeignPtr e)
mallocPlainForeignPtr = Count e -> m (ForeignPtr e)
forall s (m :: * -> *) e.
(MonadPrim s m, Prim e) =>
Count e -> m (ForeignPtr e)
mallocCountPlainForeignPtr (Count e
1 :: Count e)
{-# INLINE mallocPlainForeignPtr #-}

-- | Similar to `Foreign.ForeignPtr.mallocPlainForeignPtrArray`, except instead of `Storable` we
-- use `Prim`.
mallocCountPlainForeignPtr :: (MonadPrim s m, Prim e) => Count e -> m (ForeignPtr e)
mallocCountPlainForeignPtr :: Count e -> m (ForeignPtr e)
mallocCountPlainForeignPtr = Count Word8 -> m (ForeignPtr e)
forall s (m :: * -> *) e.
MonadPrim s m =>
Count Word8 -> m (ForeignPtr e)
mallocByteCountPlainForeignPtr (Count Word8 -> m (ForeignPtr e))
-> (Count e -> Count Word8) -> Count e -> m (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Count e -> Count Word8
forall e. Prim e => Count e -> Count Word8
toByteCount
{-# INLINE mallocCountPlainForeignPtr #-}

-- | Just like `mallocCountForeignPtr`, but memory is also aligned according to `Prim` instance
mallocCountPlainForeignPtrAligned ::
     forall e m s. (MonadPrim s m, Prim e)
  => Count e
  -> m (ForeignPtr e)
mallocCountPlainForeignPtrAligned :: Count e -> m (ForeignPtr e)
mallocCountPlainForeignPtrAligned Count e
c =
  (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e))
-> (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
forall a b. (a -> b) -> a -> b
$ \State# s
s ->
    let a# :: Int#
a# = Proxy# e -> Int#
forall a. Prim a => Proxy# a -> Int#
alignment# (Proxy# e
forall k (a :: k). Proxy# a
proxy# :: Proxy# e)
     in 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) Int#
a# State# s
s of
          (# State# s
s', MutableByteArray# s
mba# #) ->
            let addr# :: Addr#
addr# = MutableByteArray# s -> Addr#
forall s. MutableByteArray# s -> Addr#
mutableByteArrayContents# MutableByteArray# s
mba#
             in (# State# s
s', Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
addr# (MutableByteArray# RealWorld -> ForeignPtrContents
PlainPtr (MutableByteArray# s -> MutableByteArray# RealWorld
unsafeCoerce# MutableByteArray# s
mba#)) #)
{-# INLINE mallocCountPlainForeignPtrAligned #-}

-- | Lifted version of `GHC.mallocForeignPtrBytes`.
mallocByteCountPlainForeignPtr :: MonadPrim s m => Count Word8 -> m (ForeignPtr e)
mallocByteCountPlainForeignPtr :: Count Word8 -> m (ForeignPtr e)
mallocByteCountPlainForeignPtr (Count (I# Int#
c#)) =
  (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e))
-> (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
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# Int#
c# State# s
s of
      (# State# s
s', MutableByteArray# s
mba# #) ->
        (# State# s
s', 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 mallocByteCountPlainForeignPtr #-}


-- | Lifted version of `GHC.mallocForeignPtrAlignedBytes`.
mallocByteCountPlainForeignPtrAligned ::
     MonadPrim s m
  => Count Word8 -- ^ Number of bytes to allocate
  -> Int -- ^ Alignment in bytes
  -> m (ForeignPtr e)
mallocByteCountPlainForeignPtrAligned :: Count Word8 -> Int -> m (ForeignPtr e)
mallocByteCountPlainForeignPtrAligned (Count (I# Int#
c#)) (I# Int#
a#) =
  (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
forall s (m :: * -> *) a.
MonadPrim s m =>
(State# s -> (# State# s, a #)) -> m a
prim ((State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e))
-> (State# s -> (# State# s, ForeignPtr e #)) -> m (ForeignPtr e)
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# Int#
c# Int#
a# State# s
s of
      (# State# s
s', MutableByteArray# s
mba# #) ->
        (# State# s
s', 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 mallocByteCountPlainForeignPtrAligned #-}



-- | Unlifted version of `GHC.newConcForeignPtr`
newConcForeignPtr :: MonadUnliftPrim RW m => Ptr e -> m () -> m (ForeignPtr e)
newConcForeignPtr :: Ptr e -> m () -> m (ForeignPtr e)
newConcForeignPtr Ptr e
ptr m ()
fin =
  ((forall a. m a -> IO a) -> IO (ForeignPtr e)) -> m (ForeignPtr e)
forall (m :: * -> *) b.
MonadUnliftPrim RealWorld m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO (ForeignPtr e))
 -> m (ForeignPtr e))
-> ((forall a. m a -> IO a) -> IO (ForeignPtr e))
-> m (ForeignPtr e)
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO (ForeignPtr e) -> IO (ForeignPtr e)
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (Ptr e -> IO () -> IO (ForeignPtr e)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
GHC.newConcForeignPtr Ptr e
ptr (m () -> IO ()
forall a. m a -> IO a
run m ()
fin))


-- | Unlifted version of `GHC.addForeignPtrConcFinalizer`
addForeignPtrConcFinalizer :: MonadUnliftPrim RW m => ForeignPtr a -> m () -> m ()
addForeignPtrConcFinalizer :: ForeignPtr a -> m () -> m ()
addForeignPtrConcFinalizer ForeignPtr a
fp m ()
fin =
  ((forall a. m a -> IO a) -> IO ()) -> m ()
forall (m :: * -> *) b.
MonadUnliftPrim RealWorld m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (((forall a. m a -> IO a) -> IO ()) -> m ())
-> ((forall a. m a -> IO a) -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> IO () -> IO ()
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (ForeignPtr a -> IO () -> IO ()
forall a. ForeignPtr a -> IO () -> IO ()
GHC.addForeignPtrConcFinalizer ForeignPtr a
fp (m () -> IO ()
forall a. m a -> IO a
run m ()
fin))

-- | Lifted version of `GHC.finalizeForeignPtr`.
finalizeForeignPtr :: MonadPrim RW m => ForeignPtr e -> m ()
finalizeForeignPtr :: ForeignPtr e -> m ()
finalizeForeignPtr = IO () -> m ()
forall s (n :: * -> *) (m :: * -> *) a.
(MonadPrimBase s n, MonadPrim s m) =>
n a -> m a
liftPrimBase (IO () -> m ()) -> (ForeignPtr e -> IO ()) -> ForeignPtr e -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr e -> IO ()
forall a. ForeignPtr a -> IO ()
GHC.finalizeForeignPtr

-- | Advances the given address by the given offset in number of elemeents. This operation
-- does not affect associated finalizers in any way.
--
-- @since 0.1.0
plusOffForeignPtr :: Prim e => ForeignPtr e -> Off e -> ForeignPtr e
plusOffForeignPtr :: ForeignPtr e -> Off e -> ForeignPtr e
plusOffForeignPtr (ForeignPtr Addr#
addr# ForeignPtrContents
content) Off e
off =
  Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Off e -> Int#
forall e. Prim e => Off e -> Int#
unOffBytes# Off e
off) ForeignPtrContents
content
{-# INLINE plusOffForeignPtr #-}


-- | Advances the given address by the given offset in bytes. This operation does not
-- affect associated finalizers in any way.
--
-- @since 0.1.0
plusByteOffForeignPtr :: ForeignPtr e -> Off Word8 -> ForeignPtr e
plusByteOffForeignPtr :: ForeignPtr e -> Off Word8 -> ForeignPtr e
plusByteOffForeignPtr (ForeignPtr Addr#
addr# ForeignPtrContents
content) (Off (I# Int#
c#)) =
  Addr# -> ForeignPtrContents -> ForeignPtr e
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (Addr#
addr# Addr# -> Int# -> Addr#
`plusAddr#` Int#
c#) ForeignPtrContents
content
{-# INLINE plusByteOffForeignPtr #-}

-- | Find the offset in bytes that is between the two pointers by subtracting one address
-- from another.
--
-- @since 0.1.0
minusByteOffForeignPtr :: ForeignPtr e -> ForeignPtr e -> Off Word8
minusByteOffForeignPtr :: ForeignPtr e -> ForeignPtr e -> Off Word8
minusByteOffForeignPtr (ForeignPtr Addr#
xaddr# ForeignPtrContents
_) (ForeignPtr Addr#
yaddr# ForeignPtrContents
_) =
  Int -> Off Word8
forall e. Int -> Off e
Off (Int# -> Int
I# (Addr#
xaddr# Addr# -> Addr# -> Int#
`minusAddr#` Addr#
yaddr#))
{-# INLINE minusByteOffForeignPtr #-}

-- | Find the offset in number of elements that is between the two pointers by subtracting
-- one address from another and dividing the result by the size of an element.
--
-- @since 0.1.0
minusOffForeignPtr :: Prim e => ForeignPtr e -> ForeignPtr e -> Off e
minusOffForeignPtr :: ForeignPtr e -> ForeignPtr e -> Off e
minusOffForeignPtr (ForeignPtr Addr#
xaddr# ForeignPtrContents
_) (ForeignPtr Addr#
yaddr# ForeignPtrContents
_) =
  Off Word8 -> Off e
forall e. Prim e => Off Word8 -> Off e
fromByteOff (Int -> Off Word8
forall e. Int -> Off e
Off (Int# -> Int
I# (Addr#
xaddr# Addr# -> Addr# -> Int#
`minusAddr#` Addr#
yaddr#)))
{-# INLINE minusOffForeignPtr #-}

-- | Same as `minusOffForeignPtr`, but will also return the remainder in bytes that is
-- left over.
--
-- @since 0.1.0
minusOffRemForeignPtr :: Prim e => ForeignPtr e -> ForeignPtr e -> (Off e, Off Word8)
minusOffRemForeignPtr :: ForeignPtr e -> ForeignPtr e -> (Off e, Off Word8)
minusOffRemForeignPtr (ForeignPtr Addr#
xaddr# ForeignPtrContents
_) (ForeignPtr Addr#
yaddr# ForeignPtrContents
_) =
  Off Word8 -> (Off e, Off Word8)
forall e. Prim e => Off Word8 -> (Off e, Off Word8)
fromByteOffRem (Int -> Off Word8
forall e. Int -> Off e
Off (Int# -> Int
I# (Addr#
xaddr# Addr# -> Addr# -> Int#
`minusAddr#` Addr#
yaddr#)))
{-# INLINE minusOffRemForeignPtr #-}