{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE UnboxedTuples       #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.PTX.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.PTX.Array.Data (

  module Data.Array.Accelerate.LLVM.Array.Data,
  module Data.Array.Accelerate.LLVM.PTX.Array.Data,

) where

import Data.Array.Accelerate.Array.Data
import Data.Array.Accelerate.Array.Unique
import Data.Array.Accelerate.Error
import Data.Array.Accelerate.Lifetime
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.Array.Data
import Data.Array.Accelerate.LLVM.State

import Data.Array.Accelerate.LLVM.PTX.State
import Data.Array.Accelerate.LLVM.PTX.Target
import Data.Array.Accelerate.LLVM.PTX.Execute.Async
import qualified Data.Array.Accelerate.LLVM.PTX.Array.Prim          as Prim

import Control.Applicative
import Control.Monad.Reader
import Control.Monad.State                                          ( gets )
import System.IO.Unsafe
import Prelude

import GHC.Heap.NormalForm


-- | Remote memory management for the PTX target. Data can be copied
-- asynchronously using multiple execution engines whenever possible.
--
instance Remote PTX where
  {-# INLINEABLE allocateRemote   #-}
  {-# INLINEABLE indexRemoteAsync #-}
  {-# INLINEABLE useRemoteR       #-}
  {-# INLINEABLE copyToHostR      #-}
  {-# INLINEABLE copyToRemoteR    #-}
  allocateRemote :: ArrayR (Array sh e) -> sh -> Par PTX (Array sh e)
allocateRemote repr :: ArrayR (Array sh e)
repr@(ArrayR ShapeR sh
shr TypeR e
tp) !sh
sh = do
    let !n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr sh
sh
sh
    Array sh e
arr    <- IO (Array sh e) -> Par PTX (Array sh e)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array sh e) -> Par PTX (Array sh e))
-> IO (Array sh e) -> Par PTX (Array sh e)
forall a b. (a -> b) -> a -> b
$ ArrayR (Array sh e) -> sh -> IO (Array sh e)
forall sh e. ArrayR (Array sh e) -> sh -> IO (Array sh e)
allocateArray ArrayR (Array sh e)
repr sh
sh  -- shadow array on the host
    LLVM PTX (Array sh e) -> Par PTX (Array sh e)
forall arch a.
(Async arch, HasCallStack) =>
LLVM arch a -> Par arch a
liftPar (LLVM PTX (Array sh e) -> Par PTX (Array sh e))
-> LLVM PTX (Array sh e) -> Par PTX (Array sh e)
forall a b. (a -> b) -> a -> b
$ TypeR e
-> Array sh e
-> (forall s.
    (ArrayData s ~ ScalarArrayData s) =>
    Int
    -> SingleType s
    -> ScalarArrayData s
    -> LLVM PTX (ScalarArrayData s))
-> LLVM PTX (Array sh e)
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
tp Array sh e
Array sh e
arr (\Int
m SingleType s
t ScalarArrayData s
ad -> SingleType s -> Int -> ArrayData s -> LLVM PTX ()
forall e.
HasCallStack =>
SingleType e -> Int -> ArrayData e -> LLVM PTX ()
Prim.mallocArray SingleType s
t (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
m) ArrayData s
ScalarArrayData s
ad LLVM PTX ()
-> LLVM PTX (ScalarArrayData s) -> LLVM PTX (ScalarArrayData s)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ScalarArrayData s -> LLVM PTX (ScalarArrayData s)
forall (m :: * -> *) a. Monad m => a -> m a
return ScalarArrayData s
ad)

  indexRemoteAsync :: TypeR e -> Array sh e -> Int -> Par PTX (FutureR PTX e)
indexRemoteAsync  = (forall s.
 (ArrayData s ~ ScalarArrayData s) =>
 Int
 -> SingleType s
 -> ArrayData s
 -> Int
 -> Par PTX (FutureR PTX (ArrayData s)))
-> TypeR e -> Array sh e -> Int -> Par PTX (FutureR PTX e)
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 e.
HasCallStack =>
Int
-> SingleType e
-> ArrayData e
-> Int
-> Par PTX (Future (ArrayData e))
forall s.
(ArrayData s ~ ScalarArrayData s) =>
Int
-> SingleType s
-> ArrayData s
-> Int
-> Par PTX (FutureR PTX (ArrayData s))
Prim.indexArrayAsync
  useRemoteR :: SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
useRemoteR        = SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
forall e.
HasCallStack =>
SingleType e
-> Int -> ArrayData e -> Par PTX (Future (ArrayData e))
Prim.useArrayAsync
  copyToHostR :: SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
copyToHostR       = SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
forall e.
HasCallStack =>
SingleType e
-> Int -> ArrayData e -> Par PTX (Future (ArrayData e))
Prim.peekArrayAsync
  copyToRemoteR :: SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
copyToRemoteR     = SingleType e
-> Int -> ArrayData e -> Par PTX (FutureR PTX (ArrayData e))
forall e.
HasCallStack =>
SingleType e
-> Int -> ArrayData e -> Par PTX (Future (ArrayData e))
Prim.pokeArrayAsync
  copyToPeerR :: PTX
-> SingleType e
-> Int
-> ArrayData e
-> Par PTX (FutureR PTX (ArrayData e))
copyToPeerR       = String
-> PTX
-> SingleType e
-> Int
-> ArrayData e
-> Par PTX (Future (ArrayData e))
forall a. HasCallStack => String -> a
internalError String
"not supported yet"


-- | Copy an array from the remote device to the host. Although the Accelerate
-- program is hyper-strict and will evaluate the computation as soon as any part
-- of it is demanded, the individual array payloads are copied back to the host
-- _only_ as they are demanded by the Haskell program. This has several
-- consequences:
--
--   1. If the device has multiple memcpy engines, only one will be used. The
--      transfers are however associated with a non-default stream.
--
--   2. Using 'seq' to force an Array to head-normal form will initiate the
--      computation, but not transfer the results back to the host. Requesting
--      an array element or using 'deepseq' to force to normal form is required
--      to actually transfer the data.
--
{-# INLINEABLE copyToHostLazy #-}
copyToHostLazy
    :: HasCallStack
    => ArraysR arrs
    -> FutureArraysR PTX arrs
    -> Par PTX arrs
copyToHostLazy :: ArraysR arrs -> FutureArraysR PTX arrs -> Par PTX arrs
copyToHostLazy ArraysR arrs
TupRunit         ()       = () -> Par PTX ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
copyToHostLazy (TupRpair TupR ArrayR a1
r1 TupR ArrayR b
r2) (f1, f2) = do
  a1
a1 <- TupR ArrayR a1 -> FutureArraysR PTX a1 -> Par PTX a1
forall arrs.
HasCallStack =>
ArraysR arrs -> FutureArraysR PTX arrs -> Par PTX arrs
copyToHostLazy TupR ArrayR a1
r1 FutureArraysR PTX a1
f1
  b
a2 <- TupR ArrayR b -> FutureArraysR PTX b -> Par PTX b
forall arrs.
HasCallStack =>
ArraysR arrs -> FutureArraysR PTX arrs -> Par PTX arrs
copyToHostLazy TupR ArrayR b
r2 FutureArraysR PTX b
f2
  (a1, b) -> Par PTX (a1, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a1
a1, b
a2)
copyToHostLazy (TupRsingle (ArrayR ShapeR sh
shr TypeR e
tp)) FutureArraysR PTX arrs
future = do
  PTX
ptx <- (PTX -> PTX) -> Par PTX PTX
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets PTX -> PTX
forall t. t -> t
llvmTarget
  IO (Array sh e) -> Par PTX (Array sh e)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array sh e) -> Par PTX (Array sh e))
-> IO (Array sh e) -> Par PTX (Array sh e)
forall a b. (a -> b) -> a -> b
$ do
    Array sh
sh ArrayData e
adata <- Future (Array sh e) -> IO (Array sh e)
forall a. Future a -> IO a
wait FutureArraysR PTX arrs
Future (Array sh e)
future

    -- Note: [Lazy device-host transfers]
    --
    -- This needs must be non-strict at the leaves of the datatype (that
    -- is, the UniqueArray pointers). This means we can traverse the
    -- ArrayData constructors (in particular, the spine defined by Unit
    -- and Pair) until we reach the array we care about, without forcing
    -- the other fields.
    --
    -- https://github.com/AccelerateHS/accelerate/issues/437
    --
    -- Furthermore, we only want to transfer the data if the host pointer
    -- is currently unevaluated. This situation can occur for example if
    -- the argument to 'use' or 'unit' is returned as part of the result
    -- of a 'run'. Peek at GHC's underlying closure representation and
    -- check whether the pointer is a thunk, and only initiate the
    -- transfer if so.
    --
    let
      peekR :: SingleType e
            -> ArrayData e
            -> Int
            -> IO (ArrayData e)
      peekR :: SingleType e -> ArrayData e -> Int -> IO (ArrayData e)
peekR SingleType e
t ArrayData e
ad Int
m
        | SingleArrayDict e
SingleArrayDict                        <- SingleType e -> SingleArrayDict e
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType e
t
        , UniqueArray uid (Lifetime lft weak fp) <- ArrayData e
ad
        = IO (UniqueArray e) -> IO (UniqueArray e)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (UniqueArray e) -> IO (UniqueArray e))
-> IO (UniqueArray e) -> IO (UniqueArray e)
forall a b. (a -> b) -> a -> b
$ do
          Bool
yes <- ForeignPtr e -> IO Bool
forall a. a -> IO Bool
isNormalForm ForeignPtr e
fp
          ForeignPtr e
fp' <- if Bool
yes
                    then ForeignPtr e -> IO (ForeignPtr e)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr e
fp
                    else IO (ForeignPtr e) -> IO (ForeignPtr e)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (ForeignPtr e) -> IO (ForeignPtr e))
-> (Par PTX (ForeignPtr e) -> IO (ForeignPtr e))
-> Par PTX (ForeignPtr e)
-> IO (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PTX -> LLVM PTX (ForeignPtr e) -> IO (ForeignPtr e)
forall a. PTX -> LLVM PTX a -> IO a
evalPTX PTX
ptx (LLVM PTX (ForeignPtr e) -> IO (ForeignPtr e))
-> (Par PTX (ForeignPtr e) -> LLVM PTX (ForeignPtr e))
-> Par PTX (ForeignPtr e)
-> IO (ForeignPtr e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par PTX (ForeignPtr e) -> LLVM PTX (ForeignPtr e)
forall a. Par PTX a -> LLVM PTX a
evalPar (Par PTX (ForeignPtr e) -> IO (ForeignPtr e))
-> Par PTX (ForeignPtr e) -> IO (ForeignPtr e)
forall a b. (a -> b) -> a -> b
$ do
                          !UniqueArray e
_ <- Future (UniqueArray e) -> Par PTX (UniqueArray e)
forall arch a.
(Async arch, HasCallStack) =>
FutureR arch a -> Par arch a
block (Future (UniqueArray e) -> Par PTX (UniqueArray e))
-> Par PTX (Future (UniqueArray e)) -> Par PTX (UniqueArray e)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SingleType e
-> Int -> ArrayData e -> Par PTX (Future (ArrayData e))
forall e.
HasCallStack =>
SingleType e
-> Int -> ArrayData e -> Par PTX (Future (ArrayData e))
Prim.peekArrayAsync SingleType e
t Int
m ArrayData e
ad
                          ForeignPtr e -> Par PTX (ForeignPtr e)
forall (m :: * -> *) a. Monad m => a -> m a
return ForeignPtr e
fp
          --
          UniqueArray e -> IO (UniqueArray e)
forall (m :: * -> *) a. Monad m => a -> m a
return (UniqueArray e -> IO (UniqueArray e))
-> UniqueArray e -> IO (UniqueArray e)
forall a b. (a -> b) -> a -> b
$ Unique -> Lifetime (ForeignPtr e) -> UniqueArray e
forall e. Unique -> Lifetime (ForeignPtr e) -> UniqueArray e
UniqueArray Unique
uid (LTF -> Weak LTF -> ForeignPtr e -> Lifetime (ForeignPtr e)
forall a. LTF -> Weak LTF -> a -> Lifetime a
Lifetime LTF
lft Weak LTF
weak ForeignPtr e
fp')

      n :: Int
n = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr sh
sh

      runR :: TypeR e -> ArrayData e -> IO (ArrayData e)
      runR :: TypeR e -> ArrayData e -> IO (ArrayData e)
runR TypeR e
TupRunit           !()          = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      runR (TupRpair !TupR ScalarType a1
t1 !TupR ScalarType b
t2) (!ad1, !ad2) = (,) (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> IO (GArrayDataR UniqueArray a1)
-> IO
     (GArrayDataR UniqueArray b
      -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TupR ScalarType a1
-> GArrayDataR UniqueArray a1 -> IO (GArrayDataR UniqueArray a1)
forall e. TypeR e -> ArrayData e -> IO (ArrayData e)
runR TupR ScalarType a1
t1 GArrayDataR UniqueArray a1
ad1 IO
  (GArrayDataR UniqueArray b
   -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> IO (GArrayDataR UniqueArray b)
-> IO (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TupR ScalarType b
-> GArrayDataR UniqueArray b -> IO (GArrayDataR UniqueArray b)
forall e. TypeR e -> ArrayData e -> IO (ArrayData e)
runR TupR ScalarType b
t2 GArrayDataR UniqueArray b
ad2
      runR (TupRsingle !ScalarType e
t)    !ArrayData e
ad          =
        case ScalarType e
t of
          SingleScalarType SingleType e
s                       -> SingleType e -> ArrayData e -> Int -> IO (ArrayData e)
forall e. SingleType e -> ArrayData e -> Int -> IO (ArrayData e)
peekR SingleType e
s ArrayData e
ad Int
n
          VectorScalarType (VectorType Int
w SingleType a1
s)
            | SingleArrayDict a1
SingleArrayDict <- SingleType a1 -> SingleArrayDict a1
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType a1
s -> SingleType a1 -> ArrayData a1 -> Int -> IO (ArrayData a1)
forall e. SingleType e -> ArrayData e -> Int -> IO (ArrayData e)
peekR SingleType a1
s ArrayData e
ArrayData a1
ad (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    sh -> ArrayData e -> Array sh e
forall sh e. sh -> ArrayData e -> Array sh e
Array sh
sh (ArrayData e -> Array sh e) -> IO (ArrayData e) -> IO (Array sh e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeR e -> ArrayData e -> IO (ArrayData e)
forall e. TypeR e -> ArrayData e -> IO (ArrayData e)
runR TypeR e
tp ArrayData e
adata

-- | Clone an array into a newly allocated array on the device.
--
cloneArrayAsync
    :: ArrayR (Array sh e)
    -> Array sh e
    -> Par PTX (Future (Array sh e))
cloneArrayAsync :: ArrayR (Array sh e) -> Array sh e -> Par PTX (Future (Array sh e))
cloneArrayAsync repr :: ArrayR (Array sh e)
repr@(ArrayR ShapeR sh
shr TypeR e
tp) arr :: Array sh e
arr@(Array sh
_ ArrayData e
src) = do
  Array sh
_ ArrayData e
dst <- ArrayR (Array sh e) -> sh -> Par PTX (Array sh e)
forall arch sh e.
Remote arch =>
ArrayR (Array sh e) -> sh -> Par arch (Array sh e)
allocateRemote ArrayR (Array sh e)
repr sh
sh
  sh -> ArrayData e -> Array sh e
forall sh e. sh -> ArrayData e -> Array sh e
Array sh
sh (ArrayData e -> Array sh e)
-> Par PTX (FutureR PTX (ArrayData e))
-> Par PTX (FutureR PTX (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 -> ArrayData e -> Par PTX (Future (ArrayData e))
forall s.
TypeR s
-> ArrayData s -> ArrayData s -> Par PTX (Future (ArrayData s))
copyR TypeR e
tp ArrayData e
ArrayData e
src ArrayData e
ArrayData e
dst
  where
    sh :: sh
sh = Array sh e -> sh
forall sh e. Array sh e -> sh
shape Array sh e
arr
    n :: Int
n  = ShapeR sh -> sh -> Int
forall sh. ShapeR sh -> sh -> Int
size ShapeR sh
shr sh
sh
sh

    copyR :: TypeR s -> ArrayData s -> ArrayData s -> Par PTX (Future (ArrayData s))
    copyR :: TypeR s
-> ArrayData s -> ArrayData s -> Par PTX (Future (ArrayData s))
copyR TypeR s
TupRunit           !ArrayData s
_          !ArrayData s
_            = () -> Par PTX (FutureR PTX ())
forall arch a.
(Async arch, HasCallStack) =>
a -> Par arch (FutureR arch a)
newFull ()
    copyR (TupRpair !TupR ScalarType a1
t1 !TupR ScalarType b
t2) !(ad1, ad2) !(ad1', ad2') = (GArrayDataR UniqueArray a1
 -> GArrayDataR UniqueArray b
 -> (GArrayDataR UniqueArray a1, GArrayDataR UniqueArray b))
-> Par PTX (FutureR PTX (GArrayDataR UniqueArray a1))
-> Par PTX (FutureR PTX (GArrayDataR UniqueArray b))
-> Par
     PTX
     (FutureR
        PTX (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
-> GArrayDataR UniqueArray a1
-> Par PTX (Future (GArrayDataR UniqueArray a1))
forall s.
TypeR s
-> ArrayData s -> ArrayData s -> Par PTX (Future (ArrayData s))
copyR TupR ScalarType a1
t1 GArrayDataR UniqueArray a1
ad1 GArrayDataR UniqueArray a1
ad1') (TupR ScalarType b
-> GArrayDataR UniqueArray b
-> GArrayDataR UniqueArray b
-> Par PTX (Future (GArrayDataR UniqueArray b))
forall s.
TypeR s
-> ArrayData s -> ArrayData s -> Par PTX (Future (ArrayData s))
copyR TupR ScalarType b
t2 GArrayDataR UniqueArray b
ad2 GArrayDataR UniqueArray b
ad2')
    copyR (TupRsingle !ScalarType s
t)    !ArrayData s
ad         !ArrayData s
ad'          =
      case ScalarType s
t of
        SingleScalarType SingleType s
s                       -> SingleType s
-> ArrayData s
-> ArrayData s
-> Int
-> Par PTX (Future (ArrayData s))
forall s.
SingleType s
-> ArrayData s
-> ArrayData s
-> Int
-> Par PTX (Future (ArrayData s))
copyPrim SingleType s
s ArrayData s
ad ArrayData s
ad' Int
n
        VectorScalarType (VectorType Int
w SingleType a1
s)
          | SingleArrayDict a1
SingleArrayDict <- SingleType a1 -> SingleArrayDict a1
forall a. SingleType a -> SingleArrayDict a
singleArrayDict SingleType a1
s -> SingleType a1
-> ArrayData a1
-> ArrayData a1
-> Int
-> Par PTX (Future (ArrayData a1))
forall s.
SingleType s
-> ArrayData s
-> ArrayData s
-> Int
-> Par PTX (Future (ArrayData s))
copyPrim SingleType a1
s ArrayData s
ArrayData a1
ad ArrayData s
ArrayData a1
ad' (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w)

    copyPrim
        :: SingleType s
        -> ArrayData s
        -> ArrayData s
        -> Int
        -> Par PTX (Future (ArrayData s))
    copyPrim :: SingleType s
-> ArrayData s
-> ArrayData s
-> Int
-> Par PTX (Future (ArrayData s))
copyPrim !SingleType s
s !ArrayData s
a1 !ArrayData s
a2 !Int
m = SingleType s
-> Int
-> ArrayData s
-> ArrayData s
-> Par PTX (Future (ArrayData s))
forall e.
HasCallStack =>
SingleType e
-> Int
-> ArrayData e
-> ArrayData e
-> Par PTX (Future (ArrayData e))
Prim.copyArrayAsync SingleType s
s Int
m ArrayData s
a1 ArrayData s
a2

    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
      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'  -- don't create a new execution stream for this
      FutureR arch b -> Par arch (FutureR arch b)
forall (m :: * -> *) a. Monad m => a -> m a
return FutureR arch b
r

    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