{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE MagicHash            #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Array.Data
-- Copyright   : [2014..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--

module Data.Array.Accelerate.LLVM.Array.Data (

  Remote(..),
  newRemote, newRemoteAsync,
  useRemote,
  copyToRemote,
  copyToHost,
  copyToPeer,
  indexRemote,

  runIndexArray, runIndexArrayAsync,
  runArray, runArrayAsync,
  runArrays, runArraysAsync,

) where

import Data.Array.Accelerate.Array.Data
import Data.Array.Accelerate.Representation.Array
import Data.Array.Accelerate.Representation.Shape
import Data.Array.Accelerate.Representation.Type
import Data.Array.Accelerate.Type

import Data.Array.Accelerate.LLVM.Execute.Async

import Control.Monad                                                ( liftM, liftM2 )
import Prelude


class Async arch => Remote arch where

  -- | Allocate a new uninitialised array on the remote device.
  --
  allocateRemote :: ArrayR (Array sh e) -> sh -> Par arch (Array sh e)

  -- | Use the given immutable array on the remote device. Since the source
  -- array is immutable, the garbage collector can evict and re-upload the data
  -- as necessary without copy-back.
  --
  {-# INLINE useRemoteR #-}
  useRemoteR
      :: SingleType e
      -> Int                      -- ^ number of elements to copy
      -> ArrayData e              -- ^ array payload
      -> Par arch (FutureR arch (ArrayData e))
  useRemoteR SingleType e
_ Int
_ = ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull

  -- | Upload an array from the host to the remote device.
  --
  {-# INLINE copyToRemoteR #-}
  copyToRemoteR
      :: SingleType e
      -> Int                      -- ^ number of elements to copy
      -> ArrayData e              -- ^ array payload
      -> Par arch (FutureR arch (ArrayData e))
  copyToRemoteR SingleType e
_ Int
_ = ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull

  -- | Copy an array from the remote device back to the host.
  --
  {-# INLINE copyToHostR #-}
  copyToHostR
      :: SingleType e
      -> Int                      -- ^ number of elements to copy
      -> ArrayData e              -- ^ array payload
      -> Par arch (FutureR arch (ArrayData e))
  copyToHostR SingleType e
_ Int
_ = ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull

  -- | Copy a section of an array between two remote instances of the same type.
  -- This may be more efficient than copying to the host and then to the second
  -- remote instance (e.g. DMA between two CUDA devices).
  --
  {-# INLINE copyToPeerR #-}
  copyToPeerR
      :: arch                     -- ^ remote device to copy to
      -> SingleType e
      -> Int                      -- ^ number of elements to copy
      -> ArrayData e              -- ^ array payload
      -> Par arch (FutureR arch (ArrayData e))
  copyToPeerR arch
_ SingleType e
_ Int
_ = ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull

  -- | Upload an immutable array from the host to the remote device,
  -- asynchronously. Since the source array is immutable, the garbage collector
  -- can evict and re-upload the data as necessary without copy-back. This may
  -- upload each array payload in a separate execution stream, thereby making us
  -- of multiple memcpy engines.
  --
  {-# INLINE useRemoteAsync #-}
  useRemoteAsync :: ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
  useRemoteAsync ArraysR arrs
repr arrs
arrs =
    ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall arch arrs.
Async arch =>
ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
runArraysAsync ArraysR arrs
repr arrs
arrs ((forall sh e.
  ArrayR (Array sh e)
  -> Array sh e -> Par arch (FutureR arch (Array sh e)))
 -> Par arch (FutureArraysR arch arrs))
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall a b. (a -> b) -> a -> b
$ \(ArrayR ShapeR sh
shr TypeR e
tp) Array sh e
arr ->
      let n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr (Array sh e -> sh
forall sh e. Array sh e -> sh
shape Array sh e
arr)
      in  TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall arch sh e.
Async arch =>
TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
runArrayAsync TypeR e
tp Array sh e
Array sh e
arr ((forall s.
  (ArrayData s ~ ScalarArrayData s) =>
  Int
  -> SingleType s
  -> ScalarArrayData s
  -> Par arch (FutureR arch (ScalarArrayData s)))
 -> Par arch (FutureR arch (Array sh e)))
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall a b. (a -> b) -> a -> b
$ \Int
m SingleType s
tp' ScalarArrayData s
ad ->
            SingleType s
-> Int -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
forall arch e.
Remote arch =>
SingleType e
-> Int -> ArrayData e -> Par arch (FutureR arch (ArrayData e))
useRemoteR SingleType s
tp' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) ArrayData s
ScalarArrayData s
ad

  -- | Upload an existing array to the remote device, asynchronously.
  --
  {-# INLINE copyToRemoteAsync #-}
  copyToRemoteAsync :: ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
  copyToRemoteAsync ArraysR arrs
reprs arrs
arrs =
    ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall arch arrs.
Async arch =>
ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
runArraysAsync ArraysR arrs
reprs arrs
arrs ((forall sh e.
  ArrayR (Array sh e)
  -> Array sh e -> Par arch (FutureR arch (Array sh e)))
 -> Par arch (FutureArraysR arch arrs))
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall a b. (a -> b) -> a -> b
$ \(ArrayR ShapeR sh
shr TypeR e
tp) Array sh e
arr ->
      let n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr (Array sh e -> sh
forall sh e. Array sh e -> sh
shape Array sh e
arr)
      in  TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall arch sh e.
Async arch =>
TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
runArrayAsync TypeR e
tp Array sh e
Array sh e
arr ((forall s.
  (ArrayData s ~ ScalarArrayData s) =>
  Int
  -> SingleType s
  -> ScalarArrayData s
  -> Par arch (FutureR arch (ScalarArrayData s)))
 -> Par arch (FutureR arch (Array sh e)))
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall a b. (a -> b) -> a -> b
$ \Int
m SingleType s
tp' ScalarArrayData s
ad ->
            SingleType s
-> Int -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
forall arch e.
Remote arch =>
SingleType e
-> Int -> ArrayData e -> Par arch (FutureR arch (ArrayData e))
copyToRemoteR SingleType s
tp' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) ArrayData s
ScalarArrayData s
ad

  -- | Copy an array from the remote device to the host, asynchronously
  --
  {-# INLINE copyToHostAsync #-}
  copyToHostAsync :: ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
  copyToHostAsync ArraysR arrs
reprs arrs
arrs =
    ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall arch arrs.
Async arch =>
ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
runArraysAsync ArraysR arrs
reprs arrs
arrs ((forall sh e.
  ArrayR (Array sh e)
  -> Array sh e -> Par arch (FutureR arch (Array sh e)))
 -> Par arch (FutureArraysR arch arrs))
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall a b. (a -> b) -> a -> b
$ \(ArrayR ShapeR sh
shr TypeR e
tp) Array sh e
arr ->
      let n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr (Array sh e -> sh
forall sh e. Array sh e -> sh
shape Array sh e
arr)
      in  TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall arch sh e.
Async arch =>
TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
runArrayAsync TypeR e
tp Array sh e
Array sh e
arr ((forall s.
  (ArrayData s ~ ScalarArrayData s) =>
  Int
  -> SingleType s
  -> ScalarArrayData s
  -> Par arch (FutureR arch (ScalarArrayData s)))
 -> Par arch (FutureR arch (Array sh e)))
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall a b. (a -> b) -> a -> b
$ \Int
m SingleType s
tp' ScalarArrayData s
ad ->
            SingleType s
-> Int -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
forall arch e.
Remote arch =>
SingleType e
-> Int -> ArrayData e -> Par arch (FutureR arch (ArrayData e))
copyToHostR SingleType s
tp' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) ArrayData s
ScalarArrayData s
ad

  -- | Copy arrays between two remote instances. This may be more efficient than
  -- copying to the host and then to the second remote instance (e.g. by DMA
  -- between the two remote devices).
  --
  {-# INLINE copyToPeerAsync #-}
  copyToPeerAsync :: arch -> ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
  copyToPeerAsync arch
peer ArraysR arrs
reprs arrs
arrs =
    ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall arch arrs.
Async arch =>
ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
runArraysAsync ArraysR arrs
reprs arrs
arrs ((forall sh e.
  ArrayR (Array sh e)
  -> Array sh e -> Par arch (FutureR arch (Array sh e)))
 -> Par arch (FutureArraysR arch arrs))
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
forall a b. (a -> b) -> a -> b
$ \(ArrayR ShapeR sh
shr TypeR e
tp) Array sh e
arr ->
      let n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr (Array sh e -> sh
forall sh e. Array sh e -> sh
shape Array sh e
arr)
      in  TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall arch sh e.
Async arch =>
TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
runArrayAsync TypeR e
tp Array sh e
Array sh e
arr ((forall s.
  (ArrayData s ~ ScalarArrayData s) =>
  Int
  -> SingleType s
  -> ScalarArrayData s
  -> Par arch (FutureR arch (ScalarArrayData s)))
 -> Par arch (FutureR arch (Array sh e)))
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
forall a b. (a -> b) -> a -> b
$ \Int
m SingleType s
tp' ScalarArrayData s
ad ->
            arch
-> SingleType s
-> Int
-> ArrayData s
-> Par arch (FutureR arch (ArrayData s))
forall arch e.
Remote arch =>
arch
-> SingleType e
-> Int
-> ArrayData e
-> Par arch (FutureR arch (ArrayData e))
copyToPeerR arch
peer SingleType s
tp' (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) ArrayData s
ScalarArrayData s
ad

  -- | Read a single element from the array at the given row-major index
  --
  {-# INLINE indexRemoteAsync #-}
  indexRemoteAsync
      :: TypeR e
      -> Array sh e
      -> Int
      -> Par arch (FutureR arch e)
  indexRemoteAsync TypeR e
tp (Array sh
_ ArrayData e
ad) Int
i = e -> Par arch (FutureR arch e)
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull (TypeR e -> ArrayData e -> Int -> e
forall e. TupR ScalarType e -> ArrayData e -> Int -> e
indexArrayData TypeR e
tp ArrayData e
ad Int
i)


-- | Create a new array from its representation on the host, and upload it to
-- the remote device.
--
{-# INLINE newRemote #-}
newRemote
    :: Remote arch
    => ArrayR (Array sh e)
    -> sh
    -> (sh -> e)
    -> Par arch (Array sh e)
newRemote :: ArrayR (Array sh e) -> sh -> (sh -> e) -> Par arch (Array sh e)
newRemote ArrayR (Array sh e)
repr sh
sh sh -> e
f =
  FutureR arch (Array sh e) -> Par arch (Array sh e)
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get (FutureR arch (Array sh e) -> Par arch (Array sh e))
-> Par arch (FutureR arch (Array sh e)) -> Par arch (Array sh e)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArrayR (Array sh e)
-> sh -> (sh -> e) -> Par arch (FutureR arch (Array sh e))
forall arch sh e.
Remote arch =>
ArrayR (Array sh e)
-> sh -> (sh -> e) -> Par arch (FutureR arch (Array sh e))
newRemoteAsync ArrayR (Array sh e)
repr sh
sh sh -> e
f


-- | Create a new array from its representation on the host, and upload it as
-- a new remote array, asynchronously.
--
{-# INLINE newRemoteAsync #-}
newRemoteAsync
    :: Remote arch
    => ArrayR (Array sh e)
    -> sh
    -> (sh -> e)
    -> Par arch (FutureR arch (Array sh e))
newRemoteAsync :: ArrayR (Array sh e)
-> sh -> (sh -> e) -> Par arch (FutureR arch (Array sh e))
newRemoteAsync ArrayR (Array sh e)
repr sh
sh sh -> e
f =
  ArraysR (Array sh e)
-> Array sh e -> Par arch (FutureArraysR arch (Array sh e))
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
useRemoteAsync (ArrayR (Array sh e) -> ArraysR (Array sh e)
forall (s :: * -> *) a. s a -> TupR s a
TupRsingle ArrayR (Array sh e)
repr) (Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Array sh e -> Par arch (FutureR arch (Array sh e))
forall a b. (a -> b) -> a -> b
$! ArrayR (Array sh e) -> sh -> (sh -> e) -> Array sh e
forall sh e. ArrayR (Array sh e) -> sh -> (sh -> e) -> Array sh e
fromFunction ArrayR (Array sh e)
repr sh
sh sh -> e
f


-- | Upload an immutable array from the host to the remote device. This is
-- a synchronous operation in that it will not return until the transfer
-- completes, but the individual array payloads will be uploaded concurrently if
-- possible.
--
{-# INLINE useRemote #-}
useRemote :: Remote arch => ArraysR a -> a -> Par arch a
useRemote :: ArraysR a -> a -> Par arch a
useRemote ArraysR a
repr a
arrs =
  ArraysR a -> FutureArraysR arch a -> Par arch a
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays ArraysR a
repr (FutureArraysR arch a -> Par arch a)
-> Par arch (FutureArraysR arch a) -> Par arch a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArraysR a -> a -> Par arch (FutureArraysR arch a)
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
useRemoteAsync ArraysR a
repr a
arrs

-- | Uploading existing arrays from the host to the remote device. This is
-- synchronous with respect to the calling thread, but the individual array
-- payloads may themselves be transferred concurrently.
--
{-# INLINE copyToRemote #-}
copyToRemote :: Remote arch => ArraysR a -> a -> Par arch a
copyToRemote :: ArraysR a -> a -> Par arch a
copyToRemote ArraysR a
repr a
arrs =
  ArraysR a -> FutureArraysR arch a -> Par arch a
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays ArraysR a
repr (FutureArraysR arch a -> Par arch a)
-> Par arch (FutureArraysR arch a) -> Par arch a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArraysR a -> a -> Par arch (FutureArraysR arch a)
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
copyToRemoteAsync ArraysR a
repr a
arrs

-- | Copy an array from the remote device to the host. This is synchronous with
-- respect to the calling thread, but the individual array payloads may
-- themselves be transferred concurrently.
--
{-# INLINE copyToHost #-}
copyToHost :: Remote arch => ArraysR a -> a -> Par arch a
copyToHost :: ArraysR a -> a -> Par arch a
copyToHost ArraysR a
repr a
arrs =
  ArraysR a -> FutureArraysR arch a -> Par arch a
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
blockArrays ArraysR a
repr (FutureArraysR arch a -> Par arch a)
-> Par arch (FutureArraysR arch a) -> Par arch a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArraysR a -> a -> Par arch (FutureArraysR arch a)
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
copyToHostAsync ArraysR a
repr a
arrs

-- | Copy arrays between two remote instances of the same type. This may be more
-- efficient than copying to the host and then to the second remote instance
-- (e.g. DMA between CUDA devices).
--
{-# INLINE copyToPeer #-}
copyToPeer :: Remote arch => arch -> ArraysR a -> a -> Par arch a
copyToPeer :: arch -> ArraysR a -> a -> Par arch a
copyToPeer arch
peer ArraysR a
repr a
arrs =
  ArraysR a -> FutureArraysR arch a -> Par arch a
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays ArraysR a
repr (FutureArraysR arch a -> Par arch a)
-> Par arch (FutureArraysR arch a) -> Par arch a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< arch -> ArraysR a -> a -> Par arch (FutureArraysR arch a)
forall arch arrs.
Remote arch =>
arch -> ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
copyToPeerAsync arch
peer ArraysR a
repr a
arrs

-- | Read a single element from the remote array at the given row-major index.
-- This is synchronous with respect to both the host and remote device.
--
{-# INLINE indexRemote #-}
indexRemote :: Remote arch => TypeR e -> Array sh e -> Int -> Par arch e
indexRemote :: TypeR e -> Array sh e -> Int -> Par arch e
indexRemote TypeR e
tp Array sh e
arr Int
i =
  FutureR arch e -> Par arch e
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
block (FutureR arch e -> Par arch e)
-> Par arch (FutureR arch e) -> Par arch e
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TypeR e -> Array sh e -> Int -> Par arch (FutureR arch e)
forall arch e sh.
Remote arch =>
TypeR e -> Array sh e -> Int -> Par arch (FutureR arch e)
indexRemoteAsync TypeR e
tp Array sh e
arr Int
i


-- Helpers for traversing the Arrays data structure
-- ------------------------------------------------

-- | Read a single element from an array at the given row-major index.
--
{-# INLINE runIndexArray #-}
runIndexArray
    :: forall m sh e. Monad m
    => (forall s. ArrayData s ~ ScalarArrayData s => Int -> SingleType s -> ArrayData s -> Int -> m (ArrayData s))
    -> TypeR e
    -> Array sh e
    -> Int
    -> m e
runIndexArray :: (forall s.
 (ArrayData s ~ ScalarArrayData s) =>
 Int -> SingleType s -> ArrayData s -> Int -> m (ArrayData s))
-> TypeR e -> Array sh e -> Int -> m e
runIndexArray forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int -> SingleType s -> ArrayData s -> Int -> m (ArrayData s)
worker TypeR e
tp (Array sh
_ ArrayData e
adata) Int
i = (ArrayData e -> Int -> e) -> Int -> ArrayData e -> e
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TypeR e -> ArrayData e -> Int -> e
forall e. TupR ScalarType e -> ArrayData e -> Int -> e
indexArrayData TypeR e
tp) Int
0 (ArrayData e -> e) -> m (ArrayData e) -> m e
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeR e -> ArrayData e -> m (ArrayData e)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
indexR TypeR e
tp ArrayData e
adata
  where
    indexR :: TypeR s -> ArrayData s -> m (ArrayData s)
    indexR :: TypeR s -> ArrayData s -> m (ArrayData s)
indexR TypeR s
TupRunit           !ArrayData s
_           = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    indexR (TupRpair !TupR ScalarType a1
t1 !TupR ScalarType b
t2) (!ad1, !ad2) = (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> m (GArrayDataR UniqueArray a1)
-> m (GArrayDataR UniqueArray b)
-> m (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (TupR ScalarType a1
-> GArrayDataR UniqueArray a1 -> m (GArrayDataR UniqueArray a1)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
indexR TupR ScalarType a1
t1 GArrayDataR UniqueArray a1
ad1) (TupR ScalarType b
-> GArrayDataR UniqueArray b -> m (GArrayDataR UniqueArray b)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
indexR TupR ScalarType b
t2 GArrayDataR UniqueArray b
ad2)
    indexR (TupRsingle ScalarType s
t)     !ArrayData s
ad
      | ScalarArrayDict Int
w SingleType b
s <- ScalarType s -> ScalarArrayDict s
forall a. ScalarType a -> ScalarArrayDict a
scalarArrayDict ScalarType s
t
      , SingleArrayDict b
SingleArrayDict     <- SingleType b -> SingleArrayDict b
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType b
s
      = Int -> SingleType b -> ArrayData b -> Int -> m (ArrayData b)
forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int -> SingleType s -> ArrayData s -> Int -> m (ArrayData s)
worker Int
w SingleType b
s ArrayData s
ArrayData b
ad Int
i

{-# INLINE runIndexArrayAsync #-}
runIndexArrayAsync
    :: forall arch sh e. Async arch
    => (forall s. ArrayData s ~ ScalarArrayData s => Int -> SingleType s -> ArrayData s -> Int -> Par arch (FutureR arch (ArrayData s)))
    -> TypeR e
    -> Array sh e
    -> Int
    -> Par arch (FutureR arch e)
runIndexArrayAsync :: (forall s.
 (ArrayData s ~ ScalarArrayData s) =>
 Int
 -> SingleType s
 -> ArrayData s
 -> Int
 -> Par arch (FutureR arch (ArrayData s)))
-> TypeR e -> Array sh e -> Int -> Par arch (FutureR arch e)
runIndexArrayAsync forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int
-> SingleType s
-> ArrayData s
-> Int
-> Par arch (FutureR arch (ArrayData s))
worker TypeR e
tp (Array sh
_ ArrayData e
adata) Int
i = ((ArrayData e -> Int -> e) -> Int -> ArrayData e -> e
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TypeR e -> ArrayData e -> Int -> e
forall e. TupR ScalarType e -> ArrayData e -> Int -> e
indexArrayData TypeR e
tp) Int
0) (ArrayData e -> e)
-> Par arch (FutureR arch (ArrayData e))
-> Par arch (FutureR arch e)
forall arch a b.
Async arch =>
(a -> b) -> Par arch (FutureR arch a) -> Par arch (FutureR arch b)
`liftF` TypeR e -> ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
indexR TypeR e
tp ArrayData e
adata
  where
    indexR :: TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
    indexR :: TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
indexR TypeR s
TupRunit           !ArrayData s
_           = () -> Par arch (FutureR arch ())
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull ()
    indexR (TupRpair !TupR ScalarType a1
t1 !TupR ScalarType b
t2) (!ad1, !ad2) = (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> Par arch (FutureR arch (GArrayDataR UniqueArray a1))
-> Par arch (FutureR arch (GArrayDataR UniqueArray b))
-> Par
     arch
     (FutureR
        arch (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
forall a b c.
(a -> b -> c)
-> Par arch (FutureR arch a)
-> Par arch (FutureR arch b)
-> Par arch (FutureR arch c)
liftF2' (,) (TupR ScalarType a1
-> GArrayDataR UniqueArray a1
-> Par arch (FutureR arch (GArrayDataR UniqueArray a1))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
indexR TupR ScalarType a1
t1 GArrayDataR UniqueArray a1
ad1) (TupR ScalarType b
-> GArrayDataR UniqueArray b
-> Par arch (FutureR arch (GArrayDataR UniqueArray b))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
indexR TupR ScalarType b
t2 GArrayDataR UniqueArray b
ad2)
    indexR (TupRsingle ScalarType s
t)     !ArrayData s
ad
      | ScalarArrayDict Int
w SingleType b
s <- ScalarType s -> ScalarArrayDict s
forall a. ScalarType a -> ScalarArrayDict a
scalarArrayDict ScalarType s
t
      , SingleArrayDict b
SingleArrayDict     <- SingleType b -> SingleArrayDict b
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType b
s
      = Int
-> SingleType b
-> ArrayData b
-> Int
-> Par arch (FutureR arch (ArrayData b))
forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int
-> SingleType s
-> ArrayData s
-> Int
-> Par arch (FutureR arch (ArrayData s))
worker Int
w SingleType b
s ArrayData s
ArrayData b
ad Int
i

    -- It is expected these transfers will be very small, so don't bother
    -- creating new execution streams for them
    liftF2' :: (a -> b -> c) -> Par arch (FutureR arch a) -> Par arch (FutureR arch b) -> Par arch (FutureR arch c)
    liftF2' :: (a -> b -> c)
-> Par arch (FutureR arch a)
-> Par arch (FutureR arch b)
-> Par arch (FutureR arch c)
liftF2' a -> b -> c
f Par arch (FutureR arch a)
x Par arch (FutureR arch b)
y = do
      FutureR arch c
r  <- Par arch (FutureR arch c)
forall arch a.
(Async arch, HasCallStack) =>
Par arch (FutureR arch a)
new
      FutureR arch a
x' <- Par arch (FutureR arch a)
x
      FutureR arch b
y' <- Par arch (FutureR arch b)
y
      FutureR arch c -> c -> Par arch ()
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> a -> Par arch ()
put FutureR arch c
r (c -> Par arch ()) -> Par arch c -> Par arch ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> b -> c) -> Par arch a -> Par arch b -> Par arch c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> c
f (FutureR arch a -> Par arch a
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get FutureR arch a
x') (FutureR arch b -> Par arch b
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get FutureR arch b
y')
      FutureR arch c -> Par arch (FutureR arch c)
forall (m :: * -> *) a. Monad m => a -> m a
return FutureR arch c
r


-- | Generalised function to traverse the Arrays structure
--
{-# INLINE runArrays #-}
runArrays
    :: forall m arrs. Monad m
    => ArraysR arrs
    -> arrs
    -> (forall sh e. ArrayR (Array sh e) -> Array sh e -> m (Array sh e))
    -> m arrs
runArrays :: ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e) -> Array sh e -> m (Array sh e))
-> m arrs
runArrays ArraysR arrs
reprs arrs
arrs forall sh e. ArrayR (Array sh e) -> Array sh e -> m (Array sh e)
worker = ArraysR arrs -> arrs -> m arrs
forall a. ArraysR a -> a -> m a
runR ArraysR arrs
reprs arrs
arrs
  where
    runR :: ArraysR a -> a -> m a
    runR :: ArraysR a -> a -> m a
runR ArraysR a
TupRunit                   ()             = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    runR (TupRsingle repr :: ArrayR a
repr@ArrayR{}) a
arr            = ArrayR (Array sh e) -> Array sh e -> m (Array sh e)
forall sh e. ArrayR (Array sh e) -> Array sh e -> m (Array sh e)
worker ArrayR a
ArrayR (Array sh e)
repr a
Array sh e
arr
    runR (TupRpair TupR ArrayR a1
aeR2 TupR ArrayR b
aeR1)       (arrs2, arrs1) = (a1 -> b -> (a1, b)) -> m a1 -> m b -> m (a1, b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (TupR ArrayR a1 -> a1 -> m a1
forall a. ArraysR a -> a -> m a
runR TupR ArrayR a1
aeR2 a1
arrs2) (TupR ArrayR b -> b -> m b
forall a. ArraysR a -> a -> m a
runR TupR ArrayR b
aeR1 b
arrs1)

{-# INLINE runArraysAsync #-}
runArraysAsync
    :: forall arch arrs. Async arch
    => ArraysR arrs
    -> arrs
    -> (forall sh e. ArrayR (Array sh e) -> Array sh e -> Par arch (FutureR arch (Array sh e)))
    -> Par arch (FutureArraysR arch arrs)
runArraysAsync :: ArraysR arrs
-> arrs
-> (forall sh e.
    ArrayR (Array sh e)
    -> Array sh e -> Par arch (FutureR arch (Array sh e)))
-> Par arch (FutureArraysR arch arrs)
runArraysAsync ArraysR arrs
reprs arrs
arrs forall sh e.
ArrayR (Array sh e)
-> Array sh e -> Par arch (FutureR arch (Array sh e))
worker = ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
forall a. ArraysR a -> a -> Par arch (FutureArraysR arch a)
runR ArraysR arrs
reprs arrs
arrs
  where
    runR :: ArraysR a -> a -> Par arch (FutureArraysR arch a)
    runR :: ArraysR a -> a -> Par arch (FutureArraysR arch a)
runR ArraysR a
TupRunit                   ()             = () -> Par arch ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    runR (TupRsingle repr :: ArrayR a
repr@ArrayR{}) a
arr            = ArrayR (Array sh e)
-> Array sh e -> Par arch (FutureR arch (Array sh e))
forall sh e.
ArrayR (Array sh e)
-> Array sh e -> Par arch (FutureR arch (Array sh e))
worker ArrayR a
ArrayR (Array sh e)
repr a
Array sh e
arr
    runR (TupRpair TupR ArrayR a1
aeR2 TupR ArrayR b
aeR1)       (arrs2, arrs1) = (,) (FutureArraysR arch a1
 -> FutureArraysR arch b
 -> (FutureArraysR arch a1, FutureArraysR arch b))
-> Par arch (FutureArraysR arch a1)
-> Par
     arch
     (FutureArraysR arch b
      -> (FutureArraysR arch a1, FutureArraysR arch b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TupR ArrayR a1 -> a1 -> Par arch (FutureArraysR arch a1)
forall a. ArraysR a -> a -> Par arch (FutureArraysR arch a)
runR TupR ArrayR a1
aeR2 a1
arrs2 Par
  arch
  (FutureArraysR arch b
   -> (FutureArraysR arch a1, FutureArraysR arch b))
-> Par arch (FutureArraysR arch b)
-> Par arch (FutureArraysR arch a1, FutureArraysR arch b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupR ArrayR b -> b -> Par arch (FutureArraysR arch b)
forall a. ArraysR a -> a -> Par arch (FutureArraysR arch a)
runR TupR ArrayR b
aeR1 b
arrs1


-- | Generalised function to traverse the ArrayData structure with one
-- additional argument
--
{-# INLINE runArray #-}
runArray
    :: forall m sh e. Monad m
    => TypeR e
    -> Array sh e
    -> (forall s. ArrayData s ~ ScalarArrayData s => Int -> SingleType s -> ScalarArrayData s -> m (ScalarArrayData s))
    -> m (Array sh e)
runArray :: TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int -> SingleType s -> ScalarArrayData s -> m (ScalarArrayData s))
-> m (Array sh e)
runArray TypeR e
tp (Array sh
sh ArrayData e
adata) forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int -> SingleType s -> ScalarArrayData s -> m (ScalarArrayData s)
worker = sh -> ArrayData e -> Array sh e
forall sh e. sh -> ArrayData e -> Array sh e
Array sh
sh (ArrayData e -> Array sh e) -> m (ArrayData e) -> m (Array sh e)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
`liftM` TypeR e -> ArrayData e -> m (ArrayData e)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
runR TypeR e
tp ArrayData e
adata
  where
    runR :: TypeR s -> ArrayData s -> m (ArrayData s)
    runR :: TypeR s -> ArrayData s -> m (ArrayData s)
runR (TypeR s
TupRunit)         !ArrayData s
_           = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    runR (TupRpair !TupR ScalarType a1
t2 !TupR ScalarType b
t1) (!ad2, !ad1) = (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> m (GArrayDataR UniqueArray a1)
-> m (GArrayDataR UniqueArray b)
-> m (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (TupR ScalarType a1
-> GArrayDataR UniqueArray a1 -> m (GArrayDataR UniqueArray a1)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
runR TupR ScalarType a1
t2 GArrayDataR UniqueArray a1
ad2) (TupR ScalarType b
-> GArrayDataR UniqueArray b -> m (GArrayDataR UniqueArray b)
forall s. TypeR s -> ArrayData s -> m (ArrayData s)
runR TupR ScalarType b
t1 GArrayDataR UniqueArray b
ad1)
    runR (TupRsingle !ScalarType s
t)    !ArrayData s
ad
      | ScalarArrayDict Int
w SingleType b
s <- ScalarType s -> ScalarArrayDict s
forall a. ScalarType a -> ScalarArrayDict a
scalarArrayDict ScalarType s
t
      , SingleArrayDict b
SingleArrayDict     <- SingleType b -> SingleArrayDict b
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType b
s
      = Int -> SingleType b -> ScalarArrayData b -> m (ScalarArrayData b)
forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int -> SingleType s -> ScalarArrayData s -> m (ScalarArrayData s)
worker Int
w SingleType b
s ArrayData s
ScalarArrayData b
ad

{-# INLINE runArrayAsync #-}
runArrayAsync
    :: forall arch sh e. Async arch
    => TypeR e
    -> Array sh e
    -> (forall s. ArrayData s ~ ScalarArrayData s => Int -> SingleType s -> ScalarArrayData s -> Par arch (FutureR arch (ScalarArrayData s)))
    -> Par arch (FutureR arch (Array sh e))
runArrayAsync :: TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> Par arch (FutureR arch (ScalarArrayData s)))
-> Par arch (FutureR arch (Array sh e))
runArrayAsync TypeR e
tp (Array sh
sh ArrayData e
adata) forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int
-> SingleType s
-> ScalarArrayData s
-> Par arch (FutureR arch (ScalarArrayData s))
worker = sh -> ArrayData e -> Array sh e
forall sh e. sh -> ArrayData e -> Array sh e
Array sh
sh (ArrayData e -> Array sh e)
-> Par arch (FutureR arch (ArrayData e))
-> Par arch (FutureR arch (Array sh e))
forall arch a b.
Async arch =>
(a -> b) -> Par arch (FutureR arch a) -> Par arch (FutureR arch b)
`liftF` TypeR e -> ArrayData e -> Par arch (FutureR arch (ArrayData e))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
runR TypeR e
tp ArrayData e
adata
  where
    runR :: forall s. TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
    runR :: TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
runR (TypeR s
TupRunit)         !ArrayData s
_           = () -> Par arch (FutureR arch ())
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull ()
    runR (TupRpair !TupR ScalarType a1
t2 !TupR ScalarType b
t1) (!ad2, !ad1) = (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> Par arch (FutureR arch (GArrayDataR UniqueArray a1))
-> Par arch (FutureR arch (GArrayDataR UniqueArray b))
-> Par
     arch
     (FutureR
        arch (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
forall arch a b c.
Async arch =>
(a -> b -> c)
-> Par arch (FutureR arch a)
-> Par arch (FutureR arch b)
-> Par arch (FutureR arch c)
liftF2 (,) (TupR ScalarType a1
-> GArrayDataR UniqueArray a1
-> Par arch (FutureR arch (GArrayDataR UniqueArray a1))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
runR TupR ScalarType a1
t2 GArrayDataR UniqueArray a1
ad2) (TupR ScalarType b
-> GArrayDataR UniqueArray b
-> Par arch (FutureR arch (GArrayDataR UniqueArray b))
forall s.
TypeR s -> ArrayData s -> Par arch (FutureR arch (ArrayData s))
runR TupR ScalarType b
t1 GArrayDataR UniqueArray b
ad1)
    runR (TupRsingle !ScalarType s
t)    !ArrayData s
ad
      | ScalarArrayDict Int
w SingleType b
s <- ScalarType s -> ScalarArrayDict s
forall a. ScalarType a -> ScalarArrayDict a
scalarArrayDict ScalarType s
t
      , SingleArrayDict b
SingleArrayDict     <- SingleType b -> SingleArrayDict b
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType b
s
      = Int
-> SingleType b
-> ScalarArrayData b
-> Par arch (FutureR arch (ScalarArrayData b))
forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int
-> SingleType s
-> ScalarArrayData s
-> Par arch (FutureR arch (ScalarArrayData s))
worker Int
w SingleType b
s ArrayData s
ScalarArrayData b
ad

{-# INLINE liftF #-}
liftF :: Async arch
      => (a -> b)
      -> Par arch (FutureR arch a)
      -> Par arch (FutureR arch b)
liftF :: (a -> b) -> Par arch (FutureR arch a) -> Par arch (FutureR arch b)
liftF a -> b
f Par arch (FutureR arch a)
x = do
  FutureR arch b
r  <- Par arch (FutureR arch b)
forall arch a.
(Async arch, HasCallStack) =>
Par arch (FutureR arch a)
new
  FutureR arch a
x' <- Par arch (FutureR arch a)
x
  Par arch () -> Par arch ()
forall arch.
(Async arch, HasCallStack) =>
Par arch () -> Par arch ()
fork (Par arch () -> Par arch ()) -> Par arch () -> Par arch ()
forall a b. (a -> b) -> a -> b
$ FutureR arch b -> b -> Par arch ()
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> a -> Par arch ()
put FutureR arch b
r (b -> Par arch ()) -> (a -> b) -> a -> Par arch ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> Par arch ()) -> Par arch a -> Par arch ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FutureR arch a -> Par arch a
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get FutureR arch a
x'
  FutureR arch b -> Par arch (FutureR arch b)
forall (m :: * -> *) a. Monad m => a -> m a
return FutureR arch b
r

{-# INLINE liftF2 #-}
liftF2 :: Async arch
       => (a -> b -> c)
       -> Par arch (FutureR arch a)
       -> Par arch (FutureR arch b)
       -> Par arch (FutureR arch c)
liftF2 :: (a -> b -> c)
-> Par arch (FutureR arch a)
-> Par arch (FutureR arch b)
-> Par arch (FutureR arch c)
liftF2 a -> b -> c
f Par arch (FutureR arch a)
x Par arch (FutureR arch b)
y = do
  FutureR arch c
r  <- Par arch (FutureR arch c)
forall arch a.
(Async arch, HasCallStack) =>
Par arch (FutureR arch a)
new
  FutureR arch a
x' <- Par arch (FutureR arch a) -> Par arch (FutureR arch a)
forall arch a.
(Async arch, HasCallStack) =>
Par arch a -> Par arch a
spawn Par arch (FutureR arch a)
x
  FutureR arch b
y' <- Par arch (FutureR arch b) -> Par arch (FutureR arch b)
forall arch a.
(Async arch, HasCallStack) =>
Par arch a -> Par arch a
spawn Par arch (FutureR arch b)
y
  Par arch () -> Par arch ()
forall arch.
(Async arch, HasCallStack) =>
Par arch () -> Par arch ()
fork (Par arch () -> Par arch ()) -> Par arch () -> Par arch ()
forall a b. (a -> b) -> a -> b
$ FutureR arch c -> c -> Par arch ()
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> a -> Par arch ()
put FutureR arch c
r (c -> Par arch ()) -> Par arch c -> Par arch ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (a -> b -> c) -> Par arch a -> Par arch b -> Par arch c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> c
f (FutureR arch a -> Par arch a
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get FutureR arch a
x') (FutureR arch b -> Par arch b
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
get FutureR arch b
y')
  FutureR arch c -> Par arch (FutureR arch c)
forall (m :: * -> *) a. Monad m => a -> m a
return FutureR arch c
r