#include "fusion-phases.h"
module Data.Array.Parallel.Lifted.Closure
(
(:->)(..)
, ($:)
, PData(..)
, ($:^), liftedApply
, closure1, closure2, closure3, closure4, closure5
, closure1', closure2', closure3', closure4', closure5')
where
import Data.Array.Parallel.Pretty
import Data.Array.Parallel.PArray.PData.Base
import Data.Array.Parallel.PArray.PData.Unit
import Data.Array.Parallel.PArray.PData.Tuple2
import Data.Array.Parallel.PArray.PData.Tuple3
import Data.Array.Parallel.PArray.PData.Tuple4
import Data.Array.Parallel.PArray.PRepr
import qualified Data.Vector as V
import GHC.Exts
infixr 0 :->
infixl 1 $:, $:^
data (a :-> b)
= forall env. PA env
=> Clo (env -> a -> b)
(Int -> PData env -> PData a -> PData b)
env
($:) :: (a :-> b) -> a -> b
($:) (Clo fv _fl env) x = fv env x
data instance PData (a :-> b)
= forall env. PA env
=> AClo (env -> a -> b)
(Int -> PData env -> PData a -> PData b)
(PData env)
data instance PDatas (a :-> b)
= forall env. PA env
=> AClos (env -> a -> b)
(Int -> PData env -> PData a -> PData b)
(PDatas env)
($:^) :: PArray (a :-> b) -> PArray a -> PArray b
PArray n# (AClo _ f es) $:^ PArray _ as
= PArray n# (f (I# n#) es as)
liftedApply :: Int -> PData (a :-> b) -> PData a -> PData b
liftedApply n (AClo _ fl envs) as
= fl n envs as
closure1
:: (a -> b)
-> (Int -> PData a -> PData b)
-> (a :-> b)
closure1 fv fl
= Clo (\_env -> fv)
(\n _env -> fl n)
()
closure2
:: forall a b c. PA a
=> (a -> b -> c)
-> (Int -> PData a -> PData b -> PData c)
-> (a :-> b :-> c)
closure2 fv fl
= let fv_1 _ xa = Clo fv fl xa
fl_1 _ _ xs = AClo fv fl xs
in Clo fv_1 fl_1 ()
closure3
:: forall a b c d. (PA a, PA b)
=> (a -> b -> c -> d)
-> (Int -> PData a -> PData b -> PData c -> PData d)
-> (a :-> b :-> c :-> d)
closure3 fv fl
= let fv_1 _ xa = Clo fv_2 fl_2 xa
fl_1 _ _ xs = AClo fv_2 fl_2 xs
fv_2 xa yb = Clo fv_3 fl_3 (xa, yb)
fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys)
fv_3 (xa, yb) zc = fv xa yb zc
fl_3 n (PTuple2 xs ys) zs = fl n xs ys zs
in Clo fv_1 fl_1 ()
closure4
:: forall a b c d e. (PA a, PA b, PA c)
=> (a -> b -> c -> d -> e)
-> (Int -> PData a -> PData b -> PData c -> PData d -> PData e)
-> (a :-> b :-> c :-> d :-> e)
closure4 fv fl
= let fv_1 _ xa = Clo fv_2 fl_2 xa
fl_1 _ _ xs = AClo fv_2 fl_2 xs
fv_2 xa yb = Clo fv_3 fl_3 (xa, yb)
fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys)
fv_3 (xa, yb) zc = Clo fv_4 fl_4 (xa, yb, zc)
fl_3 _ (PTuple2 xs ys) zs = AClo fv_4 fl_4 (PTuple3 xs ys zs)
fv_4 (xa, yb, zc) ad = fv xa yb zc ad
fl_4 n (PTuple3 xs ys zs) as = fl n xs ys zs as
in Clo fv_1 fl_1 ()
closure5
:: forall a b c d e f. (PA a, PA b, PA c, PA d)
=> (a -> b -> c -> d -> e -> f)
-> (Int -> PData a -> PData b -> PData c -> PData d -> PData e -> PData f)
-> (a :-> b :-> c :-> d :-> e :-> f)
closure5 fv fl
= let fv_1 _ xa = Clo fv_2 fl_2 xa
fl_1 _ _ xs = AClo fv_2 fl_2 xs
fv_2 xa yb = Clo fv_3 fl_3 (xa, yb)
fl_2 _ xs ys = AClo fv_3 fl_3 (PTuple2 xs ys)
fv_3 (xa, yb) zc = Clo fv_4 fl_4 (xa, yb, zc)
fl_3 _ (PTuple2 xs ys) zs = AClo fv_4 fl_4 (PTuple3 xs ys zs)
fv_4 (xa, yb, zc) ad = Clo fv_5 fl_5 (xa, yb, zc, ad)
fl_4 _ (PTuple3 xs ys zs) as = AClo fv_5 fl_5 (PTuple4 xs ys zs as)
fv_5 (xa, yb, zc, ad) be = fv xa yb zc ad be
fl_5 n (PTuple4 xs ys zs as) bs = fl n xs ys zs as bs
in Clo fv_1 fl_1 ()
closure1'
:: forall a b
. (a -> b)
-> (PArray a -> PArray b)
-> (a :-> b)
closure1' fv fl
= let
fl' (I# n#) pdata
= case fl (PArray n# pdata) of
PArray _ pdata' -> pdata'
in closure1 fv fl'
closure2'
:: forall a b c. PA a
=> (a -> b -> c)
-> (PArray a -> PArray b -> PArray c)
-> (a :-> b :-> c)
closure2' fv fl
= let
fl' (I# n#) !pdata1 !pdata2
= case fl (PArray n# pdata1) (PArray n# pdata2) of
PArray _ pdata' -> pdata'
in closure2 fv fl'
closure3'
:: forall a b c d. (PA a, PA b)
=> (a -> b -> c -> d)
-> (PArray a -> PArray b -> PArray c -> PArray d)
-> (a :-> b :-> c :-> d)
closure3' fv fl
= let
fl' (I# n#) !pdata1 !pdata2 !pdata3
= case fl (PArray n# pdata1) (PArray n# pdata2) (PArray n# pdata3) of
PArray _ pdata' -> pdata'
in closure3 fv fl'
closure4'
:: forall a b c d e. (PA a, PA b, PA c)
=> (a -> b -> c -> d -> e)
-> (PArray a -> PArray b -> PArray c -> PArray d -> PArray e)
-> (a :-> b :-> c :-> d :-> e)
closure4' fv fl
= let
fl' (I# n#) !pdata1 !pdata2 !pdata3 !pdata4
= case fl (PArray n# pdata1) (PArray n# pdata2)
(PArray n# pdata3) (PArray n# pdata4) of
PArray _ pdata' -> pdata'
in closure4 fv fl'
closure5'
:: forall a b c d e f. (PA a, PA b, PA c, PA d)
=> (a -> b -> c -> d -> e -> f)
-> (PArray a -> PArray b -> PArray c -> PArray d -> PArray e -> PArray f)
-> (a :-> b :-> c :-> d :-> e :-> f)
closure5' fv fl
= let
fl' (I# n#) !pdata1 !pdata2 !pdata3 !pdata4 !pdata5
= case fl (PArray n# pdata1) (PArray n# pdata2)
(PArray n# pdata3) (PArray n# pdata4)
(PArray n# pdata5) of
PArray _ pdata' -> pdata'
in closure5 fv fl'
instance PR (a :-> b) where
validPR (AClo _ _ env)
= validPA env
nfPR (AClo fv fl envs)
= fv `seq` fl `seq` nfPA envs `seq` ()
similarPR _ _
= True
coversPR weak (AClo _ _ envs) ix
= coversPA weak envs ix
pprpPR (Clo _ _ env)
= vcat
[ text "Clo"
, pprpPA env ]
pprpDataPR (AClo _ _ envs)
= vcat
[ text "AClo"
, pprpDataPA envs ]
emptyPR
= let die = error "emptydPR[:->]: no function in empty closure array"
in AClo die die (emptyPA :: PData ())
replicatePR n (Clo fv fl envs)
= AClo fv fl (replicatePA n envs)
replicatesPR lens (AClo fv fl envs)
= AClo fv fl (replicatesPA lens envs)
lengthPR (AClo _ _ envs)
= lengthPA envs
indexPR (AClo fv fl envs) ix
= Clo fv fl $ indexPA envs ix
indexsPR (AClos fv fl envs) srcixs
= AClo fv fl $ indexsPA envs srcixs
extractPR (AClo fv fl envs) start len
= AClo fv fl $ extractPA envs start len
extractssPR (AClos fv fl envs) ssegd
= AClo fv fl $ extractssPA envs ssegd
extractvsPR (AClos fv fl envs) vsegd
= AClo fv fl $ extractvsPA envs vsegd
packByTagPR (AClo fv fl envs) tags tag
= AClo fv fl $ packByTagPA envs tags tag
toVectorPR (AClo fv fl envs)
= V.map (Clo fv fl) $ toVectorPA envs
emptydPR
= let die = error "emptydPR[:->]: no function in empty closure array"
in AClos die die (emptydPA :: PDatas ())
singletondPR (AClo fv fl env)
= AClos fv fl $ singletondPA env
lengthdPR (AClos _ _ env)
= lengthdPA env
indexdPR (AClos fv fl envs) ix
= AClo fv fl $ indexdPA envs ix
toVectordPR (AClos fv fl envs)
= V.map (AClo fv fl) $ toVectordPA envs
appendPR = dieHetroFunctions "appendPR"
appendsPR = dieHetroFunctions "appendsPR"
combine2PR = dieHetroFunctions "combine2PR"
fromVectorPR = dieHetroFunctions "fromVectorPR"
appenddPR = dieHetroFunctions "appenddPR"
fromVectordPR = dieHetroFunctions "fromVectordPR"
dieHetroFunctions :: String -> a
dieHetroFunctions name
= error $ unlines
[ "Data.Array.Parallel.Lifted.Closure." ++ name
, " Unsupported Array Operation"
, " It looks like you're trying to define an array containing multiple"
, " hetrogenous functions, or trying to select between multiple arrays"
, " of functions in vectorised code. Although we could support this by"
, " constructing a new function that selects between them depending on"
, " what the array index is, to make that anywhere near efficient is"
, " more work than we care to do right now, and we expect this use case"
, " to be uncommon. If you want this to work then contact the DPH team"
, " and ask what you can do to help." ]
type instance PRepr (a :-> b)
= a :-> b
instance (PA a, PA b) => PA (a :-> b) where
toPRepr = id
fromPRepr = id
toArrPRepr = id
fromArrPRepr = id
toArrPReprs = id
fromArrPReprs = id