{-# language BangPatterns #-}
{-# language ForeignFunctionInterface #-}
{-# language MagicHash #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language UnboxedTuples #-}
module Data.Primitive.Foreign
(
sizeOf, alignment
, peek, peekElemOff, peekByteOff
, poke, pokeElemOff, pokeByteOff
, alloca, F.allocaBytes, F.allocaBytesAligned
, malloc, F.mallocBytes
, calloc, F.callocBytes
, realloc, F.reallocBytes
, F.free, F.finalizerFree
, mallocArray, mallocArray0
, allocaArray, allocaArray0
, reallocArray, reallocArray0
, callocArray, callocArray0
, peekArray, peekArray0
, pokeArray, pokeArray0
, newArray, newArray0
, withArray, withArray0
, withArrayLen, withArrayLen0
, copyArray
, moveArray
, lengthArray0
, advancePtr
, with
, new
, F.maybeNew
, F.maybeWith
, F.maybePeek
, F.copyBytes
, F.moveBytes
, F.fillBytes
) where
import Control.Monad.Primitive (primitive)
import Data.Coerce (coerce)
import Data.Primitive.PrimArray
import Data.Primitive.Types
import Data.Void (Void)
import GHC.Exts
import GHC.Ptr
import qualified Foreign as F
peekElemOff :: forall a. Prim a => Ptr a -> Int -> IO a
peekElemOff !ptr = coerce (F.peekElemOff @(PrimStorable a) (coerce ptr))
pokeElemOff :: forall a. Prim a => Ptr a -> Int -> a -> IO ()
pokeElemOff !ptr !idx a = F.pokeElemOff (coerce ptr) idx (PrimStorable a)
peekByteOff :: forall a. Prim a => Ptr Void -> Int -> IO a
peekByteOff !ptr = coerce (F.peekByteOff @(PrimStorable a) ptr)
pokeByteOff :: forall a. Prim a => Ptr Void -> Int -> a -> IO ()
pokeByteOff !ptr !idx a = F.pokeByteOff ptr idx (PrimStorable a)
peek :: forall a. Prim a => Ptr a -> IO a
peek = coerce (F.peek . coerce @(Ptr a) @(Ptr (PrimStorable a)))
poke :: forall a. Prim a => Ptr a -> a -> IO ()
poke !ptr a = F.poke (coerce ptr) (PrimStorable a)
alloca :: forall a b. Prim a => (Ptr a -> IO b) -> IO b
alloca f = F.alloca (coerce f :: Ptr (PrimStorable a) -> IO b)
malloc :: forall a. Prim a => IO (Ptr a)
malloc = F.mallocBytes (sizeOf @a undefined)
calloc :: forall a. Prim a => IO (Ptr a)
calloc = F.callocBytes (sizeOf @a undefined)
realloc :: forall a b. Prim b => Ptr a -> IO (Ptr b)
realloc ptr = coerce (F.realloc ptr :: IO (Ptr (PrimStorable b)))
mallocArray :: forall a. Prim a => Int -> IO (Ptr a)
mallocArray !idx = coerce (F.mallocArray @(PrimStorable a) idx)
mallocArray0 :: forall a. Prim a => Int -> IO (Ptr a)
mallocArray0 !idx = coerce (F.mallocArray0 @(PrimStorable a) idx)
allocaArray :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
allocaArray !idx f = F.allocaArray idx (coerce f :: Ptr (PrimStorable a) -> IO b)
allocaArray0 :: forall a b. Prim a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 !idx f = F.allocaArray0 idx (coerce f :: Ptr (PrimStorable a) -> IO b)
reallocArray :: forall a. Prim a => Ptr a -> Int -> IO (Ptr a)
reallocArray !ptr !idx = coerce (F.reallocArray @(PrimStorable a) (coerce ptr) idx)
reallocArray0 :: forall a. Prim a => Ptr a -> Int -> IO (Ptr a)
reallocArray0 !ptr !idx = coerce (F.reallocArray0 @(PrimStorable a) (coerce ptr) idx)
callocArray :: forall a. Prim a => Int -> IO (Ptr a)
callocArray !idx = coerce (F.callocArray @(PrimStorable a) idx)
callocArray0 :: forall a. Prim a => Int -> IO (Ptr a)
callocArray0 !idx = coerce (F.callocArray0 @(PrimStorable a) idx)
peekArray :: forall a. Prim a => Int -> Ptr a -> IO (PrimArray a)
peekArray !sz@(I# n#) !(Ptr addr#) = do
marr@(MutablePrimArray ba#) <- newPrimArray sz
primitive $ \s0# ->
case (copyAddrToByteArray# addr# ba# 0# (n# *# (sizeOf# @a undefined)) s0#) of
s1# -> (# s1#, () #)
unsafeFreezePrimArray marr
peekArray0 :: forall a. (Prim a, Eq a) => a -> Ptr a -> IO (PrimArray a)
peekArray0 term !ptr = lengthArray0 term ptr >>= \size ->
peekArray size ptr
pokeArray :: forall a. Prim a => Ptr a -> PrimArray a -> IO ()
pokeArray !ptr !arr = flip itraversePrimArray_ arr $ \ix atIx ->
pokeElemOff ptr ix atIx
pokeArray0 :: forall a. Prim a => a -> Ptr a -> PrimArray a -> IO ()
pokeArray0 term !ptr !arr =
let !sz = sizeofPrimArray arr
in flip itraversePrimArray_ arr $ \ix atIx ->
if ix == sz
then pokeElemOff ptr ix term
else pokeElemOff ptr ix atIx
newArray :: forall a. Prim a => PrimArray a -> IO (Ptr a)
newArray !arr = do
ptr <- mallocArray (sizeofPrimArray arr)
pokeArray ptr arr
pure ptr
newArray0 :: forall a. Prim a => a -> PrimArray a -> IO (Ptr a)
newArray0 term !arr = do
ptr <- mallocArray0 (sizeofPrimArray arr)
pokeArray0 term ptr arr
pure ptr
withArray :: forall a b. Prim a => PrimArray a -> (Ptr a -> IO b) -> IO b
withArray !arr = withArrayLen arr . const
withArrayLen :: forall a b. Prim a => PrimArray a -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen !arr f = allocaArray len $ \ptr -> do
pokeArray ptr arr
f len ptr
where
!len = sizeofPrimArray arr
withArray0 :: forall a b. Prim a => a -> PrimArray a -> (Ptr a -> IO b) -> IO b
withArray0 term !arr = withArrayLen0 term arr . const
withArrayLen0 :: forall a b. Prim a => a -> PrimArray a -> (Int -> Ptr a -> IO b) -> IO b
withArrayLen0 term !arr f = allocaArray0 len $ \ptr -> do
pokeArray0 term ptr arr
f len ptr
where
!len = sizeofPrimArray arr
lengthArray0 :: forall a. (Prim a, Eq a)
=> a
-> Ptr a
-> IO Int
lengthArray0 term !ptr = go 0
where
go !ix = peekElemOff ptr ix >>= \val ->
if val == term then pure ix else go (ix + 1)
advancePtr :: forall a. Prim a => Ptr a -> Int -> Ptr a
advancePtr !ptr !ix = ptr `plusPtr` (ix * sizeOf @a undefined)
copyArray :: forall a. Prim a
=> Ptr a
-> Ptr a
-> Int
-> IO ()
copyArray !dest !src !size = F.copyBytes dest src (size * sizeOf @a undefined)
moveArray :: forall a. Prim a
=> Ptr a
-> Ptr a
-> Int
-> IO ()
moveArray !dest !src !size = F.moveBytes dest src (size * sizeOf @a undefined)
with :: forall a b. Prim a => a -> (Ptr a -> IO b) -> IO b
with val f = F.with (PrimStorable val) (coerce f :: Ptr (PrimStorable a) -> IO b)
new :: forall a. Prim a => a -> IO (Ptr a)
new val = coerce (F.new (PrimStorable val))