{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Array.Accelerate.Trafo.Delayed
where
import Data.Array.Accelerate.AST
import Data.Array.Accelerate.Analysis.Hash
import Data.Array.Accelerate.Analysis.Match
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Trafo.Substitution
import Data.Array.Accelerate.Debug.Stats as Stats
import Control.DeepSeq
import Data.ByteString.Builder
import Data.ByteString.Builder.Extra
type DelayedAcc = DelayedOpenAcc ()
type DelayedAfun = PreOpenAfun DelayedOpenAcc ()
type DelayedOpenAfun = PreOpenAfun DelayedOpenAcc
data DelayedOpenAcc aenv a where
Manifest :: PreOpenAcc DelayedOpenAcc aenv a
-> DelayedOpenAcc aenv a
Delayed ::
{ DelayedOpenAcc aenv (Array sh e) -> ArrayR (Array sh e)
reprD :: ArrayR (Array sh e)
, DelayedOpenAcc aenv (Array sh e) -> Exp aenv sh
extentD :: Exp aenv sh
, DelayedOpenAcc aenv (Array sh e) -> Fun aenv (sh -> e)
indexD :: Fun aenv (sh -> e)
, DelayedOpenAcc aenv (Array sh e) -> Fun aenv (Int -> e)
linearIndexD :: Fun aenv (Int -> e)
} -> DelayedOpenAcc aenv (Array sh e)
instance HasArraysR DelayedOpenAcc where
arraysR :: DelayedOpenAcc aenv a -> ArraysR a
arraysR (Manifest PreOpenAcc DelayedOpenAcc aenv a
a) = PreOpenAcc DelayedOpenAcc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR PreOpenAcc DelayedOpenAcc aenv a
a
arraysR Delayed{ArrayR (Array sh e)
Exp aenv sh
Fun aenv (sh -> e)
Fun aenv (Int -> e)
linearIndexD :: Fun aenv (Int -> e)
indexD :: Fun aenv (sh -> e)
extentD :: Exp aenv sh
reprD :: ArrayR (Array sh e)
linearIndexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (Int -> e)
indexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (sh -> e)
extentD :: forall aenv sh e. DelayedOpenAcc aenv (Array sh e) -> Exp aenv sh
reprD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> ArrayR (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)
reprD
instance Rebuildable DelayedOpenAcc where
type AccClo DelayedOpenAcc = DelayedOpenAcc
rebuildPartial :: (forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e)))
-> DelayedOpenAcc aenv a -> f' (DelayedOpenAcc aenv' a)
rebuildPartial forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e))
v = \case
Manifest PreOpenAcc DelayedOpenAcc aenv a
pacc -> PreOpenAcc DelayedOpenAcc aenv' a -> DelayedOpenAcc aenv' a
forall aenv a.
PreOpenAcc DelayedOpenAcc aenv a -> DelayedOpenAcc aenv a
Manifest (PreOpenAcc DelayedOpenAcc aenv' a -> DelayedOpenAcc aenv' a)
-> f' (PreOpenAcc DelayedOpenAcc aenv' a)
-> f' (DelayedOpenAcc aenv' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo (PreOpenAcc DelayedOpenAcc)) aenv' (Array sh e)))
-> PreOpenAcc DelayedOpenAcc aenv a
-> f' (PreOpenAcc DelayedOpenAcc aenv' a)
forall (f :: * -> * -> *) (f' :: * -> *)
(fa :: (* -> * -> *) -> * -> * -> *) aenv aenv' a.
(Rebuildable f, Applicative f', SyntacticAcc fa) =>
(forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo f) aenv' (Array sh e)))
-> f aenv a -> f' (f aenv' a)
rebuildPartial forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo (PreOpenAcc DelayedOpenAcc)) aenv' (Array sh e))
forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e))
v PreOpenAcc DelayedOpenAcc aenv a
pacc
Delayed{ArrayR (Array sh e)
Exp aenv sh
Fun aenv (sh -> e)
Fun aenv (Int -> e)
linearIndexD :: Fun aenv (Int -> e)
indexD :: Fun aenv (sh -> e)
extentD :: Exp aenv sh
reprD :: ArrayR (Array sh e)
linearIndexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (Int -> e)
indexD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> Fun aenv (sh -> e)
extentD :: forall aenv sh e. DelayedOpenAcc aenv (Array sh e) -> Exp aenv sh
reprD :: forall aenv sh e.
DelayedOpenAcc aenv (Array sh e) -> ArrayR (Array sh e)
..} -> (\OpenAccExp DelayedOpenAcc () aenv' sh
e OpenAccFun DelayedOpenAcc () aenv' (sh -> e)
i OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
l -> ArrayR (Array sh e)
-> Exp aenv' sh
-> Fun aenv' (sh -> e)
-> Fun aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e)
forall sh e aenv.
ArrayR (Array sh e)
-> Exp aenv sh
-> Fun aenv (sh -> e)
-> Fun aenv (Int -> e)
-> DelayedOpenAcc aenv (Array sh e)
Delayed ArrayR (Array sh e)
reprD (OpenAccExp DelayedOpenAcc () aenv' sh -> Exp aenv' sh
forall (acc :: * -> * -> *) env aenv a.
OpenAccExp acc env aenv a -> OpenExp env aenv a
unOpenAccExp OpenAccExp DelayedOpenAcc () aenv' sh
e) (OpenAccFun DelayedOpenAcc () aenv' (sh -> e) -> Fun aenv' (sh -> e)
forall (acc :: * -> * -> *) env aenv a.
OpenAccFun acc env aenv a -> OpenFun env aenv a
unOpenAccFun OpenAccFun DelayedOpenAcc () aenv' (sh -> e)
i) (OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> Fun aenv' (Int -> e)
forall (acc :: * -> * -> *) env aenv a.
OpenAccFun acc env aenv a -> OpenFun env aenv a
unOpenAccFun OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
l))
(OpenAccExp DelayedOpenAcc () aenv' sh
-> OpenAccFun DelayedOpenAcc () aenv' (sh -> e)
-> OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e))
-> f' (OpenAccExp DelayedOpenAcc () aenv' sh)
-> f'
(OpenAccFun DelayedOpenAcc () aenv' (sh -> e)
-> OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccExp DelayedOpenAcc ())) aenv' (Array sh e)))
-> OpenAccExp DelayedOpenAcc () aenv sh
-> f' (OpenAccExp DelayedOpenAcc () aenv' sh)
forall (f :: * -> * -> *) (f' :: * -> *)
(fa :: (* -> * -> *) -> * -> * -> *) aenv aenv' a.
(Rebuildable f, Applicative f', SyntacticAcc fa) =>
(forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo f) aenv' (Array sh e)))
-> f aenv a -> f' (f aenv' a)
rebuildPartial forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccExp DelayedOpenAcc ())) aenv' (Array sh e))
forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e))
v (Exp aenv sh -> OpenAccExp DelayedOpenAcc () aenv sh
forall env aenv a (acc :: * -> * -> *).
OpenExp env aenv a -> OpenAccExp acc env aenv a
OpenAccExp Exp aenv sh
extentD)
f'
(OpenAccFun DelayedOpenAcc () aenv' (sh -> e)
-> OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e))
-> f' (OpenAccFun DelayedOpenAcc () aenv' (sh -> e))
-> f'
(OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccFun DelayedOpenAcc ())) aenv' (Array sh e)))
-> OpenAccFun DelayedOpenAcc () aenv (sh -> e)
-> f' (OpenAccFun DelayedOpenAcc () aenv' (sh -> e))
forall (f :: * -> * -> *) (f' :: * -> *)
(fa :: (* -> * -> *) -> * -> * -> *) aenv aenv' a.
(Rebuildable f, Applicative f', SyntacticAcc fa) =>
(forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo f) aenv' (Array sh e)))
-> f aenv a -> f' (f aenv' a)
rebuildPartial forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccFun DelayedOpenAcc ())) aenv' (Array sh e))
forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e))
v (Fun aenv (sh -> e) -> OpenAccFun DelayedOpenAcc () aenv (sh -> e)
forall env aenv a (acc :: * -> * -> *).
OpenFun env aenv a -> OpenAccFun acc env aenv a
OpenAccFun Fun aenv (sh -> e)
indexD)
f'
(OpenAccFun DelayedOpenAcc () aenv' (Int -> e)
-> DelayedOpenAcc aenv' (Array sh e))
-> f' (OpenAccFun DelayedOpenAcc () aenv' (Int -> e))
-> f' (DelayedOpenAcc aenv' (Array sh e))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccFun DelayedOpenAcc ())) aenv' (Array sh e)))
-> OpenAccFun DelayedOpenAcc () aenv (Int -> e)
-> f' (OpenAccFun DelayedOpenAcc () aenv' (Int -> e))
forall (f :: * -> * -> *) (f' :: * -> *)
(fa :: (* -> * -> *) -> * -> * -> *) aenv aenv' a.
(Rebuildable f, Applicative f', SyntacticAcc fa) =>
(forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo f) aenv' (Array sh e)))
-> f aenv a -> f' (f aenv' a)
rebuildPartial forall sh e.
ArrayVar aenv (Array sh e)
-> f'
(fa (AccClo (OpenAccFun DelayedOpenAcc ())) aenv' (Array sh e))
forall sh e.
ArrayVar aenv (Array sh e)
-> f' (fa (AccClo DelayedOpenAcc) aenv' (Array sh e))
v (Fun aenv (Int -> e) -> OpenAccFun DelayedOpenAcc () aenv (Int -> e)
forall env aenv a (acc :: * -> * -> *).
OpenFun env aenv a -> OpenAccFun acc env aenv a
OpenAccFun Fun aenv (Int -> e)
linearIndexD)
instance Sink DelayedOpenAcc where
weaken :: (env :> env') -> DelayedOpenAcc env t -> DelayedOpenAcc env' t
weaken env :> env'
k = Text -> DelayedOpenAcc env' t -> DelayedOpenAcc env' t
forall a. Text -> a -> a
Stats.substitution Text
"weaken" (DelayedOpenAcc env' t -> DelayedOpenAcc env' t)
-> (DelayedOpenAcc env t -> DelayedOpenAcc env' t)
-> DelayedOpenAcc env t
-> DelayedOpenAcc env' t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall sh e.
ArrayVar env (Array sh e)
-> PreOpenAcc (AccClo DelayedOpenAcc) env' (Array sh e))
-> DelayedOpenAcc env t -> DelayedOpenAcc env' t
forall (f :: * -> * -> *) (fa :: (* -> * -> *) -> * -> * -> *) aenv
aenv' a.
(Rebuildable f, SyntacticAcc fa) =>
(forall sh e.
ArrayVar aenv (Array sh e) -> fa (AccClo f) aenv' (Array sh e))
-> f aenv a -> f aenv' a
rebuildA ((env :> env')
-> Var ArrayR env (Array sh e)
-> PreOpenAcc DelayedOpenAcc env' (Array sh e)
forall env env' sh e (acc :: * -> * -> *).
(env :> env')
-> ArrayVar env (Array sh e) -> PreOpenAcc acc env' (Array sh e)
rebuildWeakenVar env :> env'
k)
instance NFData (DelayedOpenAfun aenv t) where
rnf :: DelayedOpenAfun aenv t -> ()
rnf = NFDataAcc DelayedOpenAcc -> DelayedOpenAfun aenv t -> ()
forall (acc :: * -> * -> *) aenv t.
NFDataAcc acc -> PreOpenAfun acc aenv t -> ()
rnfPreOpenAfun NFDataAcc DelayedOpenAcc
rnfDelayedOpenAcc
instance NFData (DelayedOpenAcc aenv t) where
rnf :: DelayedOpenAcc aenv t -> ()
rnf = DelayedOpenAcc aenv t -> ()
NFDataAcc DelayedOpenAcc
rnfDelayedOpenAcc
encodeDelayedOpenAcc :: EncodeAcc DelayedOpenAcc
encodeDelayedOpenAcc :: HashOptions -> DelayedOpenAcc aenv a -> Builder
encodeDelayedOpenAcc HashOptions
options DelayedOpenAcc aenv a
acc =
let
travE :: Exp aenv sh -> Builder
travE :: Exp aenv sh -> Builder
travE = Exp aenv sh -> Builder
forall env aenv exp. OpenExp env aenv exp -> Builder
encodeOpenExp
travF :: Fun aenv f -> Builder
travF :: Fun aenv f -> Builder
travF = Fun aenv f -> Builder
forall env aenv f. OpenFun env aenv f -> Builder
encodeOpenFun
travA :: PreOpenAcc DelayedOpenAcc aenv a -> Builder
travA :: PreOpenAcc DelayedOpenAcc aenv a -> Builder
travA = HashOptions
-> EncodeAcc DelayedOpenAcc
-> PreOpenAcc DelayedOpenAcc aenv a
-> Builder
forall (acc :: * -> * -> *) aenv arrs.
HasArraysR acc =>
HashOptions -> EncodeAcc acc -> PreOpenAcc acc aenv arrs -> Builder
encodePreOpenAcc HashOptions
options EncodeAcc DelayedOpenAcc
encodeDelayedOpenAcc
deepA :: PreOpenAcc DelayedOpenAcc aenv a -> Builder
deepA :: PreOpenAcc DelayedOpenAcc aenv a -> Builder
deepA | HashOptions -> Bool
perfect HashOptions
options = PreOpenAcc DelayedOpenAcc aenv a -> Builder
forall aenv a. PreOpenAcc DelayedOpenAcc aenv a -> Builder
travA
| Bool
otherwise = ArraysR a -> Builder
forall arrs. ArraysR arrs -> Builder
encodeArraysType (ArraysR a -> Builder)
-> (PreOpenAcc DelayedOpenAcc aenv a -> ArraysR a)
-> PreOpenAcc DelayedOpenAcc aenv a
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PreOpenAcc DelayedOpenAcc aenv a -> ArraysR a
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR
in
case DelayedOpenAcc aenv a
acc of
Manifest PreOpenAcc DelayedOpenAcc aenv a
pacc -> Int -> Builder
intHost $(hashQ ("Manifest" :: String)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> PreOpenAcc DelayedOpenAcc aenv a -> Builder
forall aenv a. PreOpenAcc DelayedOpenAcc aenv a -> Builder
deepA PreOpenAcc DelayedOpenAcc aenv a
pacc
Delayed ArrayR (Array sh e)
_ Exp aenv sh
sh Fun aenv (sh -> e)
f Fun aenv (Int -> e)
g -> Int -> Builder
intHost $(hashQ ("Delayed" :: String)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Exp aenv sh -> Builder
forall aenv sh. Exp aenv sh -> Builder
travE Exp aenv sh
sh Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (sh -> e) -> Builder
forall aenv f. Fun aenv f -> Builder
travF Fun aenv (sh -> e)
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Fun aenv (Int -> e) -> Builder
forall aenv f. Fun aenv f -> Builder
travF Fun aenv (Int -> e)
g
matchDelayedOpenAcc :: MatchAcc DelayedOpenAcc
matchDelayedOpenAcc :: DelayedOpenAcc aenv s -> DelayedOpenAcc aenv t -> Maybe (s :~: t)
matchDelayedOpenAcc (Manifest PreOpenAcc DelayedOpenAcc aenv s
pacc1) (Manifest PreOpenAcc DelayedOpenAcc aenv t
pacc2)
= MatchAcc DelayedOpenAcc
-> PreOpenAcc DelayedOpenAcc aenv s
-> PreOpenAcc DelayedOpenAcc aenv t
-> Maybe (s :~: t)
forall (acc :: * -> * -> *) aenv s t.
HasArraysR acc =>
MatchAcc acc
-> PreOpenAcc acc aenv s
-> PreOpenAcc acc aenv t
-> Maybe (s :~: t)
matchPreOpenAcc MatchAcc DelayedOpenAcc
matchDelayedOpenAcc PreOpenAcc DelayedOpenAcc aenv s
pacc1 PreOpenAcc DelayedOpenAcc aenv t
pacc2
matchDelayedOpenAcc (Delayed ArrayR (Array sh e)
_ Exp aenv sh
sh1 Fun aenv (sh -> e)
ix1 Fun aenv (Int -> e)
lx1) (Delayed ArrayR (Array sh e)
_ Exp aenv sh
sh2 Fun aenv (sh -> e)
ix2 Fun aenv (Int -> e)
lx2)
| Just sh :~: sh
Refl <- Exp aenv sh -> Exp aenv sh -> Maybe (sh :~: sh)
forall env aenv s t.
OpenExp env aenv s -> OpenExp env aenv t -> Maybe (s :~: t)
matchOpenExp Exp aenv sh
sh1 Exp aenv sh
sh2
, Just (sh -> e) :~: (sh -> e)
Refl <- Fun aenv (sh -> e)
-> Fun aenv (sh -> e) -> Maybe ((sh -> e) :~: (sh -> e))
forall env aenv s t.
OpenFun env aenv s -> OpenFun env aenv t -> Maybe (s :~: t)
matchOpenFun Fun aenv (sh -> e)
ix1 Fun aenv (sh -> e)
ix2
, Just (Int -> e) :~: (Int -> e)
Refl <- Fun aenv (Int -> e)
-> Fun aenv (Int -> e) -> Maybe ((Int -> e) :~: (Int -> e))
forall env aenv s t.
OpenFun env aenv s -> OpenFun env aenv t -> Maybe (s :~: t)
matchOpenFun Fun aenv (Int -> e)
lx1 Fun aenv (Int -> e)
lx2
= (s :~: s) -> Maybe (s :~: s)
forall a. a -> Maybe a
Just s :~: s
forall k (a :: k). a :~: a
Refl
matchDelayedOpenAcc DelayedOpenAcc aenv s
_ DelayedOpenAcc aenv t
_
= Maybe (s :~: t)
forall a. Maybe a
Nothing
rnfDelayedOpenAcc :: NFDataAcc DelayedOpenAcc
rnfDelayedOpenAcc :: DelayedOpenAcc aenv t -> ()
rnfDelayedOpenAcc (Manifest PreOpenAcc DelayedOpenAcc aenv t
pacc) =
NFDataAcc DelayedOpenAcc -> PreOpenAcc DelayedOpenAcc aenv t -> ()
forall (acc :: * -> * -> *) aenv t.
HasArraysR acc =>
NFDataAcc acc -> PreOpenAcc acc aenv t -> ()
rnfPreOpenAcc NFDataAcc DelayedOpenAcc
rnfDelayedOpenAcc PreOpenAcc DelayedOpenAcc aenv t
pacc
rnfDelayedOpenAcc (Delayed ArrayR (Array sh e)
aR Exp aenv sh
sh Fun aenv (sh -> e)
ix Fun aenv (Int -> e)
lx) =
ArrayR (Array sh e) -> ()
forall arr. ArrayR arr -> ()
rnfArrayR ArrayR (Array sh e)
aR () -> () -> ()
`seq` Exp aenv sh -> ()
forall env aenv t. OpenExp env aenv t -> ()
rnfOpenExp Exp aenv sh
sh () -> () -> ()
`seq` Fun aenv (sh -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun Fun aenv (sh -> e)
ix () -> () -> ()
`seq` Fun aenv (Int -> e) -> ()
forall env aenv t. OpenFun env aenv t -> ()
rnfOpenFun Fun aenv (Int -> e)
lx
liftDelayedOpenAcc :: LiftAcc DelayedOpenAcc
liftDelayedOpenAcc :: DelayedOpenAcc aenv a -> Q (TExp (DelayedOpenAcc aenv a))
liftDelayedOpenAcc (Manifest PreOpenAcc DelayedOpenAcc aenv a
pacc) =
[|| Manifest $$(liftPreOpenAcc liftDelayedOpenAcc pacc) ||]
liftDelayedOpenAcc (Delayed ArrayR (Array sh e)
aR Exp aenv sh
sh Fun aenv (sh -> e)
ix Fun aenv (Int -> e)
lx) =
[|| Delayed $$(liftArrayR aR) $$(liftOpenExp sh) $$(liftOpenFun ix) $$(liftOpenFun lx) ||]