{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}
module Data.Array.Accelerate.IO.Data.Vector.Primitive.Internal
where
import Data.Primitive ( sizeOf )
import Data.Primitive.ByteArray
import Data.Vector.Primitive
import Data.Array.Accelerate.Array.Unique
import Data.Array.Accelerate.Lifetime
import GHC.Base
import GHC.ForeignPtr
import System.IO.Unsafe
{-# INLINE uniqueArrayOfVector #-}
uniqueArrayOfVector :: forall a. Prim a => Vector a -> UniqueArray a
uniqueArrayOfVector (Vector o l ba)
= unsafePerformIO
$ newUniqueArray =<< foreignPtrOfByteArray o (l * sizeOf (undefined::a)) ba
{-# INLINE vectorOfUniqueArray #-}
vectorOfUniqueArray :: forall a. Prim a => Int -> UniqueArray a -> Vector a
vectorOfUniqueArray n ua
= unsafePerformIO
$ Vector 0 n `fmap` byteArrayOfForeignPtr (n * sizeOf (undefined::a)) (unsafeGetValue (uniqueArrayData ua))
{-# INLINE byteArrayOfForeignPtr #-}
byteArrayOfForeignPtr :: Int -> ForeignPtr a -> IO ByteArray
byteArrayOfForeignPtr (I# bytes#) (ForeignPtr addr# c) = IO $ \s ->
case c of
PlainPtr mba# -> case unsafeFreezeByteArray# mba# s of
(# s', ba# #) -> (# s', ByteArray ba# #)
_ -> case newAlignedPinnedByteArray# bytes# 16# s of
(# s1, mba# #) -> case copyAddrToByteArray# addr# mba# 0# bytes# s1 of
s2 -> case unsafeFreezeByteArray# mba# s2 of
(# s3, ba# #) -> (# s3, ByteArray ba# #)
{-# INLINE foreignPtrOfByteArray #-}
foreignPtrOfByteArray :: Int -> Int -> ByteArray -> IO (ForeignPtr a)
foreignPtrOfByteArray (I# soff#) (I# bytes#) (ByteArray ba#) = IO $ \s ->
case isByteArrayPinned# ba# of
0# -> case newAlignedPinnedByteArray# bytes# 16# s of
(# s1, mba# #) -> case copyByteArray# ba# 0# mba# soff# bytes# s1 of
s2 -> (# s2, ForeignPtr (byteArrayContents# (unsafeCoerce# mba#)) (PlainPtr mba#) #)
_ -> (# s, ForeignPtr (byteArrayContents# ba#) (PlainPtr (unsafeCoerce# ba#)) #)
#if !MIN_VERSION_base(4,10,0)
isByteArrayPinned# :: ByteArray# -> Int#
isByteArrayPinned# _ = 0#
#endif