module Data.Array.Parallel.Lifted.Closure (
(:->)(..), PArray(..),
mkClosure, mkClosureP, ($:), ($:^),
closure, liftedClosure, liftedApply,
closure1, closure2, closure3, closure4
) where
import Data.Array.Parallel.PArray.PReprInstances ()
import Data.Array.Parallel.PArray.PDataInstances
import Data.Array.Parallel.Lifted.PArray
import GHC.Exts (Int#)
infixr 0 :->
infixl 0 $:, $:^
data a :-> b
= forall e. PA e
=> Clo !(e -> a -> b)
!(Int# -> PData e -> PData a -> PData b)
e
lifted :: (PArray e -> PArray a -> PArray b)
-> Int#
-> PData e
-> PData a
-> PData b
lifted f n# es as
= case f (PArray n# es) (PArray n# as) of
PArray _ bs -> bs
mkClosure
:: forall a b e
. PA e
=> (e -> a -> b)
-> (PArray e -> PArray a -> PArray b)
-> e
-> (a :-> b)
mkClosure fv fl e
= Clo fv (lifted fl) e
closure :: forall a b e
. PA e
=> (e -> a -> b)
-> (Int# -> PData e -> PData a -> PData b)
-> e
-> (a :-> b)
closure fv fl e = Clo fv fl e
($:) :: forall a b. (a :-> b) -> a -> b
Clo f _ e $: a = f e a
data instance PData (a :-> b)
= forall e. PA e
=> AClo !(e -> a -> b)
!(Int# -> PData e -> PData a -> PData b)
(PData e)
mkClosureP :: forall a b e.
PA e => (e -> a -> b)
-> (PArray e -> PArray a -> PArray b)
-> PArray e -> PArray (a :-> b)
mkClosureP fv fl (PArray n# es)
= PArray n# (AClo fv (lifted fl) es)
liftedClosure :: forall a b e.
PA e => (e -> a -> b)
-> (Int# -> PData e -> PData a -> PData b)
-> PData e
-> PData (a :-> b)
liftedClosure fv fl es = AClo fv fl es
($:^) :: forall a b. PArray (a :-> b) -> PArray a -> PArray b
PArray n# (AClo _ f es) $:^ PArray _ as
= PArray n# (f n# es as)
liftedApply :: forall a b. Int# -> PData (a :-> b) -> PData a -> PData b
liftedApply n# (AClo _ f es) as
= f n# es as
type instance PRepr (a :-> b) = a :-> b
instance (PA a, PA b) => PA (a :-> b) where
toPRepr = id
fromPRepr = id
toArrPRepr = id
fromArrPRepr = id
instance PR (a :-> b) where
emptyPR = AClo (\_ _ -> error "empty array closure")
(\_ _ -> error "empty array closure")
(emptyPD :: PData ())
replicatePR n# (Clo f f' e)
= AClo f f' (replicatePD n# e)
replicatelPR segd (AClo f f' es)
= AClo f f' (replicatelPD segd es)
indexPR (AClo f f' es) i#
= Clo f f' (indexPD es i#)
bpermutePR (AClo f f' es) n# is
= AClo f f' (bpermutePD es n# is)
packByTagPR (AClo f f' es) n# tags t#
= AClo f f' (packByTagPD es n# tags t#)
closure1 :: (a -> b) -> (PArray a -> PArray b) -> (a :-> b)
closure1 fv fl = mkClosure (\_ -> fv) (\_ -> fl) ()
closure2 :: PA a
=> (a -> b -> c)
-> (PArray a -> PArray b -> PArray c)
-> (a :-> b :-> c)
closure2 fv fl = mkClosure fv_1 fl_1 ()
where
fv_1 _ x = mkClosure fv fl x
fl_1 _ xs = mkClosureP fv fl xs
closure3 :: (PA a, PA b)
=> (a -> b -> c -> d)
-> (PArray a -> PArray b -> PArray c -> PArray d)
-> (a :-> b :-> c :-> d)
closure3 fv fl = mkClosure fv_1 fl_1 ()
where
fv_1 _ x = mkClosure fv_2 fl_2 x
fl_1 _ xs = mkClosureP fv_2 fl_2 xs
fv_2 x y = mkClosure fv_3 fl_3 (x,y)
fl_2 xs ys = mkClosureP fv_3 fl_3 (zipPA# xs ys)
fv_3 (x,y) z = fv x y z
fl_3 ps zs = case unzipPA# ps of (xs,ys) -> fl xs ys zs
closure4 :: (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 = mkClosure fv_1 fl_1 ()
where
fv_1 _ x = mkClosure fv_2 fl_2 x
fl_1 _ xs = mkClosureP fv_2 fl_2 xs
fv_2 x y = mkClosure fv_3 fl_3 (x, y)
fl_2 xs ys = mkClosureP fv_3 fl_3 (zipPA# xs ys)
fv_3 (x, y) z = mkClosure fv_4 fl_4 (x, y, z)
fl_3 xys zs = case unzipPA# xys of (xs, ys) -> mkClosureP fv_4 fl_4 (zip3PA# xs ys zs)
fv_4 (x, y, z) v = fv x y z v
fl_4 ps vs = case unzip3PA# ps of (xs, ys, zs) -> fl xs ys zs vs