{-# 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
-- Copyright   : [2008..2017] Manuel M T Chakravarty, Gabriele Keller
--               [2009..2017] Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- This module fixes the concrete representation of Accelerate arrays.  We
-- allocate all arrays using pinned memory to enable safe direct-access by
-- non-Haskell code in multi-threaded code.  In particular, we can safely pass
-- pointers to an array's payload to foreign code.
--

module Data.Array.Accelerate.Array.Data (

  -- * Array operations and representations
  ArrayElt(..), ArrayData, MutableArrayData, runArrayData,
  ArrayEltR(..), GArrayData(..),

  -- * Array tuple operations
  fstArrayData, sndArrayData, pairArrayData,

  -- * Type macros
  HTYPE_INT, HTYPE_WORD, HTYPE_LONG, HTYPE_UNSIGNED_LONG, HTYPE_CCHAR,

  -- * Allocator internals
  registerForeignPtrAllocator,

) where

-- friends
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

-- standard libraries
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(..) )


-- Determine the underlying type of a Haskell CLong or CULong.
--
$( 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 |] ) |] )


-- Array representation
-- --------------------

-- |Immutable array representation
--
type ArrayData e = MutableArrayData e

-- |Mutable array representation
--
type MutableArrayData e = GArrayData UniqueArray e

-- Array representation in dependence on the element type, but abstracting
-- over the basic array type (in particular, abstracting over mutability)
--
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


-- | GADT to reify the 'ArrayElt' class.
--
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)

-- Array operations
-- ----------------
--
-- TLM: do we need to INLINE these functions to get good performance interfacing
--      to external libraries, especially Repa?

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

-- Bool arrays are stored as arrays of bytes. While this is memory inefficient,
-- it is better suited to parallel backends than a packed bit-vector
-- representation.
--
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)

-- Unboxed Char is stored as a wide character, which is 4-bytes
--
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


-- Array tuple operations
-- ----------------------

{-# 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


-- Auxiliary functions
-- -------------------

{-# INLINE toBool #-}
toBool :: Word8 -> Bool
toBool 0 = False
toBool _ = True

{-# INLINE fromBool #-}
fromBool :: Bool -> Word8
fromBool True  = 1
fromBool False = 0

-- | Safe combination of creating and fast freezing of array data.
--
{-# INLINE runArrayData #-}
runArrayData
    :: IO (MutableArrayData e, e)
    -> (ArrayData e, e)
runArrayData st = unsafePerformIO $ do
  (mad, r) <- st
  return (mad, r)

-- Returns the element of an immutable array at the specified index. This does
-- no bounds checking.
--
{-# INLINE unsafeIndexArray #-}
unsafeIndexArray :: Storable e => UniqueArray e -> Int -> e
unsafeIndexArray ua i =
  unsafePerformIO $! unsafeReadArray ua i

-- Read an element from a mutable array at the given index. This does no bounds
-- checking.
--
{-# INLINE unsafeReadArray #-}
unsafeReadArray :: Storable e => UniqueArray e -> Int -> IO e
unsafeReadArray ua i =
  withUniqueArrayPtr ua $ \ptr -> peekElemOff ptr i

-- Write an element into a mutable array at the given index. This does no bounds
-- checking.
--
{-# INLINE unsafeWriteArray #-}
unsafeWriteArray :: Storable e => UniqueArray e -> Int -> e -> IO ()
unsafeWriteArray ua i e =
  withUniqueArrayPtr ua $ \ptr -> pokeElemOff ptr i e

-- Allocate a new array with enough storage to hold the given number of
-- elements.
--
-- The array is uninitialised and, in particular, allocated lazily. The latter
-- is important because it means that for backends that have discrete memory
-- spaces (e.g. GPUs), we will not increase host memory pressure simply to track
-- intermediate arrays that contain meaningful data only on the device.
--
{-# 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)

-- | Register the given function as the callback to use to allocate new array
-- data on the host containing the specified number of bytes. The returned array
-- must be pinned (with respect to Haskell's GC), so that it can be passed to
-- foreign code.
--
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

-- | Allocate the given number of bytes with 16-byte alignment. This is
-- essential for SIMD instructions.
--
-- Additionally, we return a plain ForeignPtr, which unlike a regular ForeignPtr
-- created with 'mallocForeignPtr' carries no finalisers. It is an error to try
-- to add a finaliser to the plain ForeignPtr. For our purposes this is fine,
-- since in Accelerate finalisers are handled using Lifetime
--
{-# 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#) #)