{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE CPP                  #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TypeApplications     #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- |
-- Module      : Data.Array.Accelerate.LLVM.Native
-- Copyright   : [2014..2020] The Accelerate Team
-- License     : BSD3
--
-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)
--
-- This module implements a backend for the /Accelerate/ language targeting
-- multicore CPUs. Expressions are on-line translated into LLVM code, which is
-- just-in-time executed in parallel over the available CPUs. Functions are
-- automatically parallelised over all available cores, unless you set the
-- environment variable 'ACCELERATE_LLVM_NATIVE_THREADS=N', in which case 'N'
-- threads will be used.
--
-- Programs must be compiled with '-threaded', otherwise you will get a "Blocked
-- indefinitely on MVar" error.
--

module Data.Array.Accelerate.LLVM.Native (

  Acc, Arrays,
  Afunction, AfunctionR,

  -- * Synchronous execution
  run, runWith,
  run1, run1With,
  runN, runNWith,
  stream, streamWith,

  -- * Asynchronous execution
  Async,
  wait, poll, cancel,

  runAsync, runAsyncWith,
  run1Async, run1AsyncWith,
  runNAsync, runNAsyncWith,

  -- * Ahead-of-time compilation
  runQ, runQWith,
  runQAsync, runQAsyncWith,

  -- * Execution targets
  Native,
  createTarget,

) where

import Data.Array.Accelerate.AST                                    ( PreOpenAfun(..), arraysR, liftALeftHandSide )
import Data.Array.Accelerate.AST.LeftHandSide
import Data.Array.Accelerate.Async                                  ( Async, async, wait, poll, cancel )
import Data.Array.Accelerate.Representation.Array                   ( liftArraysR )
import Data.Array.Accelerate.Smart                                  ( Acc )
import Data.Array.Accelerate.Sugar.Array                            ( Arrays, toArr, fromArr, ArraysR )
import Data.Array.Accelerate.Trafo
import Data.Array.Accelerate.Trafo.Sharing                          ( Afunction(..), AfunctionRepr(..), afunctionRepr )
import qualified Data.Array.Accelerate.Sugar.Array                  as Sugar

import Data.Array.Accelerate.LLVM.Native.Array.Data                 ( useRemoteAsync )
import Data.Array.Accelerate.LLVM.Native.Compile                    ( CompiledOpenAfun, compileAcc, compileAfun )
import Data.Array.Accelerate.LLVM.Native.Embed                      ( embedOpenAcc )
import Data.Array.Accelerate.LLVM.Native.Execute                    ( executeAcc, executeOpenAcc )
import Data.Array.Accelerate.LLVM.Native.Execute.Async              ( Par, evalPar, getArrays )
import Data.Array.Accelerate.LLVM.Native.Execute.Environment        ( Val, ValR(..), push )
import Data.Array.Accelerate.LLVM.Native.Link                       ( ExecOpenAfun, linkAcc, linkAfun )
import Data.Array.Accelerate.LLVM.Native.State
import Data.Array.Accelerate.LLVM.Native.Target
import Data.Array.Accelerate.LLVM.Native.Debug                      as Debug

import Control.Monad.Trans
import System.IO.Unsafe
import Text.Printf
import qualified Language.Haskell.TH                                as TH
import qualified Language.Haskell.TH.Syntax                         as TH


-- Accelerate: LLVM backend for multicore CPUs
-- -------------------------------------------

-- | Compile and run a complete embedded array program.
--
-- /NOTE:/ it is recommended to use 'runN' or 'runQ' whenever possible.
--
run :: Arrays a => Acc a -> a
run :: Acc a -> a
run = Native -> Acc a -> a
forall a. Arrays a => Native -> Acc a -> a
runWith Native
defaultTarget

-- | As 'run', but execute using the specified target (thread gang).
--
runWith :: Arrays a => Native -> Acc a -> a
runWith :: Native -> Acc a -> a
runWith Native
target Acc a
a = IO a -> a
forall a. IO a -> a
unsafePerformIO (Native -> Acc a -> IO a
forall a. Arrays a => Native -> Acc a -> IO a
runWithIO Native
target Acc a
a)

-- | As 'run', but allow the computation to run asynchronously and return
-- immediately without waiting for the result. The status of the computation can
-- be queried using 'wait', 'poll', and 'cancel'.
--
runAsync :: Arrays a => Acc a -> IO (Async a)
runAsync :: Acc a -> IO (Async a)
runAsync = Native -> Acc a -> IO (Async a)
forall a. Arrays a => Native -> Acc a -> IO (Async a)
runAsyncWith Native
defaultTarget

-- | As 'runAsync', but execute using the specified target (thread gang).
--
runAsyncWith :: Arrays a => Native -> Acc a -> IO (Async a)
runAsyncWith :: Native -> Acc a -> IO (Async a)
runAsyncWith Native
target Acc a
a = IO a -> IO (Async a)
forall a. IO a -> IO (Async a)
async (Native -> Acc a -> IO a
forall a. Arrays a => Native -> Acc a -> IO a
runWithIO Native
target Acc a
a)

runWithIO :: Arrays a => Native -> Acc a -> IO a
runWithIO :: Native -> Acc a -> IO a
runWithIO Native
target Acc a
a = IO a
execute
  where
    !acc :: DelayedAcc (ArraysR a)
acc    = Acc a -> DelayedAcc (ArraysR a)
forall arrs. Acc arrs -> DelayedAcc (ArraysR arrs)
convertAcc Acc a
a
    execute :: IO a
execute = do
      DelayedAcc (ArraysR a) -> IO ()
forall (m :: * -> *) g. (MonadIO m, PrettyGraph g) => g -> m ()
dumpGraph DelayedAcc (ArraysR a)
acc
      Native -> LLVM Native a -> IO a
forall a. Native -> LLVM Native a -> IO a
evalNative Native
target (LLVM Native a -> IO a) -> LLVM Native a -> IO a
forall a b. (a -> b) -> a -> b
$ do
        CompiledAcc Native (ArraysR a)
build <- String
-> (Double -> Double -> String)
-> LLVM Native (CompiledAcc Native (ArraysR a))
-> LLVM Native (CompiledAcc Native (ArraysR a))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"compile" Double -> Double -> String
elapsedS (DelayedAcc (ArraysR a)
-> LLVM Native (CompiledAcc Native (ArraysR a))
forall arch a.
(HasCallStack, Compile arch) =>
DelayedAcc a -> LLVM arch (CompiledAcc arch a)
compileAcc DelayedAcc (ArraysR a)
acc) LLVM Native (CompiledAcc Native (ArraysR a))
-> (CompiledAcc Native (ArraysR a)
    -> LLVM Native (CompiledAcc Native (ArraysR a)))
-> LLVM Native (CompiledAcc Native (ArraysR a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompiledAcc Native (ArraysR a)
-> LLVM Native (CompiledAcc Native (ArraysR a))
forall (m :: * -> *) a. MonadIO m => a -> m a
dumpStats
        ExecAcc Native (ArraysR a)
exec  <- String
-> (Double -> Double -> String)
-> LLVM Native (ExecAcc Native (ArraysR a))
-> LLVM Native (ExecAcc Native (ArraysR a))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"link"    Double -> Double -> String
elapsedS (CompiledAcc Native (ArraysR a)
-> LLVM Native (ExecAcc Native (ArraysR a))
forall arch a.
Link arch =>
CompiledAcc arch a -> LLVM arch (ExecAcc arch a)
linkAcc CompiledAcc Native (ArraysR a)
build)
        ArraysR a
res   <- String
-> (Double -> Double -> String)
-> LLVM Native (ArraysR a)
-> LLVM Native (ArraysR a)
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"execute" Double -> Double -> String
elapsedP (Par Native (ArraysR a) -> LLVM Native (ArraysR a)
forall a. Par Native a -> LLVM Native a
evalPar (ExecAcc Native (ArraysR a)
-> Par Native (FutureArraysR Native (ArraysR a))
forall arch a.
Execute arch =>
ExecAcc arch a -> Par arch (FutureArraysR arch a)
executeAcc ExecAcc Native (ArraysR a)
exec Par Native (FutureArraysR Native (ArraysR a))
-> (FutureArraysR Native (ArraysR a) -> Par Native (ArraysR a))
-> Par Native (ArraysR a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ArraysR (ArraysR a)
-> FutureArraysR Native (ArraysR a) -> Par Native (ArraysR a)
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays (ExecAcc Native (ArraysR a) -> ArraysR (ArraysR a)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR ExecAcc Native (ArraysR a)
exec)))
        a -> LLVM Native a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> LLVM Native a) -> a -> LLVM Native a
forall a b. (a -> b) -> a -> b
$ ArraysR a -> a
forall a. Arrays a => ArraysR a -> a
toArr ArraysR a
res


-- | This is 'runN', specialised to an array program of one argument.
--
run1 :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> b
run1 :: (Acc a -> Acc b) -> a -> b
run1 = Native -> (Acc a -> Acc b) -> a -> b
forall a b.
(Arrays a, Arrays b) =>
Native -> (Acc a -> Acc b) -> a -> b
run1With Native
defaultTarget

-- | As 'run1', but execute using the specified target (thread gang).
--
run1With :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> a -> b
run1With :: Native -> (Acc a -> Acc b) -> a -> b
run1With = Native -> (Acc a -> Acc b) -> a -> b
forall f. Afunction f => Native -> f -> AfunctionR f
runNWith


-- | Prepare and execute an embedded array program.
--
-- This function can be used to improve performance in cases where the array
-- program is constant between invocations, because it enables us to bypass
-- front-end conversion stages and move directly to the execution phase. If you
-- have a computation applied repeatedly to different input data, use this,
-- specifying any changing aspects of the computation via the input parameters.
-- If the function is only evaluated once, this is equivalent to 'run'.
--
-- In order to use 'runN' you must express your Accelerate program as a function
-- of array terms:
--
-- > f :: (Arrays a, Arrays b, ... Arrays c) => Acc a -> Acc b -> ... -> Acc c
--
-- This function then returns the compiled version of 'f':
--
-- > runN f :: (Arrays a, Arrays b, ... Arrays c) => a -> b -> ... -> c
--
-- At an example, rather than:
--
-- > step :: Acc (Vector a) -> Acc (Vector b)
-- > step = ...
-- >
-- > simulate :: Vector a -> Vector b
-- > simulate xs = run $ step (use xs)
--
-- Instead write:
--
-- > simulate = runN step
--
-- You can use the debugging options to check whether this is working
-- successfully. For example, running with the @-ddump-phases@ flag should show
-- that the compilation steps only happen once, not on the second and subsequent
-- invocations of 'simulate'. Note that this typically relies on GHC knowing
-- that it can lift out the function returned by 'runN' and reuse it.
--
-- See the programs in the 'accelerate-examples' package for examples.
--
-- See also 'runQ', which compiles the Accelerate program at _Haskell_ compile
-- time, thus eliminating the runtime overhead altogether.
--
runN :: Afunction f => f -> AfunctionR f
runN :: f -> AfunctionR f
runN = Native -> f -> AfunctionR f
forall f. Afunction f => Native -> f -> AfunctionR f
runNWith Native
defaultTarget

-- | As 'runN', but execute using the specified target (thread gang).
--
runNWith :: forall f. Afunction f => Native -> f -> AfunctionR f
runNWith :: Native -> f -> AfunctionR f
runNWith Native
target f
f = AfunctionRepr f (AfunctionR f) (ArraysFunctionR f)
-> ExecOpenAfun Native () (ArraysFunctionR f)
-> Par Native (Val ())
-> AfunctionR f
forall t aenv.
AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
-> ExecOpenAfun Native aenv (ArraysFunctionR t)
-> Par Native (Val aenv)
-> AfunctionR t
go ((Afunction f, HasCallStack) =>
AfunctionRepr f (AfunctionR f) (ArraysFunctionR f)
forall f.
(Afunction f, HasCallStack) =>
AfunctionRepr f (AfunctionR f) (ArraysFunctionR f)
afunctionRepr @f) ExecOpenAfun Native () (ArraysFunctionR f)
afun (Val () -> Par Native (Val ())
forall (m :: * -> *) a. Monad m => a -> m a
return Val ()
forall arch. ValR arch ()
Empty)
  where
    !acc :: DelayedAfun (ArraysFunctionR f)
acc  = f -> DelayedAfun (ArraysFunctionR f)
forall f. Afunction f => f -> DelayedAfun (ArraysFunctionR f)
convertAfun f
f
    !afun :: ExecOpenAfun Native () (ArraysFunctionR f)
afun = IO (ExecOpenAfun Native () (ArraysFunctionR f))
-> ExecOpenAfun Native () (ArraysFunctionR f)
forall a. IO a -> a
unsafePerformIO (IO (ExecOpenAfun Native () (ArraysFunctionR f))
 -> ExecOpenAfun Native () (ArraysFunctionR f))
-> IO (ExecOpenAfun Native () (ArraysFunctionR f))
-> ExecOpenAfun Native () (ArraysFunctionR f)
forall a b. (a -> b) -> a -> b
$ do
              DelayedAfun (ArraysFunctionR f) -> IO ()
forall (m :: * -> *) g. (MonadIO m, PrettyGraph g) => g -> m ()
dumpGraph DelayedAfun (ArraysFunctionR f)
acc
              Native
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
-> IO (ExecOpenAfun Native () (ArraysFunctionR f))
forall a. Native -> LLVM Native a -> IO a
evalNative Native
target (LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
 -> IO (ExecOpenAfun Native () (ArraysFunctionR f)))
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
-> IO (ExecOpenAfun Native () (ArraysFunctionR f))
forall a b. (a -> b) -> a -> b
$ do
                CompiledAfun Native (ArraysFunctionR f)
build <- String
-> (Double -> Double -> String)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"compile" Double -> Double -> String
elapsedS (DelayedAfun (ArraysFunctionR f)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall arch f.
(HasCallStack, Compile arch) =>
DelayedAfun f -> LLVM arch (CompiledAfun arch f)
compileAfun DelayedAfun (ArraysFunctionR f)
acc) LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> (CompiledAfun Native (ArraysFunctionR f)
    -> LLVM Native (CompiledAfun Native (ArraysFunctionR f)))
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompiledAfun Native (ArraysFunctionR f)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a. MonadIO m => a -> m a
dumpStats
                ExecOpenAfun Native () (ArraysFunctionR f)
link  <- String
-> (Double -> Double -> String)
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"link"    Double -> Double -> String
elapsedS (CompiledAfun Native (ArraysFunctionR f)
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
forall arch f.
Link arch =>
CompiledAfun arch f -> LLVM arch (ExecAfun arch f)
linkAfun CompiledAfun Native (ArraysFunctionR f)
build)
                ExecOpenAfun Native () (ArraysFunctionR f)
-> LLVM Native (ExecOpenAfun Native () (ArraysFunctionR f))
forall (m :: * -> *) a. Monad m => a -> m a
return ExecOpenAfun Native () (ArraysFunctionR f)
link

    go :: AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
       -> ExecOpenAfun Native aenv (ArraysFunctionR t)
       -> Par Native (Val aenv)
       -> AfunctionR t
    go :: AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
-> ExecOpenAfun Native aenv (ArraysFunctionR t)
-> Par Native (Val aenv)
-> AfunctionR t
go (AfunctionReprLam AfunctionRepr b br breprr
repr) (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun (ExecOpenAcc Native) aenv' t1
l) Par Native (Val aenv)
k = \(a
arrs :: a) ->
      let k' :: Par Native (ValR Native aenv')
k' = do Val aenv
aenv  <- Par Native (Val aenv)
k
                  FutureArraysR Native (ArraysR a)
a     <- ArraysR (ArraysR a)
-> ArraysR a -> Par Native (FutureArraysR Native (ArraysR a))
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
useRemoteAsync (Arrays a => ArraysR (ArraysR a)
forall a. Arrays a => ArraysR (ArraysR a)
Sugar.arraysR @a) (ArraysR a -> Par Native (FutureArraysR Native (ArraysR a)))
-> ArraysR a -> Par Native (FutureArraysR Native (ArraysR a))
forall a b. (a -> b) -> a -> b
$ a -> ArraysR a
forall a. Arrays a => a -> ArraysR a
fromArr a
arrs
                  ValR Native aenv' -> Par Native (ValR Native aenv')
forall (m :: * -> *) a. Monad m => a -> m a
return (Val aenv
aenv Val aenv
-> (ALeftHandSide a aenv aenv', FutureArraysR Native a)
-> ValR Native aenv'
forall arch env t env'.
ValR arch env
-> (ALeftHandSide t env env', FutureArraysR arch t)
-> ValR arch env'
`push` (ALeftHandSide a aenv aenv'
lhs, FutureArraysR Native a
FutureArraysR Native (ArraysR a)
a))
      in AfunctionRepr b (AfunctionR b) (ArraysFunctionR b)
-> ExecOpenAfun Native aenv' (ArraysFunctionR b)
-> Par Native (ValR Native aenv')
-> AfunctionR b
forall t aenv.
AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
-> ExecOpenAfun Native aenv (ArraysFunctionR t)
-> Par Native (Val aenv)
-> AfunctionR t
go AfunctionRepr b br breprr
AfunctionRepr b (AfunctionR b) (ArraysFunctionR b)
repr PreOpenAfun (ExecOpenAcc Native) aenv' t1
ExecOpenAfun Native aenv' (ArraysFunctionR b)
l Par Native (ValR Native aenv')
k'
    go AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
AfunctionReprBody (Abody ExecOpenAcc Native aenv (ArraysFunctionR t)
b) Par Native (Val aenv)
k = IO (AfunctionR t) -> AfunctionR t
forall a. IO a -> a
unsafePerformIO (IO (AfunctionR t) -> AfunctionR t)
-> (Par Native (AfunctionR t) -> IO (AfunctionR t))
-> Par Native (AfunctionR t)
-> AfunctionR t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> (Double -> Double -> String)
-> IO (AfunctionR t)
-> IO (AfunctionR t)
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"execute" Double -> Double -> String
elapsedP (IO (AfunctionR t) -> IO (AfunctionR t))
-> (Par Native (AfunctionR t) -> IO (AfunctionR t))
-> Par Native (AfunctionR t)
-> IO (AfunctionR t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Native -> LLVM Native (AfunctionR t) -> IO (AfunctionR t)
forall a. Native -> LLVM Native a -> IO a
evalNative Native
target (LLVM Native (AfunctionR t) -> IO (AfunctionR t))
-> (Par Native (AfunctionR t) -> LLVM Native (AfunctionR t))
-> Par Native (AfunctionR t)
-> IO (AfunctionR t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par Native (AfunctionR t) -> LLVM Native (AfunctionR t)
forall a. Par Native a -> LLVM Native a
evalPar (Par Native (AfunctionR t) -> AfunctionR t)
-> Par Native (AfunctionR t) -> AfunctionR t
forall a b. (a -> b) -> a -> b
$ do
      Val aenv
aenv <- Par Native (Val aenv)
k
      FutureArraysR Native (ArraysR (AfunctionR t))
res  <- ExecOpenAcc Native aenv (ArraysR (AfunctionR t))
-> Val aenv
-> Par Native (FutureArraysR Native (ArraysR (AfunctionR t)))
forall arch aenv arrs.
Execute arch =>
ExecOpenAcc arch aenv arrs
-> ValR arch aenv -> Par arch (FutureArraysR arch arrs)
executeOpenAcc ExecOpenAcc Native aenv (ArraysFunctionR t)
ExecOpenAcc Native aenv (ArraysR (AfunctionR t))
b Val aenv
aenv
      ArraysR (AfunctionR t)
arrs <- ArraysR (ArraysR (AfunctionR t))
-> FutureArraysR Native (ArraysR (AfunctionR t))
-> Par Native (ArraysR (AfunctionR t))
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays (ExecOpenAcc Native aenv (ArraysR (AfunctionR t))
-> ArraysR (ArraysR (AfunctionR t))
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR ExecOpenAcc Native aenv (ArraysFunctionR t)
ExecOpenAcc Native aenv (ArraysR (AfunctionR t))
b) FutureArraysR Native (ArraysR (AfunctionR t))
res
      AfunctionR t -> Par Native (AfunctionR t)
forall (m :: * -> *) a. Monad m => a -> m a
return (AfunctionR t -> Par Native (AfunctionR t))
-> AfunctionR t -> Par Native (AfunctionR t)
forall a b. (a -> b) -> a -> b
$ ArraysR (AfunctionR t) -> AfunctionR t
forall a. Arrays a => ArraysR a -> a
toArr ArraysR (AfunctionR t)
arrs
    go AfunctionRepr t (AfunctionR t) (ArraysFunctionR t)
_ ExecOpenAfun Native aenv (ArraysFunctionR t)
_ Par Native (Val aenv)
_ = String -> AfunctionR t
forall a. HasCallStack => String -> a
error String
"The moon is hanging upside down"


-- | As 'run1', but execute asynchronously.
--
run1Async :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> a -> IO (Async b)
run1Async :: (Acc a -> Acc b) -> a -> IO (Async b)
run1Async = Native -> (Acc a -> Acc b) -> a -> IO (Async b)
forall a b.
(Arrays a, Arrays b) =>
Native -> (Acc a -> Acc b) -> a -> IO (Async b)
run1AsyncWith Native
defaultTarget

-- | As 'run1Async', but execute using the specified target (thread gang).
--
run1AsyncWith :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> a -> IO (Async b)
run1AsyncWith :: Native -> (Acc a -> Acc b) -> a -> IO (Async b)
run1AsyncWith = Native -> (Acc a -> Acc b) -> a -> IO (Async b)
forall f r.
(Afunction f, RunAsync r, ArraysFunctionR f ~ RunAsyncR r) =>
Native -> f -> r
runNAsyncWith


-- | As 'runN', but execute asynchronously.
--
runNAsync :: (Afunction f, RunAsync r, ArraysFunctionR f ~ RunAsyncR r) => f -> r
runNAsync :: f -> r
runNAsync = Native -> f -> r
forall f r.
(Afunction f, RunAsync r, ArraysFunctionR f ~ RunAsyncR r) =>
Native -> f -> r
runNAsyncWith Native
defaultTarget

-- | As 'runNWith', but execute asynchronously.
--
runNAsyncWith :: (Afunction f, RunAsync r, ArraysFunctionR f ~ RunAsyncR r) => Native -> f -> r
runNAsyncWith :: Native -> f -> r
runNAsyncWith Native
target f
f = r
exec
  where
    !acc :: DelayedAfun (ArraysFunctionR f)
acc  = f -> DelayedAfun (ArraysFunctionR f)
forall f. Afunction f => f -> DelayedAfun (ArraysFunctionR f)
convertAfun f
f
    !afun :: ExecAfun Native (RunAsyncR r)
afun = IO (ExecAfun Native (RunAsyncR r)) -> ExecAfun Native (RunAsyncR r)
forall a. IO a -> a
unsafePerformIO (IO (ExecAfun Native (RunAsyncR r))
 -> ExecAfun Native (RunAsyncR r))
-> IO (ExecAfun Native (RunAsyncR r))
-> ExecAfun Native (RunAsyncR r)
forall a b. (a -> b) -> a -> b
$ do
              DelayedAfun (RunAsyncR r) -> IO ()
forall (m :: * -> *) g. (MonadIO m, PrettyGraph g) => g -> m ()
dumpGraph DelayedAfun (ArraysFunctionR f)
DelayedAfun (RunAsyncR r)
acc
              Native
-> LLVM Native (ExecAfun Native (RunAsyncR r))
-> IO (ExecAfun Native (RunAsyncR r))
forall a. Native -> LLVM Native a -> IO a
evalNative Native
target (LLVM Native (ExecAfun Native (RunAsyncR r))
 -> IO (ExecAfun Native (RunAsyncR r)))
-> LLVM Native (ExecAfun Native (RunAsyncR r))
-> IO (ExecAfun Native (RunAsyncR r))
forall a b. (a -> b) -> a -> b
$ do
                CompiledAfun Native (RunAsyncR r)
build <- String
-> (Double -> Double -> String)
-> LLVM Native (CompiledAfun Native (RunAsyncR r))
-> LLVM Native (CompiledAfun Native (RunAsyncR r))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"compile" Double -> Double -> String
elapsedS (DelayedAfun (RunAsyncR r)
-> LLVM Native (CompiledAfun Native (RunAsyncR r))
forall arch f.
(HasCallStack, Compile arch) =>
DelayedAfun f -> LLVM arch (CompiledAfun arch f)
compileAfun DelayedAfun (ArraysFunctionR f)
DelayedAfun (RunAsyncR r)
acc) LLVM Native (CompiledAfun Native (RunAsyncR r))
-> (CompiledAfun Native (RunAsyncR r)
    -> LLVM Native (CompiledAfun Native (RunAsyncR r)))
-> LLVM Native (CompiledAfun Native (RunAsyncR r))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompiledAfun Native (RunAsyncR r)
-> LLVM Native (CompiledAfun Native (RunAsyncR r))
forall (m :: * -> *) a. MonadIO m => a -> m a
dumpStats
                ExecAfun Native (RunAsyncR r)
link  <- String
-> (Double -> Double -> String)
-> LLVM Native (ExecAfun Native (RunAsyncR r))
-> LLVM Native (ExecAfun Native (RunAsyncR r))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"link"    Double -> Double -> String
elapsedS (CompiledAfun Native (RunAsyncR r)
-> LLVM Native (ExecAfun Native (RunAsyncR r))
forall arch f.
Link arch =>
CompiledAfun arch f -> LLVM arch (ExecAfun arch f)
linkAfun CompiledAfun Native (RunAsyncR r)
build)
                ExecAfun Native (RunAsyncR r)
-> LLVM Native (ExecAfun Native (RunAsyncR r))
forall (m :: * -> *) a. Monad m => a -> m a
return ExecAfun Native (RunAsyncR r)
link
    !exec :: r
exec = Native -> ExecAfun Native (RunAsyncR r) -> Par Native (Val ()) -> r
forall f aenv.
RunAsync f =>
Native
-> ExecOpenAfun Native aenv (RunAsyncR f)
-> Par Native (Val aenv)
-> f
runAsync' Native
target ExecAfun Native (RunAsyncR r)
afun (Val () -> Par Native (Val ())
forall (m :: * -> *) a. Monad m => a -> m a
return Val ()
forall arch. ValR arch ()
Empty)

class RunAsync f where
  type RunAsyncR f
  runAsync' :: Native -> ExecOpenAfun Native aenv (RunAsyncR f) -> Par Native (Val aenv) -> f

instance (Arrays a, RunAsync b) => RunAsync (a -> b) where
  type RunAsyncR (a -> b) = ArraysR a -> RunAsyncR b
  runAsync' :: Native
-> ExecOpenAfun Native aenv (RunAsyncR (a -> b))
-> Par Native (Val aenv)
-> a
-> b
runAsync' Native
_      Abody{}  Par Native (Val aenv)
_ a
_    = String -> b
forall a. HasCallStack => String -> a
error String
"runAsync: function oversaturated"
  runAsync' Native
target (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun (ExecOpenAcc Native) aenv' t1
l) Par Native (Val aenv)
k a
arrs =
    let k' :: Par Native (ValR Native aenv')
k' = do Val aenv
aenv  <- Par Native (Val aenv)
k
                FutureArraysR Native a
a     <- ArraysR a -> a -> Par Native (FutureArraysR Native a)
forall arch arrs.
Remote arch =>
ArraysR arrs -> arrs -> Par arch (FutureArraysR arch arrs)
useRemoteAsync (Arrays a => ArraysR (ArraysR a)
forall a. Arrays a => ArraysR (ArraysR a)
Sugar.arraysR @a) (a -> Par Native (FutureArraysR Native a))
-> a -> Par Native (FutureArraysR Native a)
forall a b. (a -> b) -> a -> b
$ a -> ArraysR a
forall a. Arrays a => a -> ArraysR a
fromArr a
arrs
                ValR Native aenv' -> Par Native (ValR Native aenv')
forall (m :: * -> *) a. Monad m => a -> m a
return (Val aenv
aenv Val aenv
-> (ALeftHandSide a aenv aenv', FutureArraysR Native a)
-> ValR Native aenv'
forall arch env t env'.
ValR arch env
-> (ALeftHandSide t env env', FutureArraysR arch t)
-> ValR arch env'
`push` (ALeftHandSide a aenv aenv'
lhs, FutureArraysR Native a
a))
    in Native
-> ExecOpenAfun Native aenv' (RunAsyncR b)
-> Par Native (ValR Native aenv')
-> b
forall f aenv.
RunAsync f =>
Native
-> ExecOpenAfun Native aenv (RunAsyncR f)
-> Par Native (Val aenv)
-> f
runAsync' Native
target PreOpenAfun (ExecOpenAcc Native) aenv' t1
ExecOpenAfun Native aenv' (RunAsyncR b)
l Par Native (ValR Native aenv')
k'

instance Arrays b => RunAsync (IO (Async b)) where
  type RunAsyncR  (IO (Async b)) = ArraysR b
  runAsync' :: Native
-> ExecOpenAfun Native aenv (RunAsyncR (IO (Async b)))
-> Par Native (Val aenv)
-> IO (Async b)
runAsync' Native
_      Alam{}    Par Native (Val aenv)
_ = String -> IO (Async b)
forall a. HasCallStack => String -> a
error String
"runAsync: function not fully applied"
  runAsync' Native
target (Abody ExecOpenAcc Native aenv (RunAsyncR (IO (Async b)))
b) Par Native (Val aenv)
k = IO b -> IO (Async b)
forall a. IO a -> IO (Async a)
async (IO b -> IO (Async b))
-> (Par Native b -> IO b) -> Par Native b -> IO (Async b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Double -> Double -> String) -> IO b -> IO b
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"execute" Double -> Double -> String
elapsedP (IO b -> IO b) -> (Par Native b -> IO b) -> Par Native b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Native -> LLVM Native b -> IO b
forall a. Native -> LLVM Native a -> IO a
evalNative Native
target (LLVM Native b -> IO b)
-> (Par Native b -> LLVM Native b) -> Par Native b -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Par Native b -> LLVM Native b
forall a. Par Native a -> LLVM Native a
evalPar (Par Native b -> IO (Async b)) -> Par Native b -> IO (Async b)
forall a b. (a -> b) -> a -> b
$ do
    Val aenv
aenv  <- Par Native (Val aenv)
k
    FutureArraysR Native (ArraysR b)
ans   <- ExecOpenAcc Native aenv (ArraysR b)
-> Val aenv -> Par Native (FutureArraysR Native (ArraysR b))
forall arch aenv arrs.
Execute arch =>
ExecOpenAcc arch aenv arrs
-> ValR arch aenv -> Par arch (FutureArraysR arch arrs)
executeOpenAcc ExecOpenAcc Native aenv (ArraysR b)
ExecOpenAcc Native aenv (RunAsyncR (IO (Async b)))
b Val aenv
aenv
    ArraysR b
arrs  <- ArraysR (ArraysR b)
-> FutureArraysR Native (ArraysR b) -> Par Native (ArraysR b)
forall arch a.
Async arch =>
ArraysR a -> FutureArraysR arch a -> Par arch a
getArrays (ExecOpenAcc Native aenv (ArraysR b) -> ArraysR (ArraysR b)
forall (f :: * -> * -> *) aenv a.
HasArraysR f =>
f aenv a -> ArraysR a
arraysR ExecOpenAcc Native aenv (ArraysR b)
ExecOpenAcc Native aenv (RunAsyncR (IO (Async b)))
b) FutureArraysR Native (ArraysR b)
ans
    b -> Par Native b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Par Native b) -> b -> Par Native b
forall a b. (a -> b) -> a -> b
$ ArraysR b -> b
forall a. Arrays a => ArraysR a -> a
toArr ArraysR b
arrs


-- | Stream a lazily read list of input arrays through the given program,
-- collecting results as we go.
--
stream :: (Arrays a, Arrays b) => (Acc a -> Acc b) -> [a] -> [b]
stream :: (Acc a -> Acc b) -> [a] -> [b]
stream = Native -> (Acc a -> Acc b) -> [a] -> [b]
forall a b.
(Arrays a, Arrays b) =>
Native -> (Acc a -> Acc b) -> [a] -> [b]
streamWith Native
defaultTarget

-- | As 'stream', but execute using the specified target (thread gang).
--
streamWith :: (Arrays a, Arrays b) => Native -> (Acc a -> Acc b) -> [a] -> [b]
streamWith :: Native -> (Acc a -> Acc b) -> [a] -> [b]
streamWith Native
target Acc a -> Acc b
f [a]
arrs = (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
go [a]
arrs
  where
    !go :: a -> b
go = Native -> (Acc a -> Acc b) -> a -> b
forall a b.
(Arrays a, Arrays b) =>
Native -> (Acc a -> Acc b) -> a -> b
run1With Native
target Acc a -> Acc b
f


-- | Ahead-of-time compilation for an embedded array program.
--
-- This function will generate, compile, and link into the final executable,
-- code to execute the given Accelerate computation /at Haskell compile time/.
-- This eliminates any runtime overhead associated with the other @run*@
-- operations. The generated code will be optimised for the compiling
-- architecture.
--
-- Since the Accelerate program will be generated at Haskell compile time,
-- construction of the Accelerate program, in particular via meta-programming,
-- will be limited to operations available to that phase. Also note that any
-- arrays which are embedded into the program via 'Data.Array.Accelerate.use'
-- will be stored as part of the final executable.
--
-- Usage of this function in your program is similar to that of 'runN'. First,
-- express your Accelerate program as a function of array terms:
--
-- > f :: (Arrays a, Arrays b, ... Arrays c) => Acc a -> Acc b -> ... -> Acc c
--
-- This function then returns a compiled version of @f@ as a Template Haskell
-- splice, to be added into your program at Haskell compile time:
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- >
-- > f' :: a -> b -> ... -> c
-- > f' = $( runQ f )
--
-- Note that at the splice point the usage of @f@ must monomorphic; i.e. the
-- types @a@, @b@ and @c@ must be at some known concrete type.
--
-- See the <https://github.com/tmcdonell/lulesh-accelerate lulesh-accelerate>
-- project for an example.
--
-- [/Note:/]
--
-- It is recommended to use GHC-8.6 or later. Earlier GHC versions can
-- successfully build executables utilising 'runQ', but fail to correctly link
-- libraries containing this function.
--
-- [/Note:/]
--
-- Due to <https://ghc.haskell.org/trac/ghc/ticket/13587 GHC#13587>, this
-- currently must be as an /untyped/ splice.
--
-- The correct type of this function is similar to that of 'runN':
--
-- > runQ :: Afunction f => f -> Q (TExp (AfunctionR f))
--
-- @since 1.1.0.0
--
runQ :: Afunction f => f -> TH.ExpQ
runQ :: f -> ExpQ
runQ = ExpQ -> ExpQ -> f -> ExpQ
forall f. Afunction f => ExpQ -> ExpQ -> f -> ExpQ
runQ' [| unsafePerformIO |] [| defaultTarget |]

-- | Ahead-of-time analogue of 'runNWith'. See 'runQ' for more information.
--
-- The correct type of this function is:
--
-- > runQWith :: Afunction f => f -> Q (TExp (Native -> AfunctionR f))
--
-- @since 1.1.0.0
--
runQWith :: Afunction f => f -> TH.ExpQ
runQWith :: f -> ExpQ
runQWith f
f = do
  Name
target <- String -> Q Name
TH.newName String
"target"
  [PatQ] -> ExpQ -> ExpQ
TH.lamE [Name -> PatQ
TH.varP Name
target] (ExpQ -> ExpQ -> f -> ExpQ
forall f. Afunction f => ExpQ -> ExpQ -> f -> ExpQ
runQ' [| unsafePerformIO |] (Name -> ExpQ
TH.varE Name
target) f
f)


-- | Ahead-of-time analogue of 'runNAsync'. See 'runQ' for more information.
--
-- The correct type of this function is:
--
-- > runQAsync :: (Afunction f, RunAsync r, AfunctionR f ~ RunAsyncR r) => f -> Q (TExp r)
--
-- @since 1.1.0.0
--
runQAsync :: Afunction f => f -> TH.ExpQ
runQAsync :: f -> ExpQ
runQAsync = ExpQ -> ExpQ -> f -> ExpQ
forall f. Afunction f => ExpQ -> ExpQ -> f -> ExpQ
runQ' [| async |] [| defaultTarget |]

-- | Ahead-of-time analogue of 'runNAsyncWith'. See 'runQ' for more information.
--
-- The correct type of this function is:
--
-- > runQAsyncWith :: (Afunction f, RunAsync r, AfunctionR f ~ RunAsyncR r) => f -> Q (TExp (Native -> r))
--
-- @since 1.1.0.0
--
runQAsyncWith :: Afunction f => f -> TH.ExpQ
runQAsyncWith :: f -> ExpQ
runQAsyncWith f
f = do
  Name
target <- String -> Q Name
TH.newName String
"target"
  [PatQ] -> ExpQ -> ExpQ
TH.lamE [Name -> PatQ
TH.varP Name
target] (ExpQ -> ExpQ -> f -> ExpQ
forall f. Afunction f => ExpQ -> ExpQ -> f -> ExpQ
runQ' [| async |] (Name -> ExpQ
TH.varE Name
target) f
f)


runQ' :: forall f. Afunction f => TH.ExpQ -> TH.ExpQ -> f -> TH.ExpQ
runQ' :: ExpQ -> ExpQ -> f -> ExpQ
runQ' ExpQ
using ExpQ
target f
f = do
#if MIN_VERSION_template_haskell(2,13,0)
  -- The plugin ensures that objects are loaded correctly into GHCi
  String -> Q ()
TH.addCorePlugin String
"Data.Array.Accelerate.LLVM.Native.Plugin"
#endif

  CompiledAfun Native (ArraysFunctionR f)
afun  <- let acc :: DelayedAfun (ArraysFunctionR f)
acc = f -> DelayedAfun (ArraysFunctionR f)
forall f. Afunction f => f -> DelayedAfun (ArraysFunctionR f)
convertAfun f
f
            in IO (CompiledAfun Native (ArraysFunctionR f))
-> Q (CompiledAfun Native (ArraysFunctionR f))
forall a. IO a -> Q a
TH.runIO (IO (CompiledAfun Native (ArraysFunctionR f))
 -> Q (CompiledAfun Native (ArraysFunctionR f)))
-> IO (CompiledAfun Native (ArraysFunctionR f))
-> Q (CompiledAfun Native (ArraysFunctionR f))
forall a b. (a -> b) -> a -> b
$ do
                 DelayedAfun (ArraysFunctionR f) -> IO ()
forall (m :: * -> *) g. (MonadIO m, PrettyGraph g) => g -> m ()
dumpGraph DelayedAfun (ArraysFunctionR f)
acc
                 Native
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> IO (CompiledAfun Native (ArraysFunctionR f))
forall a. Native -> LLVM Native a -> IO a
evalNative Native
defaultTarget (LLVM Native (CompiledAfun Native (ArraysFunctionR f))
 -> IO (CompiledAfun Native (ArraysFunctionR f)))
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> IO (CompiledAfun Native (ArraysFunctionR f))
forall a b. (a -> b) -> a -> b
$
                  String
-> (Double -> Double -> String)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a.
MonadIO m =>
String -> (Double -> Double -> String) -> m a -> m a
phase String
"compile" Double -> Double -> String
elapsedS (DelayedAfun (ArraysFunctionR f)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall arch f.
(HasCallStack, Compile arch) =>
DelayedAfun f -> LLVM arch (CompiledAfun arch f)
compileAfun DelayedAfun (ArraysFunctionR f)
acc) LLVM Native (CompiledAfun Native (ArraysFunctionR f))
-> (CompiledAfun Native (ArraysFunctionR f)
    -> LLVM Native (CompiledAfun Native (ArraysFunctionR f)))
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CompiledAfun Native (ArraysFunctionR f)
-> LLVM Native (CompiledAfun Native (ArraysFunctionR f))
forall (m :: * -> *) a. MonadIO m => a -> m a
dumpStats

  -- generate a lambda function with the correct number of arguments and
  -- apply directly to the body expression.
  --
  -- XXX: remove use of 'getArrays', 'toArr', and 'fromArr' in the embedded
  -- code; we should be able to generate all bindings directly and assemble
  -- the pieces directly.
  --
  let
      go :: CompiledOpenAfun Native aenv t -> [TH.PatQ] -> [TH.ExpQ] -> [TH.StmtQ] -> TH.ExpQ
      go :: CompiledOpenAfun Native aenv t
-> [PatQ] -> [ExpQ] -> [StmtQ] -> ExpQ
go (Alam ALeftHandSide a aenv aenv'
lhs PreOpenAfun (CompiledOpenAcc Native) aenv' t1
l) [PatQ]
xs [ExpQ]
as [StmtQ]
stmts = do
        Name
x <- String -> Q Name
TH.newName String
"x" -- lambda bound variable
        Name
a <- String -> Q Name
TH.newName String
"a" -- local array name
        Stmt
s <- PatQ -> ExpQ -> StmtQ
TH.bindS (Name -> PatQ
TH.varP Name
a) [| useRemoteAsync $(TH.unTypeQ $ liftArraysR (lhsToTupR lhs)) (fromArr $(TH.varE x)) |]
        PreOpenAfun (CompiledOpenAcc Native) aenv' t1
-> [PatQ] -> [ExpQ] -> [StmtQ] -> ExpQ
forall aenv t.
CompiledOpenAfun Native aenv t
-> [PatQ] -> [ExpQ] -> [StmtQ] -> ExpQ
go PreOpenAfun (CompiledOpenAcc Native) aenv' t1
l (Name -> PatQ
TH.varP Name
x PatQ -> [PatQ] -> [PatQ]
forall a. a -> [a] -> [a]
: [PatQ]
xs) ([| ($(TH.unTypeQ $ liftALeftHandSide lhs), $(TH.varE a)) |] ExpQ -> [ExpQ] -> [ExpQ]
forall a. a -> [a] -> [a]
: [ExpQ]
as) (Stmt -> StmtQ
forall (m :: * -> *) a. Monad m => a -> m a
return Stmt
s StmtQ -> [StmtQ] -> [StmtQ]
forall a. a -> [a] -> [a]
: [StmtQ]
stmts)

      go (Abody CompiledOpenAcc Native aenv t
b) [PatQ]
xs [ExpQ]
as [StmtQ]
stmts = do
        Name
r <- String -> Q Name
TH.newName String
"r" -- result
        Name
s <- String -> Q Name
TH.newName String
"s"
        let
            aenv :: ExpQ
aenv  = (ExpQ -> ExpQ -> ExpQ) -> ExpQ -> [ExpQ] -> ExpQ
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ExpQ
a ExpQ
gamma -> [| $gamma `push` $a |]) [| Empty |] [ExpQ]
as
            body :: Q (TExp (ExecOpenAcc Native aenv t))
body  = Native
-> CompiledOpenAcc Native aenv t
-> Q (TExp (ExecOpenAcc Native aenv t))
forall arch aenv arrs.
(HasCallStack, Embed arch) =>
arch
-> CompiledOpenAcc arch aenv arrs
-> Q (TExp (ExecOpenAcc arch aenv arrs))
embedOpenAcc Native
defaultTarget CompiledOpenAcc Native aenv t
b
        --
        [PatQ] -> ExpQ -> ExpQ
TH.lamE ([PatQ] -> [PatQ]
forall a. [a] -> [a]
reverse [PatQ]
xs)
                [| $using . phase "execute" elapsedP . evalNative $target . evalPar $
                      $(TH.doE ( reverse stmts ++
                               [ TH.bindS (TH.varP r) [| executeOpenAcc $(TH.unTypeQ body) $aenv |]
                               , TH.bindS (TH.varP s) [| getArrays $(TH.unTypeQ (liftArraysR (arraysR b))) $(TH.varE r) |]
                               , TH.noBindS [| return $ toArr $(TH.varE s) |]
                               ]))
                 |]
  --
  CompiledAfun Native (ArraysFunctionR f)
-> [PatQ] -> [ExpQ] -> [StmtQ] -> ExpQ
forall aenv t.
CompiledOpenAfun Native aenv t
-> [PatQ] -> [ExpQ] -> [StmtQ] -> ExpQ
go CompiledAfun Native (ArraysFunctionR f)
afun [] [] []


-- Debugging
-- =========

dumpStats :: MonadIO m => a -> m a
dumpStats :: a -> m a
dumpStats a
x = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
dumpSimplStats m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

phase :: MonadIO m => String -> (Double -> Double -> String) -> m a -> m a
phase :: String -> (Double -> Double -> String) -> m a -> m a
phase String
n Double -> Double -> String
fmt m a
go = Flag -> (Double -> Double -> String) -> m a -> m a
forall (m :: * -> *) a.
MonadIO m =>
Flag -> (Double -> Double -> String) -> m a -> m a
timed Flag
dump_phases (\Double
wall Double
cpu -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"phase %s: %s" String
n (Double -> Double -> String
fmt Double
wall Double
cpu)) m a
go