{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Array.Accelerate.LLVM.AST (
DelayedOpenAcc(..),
PreOpenAccCommand(..),
PreOpenAccSkeleton(..),
UnzipIdx(..),
HasInitialValue,
) where
import Data.Array.Accelerate.LLVM.Execute.Async
import Data.Array.Accelerate.AST ( PreOpenAfun(..), HasArraysR(..), ArrayVar, ALeftHandSide, Exp, Direction, PrimBool, arrayR )
import Data.Array.Accelerate.AST.Idx
import Data.Array.Accelerate.AST.Var
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Type
data PreOpenAccCommand acc arch aenv a where
Avar :: ArrayVar aenv arrs
-> PreOpenAccCommand acc arch aenv arrs
Alet :: ALeftHandSide bnd aenv aenv'
-> acc arch aenv bnd
-> acc arch aenv' body
-> PreOpenAccCommand acc arch aenv body
Alloc :: ArrayR (Array sh e)
-> Exp aenv sh
-> PreOpenAccCommand acc arch aenv (Array sh e)
Use :: ArrayR (Array sh e)
-> Array sh e
-> PreOpenAccCommand acc arch aenv (Array sh e)
Unit :: TypeR e
-> Exp aenv e
-> PreOpenAccCommand acc arch aenv (Scalar e)
Apair :: acc arch aenv arrs1
-> acc arch aenv arrs2
-> PreOpenAccCommand acc arch aenv (arrs1, arrs2)
Anil :: PreOpenAccCommand acc arch aenv ()
Apply :: ArraysR bs
-> PreOpenAfun (acc arch) aenv (as -> bs)
-> acc arch aenv as
-> PreOpenAccCommand acc arch aenv bs
Aforeign :: ArraysR bs
-> String
-> (as -> Par arch (FutureR arch bs))
-> acc arch aenv as
-> PreOpenAccCommand acc arch aenv bs
Acond :: Exp aenv PrimBool
-> acc arch aenv arrs
-> acc arch aenv arrs
-> PreOpenAccCommand acc arch aenv arrs
Awhile :: PreOpenAfun (acc arch) aenv (arrs -> Scalar PrimBool)
-> PreOpenAfun (acc arch) aenv (arrs -> arrs)
-> acc arch aenv arrs
-> PreOpenAccCommand acc arch aenv arrs
Reshape :: ShapeR sh
-> Exp aenv sh
-> ArrayVar aenv (Array sh' e)
-> PreOpenAccCommand acc arch aenv (Array sh e)
Unzip :: UnzipIdx tup e
-> ArrayVar aenv (Array sh tup)
-> PreOpenAccCommand acc arch aenv (Array sh e)
data PreOpenAccSkeleton acc arch aenv a where
Map :: TypeR b
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
Generate :: ArrayR (Array sh e)
-> Exp aenv sh
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
Transform :: ArrayR (Array sh' b)
-> Exp aenv sh'
-> acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh' b)
Backpermute :: ShapeR sh'
-> Exp aenv sh'
-> acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
Fold :: HasInitialValue
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array sh e)
FoldSeg :: IntegralType i
-> HasInitialValue
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> DelayedOpenAcc acc arch aenv (Segments i)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
Scan :: Direction
-> HasInitialValue
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e)
Scan' :: Direction
-> DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> PreOpenAccSkeleton acc arch aenv (Array (sh, Int) e, Array sh e)
Permute :: acc arch aenv (Array sh' e)
-> DelayedOpenAcc acc arch aenv (Array sh e)
-> PreOpenAccSkeleton acc arch aenv (Array sh' e)
Stencil1 :: TypeR b
-> sh
-> DelayedOpenAcc acc arch aenv (Array sh a)
-> PreOpenAccSkeleton acc arch aenv (Array sh b)
Stencil2 :: TypeR c
-> sh
-> DelayedOpenAcc acc arch aenv (Array sh a)
-> DelayedOpenAcc acc arch aenv (Array sh b)
-> PreOpenAccSkeleton acc arch aenv (Array sh c)
data UnzipIdx a b where
UnzipId :: UnzipIdx a a
UnzipPrj :: PairIdx a b -> UnzipIdx b c -> UnzipIdx a c
UnzipUnit :: UnzipIdx a ()
UnzipPair :: UnzipIdx a b1 -> UnzipIdx a b2 -> UnzipIdx a (b1, b2)
type HasInitialValue = Bool
data DelayedOpenAcc acc arch aenv a where
Delayed :: ArrayR (Array sh e)
-> Exp aenv sh
-> DelayedOpenAcc acc arch aenv (Array sh e)
Manifest :: ArraysR (Array sh e)
-> acc arch aenv (Array sh e)
-> DelayedOpenAcc acc arch aenv (Array sh e)
instance HasArraysR (acc arch) => HasArraysR (PreOpenAccCommand acc arch) where
{-# INLINEABLE arraysR #-}
arraysR :: PreOpenAccCommand acc arch aenv a -> ArraysR a
arraysR (Avar (Var ArrayR a
repr Idx aenv a
_)) = ArrayR a -> ArraysR a
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR a
repr
arraysR (Alet ALeftHandSide bnd aenv aenv'
_ acc arch aenv bnd
_ acc arch aenv' a
a) = acc arch aenv' a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv' a
a
arraysR (Alloc ArrayR (Array sh e)
repr Exp aenv sh
_) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh e)
repr
arraysR (Use ArrayR (Array sh e)
repr Array sh e
_) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh e)
repr
arraysR (Unit TypeR e
tp Exp aenv e
_) = ArrayR (Array () e) -> TupR ArrayR (Array () e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array () e) -> TupR ArrayR (Array () e))
-> ArrayR (Array () e) -> TupR ArrayR (Array () e)
forall a b. (a -> b) -> a -> b
$ ShapeR () -> TypeR e -> ArrayR (Array () e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR ()
ShapeRz TypeR e
tp
arraysR (Apair acc arch aenv arrs1
a1 acc arch aenv arrs2
a2) = acc arch aenv arrs1 -> ArraysR arrs1
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv arrs1
a1 ArraysR arrs1 -> TupR ArrayR arrs2 -> TupR ArrayR (arrs1, arrs2)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` acc arch aenv arrs2 -> TupR ArrayR arrs2
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv arrs2
a2
arraysR PreOpenAccCommand acc arch aenv a
Anil = ArraysR a
forall (s :: * -> *). TupR s ()
TupRunit
arraysR (Apply ArraysR a
repr PreOpenAfun (acc arch) aenv (as -> a)
_ acc arch aenv as
_) = ArraysR a
repr
arraysR (Aforeign ArraysR a
repr String
_ as -> Par arch (FutureR arch a)
_ acc arch aenv as
_) = ArraysR a
repr
arraysR (Acond Exp aenv PrimBool
_ acc arch aenv a
a1 acc arch aenv a
_) = acc arch aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv a
a1
arraysR (Awhile PreOpenAfun (acc arch) aenv (a -> Scalar PrimBool)
_ PreOpenAfun (acc arch) aenv (a -> a)
_ acc arch aenv a
a) = acc arch aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv a
a
arraysR (Reshape ShapeR sh
shr Exp aenv sh
_ (Var (ArrayR ShapeR sh
_ TypeR e
tp) Idx aenv (Array sh' e)
_)) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh e) -> TupR ArrayR (Array sh e))
-> ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR e
tp
arraysR (Unzip UnzipIdx tup e
idx (Var (ArrayR ShapeR sh
shr TypeR e
tp) Idx aenv (Array sh tup)
_)) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh e) -> TupR ArrayR (Array sh e))
-> ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr (TypeR e -> ArrayR (Array sh e)) -> TypeR e -> ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ UnzipIdx tup e -> TypeR tup -> TypeR e
forall a b. UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx tup e
idx TypeR tup
TypeR e
tp
where
go :: UnzipIdx a b -> TypeR a -> TypeR b
go :: UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx a b
UnzipId TypeR a
t = TypeR a
TypeR b
t
go (UnzipPrj PairIdx a b
PairIdxLeft UnzipIdx b b
ix) (TupRpair TupR ScalarType a1
t TupR ScalarType b
_) = UnzipIdx b b -> TypeR b -> TypeR b
forall a b. UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx b b
ix TypeR b
TupR ScalarType a1
t
go (UnzipPrj PairIdx a b
PairIdxRight UnzipIdx b b
ix) (TupRpair TupR ScalarType a1
_ TupR ScalarType b
t) = UnzipIdx b b -> TypeR b -> TypeR b
forall a b. UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx b b
ix TypeR b
TupR ScalarType b
t
go UnzipIdx a b
UnzipUnit TypeR a
_ = TypeR b
forall (s :: * -> *). TupR s ()
TupRunit
go (UnzipPair UnzipIdx a b1
ix1 UnzipIdx a b2
ix2) TypeR a
t = UnzipIdx a b1 -> TypeR a -> TypeR b1
forall a b. UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx a b1
ix1 TypeR a
t TypeR b1 -> TupR ScalarType b2 -> TupR ScalarType (b1, b2)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` UnzipIdx a b2 -> TypeR a -> TupR ScalarType b2
forall a b. UnzipIdx a b -> TypeR a -> TypeR b
go UnzipIdx a b2
ix2 TypeR a
t
go UnzipIdx a b
_ TypeR a
_ = String -> TypeR b
forall a. HasCallStack => String -> a
error String
"Time enough for life to unfold all the precious things life has in store."
instance HasArraysR (acc arch) => HasArraysR (PreOpenAccSkeleton acc arch) where
{-# INLINEABLE arraysR #-}
arraysR :: PreOpenAccSkeleton acc arch aenv a -> ArraysR a
arraysR (Map TypeR b
tp acc arch aenv (Array sh a)
a) = let ArrayR ShapeR sh
shr TypeR e
_ = acc arch aenv (Array sh a) -> ArrayR (Array sh a)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc arch aenv (Array sh a)
a
in ArrayR (Array sh b) -> TupR ArrayR (Array sh b)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh b) -> TupR ArrayR (Array sh b))
-> ArrayR (Array sh b) -> TupR ArrayR (Array sh b)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR b -> ArrayR (Array sh b)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR b
tp
arraysR (Generate ArrayR (Array sh e)
repr Exp aenv sh
_) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh e)
repr
arraysR (Transform ArrayR (Array sh' b)
repr Exp aenv sh'
_ acc arch aenv (Array sh a)
_) = ArrayR (Array sh' b) -> TupR ArrayR (Array sh' b)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh' b)
repr
arraysR (Backpermute ShapeR sh'
shr Exp aenv sh'
_ acc arch aenv (Array sh e)
a) = ArrayR (Array sh' e) -> TupR ArrayR (Array sh' e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh' e) -> TupR ArrayR (Array sh' e))
-> ArrayR (Array sh' e) -> TupR ArrayR (Array sh' e)
forall a b. (a -> b) -> a -> b
$ ShapeR sh' -> TypeR e -> ArrayR (Array sh' e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh'
shr (TypeR e -> ArrayR (Array sh' e))
-> TypeR e -> ArrayR (Array sh' e)
forall a b. (a -> b) -> a -> b
$ ArrayR (Array sh e) -> TypeR e
forall sh e. ArrayR (Array sh e) -> TypeR e
arrayRtype (ArrayR (Array sh e) -> TypeR e) -> ArrayR (Array sh e) -> TypeR e
forall a b. (a -> b) -> a -> b
$ acc arch aenv (Array sh e) -> ArrayR (Array sh e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR acc arch aenv (Array sh e)
a
arraysR (Fold HasInitialValue
_ DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a) = let ArrayR (ShapeRsnoc ShapeR sh1
shr) TypeR e
tp = DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> ArrayR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
in ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh e) -> TupR ArrayR (Array sh e))
-> ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR e
tp
arraysR (FoldSeg IntegralType i
_ HasInitialValue
_ DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a DelayedOpenAcc acc arch aenv (Segments i)
_) = DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> ArraysR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
arraysR (Scan Direction
_ HasInitialValue
_ DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a) = DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> ArraysR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
arraysR (Scan' Direction
_ DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a) = let ArrayR (ShapeRsnoc ShapeR sh1
shr) TypeR e
tp = DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
-> ArrayR (Array (sh, Int) e)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR DelayedOpenAcc acc arch aenv (Array (sh, Int) e)
a
in ArrayR (Array (sh, Int) e) -> TupR ArrayR (Array (sh, Int) e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ShapeR (sh, Int) -> TypeR e -> ArrayR (Array (sh, Int) e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR (ShapeR sh -> ShapeR (sh, Int)
forall sh1. ShapeR sh1 -> ShapeR (sh1, Int)
ShapeRsnoc ShapeR sh
shr) TypeR e
tp) TupR ArrayR (Array (sh, Int) e)
-> TupR ArrayR (Array sh e)
-> TupR ArrayR (Array (sh, Int) e, Array sh e)
forall (s :: * -> *) a1 b. TupR s a1 -> TupR s b -> TupR s (a1, b)
`TupRpair` ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ShapeR sh -> TypeR e -> ArrayR (Array sh e)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR e
tp)
arraysR (Permute acc arch aenv (Array sh' e)
a DelayedOpenAcc acc arch aenv (Array sh e)
_) = acc arch aenv (Array sh' e) -> ArraysR (Array sh' e)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR acc arch aenv (Array sh' e)
a
arraysR (Stencil1 TypeR b
tp sh
_ DelayedOpenAcc acc arch aenv (Array sh a)
a) = let ArrayR ShapeR sh
shr TypeR e
_ = DelayedOpenAcc acc arch aenv (Array sh a) -> ArrayR (Array sh a)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR DelayedOpenAcc acc arch aenv (Array sh a)
a
in ArrayR (Array sh b) -> TupR ArrayR (Array sh b)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh b) -> TupR ArrayR (Array sh b))
-> ArrayR (Array sh b) -> TupR ArrayR (Array sh b)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR b -> ArrayR (Array sh b)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR b
tp
arraysR (Stencil2 TypeR c
tp sh
_ DelayedOpenAcc acc arch aenv (Array sh a)
a DelayedOpenAcc acc arch aenv (Array sh b)
_) = let ArrayR ShapeR sh
shr TypeR e
_ = DelayedOpenAcc acc arch aenv (Array sh a) -> ArrayR (Array sh a)
forall (f :: * -> * -> *) aenv sh e.
HasArraysR f =>
f aenv (Array sh e) -> ArrayR (Array sh e)
arrayR DelayedOpenAcc acc arch aenv (Array sh a)
a
in ArrayR (Array sh c) -> TupR ArrayR (Array sh c)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle (ArrayR (Array sh c) -> TupR ArrayR (Array sh c))
-> ArrayR (Array sh c) -> TupR ArrayR (Array sh c)
forall a b. (a -> b) -> a -> b
$ ShapeR sh -> TypeR c -> ArrayR (Array sh c)
forall sh e. ShapeR sh -> TypeR e -> ArrayR (Array sh e)
ArrayR ShapeR sh
shr TypeR c
tp
instance HasArraysR (acc arch) => HasArraysR (DelayedOpenAcc acc arch) where
{-# INLINEABLE arraysR #-}
arraysR :: DelayedOpenAcc acc arch aenv a -> ArraysR a
arraysR (Delayed ArrayR (Array sh e)
repr Exp aenv sh
_) = ArrayR (Array sh e) -> TupR ArrayR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh e)
repr
arraysR (Manifest ArraysR (Array sh e)
repr acc arch aenv (Array sh e)
_) = ArraysR a
ArraysR (Array sh e)
repr