{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 ()
import Data.Array.Accelerate.LLVM.Native.Target
import Control.Monad.Trans
import Foreign.Ptr
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
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))
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)