{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Array.Accelerate.Array.Data (
ArrayElt(..), ArrayData, MutableArrayData, runArrayData,
ArrayEltR(..), GArrayData(..),
fstArrayData, sndArrayData, pairArrayData,
HTYPE_INT, HTYPE_WORD, HTYPE_LONG, HTYPE_UNSIGNED_LONG, HTYPE_CCHAR,
registerForeignPtrAllocator,
) where
import Data.Array.Accelerate.Array.Unique
import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Type
import Data.Array.Accelerate.Debug.Flags
import Data.Array.Accelerate.Debug.Monitoring
import Data.Array.Accelerate.Debug.Trace
import Control.Applicative
import Control.Monad
import Data.Bits
import Data.IORef
import Data.Typeable ( Typeable )
import Foreign.C.Types
import Foreign.ForeignPtr
import Foreign.Ptr
import Foreign.Storable
import Language.Haskell.TH
import System.IO.Unsafe
import Text.Printf
import Prelude
import GHC.Base ( Int(..), IO(..), unsafeCoerce#, newAlignedPinnedByteArray#, byteArrayContents# )
import GHC.ForeignPtr ( ForeignPtr(..), ForeignPtrContents(..) )
$( runQ [d| type HTYPE_INT = $(
case finiteBitSize (undefined::Int) of
32 -> [t| Int32 |]
64 -> [t| Int64 |]
_ -> error "I don't know what architecture I am" ) |] )
$( runQ [d| type HTYPE_WORD = $(
case finiteBitSize (undefined::Word) of
32 -> [t| Word32 |]
64 -> [t| Word64 |]
_ -> error "I don't know what architecture I am" ) |] )
$( runQ [d| type HTYPE_LONG = $(
case finiteBitSize (undefined::CLong) of
32 -> [t| Int32 |]
64 -> [t| Int64 |]
_ -> error "I don't know what architecture I am" ) |] )
$( runQ [d| type HTYPE_UNSIGNED_LONG = $(
case finiteBitSize (undefined::CULong) of
32 -> [t| Word32 |]
64 -> [t| Word64 |]
_ -> error "I don't know what architecture I am" ) |] )
$( runQ [d| type HTYPE_CCHAR = $(
case isSigned (undefined::CChar) of
True -> [t| Int8 |]
False -> [t| Word8 |] ) |] )
type ArrayData e = MutableArrayData e
type MutableArrayData e = GArrayData UniqueArray e
data family GArrayData :: (* -> *) -> * -> *
data instance GArrayData ba () = AD_Unit
data instance GArrayData ba Int = AD_Int (ba Int)
data instance GArrayData ba Int8 = AD_Int8 (ba Int8)
data instance GArrayData ba Int16 = AD_Int16 (ba Int16)
data instance GArrayData ba Int32 = AD_Int32 (ba Int32)
data instance GArrayData ba Int64 = AD_Int64 (ba Int64)
data instance GArrayData ba Word = AD_Word (ba Word)
data instance GArrayData ba Word8 = AD_Word8 (ba Word8)
data instance GArrayData ba Word16 = AD_Word16 (ba Word16)
data instance GArrayData ba Word32 = AD_Word32 (ba Word32)
data instance GArrayData ba Word64 = AD_Word64 (ba Word64)
data instance GArrayData ba CShort = AD_CShort (ba Int16)
data instance GArrayData ba CUShort = AD_CUShort (ba Word16)
data instance GArrayData ba CInt = AD_CInt (ba Int32)
data instance GArrayData ba CUInt = AD_CUInt (ba Word32)
data instance GArrayData ba CLong = AD_CLong (ba HTYPE_LONG)
data instance GArrayData ba CULong = AD_CULong (ba HTYPE_UNSIGNED_LONG)
data instance GArrayData ba CLLong = AD_CLLong (ba Int64)
data instance GArrayData ba CULLong = AD_CULLong (ba Word64)
data instance GArrayData ba Half = AD_Half (ba Half)
data instance GArrayData ba Float = AD_Float (ba Float)
data instance GArrayData ba Double = AD_Double (ba Double)
data instance GArrayData ba CFloat = AD_CFloat (ba Float)
data instance GArrayData ba CDouble = AD_CDouble (ba Double)
data instance GArrayData ba Bool = AD_Bool (ba Word8)
data instance GArrayData ba Char = AD_Char (ba Char)
data instance GArrayData ba CChar = AD_CChar (ba HTYPE_CCHAR)
data instance GArrayData ba CSChar = AD_CSChar (ba Int8)
data instance GArrayData ba CUChar = AD_CUChar (ba Word8)
data instance GArrayData ba (V2 a) = AD_V2 (GArrayData ba a)
data instance GArrayData ba (V3 a) = AD_V3 (GArrayData ba a)
data instance GArrayData ba (V4 a) = AD_V4 (GArrayData ba a)
data instance GArrayData ba (V8 a) = AD_V8 (GArrayData ba a)
data instance GArrayData ba (V16 a) = AD_V16 (GArrayData ba a)
data instance GArrayData ba (a, b) = AD_Pair (GArrayData ba a)
(GArrayData ba b)
deriving instance Typeable GArrayData
data ArrayEltR a where
ArrayEltRunit :: ArrayEltR ()
ArrayEltRint :: ArrayEltR Int
ArrayEltRint8 :: ArrayEltR Int8
ArrayEltRint16 :: ArrayEltR Int16
ArrayEltRint32 :: ArrayEltR Int32
ArrayEltRint64 :: ArrayEltR Int64
ArrayEltRword :: ArrayEltR Word
ArrayEltRword8 :: ArrayEltR Word8
ArrayEltRword16 :: ArrayEltR Word16
ArrayEltRword32 :: ArrayEltR Word32
ArrayEltRword64 :: ArrayEltR Word64
ArrayEltRcshort :: ArrayEltR CShort
ArrayEltRcushort :: ArrayEltR CUShort
ArrayEltRcint :: ArrayEltR CInt
ArrayEltRcuint :: ArrayEltR CUInt
ArrayEltRclong :: ArrayEltR CLong
ArrayEltRculong :: ArrayEltR CULong
ArrayEltRcllong :: ArrayEltR CLLong
ArrayEltRcullong :: ArrayEltR CULLong
ArrayEltRhalf :: ArrayEltR Half
ArrayEltRfloat :: ArrayEltR Float
ArrayEltRdouble :: ArrayEltR Double
ArrayEltRcfloat :: ArrayEltR CFloat
ArrayEltRcdouble :: ArrayEltR CDouble
ArrayEltRbool :: ArrayEltR Bool
ArrayEltRchar :: ArrayEltR Char
ArrayEltRcchar :: ArrayEltR CChar
ArrayEltRcschar :: ArrayEltR CSChar
ArrayEltRcuchar :: ArrayEltR CUChar
ArrayEltRvec2 :: ArrayEltR a -> ArrayEltR (V2 a)
ArrayEltRvec3 :: ArrayEltR a -> ArrayEltR (V3 a)
ArrayEltRvec4 :: ArrayEltR a -> ArrayEltR (V4 a)
ArrayEltRvec8 :: ArrayEltR a -> ArrayEltR (V8 a)
ArrayEltRvec16 :: ArrayEltR a -> ArrayEltR (V16 a)
ArrayEltRpair :: (ArrayElt a, ArrayElt b)
=> ArrayEltR a -> ArrayEltR b -> ArrayEltR (a,b)
class ArrayElt e where
type ArrayPtrs e
arrayElt :: ArrayEltR e
unsafeIndexArrayData :: ArrayData e -> Int -> e
ptrsOfArrayData :: ArrayData e -> ArrayPtrs e
touchArrayData :: ArrayData e -> IO ()
newArrayData :: Int -> IO (MutableArrayData e)
unsafeReadArrayData :: MutableArrayData e -> Int -> IO e
unsafeWriteArrayData :: MutableArrayData e -> Int -> e -> IO ()
unsafeFreezeArrayData :: MutableArrayData e -> IO (ArrayData e)
ptrsOfMutableArrayData :: MutableArrayData e -> IO (ArrayPtrs e)
{-# INLINE unsafeFreezeArrayData #-}
{-# INLINE ptrsOfMutableArrayData #-}
unsafeFreezeArrayData = return
ptrsOfMutableArrayData = return . ptrsOfArrayData
instance ArrayElt () where
type ArrayPtrs () = ()
arrayElt = ArrayEltRunit
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData !_ = return AD_Unit
ptrsOfArrayData AD_Unit = ()
touchArrayData AD_Unit = return ()
unsafeIndexArrayData AD_Unit !_ = ()
unsafeReadArrayData AD_Unit !_ = return ()
unsafeWriteArrayData AD_Unit !_ () = return ()
instance ArrayElt Int where
type ArrayPtrs Int = Ptr Int
arrayElt = ArrayEltRint
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Int <$> newArrayData' size
ptrsOfArrayData (AD_Int ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Int ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Int ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Int ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Int ba) i e = unsafeWriteArray ba i e
instance ArrayElt Int8 where
type ArrayPtrs Int8 = Ptr Int8
arrayElt = ArrayEltRint8
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Int8 <$> newArrayData' size
ptrsOfArrayData (AD_Int8 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Int8 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Int8 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Int8 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Int8 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Int16 where
type ArrayPtrs Int16 = Ptr Int16
arrayElt = ArrayEltRint16
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Int16 <$> newArrayData' size
ptrsOfArrayData (AD_Int16 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Int16 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Int16 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Int16 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Int16 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Int32 where
type ArrayPtrs Int32 = Ptr Int32
arrayElt = ArrayEltRint32
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Int32 <$> newArrayData' size
ptrsOfArrayData (AD_Int32 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Int32 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Int32 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Int32 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Int32 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Int64 where
type ArrayPtrs Int64 = Ptr Int64
arrayElt = ArrayEltRint64
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Int64 <$> newArrayData' size
ptrsOfArrayData (AD_Int64 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Int64 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Int64 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Int64 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Int64 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Word where
type ArrayPtrs Word = Ptr Word
arrayElt = ArrayEltRword
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Word <$> newArrayData' size
ptrsOfArrayData (AD_Word ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Word ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Word ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Word ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Word ba) i e = unsafeWriteArray ba i e
instance ArrayElt Word8 where
type ArrayPtrs Word8 = Ptr Word8
arrayElt = ArrayEltRword8
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Word8 <$> newArrayData' size
ptrsOfArrayData (AD_Word8 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Word8 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Word8 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Word8 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Word8 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Word16 where
type ArrayPtrs Word16 = Ptr Word16
arrayElt = ArrayEltRword16
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Word16 <$> newArrayData' size
unsafeIndexArrayData (AD_Word16 ba) i = unsafeIndexArray ba i
ptrsOfArrayData (AD_Word16 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Word16 ba) = touchUniqueArray ba
unsafeReadArrayData (AD_Word16 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Word16 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Word32 where
type ArrayPtrs Word32 = Ptr Word32
arrayElt = ArrayEltRword32
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Word32 <$> newArrayData' size
ptrsOfArrayData (AD_Word32 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Word32 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Word32 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Word32 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Word32 ba) i e = unsafeWriteArray ba i e
instance ArrayElt Word64 where
type ArrayPtrs Word64 = Ptr Word64
arrayElt = ArrayEltRword64
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Word64 <$> newArrayData' size
ptrsOfArrayData (AD_Word64 ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Word64 ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Word64 ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Word64 ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Word64 ba) i e = unsafeWriteArray ba i e
instance ArrayElt CShort where
type ArrayPtrs CShort = Ptr Int16
arrayElt = ArrayEltRcshort
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CShort <$> newArrayData' size
ptrsOfArrayData (AD_CShort ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CShort ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CShort ba) i = CShort $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CShort ba) i = CShort <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CShort ba) i (CShort e) = unsafeWriteArray ba i e
instance ArrayElt CUShort where
type ArrayPtrs CUShort = Ptr Word16
arrayElt = ArrayEltRcushort
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CUShort <$> newArrayData' size
ptrsOfArrayData (AD_CUShort ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CUShort ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CUShort ba) i = CUShort $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CUShort ba) i = CUShort <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CUShort ba) i (CUShort e) = unsafeWriteArray ba i e
instance ArrayElt CInt where
type ArrayPtrs CInt = Ptr Int32
arrayElt = ArrayEltRcint
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CInt <$> newArrayData' size
ptrsOfArrayData (AD_CInt ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CInt ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CInt ba) i = CInt $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CInt ba) i = CInt <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CInt ba) i (CInt e) = unsafeWriteArray ba i e
instance ArrayElt CUInt where
type ArrayPtrs CUInt = Ptr Word32
arrayElt = ArrayEltRcuint
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CUInt <$> newArrayData' size
ptrsOfArrayData (AD_CUInt ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CUInt ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CUInt ba) i = CUInt $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CUInt ba) i = CUInt <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CUInt ba) i (CUInt e) = unsafeWriteArray ba i e
instance ArrayElt CLong where
type ArrayPtrs CLong = Ptr HTYPE_LONG
arrayElt = ArrayEltRclong
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CLong <$> newArrayData' size
ptrsOfArrayData (AD_CLong ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CLong ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CLong ba) i = CLong $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CLong ba) i = CLong <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CLong ba) i (CLong e) = unsafeWriteArray ba i e
instance ArrayElt CULong where
type ArrayPtrs CULong = Ptr HTYPE_UNSIGNED_LONG
arrayElt = ArrayEltRculong
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CULong <$> newArrayData' size
ptrsOfArrayData (AD_CULong ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CULong ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CULong ba) i = CULong $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CULong ba) i = CULong <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CULong ba) i (CULong e) = unsafeWriteArray ba i e
instance ArrayElt CLLong where
type ArrayPtrs CLLong = Ptr Int64
arrayElt = ArrayEltRcllong
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE newArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CLLong <$> newArrayData' size
ptrsOfArrayData (AD_CLLong ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CLLong ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CLLong ba) i = CLLong $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CLLong ba) i = CLLong <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CLLong ba) i (CLLong e) = unsafeWriteArray ba i e
instance ArrayElt CULLong where
type ArrayPtrs CULLong = Ptr Word64
arrayElt = ArrayEltRcullong
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CULLong <$> newArrayData' size
ptrsOfArrayData (AD_CULLong ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CULLong ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CULLong ba) i = CULLong $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CULLong ba) i = CULLong <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CULLong ba) i (CULLong e) = unsafeWriteArray ba i e
instance ArrayElt Half where
type ArrayPtrs Half = Ptr Half
arrayElt = ArrayEltRhalf
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Half <$> newArrayData' size
ptrsOfArrayData (AD_Half ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Half ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Half ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Half ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Half ba) i e = unsafeWriteArray ba i e
instance ArrayElt Float where
type ArrayPtrs Float = Ptr Float
arrayElt = ArrayEltRfloat
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Float <$> newArrayData' size
ptrsOfArrayData (AD_Float ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Float ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Float ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Float ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Float ba) i e = unsafeWriteArray ba i e
instance ArrayElt Double where
type ArrayPtrs Double = Ptr Double
arrayElt = ArrayEltRdouble
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE newArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Double <$> newArrayData' size
ptrsOfArrayData (AD_Double ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Double ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Double ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Double ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Double ba) i e = unsafeWriteArray ba i e
instance ArrayElt CFloat where
type ArrayPtrs CFloat = Ptr Float
arrayElt = ArrayEltRcfloat
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CFloat <$> newArrayData' size
ptrsOfArrayData (AD_CFloat ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CFloat ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CFloat ba) i = CFloat $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CFloat ba) i = CFloat <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CFloat ba) i (CFloat e) = unsafeWriteArray ba i e
instance ArrayElt CDouble where
type ArrayPtrs CDouble = Ptr Double
arrayElt = ArrayEltRcdouble
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CDouble <$> newArrayData' size
ptrsOfArrayData (AD_CDouble ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CDouble ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CDouble ba) i = CDouble $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CDouble ba) i = CDouble <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CDouble ba) i (CDouble e) = unsafeWriteArray ba i e
instance ArrayElt Bool where
type ArrayPtrs Bool = Ptr Word8
arrayElt = ArrayEltRbool
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Bool <$> newArrayData' size
ptrsOfArrayData (AD_Bool ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Bool ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Bool ba) i = toBool $! unsafeIndexArray ba i
unsafeReadArrayData (AD_Bool ba) i = toBool <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_Bool ba) i e = unsafeWriteArray ba i (fromBool e)
instance ArrayElt Char where
type ArrayPtrs Char = Ptr Char
arrayElt = ArrayEltRchar
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Char <$> newArrayData' size
ptrsOfArrayData (AD_Char ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_Char ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_Char ba) i = unsafeIndexArray ba i
unsafeReadArrayData (AD_Char ba) i = unsafeReadArray ba i
unsafeWriteArrayData (AD_Char ba) i e = unsafeWriteArray ba i e
instance ArrayElt CChar where
type ArrayPtrs CChar = Ptr HTYPE_CCHAR
arrayElt = ArrayEltRcchar
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CChar <$> newArrayData' size
ptrsOfArrayData (AD_CChar ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CChar ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CChar ba) i = CChar $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CChar ba) i = CChar <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CChar ba) i (CChar e) = unsafeWriteArray ba i e
instance ArrayElt CSChar where
type ArrayPtrs CSChar = Ptr Int8
arrayElt = ArrayEltRcschar
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CSChar <$> newArrayData' size
ptrsOfArrayData (AD_CSChar ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CSChar ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CSChar ba) i = CSChar $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CSChar ba) i = CSChar <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CSChar ba) i (CSChar e) = unsafeWriteArray ba i e
instance ArrayElt CUChar where
type ArrayPtrs CUChar = Ptr Word8
arrayElt = ArrayEltRcuchar
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_CUChar <$> newArrayData' size
ptrsOfArrayData (AD_CUChar ba) = unsafeUniqueArrayPtr ba
touchArrayData (AD_CUChar ba) = touchUniqueArray ba
unsafeIndexArrayData (AD_CUChar ba) i = CUChar $! unsafeIndexArray ba i
unsafeReadArrayData (AD_CUChar ba) i = CUChar <$> unsafeReadArray ba i
unsafeWriteArrayData (AD_CUChar ba) i (CUChar e) = unsafeWriteArray ba i e
instance ArrayElt a => ArrayElt (V2 a) where
type ArrayPtrs (V2 a) = ArrayPtrs a
arrayElt = ArrayEltRvec2 arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
ptrsOfArrayData (AD_V2 ba) = ptrsOfArrayData ba
touchArrayData (AD_V2 ba) = touchArrayData ba
newArrayData size = AD_V2 <$> newArrayData (2 * size)
unsafeIndexArrayData (AD_V2 ba) ix =
let ix' = 2*ix
in V2 (unsafeIndexArrayData ba ix')
(unsafeIndexArrayData ba (ix'+1))
unsafeReadArrayData (AD_V2 ba) ix =
let ix' = 2*ix
in V2 <$> unsafeReadArrayData ba ix'
<*> unsafeReadArrayData ba (ix'+1)
unsafeWriteArrayData (AD_V2 ba) ix (V2 a b) =
let ix' = 2*ix
in do unsafeWriteArrayData ba ix' a
unsafeWriteArrayData ba (ix'+1) b
instance ArrayElt a => ArrayElt (V3 a) where
type ArrayPtrs (V3 a) = ArrayPtrs a
arrayElt = ArrayEltRvec3 arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
ptrsOfArrayData (AD_V3 ba) = ptrsOfArrayData ba
touchArrayData (AD_V3 ba) = touchArrayData ba
newArrayData size = AD_V3 <$> newArrayData (3 * size)
unsafeIndexArrayData (AD_V3 ba) ix =
let ix' = 3*ix
in V3 (unsafeIndexArrayData ba ix')
(unsafeIndexArrayData ba (ix'+1))
(unsafeIndexArrayData ba (ix'+2))
unsafeReadArrayData (AD_V3 ba) ix =
let ix' = 3*ix
in V3 <$> unsafeReadArrayData ba ix'
<*> unsafeReadArrayData ba (ix'+1)
<*> unsafeReadArrayData ba (ix'+2)
unsafeWriteArrayData (AD_V3 ba) ix (V3 a b c) =
let ix' = 3*ix
in do unsafeWriteArrayData ba ix' a
unsafeWriteArrayData ba (ix'+1) b
unsafeWriteArrayData ba (ix'+3) c
instance ArrayElt a => ArrayElt (V4 a) where
type ArrayPtrs (V4 a) = ArrayPtrs a
arrayElt = ArrayEltRvec4 arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
ptrsOfArrayData (AD_V4 ba) = ptrsOfArrayData ba
touchArrayData (AD_V4 ba) = touchArrayData ba
newArrayData size = AD_V4 <$> newArrayData (4 * size)
unsafeIndexArrayData (AD_V4 ba) ix =
let ix' = 4*ix
in V4 (unsafeIndexArrayData ba ix')
(unsafeIndexArrayData ba (ix'+1))
(unsafeIndexArrayData ba (ix'+2))
(unsafeIndexArrayData ba (ix'+3))
unsafeReadArrayData (AD_V4 ba) ix =
let ix' = 4*ix
in V4 <$> unsafeReadArrayData ba ix'
<*> unsafeReadArrayData ba (ix'+1)
<*> unsafeReadArrayData ba (ix'+2)
<*> unsafeReadArrayData ba (ix'+3)
unsafeWriteArrayData (AD_V4 ba) ix (V4 a b c d) =
let ix' = 4*ix
in do unsafeWriteArrayData ba ix' a
unsafeWriteArrayData ba (ix'+1) b
unsafeWriteArrayData ba (ix'+2) c
unsafeWriteArrayData ba (ix'+3) d
instance ArrayElt a => ArrayElt (V8 a) where
type ArrayPtrs (V8 a) = ArrayPtrs a
arrayElt = ArrayEltRvec8 arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
ptrsOfArrayData (AD_V8 ba) = ptrsOfArrayData ba
touchArrayData (AD_V8 ba) = touchArrayData ba
newArrayData size = AD_V8 <$> newArrayData (8 * size)
unsafeIndexArrayData (AD_V8 ba) ix =
let ix' = 8*ix
in V8 (unsafeIndexArrayData ba ix')
(unsafeIndexArrayData ba (ix'+1))
(unsafeIndexArrayData ba (ix'+2))
(unsafeIndexArrayData ba (ix'+3))
(unsafeIndexArrayData ba (ix'+4))
(unsafeIndexArrayData ba (ix'+5))
(unsafeIndexArrayData ba (ix'+6))
(unsafeIndexArrayData ba (ix'+7))
unsafeReadArrayData (AD_V8 ba) ix =
let ix' = 8*ix
in V8 <$> unsafeReadArrayData ba ix'
<*> unsafeReadArrayData ba (ix'+1)
<*> unsafeReadArrayData ba (ix'+2)
<*> unsafeReadArrayData ba (ix'+3)
<*> unsafeReadArrayData ba (ix'+4)
<*> unsafeReadArrayData ba (ix'+5)
<*> unsafeReadArrayData ba (ix'+6)
<*> unsafeReadArrayData ba (ix'+7)
unsafeWriteArrayData (AD_V8 ba) ix (V8 a b c d e f g h) =
let ix' = 8*ix
in do unsafeWriteArrayData ba ix' a
unsafeWriteArrayData ba (ix'+1) b
unsafeWriteArrayData ba (ix'+2) c
unsafeWriteArrayData ba (ix'+3) d
unsafeWriteArrayData ba (ix'+4) e
unsafeWriteArrayData ba (ix'+5) f
unsafeWriteArrayData ba (ix'+6) g
unsafeWriteArrayData ba (ix'+7) h
instance ArrayElt a => ArrayElt (V16 a) where
type ArrayPtrs (V16 a) = ArrayPtrs a
arrayElt = ArrayEltRvec16 arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
ptrsOfArrayData (AD_V16 ba) = ptrsOfArrayData ba
touchArrayData (AD_V16 ba) = touchArrayData ba
newArrayData size = AD_V16 <$> newArrayData (16 * size)
unsafeIndexArrayData (AD_V16 ba) ix =
let ix' = 16*ix
in V16 (unsafeIndexArrayData ba ix')
(unsafeIndexArrayData ba (ix'+1))
(unsafeIndexArrayData ba (ix'+2))
(unsafeIndexArrayData ba (ix'+3))
(unsafeIndexArrayData ba (ix'+4))
(unsafeIndexArrayData ba (ix'+5))
(unsafeIndexArrayData ba (ix'+6))
(unsafeIndexArrayData ba (ix'+7))
(unsafeIndexArrayData ba (ix'+8))
(unsafeIndexArrayData ba (ix'+9))
(unsafeIndexArrayData ba (ix'+10))
(unsafeIndexArrayData ba (ix'+11))
(unsafeIndexArrayData ba (ix'+12))
(unsafeIndexArrayData ba (ix'+13))
(unsafeIndexArrayData ba (ix'+14))
(unsafeIndexArrayData ba (ix'+15))
unsafeReadArrayData (AD_V16 ba) ix =
let ix' = 16*ix
in V16 <$> unsafeReadArrayData ba ix'
<*> unsafeReadArrayData ba (ix'+1)
<*> unsafeReadArrayData ba (ix'+2)
<*> unsafeReadArrayData ba (ix'+3)
<*> unsafeReadArrayData ba (ix'+4)
<*> unsafeReadArrayData ba (ix'+5)
<*> unsafeReadArrayData ba (ix'+6)
<*> unsafeReadArrayData ba (ix'+7)
<*> unsafeReadArrayData ba (ix'+8)
<*> unsafeReadArrayData ba (ix'+9)
<*> unsafeReadArrayData ba (ix'+10)
<*> unsafeReadArrayData ba (ix'+11)
<*> unsafeReadArrayData ba (ix'+12)
<*> unsafeReadArrayData ba (ix'+13)
<*> unsafeReadArrayData ba (ix'+14)
<*> unsafeReadArrayData ba (ix'+15)
unsafeWriteArrayData (AD_V16 ba) ix (V16 a b c d e f g h i j k l m n o p) =
let ix' = 16*ix
in do unsafeWriteArrayData ba ix' a
unsafeWriteArrayData ba (ix'+1) b
unsafeWriteArrayData ba (ix'+2) c
unsafeWriteArrayData ba (ix'+3) d
unsafeWriteArrayData ba (ix'+4) e
unsafeWriteArrayData ba (ix'+5) f
unsafeWriteArrayData ba (ix'+6) g
unsafeWriteArrayData ba (ix'+7) h
unsafeWriteArrayData ba (ix'+8) i
unsafeWriteArrayData ba (ix'+9) j
unsafeWriteArrayData ba (ix'+10) k
unsafeWriteArrayData ba (ix'+11) l
unsafeWriteArrayData ba (ix'+12) m
unsafeWriteArrayData ba (ix'+13) n
unsafeWriteArrayData ba (ix'+14) o
unsafeWriteArrayData ba (ix'+15) p
instance (ArrayElt a, ArrayElt b) => ArrayElt (a, b) where
type ArrayPtrs (a, b) = (ArrayPtrs a, ArrayPtrs b)
arrayElt = ArrayEltRpair arrayElt arrayElt
{-# INLINE newArrayData #-}
{-# INLINE ptrsOfArrayData #-}
{-# INLINE ptrsOfMutableArrayData #-}
{-# INLINE touchArrayData #-}
{-# INLINE unsafeFreezeArrayData #-}
{-# INLINE unsafeIndexArrayData #-}
{-# INLINE unsafeReadArrayData #-}
{-# INLINE unsafeWriteArrayData #-}
newArrayData size = AD_Pair <$> newArrayData size <*> newArrayData size
touchArrayData (AD_Pair a b) = touchArrayData a >> touchArrayData b
ptrsOfArrayData (AD_Pair a b) = (ptrsOfArrayData a, ptrsOfArrayData b)
ptrsOfMutableArrayData (AD_Pair a b) = (,) <$> ptrsOfMutableArrayData a <*> ptrsOfMutableArrayData b
unsafeReadArrayData (AD_Pair a b) i = (,) <$> unsafeReadArrayData a i <*> unsafeReadArrayData b i
unsafeIndexArrayData (AD_Pair a b) i = (unsafeIndexArrayData a i, unsafeIndexArrayData b i)
unsafeWriteArrayData (AD_Pair a b) i (x, y) = unsafeWriteArrayData a i x >> unsafeWriteArrayData b i y
unsafeFreezeArrayData (AD_Pair a b) = AD_Pair <$> unsafeFreezeArrayData a <*> unsafeFreezeArrayData b
{-# INLINE fstArrayData #-}
fstArrayData :: ArrayData (a, b) -> ArrayData a
fstArrayData (AD_Pair x _) = x
{-# INLINE sndArrayData #-}
sndArrayData :: ArrayData (a, b) -> ArrayData b
sndArrayData (AD_Pair _ y) = y
{-# INLINE pairArrayData #-}
pairArrayData :: ArrayData a -> ArrayData b -> ArrayData (a, b)
pairArrayData = AD_Pair
{-# INLINE toBool #-}
toBool :: Word8 -> Bool
toBool 0 = False
toBool _ = True
{-# INLINE fromBool #-}
fromBool :: Bool -> Word8
fromBool True = 1
fromBool False = 0
{-# INLINE runArrayData #-}
runArrayData
:: IO (MutableArrayData e, e)
-> (ArrayData e, e)
runArrayData st = unsafePerformIO $ do
(mad, r) <- st
return (mad, r)
{-# INLINE unsafeIndexArray #-}
unsafeIndexArray :: Storable e => UniqueArray e -> Int -> e
unsafeIndexArray ua i =
unsafePerformIO $! unsafeReadArray ua i
{-# INLINE unsafeReadArray #-}
unsafeReadArray :: Storable e => UniqueArray e -> Int -> IO e
unsafeReadArray ua i =
withUniqueArrayPtr ua $ \ptr -> peekElemOff ptr i
{-# INLINE unsafeWriteArray #-}
unsafeWriteArray :: Storable e => UniqueArray e -> Int -> e -> IO ()
unsafeWriteArray ua i e =
withUniqueArrayPtr ua $ \ptr -> pokeElemOff ptr i e
{-# INLINE newArrayData' #-}
newArrayData' :: forall e. Storable e => Int -> IO (UniqueArray e)
newArrayData' !size
= $internalCheck "newArrayData" "size must be >= 0" (size >= 0)
$ newUniqueArray <=< unsafeInterleaveIO $ do
let bytes = size * sizeOf (undefined :: e)
new <- readIORef __mallocForeignPtrBytes
ptr <- new bytes
traceIO dump_gc $ printf "gc: allocated new host array (size=%d, ptr=%s)" bytes (show ptr)
didAllocateBytesLocal (fromIntegral bytes)
return (castForeignPtr ptr)
registerForeignPtrAllocator
:: (Int -> IO (ForeignPtr Word8))
-> IO ()
registerForeignPtrAllocator new = do
traceIO dump_gc "registering new array allocator"
atomicWriteIORef __mallocForeignPtrBytes new
{-# NOINLINE __mallocForeignPtrBytes #-}
__mallocForeignPtrBytes :: IORef (Int -> IO (ForeignPtr Word8))
__mallocForeignPtrBytes = unsafePerformIO $! newIORef mallocPlainForeignPtrBytesAligned
{-# INLINE mallocPlainForeignPtrBytesAligned #-}
mallocPlainForeignPtrBytesAligned :: Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytesAligned (I# size) = IO $ \s ->
case newAlignedPinnedByteArray# size 16# s of
(# s', mbarr# #) -> (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#)) (PlainPtr mbarr#) #)