{-# LANGUAGE CPP                 #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE UnboxedTuples       #-}
{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.Array.Data
-- Copyright   : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
--               [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell
-- License     : BSD3
--
-- Maintainer  : Manuel M T Chakravarty <chak@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

) where

-- standard libraries
import Foreign            (Ptr)
import Foreign.C.Types
import GHC.Base           (Int(..))
import GHC.Prim           (newPinnedByteArray#, byteArrayContents#,
                           unsafeFreezeByteArray#, Int#, (*#))
import GHC.Ptr            (Ptr(Ptr))
import GHC.ST             (ST(ST))
import Data.Typeable
import Data.Functor       ((<$>))
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.IArray  as IArray
#ifdef ACCELERATE_UNSAFE_CHECKS
import qualified Data.Array.Base    as MArray (readArray, writeArray)
#else
import qualified Data.Array.Base    as MArray (unsafeRead, unsafeWrite)
import qualified Data.Array.Base    as IArray (unsafeAt)
#endif
#if __GLASGOW_HASKELL__ >= 700 && __GLASGOW_HASKELL__ < 703
import qualified Data.Array.MArray  as Unsafe
#else
import qualified Data.Array.Unsafe  as Unsafe
#endif
import Data.Array.ST      (STUArray)
import Data.Array.Unboxed (UArray)
import Data.Array.MArray  (MArray)
import Data.Array.Base    (UArray(UArray), STUArray(STUArray),
                           wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE)

-- friends
import Data.Array.Accelerate.Type


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

-- |Immutable array representation
--
type ArrayData e = GArrayData (UArray Int) e

-- |Mutable array representation
--
type MutableArrayData s e = GArrayData (STUArray s Int) 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 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 Int8)
data instance GArrayData ba CSChar  = AD_CSChar  (ba Int8)
data instance GArrayData ba CUChar  = AD_CUChar  (ba Word8)
data instance GArrayData ba (a, b)  = AD_Pair (GArrayData ba a)
                                              (GArrayData ba b)

instance (Typeable1 ba, Typeable e) => Typeable (GArrayData ba e) where
  typeOf _ = myMkTyCon "Data.Array.Accelerate.Array.Data.GArrayData"
            `mkTyConApp` [typeOf (undefined::ba e), typeOf (undefined::e)]


-- | 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
  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
  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
  --
  unsafeIndexArrayData   :: ArrayData e -> Int -> e
  ptrsOfArrayData        :: ArrayData e -> ArrayPtrs e
  --
  newArrayData           :: Int -> ST s (MutableArrayData s e)
  unsafeReadArrayData    :: MutableArrayData s e -> Int      -> ST s e
  unsafeWriteArrayData   :: MutableArrayData s e -> Int -> e -> ST s ()
  unsafeFreezeArrayData  :: MutableArrayData s e -> ST s (ArrayData e)
  ptrsOfMutableArrayData :: MutableArrayData s e -> ST s (ArrayPtrs e)
  --
  arrayElt               :: ArrayEltR e

instance ArrayElt () where
  type ArrayPtrs () = ()
  unsafeIndexArrayData AD_Unit i    = i `seq` ()
  ptrsOfArrayData AD_Unit           = ()
  newArrayData size                 = size `seq` return AD_Unit
  unsafeReadArrayData AD_Unit i     = i `seq` return ()
  unsafeWriteArrayData AD_Unit i () = i `seq` return ()
  unsafeFreezeArrayData AD_Unit     = return AD_Unit
  ptrsOfMutableArrayData AD_Unit    = return ()
  arrayElt                          = ArrayEltRunit

instance ArrayElt Int where
  type ArrayPtrs Int = Ptr Int
  unsafeIndexArrayData (AD_Int ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Int ba)          = uArrayPtr ba
  newArrayData size                    = liftM AD_Int $ unsafeNewArray_ size wORD_SCALE
  unsafeReadArrayData (AD_Int ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Int ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Int ba)    = liftM AD_Int $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Int ba)   = sTUArrayPtr ba
  arrayElt                             = ArrayEltRint

instance ArrayElt Int8 where
  type ArrayPtrs Int8 = Ptr Int8
  unsafeIndexArrayData (AD_Int8 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Int8 ba)          = uArrayPtr ba
  newArrayData size                     = liftM AD_Int8 $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_Int8 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Int8 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Int8 ba)    = liftM AD_Int8 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Int8 ba)   = sTUArrayPtr ba
  arrayElt                              = ArrayEltRint8

instance ArrayElt Int16 where
  type ArrayPtrs Int16 = Ptr Int16
  unsafeIndexArrayData (AD_Int16 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Int16 ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_Int16 $ unsafeNewArray_ size (*# 2#)
  unsafeReadArrayData (AD_Int16 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Int16 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Int16 ba)    = liftM AD_Int16 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Int16 ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRint16

instance ArrayElt Int32 where
  type ArrayPtrs Int32 = Ptr Int32
  unsafeIndexArrayData (AD_Int32 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Int32 ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_Int32 $ unsafeNewArray_ size (*# 4#)
  unsafeReadArrayData (AD_Int32 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Int32 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Int32 ba)    = liftM AD_Int32 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Int32 ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRint32

instance ArrayElt Int64 where
  type ArrayPtrs Int64 = Ptr Int64
  unsafeIndexArrayData (AD_Int64 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Int64 ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_Int64 $ unsafeNewArray_ size (*# 8#)
  unsafeReadArrayData (AD_Int64 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Int64 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Int64 ba)    = liftM AD_Int64 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Int64 ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRint64

instance ArrayElt Word where
  type ArrayPtrs Word = Ptr Word
  unsafeIndexArrayData (AD_Word ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Word ba)          = uArrayPtr ba
  newArrayData size                     = liftM AD_Word $ unsafeNewArray_ size wORD_SCALE
  unsafeReadArrayData (AD_Word ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Word ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Word ba)    = liftM AD_Word $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Word ba)   = sTUArrayPtr ba
  arrayElt                              = ArrayEltRword

instance ArrayElt Word8 where
  type ArrayPtrs Word8 = Ptr Word8
  unsafeIndexArrayData (AD_Word8 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Word8 ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_Word8 $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_Word8 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Word8 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Word8 ba)    = liftM AD_Word8 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Word8 ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRword8

instance ArrayElt Word16 where
  type ArrayPtrs Word16 = Ptr Word16
  unsafeIndexArrayData (AD_Word16 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Word16 ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_Word16 $ unsafeNewArray_ size (*# 2#)
  unsafeReadArrayData (AD_Word16 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Word16 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Word16 ba)    = liftM AD_Word16 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Word16 ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRword16

instance ArrayElt Word32 where
  type ArrayPtrs Word32 = Ptr Word32
  unsafeIndexArrayData (AD_Word32 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Word32 ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_Word32 $ unsafeNewArray_ size (*# 4#)
  unsafeReadArrayData (AD_Word32 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Word32 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Word32 ba)    = liftM AD_Word32 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Word32 ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRword32

instance ArrayElt Word64 where
  type ArrayPtrs Word64 = Ptr Word64
  unsafeIndexArrayData (AD_Word64 ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Word64 ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_Word64 $ unsafeNewArray_ size (*# 8#)
  unsafeReadArrayData (AD_Word64 ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Word64 ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Word64 ba)    = liftM AD_Word64 $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Word64 ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRword64

instance ArrayElt CShort where
  type ArrayPtrs CShort = Ptr Int16
  unsafeIndexArrayData (AD_CShort ba) i   = CShort $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CShort ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CShort $ unsafeNewArray_ size (*# 2#)
  unsafeReadArrayData (AD_CShort ba) i    = CShort <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CShort ba) i (CShort e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CShort ba)    = liftM AD_CShort $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CShort ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRcshort

instance ArrayElt CUShort where
  type ArrayPtrs CUShort = Ptr Word16
  unsafeIndexArrayData (AD_CUShort ba) i   = CUShort $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CUShort ba)          = uArrayPtr ba
  newArrayData size                        = liftM AD_CUShort $ unsafeNewArray_ size (*# 2#)
  unsafeReadArrayData (AD_CUShort ba) i    = CUShort <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CUShort ba) i (CUShort e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CUShort ba)    = liftM AD_CUShort $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CUShort ba)   = sTUArrayPtr ba
  arrayElt                                 = ArrayEltRcushort

instance ArrayElt CInt where
  type ArrayPtrs CInt = Ptr Int32
  unsafeIndexArrayData (AD_CInt ba) i   = CInt $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CInt ba)          = uArrayPtr ba
  newArrayData size                     = liftM AD_CInt $ unsafeNewArray_ size (*# 4#)
  unsafeReadArrayData (AD_CInt ba) i    = CInt <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CInt ba) i (CInt e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CInt ba)    = liftM AD_CInt $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CInt ba)   = sTUArrayPtr ba
  arrayElt                              = ArrayEltRcint

instance ArrayElt CUInt where
  type ArrayPtrs CUInt = Ptr Word32
  unsafeIndexArrayData (AD_CUInt ba) i   = CUInt $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CUInt ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_CUInt $ unsafeNewArray_ size (*# 4#)
  unsafeReadArrayData (AD_CUInt ba) i    = CUInt <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CUInt ba) i (CUInt e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CUInt ba)    = liftM AD_CUInt $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CUInt ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRcuint

instance ArrayElt CLong where
  type ArrayPtrs CLong = Ptr HTYPE_LONG
  unsafeIndexArrayData (AD_CLong ba) i   = CLong $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CLong ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_CLong $ unsafeNewArray_ size wORD_SCALE
  unsafeReadArrayData (AD_CLong ba) i    = CLong <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CLong ba) i (CLong e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CLong ba)    = liftM AD_CLong $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CLong ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRclong

instance ArrayElt CULong where
  type ArrayPtrs CULong = Ptr HTYPE_UNSIGNED_LONG
  unsafeIndexArrayData (AD_CULong ba) i   = CULong $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CULong ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CULong $ unsafeNewArray_ size wORD_SCALE
  unsafeReadArrayData (AD_CULong ba) i    = CULong <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CULong ba) i (CULong e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CULong ba)    = liftM AD_CULong $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CULong ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRculong

instance ArrayElt CLLong where
  type ArrayPtrs CLLong = Ptr Int64
  unsafeIndexArrayData (AD_CLLong ba) i   = CLLong $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CLLong ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CLLong $ unsafeNewArray_ size (*# 8#)
  unsafeReadArrayData (AD_CLLong ba) i    = CLLong <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CLLong ba) i (CLLong e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CLLong ba)    = liftM AD_CLLong $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CLLong ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRcllong

instance ArrayElt CULLong where
  type ArrayPtrs CULLong = Ptr Word64
  unsafeIndexArrayData (AD_CULLong ba) i   = CULLong $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CULLong ba)          = uArrayPtr ba
  newArrayData size                        = liftM AD_CULLong $ unsafeNewArray_ size (*# 8#)
  unsafeReadArrayData (AD_CULLong ba) i    = CULLong <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CULLong ba) i (CULLong e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CULLong ba)    = liftM AD_CULLong $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CULLong ba)   = sTUArrayPtr ba
  arrayElt                                 = ArrayEltRcullong

instance ArrayElt Float where
  type ArrayPtrs Float = Ptr Float
  unsafeIndexArrayData (AD_Float ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Float ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_Float $ unsafeNewArray_ size fLOAT_SCALE
  unsafeReadArrayData (AD_Float ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Float ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Float ba)    = liftM AD_Float $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Float ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRfloat

instance ArrayElt Double where
  type ArrayPtrs Double = Ptr Double
  unsafeIndexArrayData (AD_Double ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Double ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_Double $ unsafeNewArray_ size dOUBLE_SCALE
  unsafeReadArrayData (AD_Double ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Double ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Double ba)    = liftM AD_Double $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Double ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRdouble

instance ArrayElt CFloat where
  type ArrayPtrs CFloat = Ptr Float
  unsafeIndexArrayData (AD_CFloat ba) i   = CFloat $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CFloat ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CFloat $ unsafeNewArray_ size fLOAT_SCALE
  unsafeReadArrayData (AD_CFloat ba) i    = CFloat <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CFloat ba) i (CFloat e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CFloat ba)    = liftM AD_CFloat $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CFloat ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRcfloat

instance ArrayElt CDouble where
  type ArrayPtrs CDouble = Ptr Double
  unsafeIndexArrayData (AD_CDouble ba) i   = CDouble $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CDouble ba)          = uArrayPtr ba
  newArrayData size                        = liftM AD_CDouble $ unsafeNewArray_ size dOUBLE_SCALE
  unsafeReadArrayData (AD_CDouble ba) i    = CDouble <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CDouble ba) i (CDouble e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CDouble ba)    = liftM AD_CDouble $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CDouble ba)   = sTUArrayPtr ba
  arrayElt                                 = ArrayEltRcdouble

-- Bool arrays are stored as arrays of bytes. While this is memory inefficient,
-- it is better suited to parallel backends than the native Unboxed Bool
-- array representation that uses packed bit vectors, as that would require
-- atomic operations when writing data necessarily serialising threads.
--
instance ArrayElt Bool where
  type ArrayPtrs Bool = Ptr Word8
  unsafeIndexArrayData (AD_Bool ba) i   = toBool (unsafeIndexArray ba i)
  ptrsOfArrayData (AD_Bool ba)          = uArrayPtr ba
  newArrayData size                     = liftM AD_Bool $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_Bool ba) i    = liftM toBool  $ unsafeReadArray ba i
  unsafeWriteArrayData (AD_Bool ba) i e = unsafeWriteArray ba i (fromBool e)
  unsafeFreezeArrayData (AD_Bool ba)    = liftM AD_Bool $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Bool ba)   = sTUArrayPtr ba
  arrayElt                              = ArrayEltRbool

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

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


-- Unboxed Char is stored as a wide character, which is 4-bytes
--
instance ArrayElt Char where
  type ArrayPtrs Char = Ptr Char
  unsafeIndexArrayData (AD_Char ba) i   = unsafeIndexArray ba i
  ptrsOfArrayData (AD_Char ba)          = uArrayPtr ba
  newArrayData size                     = liftM AD_Char $ unsafeNewArray_ size (*# 4#)
  unsafeReadArrayData (AD_Char ba) i    = unsafeReadArray ba i
  unsafeWriteArrayData (AD_Char ba) i e = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_Char ba)    = liftM AD_Char $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_Char ba)   = sTUArrayPtr ba
  arrayElt                              = ArrayEltRchar

instance ArrayElt CChar where
  type ArrayPtrs CChar = Ptr Int8
  unsafeIndexArrayData (AD_CChar ba) i   = CChar $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CChar ba)          = uArrayPtr ba
  newArrayData size                      = liftM AD_CChar $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_CChar ba) i    = CChar <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CChar ba) i (CChar e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CChar ba)    = liftM AD_CChar $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CChar ba)   = sTUArrayPtr ba
  arrayElt                               = ArrayEltRcchar

instance ArrayElt CSChar where
  type ArrayPtrs CSChar = Ptr Int8
  unsafeIndexArrayData (AD_CSChar ba) i   = CSChar $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CSChar ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CSChar $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_CSChar ba) i    = CSChar <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CSChar ba) i (CSChar e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CSChar ba)    = liftM AD_CSChar $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CSChar ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRcschar

instance ArrayElt CUChar where
  type ArrayPtrs CUChar = Ptr Word8
  unsafeIndexArrayData (AD_CUChar ba) i   = CUChar $ unsafeIndexArray ba i
  ptrsOfArrayData (AD_CUChar ba)          = uArrayPtr ba
  newArrayData size                       = liftM AD_CUChar $ unsafeNewArray_ size (\x -> x)
  unsafeReadArrayData (AD_CUChar ba) i    = CUChar <$> unsafeReadArray ba i
  unsafeWriteArrayData (AD_CUChar ba) i (CUChar e)
    = unsafeWriteArray ba i e
  unsafeFreezeArrayData (AD_CUChar ba)    = liftM AD_CUChar $ Unsafe.unsafeFreeze ba
  ptrsOfMutableArrayData (AD_CUChar ba)   = sTUArrayPtr ba
  arrayElt                                = ArrayEltRcuchar

instance (ArrayElt a, ArrayElt b) => ArrayElt (a, b) where
  type ArrayPtrs (a, b)                = (ArrayPtrs a, ArrayPtrs b)
  unsafeIndexArrayData (AD_Pair a b) i = (unsafeIndexArrayData a i, unsafeIndexArrayData b i)
  ptrsOfArrayData (AD_Pair a b)        = (ptrsOfArrayData a, ptrsOfArrayData b)
  newArrayData size
    = do
        a <- newArrayData size
        b <- newArrayData size
        return $ AD_Pair a b
  unsafeReadArrayData (AD_Pair a b) i
    = do
        x <- unsafeReadArrayData a i
        y <- unsafeReadArrayData b i
        return (x, y)
  unsafeWriteArrayData (AD_Pair a b) i (x, y)
    = do
        unsafeWriteArrayData a i x
        unsafeWriteArrayData b i y
  unsafeFreezeArrayData (AD_Pair a b)
    = do
        a' <- unsafeFreezeArrayData a
        b' <- unsafeFreezeArrayData b
        return $ AD_Pair a' b'
  ptrsOfMutableArrayData (AD_Pair a b)
    = do
        aptr <- ptrsOfMutableArrayData a
        bptr <- ptrsOfMutableArrayData b
        return (aptr, bptr)
  arrayElt = ArrayEltRpair arrayElt arrayElt

-- |Safe combination of creating and fast freezing of array data.
--
{-# INLINE runArrayData #-}
runArrayData :: ArrayElt e
             => (forall s. ST s (MutableArrayData s e, e)) -> (ArrayData e, e)
runArrayData st = runST $ do
                    (mad, r) <- st
                    ad       <- unsafeFreezeArrayData mad
                    return (ad, r)

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

fstArrayData :: ArrayData (a, b) -> ArrayData a
fstArrayData (AD_Pair x _) = x

sndArrayData :: ArrayData (a, b) -> ArrayData b
sndArrayData (AD_Pair _ y) = y

pairArrayData :: ArrayData a -> ArrayData b -> ArrayData (a, b)
pairArrayData = AD_Pair



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

-- Returns the element of an immutable array at the specified index.
--
-- This does no bounds checking unless you configured with -funsafe-checks. This
-- is usually OK, since the functions that convert from multidimensional to
-- linear indexing do bounds checking by default.
--
{-# INLINE unsafeIndexArray #-}
unsafeIndexArray :: IArray.IArray UArray e => UArray Int e -> Int -> e
#ifdef ACCELERATE_UNSAFE_CHECKS
unsafeIndexArray = IArray.!
#else
unsafeIndexArray = IArray.unsafeAt
#endif


-- Read an element from a mutable array.
--
-- This does no bounds checking unless you configured with -funsafe-checks. This
-- is usually OK, since the functions that convert from multidimensional to
-- linear indexing do bounds checking by default.
--
{-# INLINE unsafeReadArray #-}
unsafeReadArray :: MArray a e m => a Int e -> Int -> m e
#ifdef ACCELERATE_UNSAFE_CHECKS
unsafeReadArray = MArray.readArray
#else
unsafeReadArray = MArray.unsafeRead
#endif

-- Write an element into a mutable array.
--
-- This does no bounds checking unless you configured with -funsafe-checks. This
-- is usually OK, since the functions that convert from multidimensional to
-- linear indexing do bounds checking by default.
--
{-# INLINE unsafeWriteArray #-}
unsafeWriteArray :: MArray a e m => a Int e -> Int -> e -> m ()
#ifdef ACCELERATE_UNSAFE_CHECKS
unsafeWriteArray = MArray.writeArray
#else
unsafeWriteArray = MArray.unsafeWrite
#endif


-- Our own version of the 'STUArray' allocation that uses /pinned/ memory,
-- which is aligned to 16 bytes.
--
{-# INLINE unsafeNewArray_ #-}
unsafeNewArray_ :: Int -> (Int# -> Int#) -> ST s (STUArray s Int e)
unsafeNewArray_ n@(I# n#) elemsToBytes
 = ST $ \s1# ->
     case newPinnedByteArray# (elemsToBytes n#) s1# of
         (# s2#, marr# #) ->
             (# s2#, STUArray 0 (n - 1) n marr# #)

-- Obtains a pointer to the payload of an unboxed array.
--
-- PRECONDITION: The unboxed array must be pinned.
--
{-# INLINE uArrayPtr #-}
uArrayPtr :: UArray Int a -> Ptr a
uArrayPtr (UArray _ _ _ ba) = Ptr (byteArrayContents# ba)

-- Obtains a pointer to the payload of an unboxed ST array.
--
-- PRECONDITION: The unboxed ST array must be pinned.
--
{-# INLINE sTUArrayPtr #-}
sTUArrayPtr :: STUArray s Int a -> ST s (Ptr a)
sTUArrayPtr (STUArray _ _ _ mba) = ST $ \s ->
  case unsafeFreezeByteArray# mba s of
    (# s', ba #) -> (# s', Ptr (byteArrayContents# ba) #)