{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Array.Accelerate.IO.Repa (
A, Shapes,
fromRepa, toRepa,
computeAccS, computeAccP
) where
import Control.Monad
import qualified Data.Array.Repa as R
import qualified Data.Array.Repa.Eval as R
import qualified Data.Array.Accelerate.Array.Data as A
import qualified Data.Array.Accelerate.Array.Sugar as A
class (R.Shape r, A.Shape a) => Shapes r a | a -> r, r -> a where
toR :: a -> r
toA :: r -> a
instance Shapes R.Z A.Z where
{-# INLINE toR #-}
toR A.Z = R.Z
{-# INLINE toA #-}
toA R.Z = A.Z
instance Shapes sr sa => Shapes (sr R.:. Int) (sa A.:. Int) where
{-# INLINE toR #-}
toR (sa A.:. sz) = toR sa R.:. sz
{-# INLINE toA #-}
toA (sr R.:. sz) = toA sr A.:. sz
data A
instance A.Elt e => R.Source A e where
data Array A sh e
= AAccelerate !sh !(A.ArrayData (A.EltRepr e))
{-# INLINE extent #-}
extent (AAccelerate sh _)
= sh
{-# INLINE linearIndex #-}
linearIndex (AAccelerate sh adata) ix
| ix >= 0 && ix < R.size sh
= A.toElt (adata `A.unsafeIndexArrayData` ix)
| otherwise
= error "Repa: accelerate array out of bounds"
{-# INLINE unsafeLinearIndex #-}
unsafeLinearIndex (AAccelerate _ adata) ix
= A.toElt (adata `A.unsafeIndexArrayData` ix)
{-# INLINE deepSeqArray #-}
deepSeqArray (AAccelerate sh adata) x
= sh `R.deepSeq` adata `seq` x
instance A.Elt e => R.Target A e where
data MVec A e
= MAVec (A.MutableArrayData (A.EltRepr e))
{-# INLINE newMVec #-}
newMVec n
= MAVec `liftM` A.newArrayData n
{-# INLINE unsafeWriteMVec #-}
unsafeWriteMVec (MAVec mad) n e
= A.unsafeWriteArrayData mad n (A.fromElt e)
{-# INLINE unsafeFreezeMVec #-}
unsafeFreezeMVec sh (MAVec mad)
= do adata <- A.unsafeFreezeArrayData mad
return $! AAccelerate sh adata
{-# INLINE deepSeqMVec #-}
deepSeqMVec (MAVec arr) x
= arr `seq` x
{-# INLINE touchMVec #-}
touchMVec _
= return ()
toRepa
:: Shapes sh sh'
=> A.Array sh' e -> R.Array A sh e
{-# INLINE toRepa #-}
toRepa arr@(A.Array _ adata)
= AAccelerate (toR (A.shape arr)) adata
fromRepa
:: (Shapes sh sh', A.Elt e)
=> R.Array A sh e -> A.Array sh' e
{-# INLINE fromRepa #-}
fromRepa (AAccelerate sh adata)
= A.Array (A.fromElt (toA sh)) adata
computeAccS
:: (R.Load r sh e, A.Elt e)
=> R.Array r sh e -> R.Array A sh e
{-# INLINE computeAccS #-}
computeAccS = R.computeS
computeAccP
:: (R.Load r sh e, A.Elt e, Monad m)
=> R.Array r sh e
-> m (R.Array A sh e)
{-# INLINE computeAccP #-}
computeAccP = R.computeP