{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native.Array.Data
-- Copyright   : [2014..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Native.Array.Data (

  module Data.Array.Accelerate.LLVM.Array.Data,
  cloneArray,

) where

import Data.Array.Accelerate.Array.Data
import Data.Array.Accelerate.Array.Unique
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Elt
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Type

import Data.Array.Accelerate.LLVM.State
import Data.Array.Accelerate.LLVM.Array.Data
import Data.Array.Accelerate.LLVM.Native.Execute.Async              ()  -- Async Native
import Data.Array.Accelerate.LLVM.Native.Target

import Control.Monad.Trans
import Foreign.Ptr


-- | Data instance for arrays in the native backend. We assume a shared-memory
-- machine, and just manipulate the underlying Haskell array directly.
--
instance Remote Native where
  {-# INLINE allocateRemote #-}
  allocateRemote :: ArrayR (Array sh e) -> sh -> Par Native (Array sh e)
allocateRemote ArrayR (Array sh e)
repr = IO (Array sh e) -> Par Native (Array sh e)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array sh e) -> Par Native (Array sh e))
-> (sh -> IO (Array sh e)) -> sh -> Par Native (Array sh e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArrayR (Array sh e) -> sh -> IO (Array sh e)
forall sh e. ArrayR (Array sh e) -> sh -> IO (Array sh e)
allocateArray ArrayR (Array sh e)
repr


-- | Copy an array into a newly allocated array. This uses 'memcpy'.
--
cloneArray :: ArrayR (Array sh e) -> Array sh e -> LLVM Native (Array sh e)
cloneArray :: ArrayR (Array sh e) -> Array sh e -> LLVM Native (Array sh e)
cloneArray ArrayR (Array sh e)
repr (Array sh
sh ArrayData e
src) = IO (Array sh e) -> LLVM Native (Array sh e)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array sh e) -> LLVM Native (Array sh e))
-> IO (Array sh e) -> LLVM Native (Array sh e)
forall a b. (a -> b) -> a -> b
$ do
  out :: Array sh e
out@(Array sh
_ ArrayData e
dst) <- ArrayR (Array sh e) -> sh -> IO (Array sh e)
forall sh e. ArrayR (Array sh e) -> sh -> IO (Array sh e)
allocateArray ArrayR (Array sh e)
repr sh
sh
  TypeR e -> ArrayData e -> ArrayData e -> IO ()
forall e. TypeR e -> ArrayData e -> ArrayData e -> IO ()
copyR (ArrayR (Array sh e) -> TypeR e
forall sh e. ArrayR (Array sh e) -> TypeR e
arrayRtype ArrayR (Array sh e)
repr) ArrayData e
src ArrayData e
dst
  Array sh e -> IO (Array sh e)
forall (m :: * -> *) a. Monad m => a -> m a
return Array sh e
out
  where
    n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size (ArrayR (Array sh e) -> ShapeR sh
forall sh e. ArrayR (Array sh e) -> ShapeR sh
arrayRshape ArrayR (Array sh e)
repr) sh
sh

    copyR :: TypeR e -> ArrayData e -> ArrayData e -> IO ()
    copyR :: TypeR e -> ArrayData e -> ArrayData e -> IO ()
copyR TypeR e
TupRunit          !ArrayData e
_          !ArrayData e
_          = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    copyR (TupRsingle ScalarType e
t)    !ArrayData e
ad1        !ArrayData e
ad2        = ScalarType e -> ArrayData e -> ArrayData e -> IO ()
forall e. ScalarType e -> ArrayData e -> ArrayData e -> IO ()
copyPrim ScalarType e
t ArrayData e
ad1 ArrayData e
ad2
    copyR (TupRpair !TupR ScalarType a1
t !TupR ScalarType b
t') (ad1, ad1') (ad2, ad2') = do
      TupR ScalarType a1 -> ArrayData a1 -> ArrayData a1 -> IO ()
forall e. TypeR e -> ArrayData e -> ArrayData e -> IO ()
copyR TupR ScalarType a1
t  ArrayData a1
ad1  ArrayData a1
ad2
      TupR ScalarType b -> ArrayData b -> ArrayData b -> IO ()
forall e. TypeR e -> ArrayData e -> ArrayData e -> IO ()
copyR TupR ScalarType b
t' ArrayData b
ad1' ArrayData b
ad2'

    copyPrim :: ScalarType e -> ArrayData e -> ArrayData e -> IO ()
    copyPrim :: ScalarType e -> ArrayData e -> ArrayData e -> IO ()
copyPrim !ScalarType e
tp !ArrayData e
a1 !ArrayData e
a2
      | ScalarArrayDict{} <- ScalarType e -> ScalarArrayDict e
forall a. ScalarType a -> ScalarArrayDict a
scalarArrayDict ScalarType e
tp = do
      let p1 :: Ptr (ScalarArrayDataR b)
p1 = UniqueArray (ScalarArrayDataR b) -> Ptr (ScalarArrayDataR b)
forall a. UniqueArray a -> Ptr a
unsafeUniqueArrayPtr ArrayData e
UniqueArray (ScalarArrayDataR b)
a1
          p2 :: Ptr (ScalarArrayDataR b)
p2 = UniqueArray (ScalarArrayDataR b) -> Ptr (ScalarArrayDataR b)
forall a. UniqueArray a -> Ptr a
unsafeUniqueArrayPtr ArrayData e
UniqueArray (ScalarArrayDataR b)
a2
      Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr (ScalarArrayDataR b) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (ScalarArrayDataR b)
p2) (Ptr (ScalarArrayDataR b) -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr (ScalarArrayDataR b)
p1) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* TypeR e -> Int
forall e. TypeR e -> Int
bytesElt (ScalarType e -> TypeR e
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ScalarType e
tp))


-- Standard C functions
-- --------------------

memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
p Ptr Word8
q Int
s = Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)
c_memcpy Ptr Word8
p Ptr Word8
q (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s) IO (Ptr Word8) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

foreign import ccall unsafe "string.h memcpy" c_memcpy
    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)