-- | Facilities for handling Futhark benchmark results.  A Futhark
-- benchmark program is just like a Futhark test program.
module Futhark.Bench
  ( RunResult (..),
    DataResult (..),
    BenchResult (..),
    Result (..),
    encodeBenchResults,
    decodeBenchResults,
    binaryName,
    benchmarkDataset,
    RunOptions (..),
    prepareBenchmarkProgram,
    CompileOptions (..),
    module Futhark.Profile,
  )
where

import Control.Applicative
import Control.Monad
import Control.Monad.Except (ExceptT, MonadError (..), liftEither, runExceptT)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Aeson qualified as JSON
import Data.Aeson.Key qualified as JSON
import Data.Aeson.KeyMap qualified as JSON
import Data.ByteString.Char8 qualified as SBS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.DList qualified as DL
import Data.Map qualified as M
import Data.Maybe
import Data.Text qualified as T
import Data.Time.Clock
import Data.Vector.Unboxed qualified as U
import Futhark.Profile
import Futhark.Server
import Futhark.Test
import Futhark.Util (showText)
import Statistics.Autocorrelation (autocorrelation)
import Statistics.Sample (fastStdDev, mean)
import System.Exit
import System.FilePath
import System.Process.ByteString (readProcessWithExitCode)
import System.Timeout (timeout)

-- | The runtime of a single succesful run.
newtype RunResult = RunResult {RunResult -> Int
runMicroseconds :: Int}
  deriving (RunResult -> RunResult -> Bool
(RunResult -> RunResult -> Bool)
-> (RunResult -> RunResult -> Bool) -> Eq RunResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RunResult -> RunResult -> Bool
== :: RunResult -> RunResult -> Bool
$c/= :: RunResult -> RunResult -> Bool
/= :: RunResult -> RunResult -> Bool
Eq, Int -> RunResult -> ShowS
[RunResult] -> ShowS
RunResult -> [Char]
(Int -> RunResult -> ShowS)
-> (RunResult -> [Char])
-> ([RunResult] -> ShowS)
-> Show RunResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunResult -> ShowS
showsPrec :: Int -> RunResult -> ShowS
$cshow :: RunResult -> [Char]
show :: RunResult -> [Char]
$cshowList :: [RunResult] -> ShowS
showList :: [RunResult] -> ShowS
Show)

-- | The measurements resulting from various successful runs of a
-- benchmark (same dataset).
data Result = Result
  { -- | Runtime of every run.
    Result -> [RunResult]
runResults :: [RunResult],
    -- | Memory usage.
    Result -> Map Text Int
memoryMap :: M.Map T.Text Int,
    -- | The error output produced during execution.  Often 'Nothing'
    -- for space reasons, and otherwise only the output from the last
    -- run.
    Result -> Maybe Text
stdErr :: Maybe T.Text,
    -- | Profiling report.  This will have been measured based on the
    -- last run.
    Result -> Maybe ProfilingReport
report :: Maybe ProfilingReport
  }
  deriving (Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
/= :: Result -> Result -> Bool
Eq, Int -> Result -> ShowS
[Result] -> ShowS
Result -> [Char]
(Int -> Result -> ShowS)
-> (Result -> [Char]) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Result -> ShowS
showsPrec :: Int -> Result -> ShowS
$cshow :: Result -> [Char]
show :: Result -> [Char]
$cshowList :: [Result] -> ShowS
showList :: [Result] -> ShowS
Show)

-- | The results for a single named dataset is either an error message, or
-- a result.
data DataResult = DataResult T.Text (Either T.Text Result)
  deriving (DataResult -> DataResult -> Bool
(DataResult -> DataResult -> Bool)
-> (DataResult -> DataResult -> Bool) -> Eq DataResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DataResult -> DataResult -> Bool
== :: DataResult -> DataResult -> Bool
$c/= :: DataResult -> DataResult -> Bool
/= :: DataResult -> DataResult -> Bool
Eq, Int -> DataResult -> ShowS
[DataResult] -> ShowS
DataResult -> [Char]
(Int -> DataResult -> ShowS)
-> (DataResult -> [Char])
-> ([DataResult] -> ShowS)
-> Show DataResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DataResult -> ShowS
showsPrec :: Int -> DataResult -> ShowS
$cshow :: DataResult -> [Char]
show :: DataResult -> [Char]
$cshowList :: [DataResult] -> ShowS
showList :: [DataResult] -> ShowS
Show)

-- | The results for all datasets for some benchmark program.
data BenchResult = BenchResult
  { BenchResult -> [Char]
benchResultProg :: FilePath,
    BenchResult -> [DataResult]
benchResultResults :: [DataResult]
  }
  deriving (BenchResult -> BenchResult -> Bool
(BenchResult -> BenchResult -> Bool)
-> (BenchResult -> BenchResult -> Bool) -> Eq BenchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BenchResult -> BenchResult -> Bool
== :: BenchResult -> BenchResult -> Bool
$c/= :: BenchResult -> BenchResult -> Bool
/= :: BenchResult -> BenchResult -> Bool
Eq, Int -> BenchResult -> ShowS
[BenchResult] -> ShowS
BenchResult -> [Char]
(Int -> BenchResult -> ShowS)
-> (BenchResult -> [Char])
-> ([BenchResult] -> ShowS)
-> Show BenchResult
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BenchResult -> ShowS
showsPrec :: Int -> BenchResult -> ShowS
$cshow :: BenchResult -> [Char]
show :: BenchResult -> [Char]
$cshowList :: [BenchResult] -> ShowS
showList :: [BenchResult] -> ShowS
Show)

newtype DataResults = DataResults {DataResults -> [DataResult]
unDataResults :: [DataResult]}

newtype BenchResults = BenchResults {BenchResults -> [BenchResult]
unBenchResults :: [BenchResult]}

instance JSON.ToJSON Result where
  toJSON :: Result -> Value
toJSON (Result [RunResult]
runres Map Text Int
memmap Maybe Text
err Maybe ProfilingReport
profiling) =
    ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
-> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ([RunResult]
runres, Map Text Int
memmap, Maybe Text
err, Maybe ProfilingReport
profiling)

instance JSON.FromJSON Result where
  parseJSON :: Value -> Parser Result
parseJSON = (([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
 -> Result)
-> Parser
     ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
-> Parser Result
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
-> Result
f (Parser
   ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
 -> Parser Result)
-> (Value
    -> Parser
         ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport))
-> Value
-> Parser Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value
-> Parser
     ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON
    where
      f :: ([RunResult], Map Text Int, Maybe Text, Maybe ProfilingReport)
-> Result
f ([RunResult]
runres, Map Text Int
memmap, Maybe Text
err, Maybe ProfilingReport
profiling) = [RunResult]
-> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
Result [RunResult]
runres Map Text Int
memmap Maybe Text
err Maybe ProfilingReport
profiling

instance JSON.ToJSON RunResult where
  toJSON :: RunResult -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (Int -> Value) -> (RunResult -> Int) -> RunResult -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds

instance JSON.FromJSON RunResult where
  parseJSON :: Value -> Parser RunResult
parseJSON = (Int -> RunResult) -> Parser Int -> Parser RunResult
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> RunResult
RunResult (Parser Int -> Parser RunResult)
-> (Value -> Parser Int) -> Value -> Parser RunResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON

instance JSON.ToJSON DataResults where
  toJSON :: DataResults -> Value
toJSON (DataResults [DataResult]
rs) =
    [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (DataResult -> Pair) -> [DataResult] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map DataResult -> Pair
dataResultJSON [DataResult]
rs
  toEncoding :: DataResults -> Encoding
toEncoding (DataResults [DataResult]
rs) =
    Series -> Encoding
JSON.pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$ (DataResult -> Series) -> [DataResult] -> [Series]
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Value -> Series) -> Pair -> Series
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> Value -> Series
forall v. ToJSON v => Key -> v -> Series
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) (Pair -> Series) -> (DataResult -> Pair) -> DataResult -> Series
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataResult -> Pair
dataResultJSON) [DataResult]
rs

instance JSON.FromJSON DataResults where
  parseJSON :: Value -> Parser DataResults
parseJSON = [Char]
-> (Object -> Parser DataResults) -> Value -> Parser DataResults
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject [Char]
"datasets" ((Object -> Parser DataResults) -> Value -> Parser DataResults)
-> (Object -> Parser DataResults) -> Value -> Parser DataResults
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [DataResult] -> DataResults
DataResults ([DataResult] -> DataResults)
-> Parser [DataResult] -> Parser DataResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser DataResult) -> [Pair] -> Parser [DataResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pair -> Parser DataResult
datasetResult (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
JSON.toList Object
o)
    where
      datasetResult :: Pair -> Parser DataResult
datasetResult (Key
k, Value
v) =
        Text -> Either Text Result -> DataResult
DataResult (Key -> Text
JSON.toText Key
k)
          (Either Text Result -> DataResult)
-> Parser (Either Text Result) -> Parser DataResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Result -> Either Text Result
forall a b. b -> Either a b
Right (Result -> Either Text Result)
-> Parser Result -> Parser (Either Text Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Result
success Value
v) Parser (Either Text Result)
-> Parser (Either Text Result) -> Parser (Either Text Result)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Either Text Result
forall a b. a -> Either a b
Left (Text -> Either Text Result)
-> Parser Text -> Parser (Either Text Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON Value
v))
      success :: Value -> Parser Result
success = [Char] -> (Object -> Parser Result) -> Value -> Parser Result
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject [Char]
"result" ((Object -> Parser Result) -> Value -> Parser Result)
-> (Object -> Parser Result) -> Value -> Parser Result
forall a b. (a -> b) -> a -> b
$ \Object
o ->
        [RunResult]
-> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
Result
          ([RunResult]
 -> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
-> Parser [RunResult]
-> Parser
     (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser [RunResult]
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"runtimes"
          Parser
  (Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result)
-> Parser (Map Text Int)
-> Parser (Maybe Text -> Maybe ProfilingReport -> Result)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Map Text Int)
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"bytes"
          Parser (Maybe Text -> Maybe ProfilingReport -> Result)
-> Parser (Maybe Text) -> Parser (Maybe ProfilingReport -> Result)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
JSON..:? Key
"stderr"
          Parser (Maybe ProfilingReport -> Result)
-> Parser (Maybe ProfilingReport) -> Parser Result
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ProfilingReport)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
JSON..:? Key
"profiling"

dataResultJSON :: DataResult -> (JSON.Key, JSON.Value)
dataResultJSON :: DataResult -> Pair
dataResultJSON (DataResult Text
desc (Left Text
err)) =
  (Text -> Key
JSON.fromText Text
desc, Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
err)
dataResultJSON (DataResult Text
desc (Right (Result [RunResult]
runtimes Map Text Int
bytes Maybe Text
progerr_opt Maybe ProfilingReport
profiling_opt))) =
  ( Text -> Key
JSON.fromText Text
desc,
    [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [ (Key
"runtimes", [Int] -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ([Int] -> Value) -> [Int] -> Value
forall a b. (a -> b) -> a -> b
$ (RunResult -> Int) -> [RunResult] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map RunResult -> Int
runMicroseconds [RunResult]
runtimes),
        (Key
"bytes", Map Text Int -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Map Text Int
bytes)
      ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case Maybe Text
progerr_opt of
          Maybe Text
Nothing -> []
          Just Text
progerr -> [(Key
"stderr", Text -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON Text
progerr)]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> case Maybe ProfilingReport
profiling_opt of
          Maybe ProfilingReport
Nothing -> []
          Just ProfilingReport
profiling -> [(Key
"profiling", ProfilingReport -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON ProfilingReport
profiling)]
  )

benchResultJSON :: BenchResult -> (JSON.Key, JSON.Value)
benchResultJSON :: BenchResult -> Pair
benchResultJSON (BenchResult [Char]
prog [DataResult]
r) =
  ( [Char] -> Key
JSON.fromString [Char]
prog,
    [Pair] -> Value
JSON.object [(Key
"datasets", DataResults -> Value
forall a. ToJSON a => a -> Value
JSON.toJSON (DataResults -> Value) -> DataResults -> Value
forall a b. (a -> b) -> a -> b
$ [DataResult] -> DataResults
DataResults [DataResult]
r)]
  )

instance JSON.ToJSON BenchResults where
  toJSON :: BenchResults -> Value
toJSON (BenchResults [BenchResult]
rs) =
    [Pair] -> Value
JSON.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (BenchResult -> Pair) -> [BenchResult] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map BenchResult -> Pair
benchResultJSON [BenchResult]
rs

instance JSON.FromJSON BenchResults where
  parseJSON :: Value -> Parser BenchResults
parseJSON = [Char]
-> (Object -> Parser BenchResults) -> Value -> Parser BenchResults
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject [Char]
"benchmarks" ((Object -> Parser BenchResults) -> Value -> Parser BenchResults)
-> (Object -> Parser BenchResults) -> Value -> Parser BenchResults
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [BenchResult] -> BenchResults
BenchResults ([BenchResult] -> BenchResults)
-> Parser [BenchResult] -> Parser BenchResults
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pair -> Parser BenchResult) -> [Pair] -> Parser [BenchResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Pair -> Parser BenchResult
onBenchmark (Object -> [Pair]
forall v. KeyMap v -> [(Key, v)]
JSON.toList Object
o)
    where
      onBenchmark :: Pair -> Parser BenchResult
onBenchmark (Key
k, Value
v) =
        [Char] -> [DataResult] -> BenchResult
BenchResult (Key -> [Char]
JSON.toString Key
k)
          ([DataResult] -> BenchResult)
-> Parser [DataResult] -> Parser BenchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
-> (Object -> Parser [DataResult]) -> Value -> Parser [DataResult]
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
JSON.withObject [Char]
"benchmark" Object -> Parser [DataResult]
onBenchmark' Value
v
      onBenchmark' :: Object -> Parser [DataResult]
onBenchmark' Object
o =
        (DataResults -> [DataResult])
-> Parser DataResults -> Parser [DataResult]
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataResults -> [DataResult]
unDataResults (Parser DataResults -> Parser [DataResult])
-> (Value -> Parser DataResults) -> Value -> Parser [DataResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser DataResults
forall a. FromJSON a => Value -> Parser a
JSON.parseJSON (Value -> Parser [DataResult])
-> Parser Value -> Parser [DataResult]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
o Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
JSON..: Key
"datasets"

-- | Transform benchmark results to a JSON bytestring.
encodeBenchResults :: [BenchResult] -> LBS.ByteString
encodeBenchResults :: [BenchResult] -> ByteString
encodeBenchResults = BenchResults -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encode (BenchResults -> ByteString)
-> ([BenchResult] -> BenchResults) -> [BenchResult] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [BenchResult] -> BenchResults
BenchResults

-- | Decode benchmark results from a JSON bytestring.
decodeBenchResults :: LBS.ByteString -> Either String [BenchResult]
decodeBenchResults :: ByteString -> Either [Char] [BenchResult]
decodeBenchResults = (BenchResults -> [BenchResult])
-> Either [Char] BenchResults -> Either [Char] [BenchResult]
forall a b. (a -> b) -> Either [Char] a -> Either [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BenchResults -> [BenchResult]
unBenchResults (Either [Char] BenchResults -> Either [Char] [BenchResult])
-> (ByteString -> Either [Char] BenchResults)
-> ByteString
-> Either [Char] [BenchResult]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either [Char] BenchResults
forall a. FromJSON a => ByteString -> Either [Char] a
JSON.eitherDecode'

--- Running benchmarks

-- | How to run a benchmark.
data RunOptions = RunOptions
  { -- | Applies both to initial and convergence phase.
    RunOptions -> Int
runMinRuns :: Int,
    RunOptions -> NominalDiffTime
runMinTime :: NominalDiffTime,
    RunOptions -> Int
runTimeout :: Int,
    RunOptions -> Int
runVerbose :: Int,
    -- | If true, run the convergence phase.
    RunOptions -> Bool
runConvergencePhase :: Bool,
    -- | Stop convergence once this much time has passed.
    RunOptions -> NominalDiffTime
runConvergenceMaxTime :: NominalDiffTime,
    -- | Invoked for every runtime measured during the run.  Can be
    -- used to provide a progress bar.
    RunOptions -> (Int, Maybe Double) -> IO ()
runResultAction :: (Int, Maybe Double) -> IO (),
    -- | Perform a final run at the end with profiling information
    -- enabled.
    RunOptions -> Bool
runProfile :: Bool
  }

-- | A list of @(autocorrelation,rse)@ pairs.  When the
-- autocorrelation is above the first element and the RSE is above the
-- second element, we want more runs.
convergenceCriteria :: [(Double, Double)]
convergenceCriteria :: [(Double, Double)]
convergenceCriteria =
  [ (Double
0.95, Double
0.0010),
    (Double
0.75, Double
0.0015),
    (Double
0.65, Double
0.0025),
    (Double
0.45, Double
0.0050),
    (Double
0.00, Double
0.0100)
  ]

-- Returns the next run count.
nextRunCount :: Int -> Double -> Double -> Int
nextRunCount :: Int -> Double -> Double -> Int
nextRunCount Int
runs Double
rse Double
acor = if ((Double, Double) -> Bool) -> [(Double, Double)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Double, Double) -> Bool
check [(Double, Double)]
convergenceCriteria then Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
runs Int
2 else Int
0
  where
    check :: (Double, Double) -> Bool
check (Double
acor_lb, Double
rse_lb) = Double
acor Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
acor_lb Bool -> Bool -> Bool
&& Double
rse Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
rse_lb

type BenchM = ExceptT T.Text IO

-- Do the minimum number of runs.
runMinimum ::
  BenchM (RunResult, [T.Text]) ->
  RunOptions ->
  Int ->
  NominalDiffTime ->
  DL.DList (RunResult, [T.Text]) ->
  BenchM (DL.DList (RunResult, [T.Text]))
runMinimum :: BenchM (RunResult, [Text])
-> RunOptions
-> Int
-> NominalDiffTime
-> DList (RunResult, [Text])
-> BenchM (DList (RunResult, [Text]))
runMinimum BenchM (RunResult, [Text])
do_run RunOptions
opts Int
runs_done NominalDiffTime
elapsed DList (RunResult, [Text])
r = do
  let actions :: BenchM (RunResult, [Text])
actions = do
        (RunResult, [Text])
x <- BenchM (RunResult, [Text])
do_run
        IO () -> ExceptT Text IO ()
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ RunOptions -> (Int, Maybe Double) -> IO ()
runResultAction RunOptions
opts (RunResult -> Int
runMicroseconds ((RunResult, [Text]) -> RunResult
forall a b. (a, b) -> a
fst (RunResult, [Text])
x), Maybe Double
forall a. Maybe a
Nothing)
        (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult, [Text])
x

  -- Figure out how much we have left to do.
  let todo :: Int
todo
        | Int
runs_done Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< RunOptions -> Int
runMinRuns RunOptions
opts =
            RunOptions -> Int
runMinRuns RunOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
runs_done
        | Bool
otherwise =
            -- Guesstimate how many runs we need to reach the minimum
            -- time.
            let time_per_run :: NominalDiffTime
time_per_run = NominalDiffTime
elapsed NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ Int -> NominalDiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
runs_done
             in NominalDiffTime -> Int
forall b. Integral b => NominalDiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling ((RunOptions -> NominalDiffTime
runMinTime RunOptions
opts NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
elapsed) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ NominalDiffTime
time_per_run)

  -- Note that todo might be negative if minimum time has been exceeded.
  if Int
todo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
    then DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (RunResult, [Text])
r
    else do
      UTCTime
before <- IO UTCTime -> ExceptT Text IO UTCTime
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      DList (RunResult, [Text])
r' <- [(RunResult, [Text])] -> DList (RunResult, [Text])
forall a. [a] -> DList a
DL.fromList ([(RunResult, [Text])] -> DList (RunResult, [Text]))
-> ExceptT Text IO [(RunResult, [Text])]
-> BenchM (DList (RunResult, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> BenchM (RunResult, [Text])
-> ExceptT Text IO [(RunResult, [Text])]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
todo BenchM (RunResult, [Text])
actions
      UTCTime
after <- IO UTCTime -> ExceptT Text IO UTCTime
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let elapsed' :: NominalDiffTime
elapsed' = NominalDiffTime
elapsed NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
after UTCTime
before
      BenchM (RunResult, [Text])
-> RunOptions
-> Int
-> NominalDiffTime
-> DList (RunResult, [Text])
-> BenchM (DList (RunResult, [Text]))
runMinimum BenchM (RunResult, [Text])
do_run RunOptions
opts (Int
runs_done Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
todo) NominalDiffTime
elapsed' (DList (RunResult, [Text])
r DList (RunResult, [Text])
-> DList (RunResult, [Text]) -> DList (RunResult, [Text])
forall a. Semigroup a => a -> a -> a
<> DList (RunResult, [Text])
r')

-- Do more runs until a convergence criterion is reached.
runConvergence ::
  BenchM (RunResult, [T.Text]) ->
  RunOptions ->
  DL.DList (RunResult, [T.Text]) ->
  BenchM (DL.DList (RunResult, [T.Text]))
runConvergence :: BenchM (RunResult, [Text])
-> RunOptions
-> DList (RunResult, [Text])
-> BenchM (DList (RunResult, [Text]))
runConvergence BenchM (RunResult, [Text])
do_run RunOptions
opts DList (RunResult, [Text])
initial_r =
  let runtimes :: Vector Double
runtimes = [(RunResult, [Text])] -> Vector Double
forall {b}. [(RunResult, b)] -> Vector Double
resultRuntimes (DList (RunResult, [Text]) -> [(RunResult, [Text])]
forall a. DList a -> [a]
DL.toList DList (RunResult, [Text])
initial_r)
      (Int
n, NominalDiffTime
_, Double
rse, Double
acor) = Vector Double -> (Int, NominalDiffTime, Double, Double)
runtimesMetrics Vector Double
runtimes
   in -- If the runtimes collected during the runMinimum phase are
      -- unstable enough that we need more in order to converge, we throw
      -- away the runMinimum runtimes.  This is because they often exhibit
      -- behaviour similar to a "warmup" period, and hence function as
      -- outliers that poison the metrics we use to determine convergence.
      -- By throwing them away we converge much faster, and still get the
      -- right result.
      case Int -> Double -> Double -> Int
nextRunCount Int
n Double
rse Double
acor of
        Int
x
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0,
            RunOptions -> Bool
runConvergencePhase RunOptions
opts ->
              Vector Double
-> DList (RunResult, [Text])
-> Double
-> Int
-> BenchM (DList (RunResult, [Text]))
moreRuns Vector Double
forall a. Monoid a => a
mempty DList (RunResult, [Text])
forall a. Monoid a => a
mempty Double
rse (Int
x Int -> Int -> Int
forall a. Ord a => a -> a -> a
`max` RunOptions -> Int
runMinRuns RunOptions
opts)
          | Bool
otherwise ->
              DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (RunResult, [Text])
initial_r
  where
    resultRuntimes :: [(RunResult, b)] -> Vector Double
resultRuntimes =
      [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
U.fromList ([Double] -> Vector Double)
-> ([(RunResult, b)] -> [Double])
-> [(RunResult, b)]
-> Vector Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((RunResult, b) -> Double) -> [(RunResult, b)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double)
-> ((RunResult, b) -> Int) -> (RunResult, b) -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds (RunResult -> Int)
-> ((RunResult, b) -> RunResult) -> (RunResult, b) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RunResult, b) -> RunResult
forall a b. (a, b) -> a
fst)

    runtimesMetrics :: Vector Double -> (Int, NominalDiffTime, Double, Double)
runtimesMetrics Vector Double
runtimes =
      let n :: Int
n = Vector Double -> Int
forall a. Unbox a => Vector a -> Int
U.length Vector Double
runtimes
          rse :: Double
rse = (Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
fastStdDev Vector Double
runtimes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double -> Double
forall a. Floating a => a -> a
sqrt (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Vector Double -> Double
forall (v :: * -> *). Vector v Double => v Double -> Double
mean Vector Double
runtimes
          (Vector Double
x, Vector Double
_, Vector Double
_) = Vector Double -> (Vector Double, Vector Double, Vector Double)
forall (v :: * -> *).
(Vector v Double, Vector v Int) =>
v Double -> (v Double, v Double, v Double)
autocorrelation Vector Double
runtimes
       in ( Int
n,
            Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Vector Double -> Double
forall a. (Unbox a, Num a) => Vector a -> a
U.sum Vector Double
runtimes) :: NominalDiffTime,
            Double
rse,
            Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 (Vector Double
x Vector Double -> Int -> Maybe Double
forall a. Unbox a => Vector a -> Int -> Maybe a
U.!? Int
1)
          )

    sample :: Double -> BenchM (RunResult, [Text])
sample Double
rse = do
      (RunResult, [Text])
x <- BenchM (RunResult, [Text])
do_run
      IO () -> ExceptT Text IO ()
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ()) -> IO () -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ RunOptions -> (Int, Maybe Double) -> IO ()
runResultAction RunOptions
opts (RunResult -> Int
runMicroseconds ((RunResult, [Text]) -> RunResult
forall a b. (a, b) -> a
fst (RunResult, [Text])
x), Double -> Maybe Double
forall a. a -> Maybe a
Just Double
rse)
      (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RunResult, [Text])
x

    moreRuns :: Vector Double
-> DList (RunResult, [Text])
-> Double
-> Int
-> BenchM (DList (RunResult, [Text]))
moreRuns Vector Double
runtimes DList (RunResult, [Text])
r Double
rse Int
x = do
      [(RunResult, [Text])]
r' <- Int
-> BenchM (RunResult, [Text])
-> ExceptT Text IO [(RunResult, [Text])]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
x (BenchM (RunResult, [Text])
 -> ExceptT Text IO [(RunResult, [Text])])
-> BenchM (RunResult, [Text])
-> ExceptT Text IO [(RunResult, [Text])]
forall a b. (a -> b) -> a -> b
$ Double -> BenchM (RunResult, [Text])
sample Double
rse
      Vector Double
-> DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
loop (Vector Double
runtimes Vector Double -> Vector Double -> Vector Double
forall a. Semigroup a => a -> a -> a
<> [(RunResult, [Text])] -> Vector Double
forall {b}. [(RunResult, b)] -> Vector Double
resultRuntimes [(RunResult, [Text])]
r') (DList (RunResult, [Text])
r DList (RunResult, [Text])
-> DList (RunResult, [Text]) -> DList (RunResult, [Text])
forall a. Semigroup a => a -> a -> a
<> [(RunResult, [Text])] -> DList (RunResult, [Text])
forall a. [a] -> DList a
DL.fromList [(RunResult, [Text])]
r')

    loop :: Vector Double
-> DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
loop Vector Double
runtimes DList (RunResult, [Text])
r = do
      let (Int
n, NominalDiffTime
total, Double
rse, Double
acor) = Vector Double -> (Int, NominalDiffTime, Double, Double)
runtimesMetrics Vector Double
runtimes
      case Int -> Double -> Double -> Int
nextRunCount Int
n Double
rse Double
acor of
        Int
x
          | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0,
            NominalDiffTime
total NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< RunOptions -> NominalDiffTime
runConvergenceMaxTime RunOptions
opts ->
              Vector Double
-> DList (RunResult, [Text])
-> Double
-> Int
-> BenchM (DList (RunResult, [Text]))
moreRuns Vector Double
runtimes DList (RunResult, [Text])
r Double
rse Int
x
          | Bool
otherwise ->
              DList (RunResult, [Text]) -> BenchM (DList (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DList (RunResult, [Text])
r

-- | Run the benchmark program on the indicated dataset.
benchmarkDataset ::
  Server ->
  RunOptions ->
  FutharkExe ->
  FilePath ->
  T.Text ->
  Values ->
  Maybe Success ->
  FilePath ->
  IO (Either T.Text ([RunResult], T.Text, ProfilingReport))
benchmarkDataset :: Server
-> RunOptions
-> FutharkExe
-> [Char]
-> Text
-> Values
-> Maybe Success
-> [Char]
-> IO (Either Text ([RunResult], Text, ProfilingReport))
benchmarkDataset Server
server RunOptions
opts FutharkExe
futhark [Char]
program Text
entry Values
input_spec Maybe Success
expected_spec [Char]
ref_out = ExceptT Text IO ([RunResult], Text, ProfilingReport)
-> IO (Either Text ([RunResult], Text, ProfilingReport))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO ([RunResult], Text, ProfilingReport)
 -> IO (Either Text ([RunResult], Text, ProfilingReport)))
-> ExceptT Text IO ([RunResult], Text, ProfilingReport)
-> IO (Either Text ([RunResult], Text, ProfilingReport))
forall a b. (a -> b) -> a -> b
$ do
  [OutputType]
output_types <- IO (Either CmdFailure [OutputType]) -> ExceptT Text IO [OutputType]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [OutputType])
 -> ExceptT Text IO [OutputType])
-> IO (Either CmdFailure [OutputType])
-> ExceptT Text IO [OutputType]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> IO (Either CmdFailure [OutputType])
cmdOutputs Server
server Text
entry
  [InputType]
input_types <- IO (Either CmdFailure [InputType]) -> ExceptT Text IO [InputType]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [InputType]) -> ExceptT Text IO [InputType])
-> IO (Either CmdFailure [InputType])
-> ExceptT Text IO [InputType]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> IO (Either CmdFailure [InputType])
cmdInputs Server
server Text
entry
  let outs :: [Text]
outs = [Text
"out" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
i | Int
i <- [Int
0 .. [OutputType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [OutputType]
output_types Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
      ins :: [Text]
ins = [Text
"in" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
i | Int
i <- [Int
0 .. [InputType] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InputType]
input_types Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]

  IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> (IO (Maybe CmdFailure) -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> IO (Maybe CmdFailure)
cmdClear Server
server

  IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> (IO (Maybe CmdFailure) -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> IO (Maybe CmdFailure)
cmdPauseProfiling Server
server

  let freeOuts :: ExceptT Text IO ()
freeOuts = IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (Server -> [Text] -> IO (Maybe CmdFailure)
cmdFree Server
server [Text]
outs)
      freeIns :: ExceptT Text IO ()
freeIns = IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (Server -> [Text] -> IO (Maybe CmdFailure)
cmdFree Server
server [Text]
ins)
      loadInput :: ExceptT Text IO ()
loadInput = Server
-> [(Text, Text)]
-> FutharkExe
-> [Char]
-> Values
-> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
Server -> [(Text, Text)] -> FutharkExe -> [Char] -> Values -> m ()
valuesAsVars Server
server ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
ins ([Text] -> [(Text, Text)]) -> [Text] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ (InputType -> Text) -> [InputType] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map InputType -> Text
inputType [InputType]
input_types) FutharkExe
futhark [Char]
dir Values
input_spec
      reloadInput :: ExceptT Text IO ()
reloadInput = ExceptT Text IO ()
freeIns ExceptT Text IO () -> ExceptT Text IO () -> ExceptT Text IO ()
forall a b.
ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT Text IO ()
loadInput

  ExceptT Text IO ()
loadInput

  let runtime :: Text -> Maybe a
runtime Text
l
        | Just Text
l' <- Text -> Text -> Maybe Text
T.stripPrefix Text
"runtime: " Text
l,
          [(a
x, [Char]
"")] <- ReadS a
forall a. Read a => ReadS a
reads ReadS a -> ReadS a
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
l' =
            a -> Maybe a
forall a. a -> Maybe a
Just a
x
        | Bool
otherwise =
            Maybe a
forall a. Maybe a
Nothing

      doRun :: BenchM (RunResult, [Text])
doRun = do
        [Text]
call_lines <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
cmdCall Server
server Text
entry [Text]
outs [Text]
ins)
        Bool -> ExceptT Text IO () -> ExceptT Text IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ((InputType -> Bool) -> [InputType] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InputType -> Bool
inputConsumed [InputType]
input_types) ExceptT Text IO ()
reloadInput
        case (Text -> Maybe Int) -> [Text] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Text -> Maybe Int
forall {a}. Read a => Text -> Maybe a
runtime [Text]
call_lines of
          [Int
call_runtime] -> (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> RunResult
RunResult Int
call_runtime, [Text]
call_lines)
          [] -> Text -> BenchM (RunResult, [Text])
forall a. Text -> ExceptT Text IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Could not find runtime in output."
          [Int]
ls -> Text -> BenchM (RunResult, [Text])
forall a. Text -> ExceptT Text IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> BenchM (RunResult, [Text]))
-> Text -> BenchM (RunResult, [Text])
forall a b. (a -> b) -> a -> b
$ Text
"Ambiguous runtimes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
showText [Int]
ls

  Maybe
  (Either
     Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
maybe_call_logs <- IO
  (Maybe
     (Either
        Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
-> ExceptT
     Text
     IO
     (Maybe
        (Either
           Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Maybe
      (Either
         Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
 -> ExceptT
      Text
      IO
      (Maybe
         (Either
            Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))))
-> (ExceptT
      Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    -> IO
         (Maybe
            (Either
               Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))))
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> ExceptT
     Text
     IO
     (Maybe
        (Either
           Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> IO
     (Either
        Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
-> IO
     (Maybe
        (Either
           Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
forall a. Int -> IO a -> IO (Maybe a)
timeout (RunOptions -> Int
runTimeout RunOptions
opts Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000000) (IO
   (Either
      Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
 -> IO
      (Maybe
         (Either
            Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))))
-> (ExceptT
      Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
    -> IO
         (Either
            Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> IO
     (Maybe
        (Either
           Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> IO
     (Either
        Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
 -> ExceptT
      Text
      IO
      (Maybe
         (Either
            Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))))
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> ExceptT
     Text
     IO
     (Maybe
        (Either
           Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))))
forall a b. (a -> b) -> a -> b
$ do
    -- First one uncounted warmup run.
    ExceptT Text IO [Text] -> ExceptT Text IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT Text IO [Text] -> ExceptT Text IO ())
-> ExceptT Text IO [Text] -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> Text -> [Text] -> [Text] -> IO (Either CmdFailure [Text])
cmdCall Server
server Text
entry [Text]
outs [Text]
ins

    DList (RunResult, [Text])
ys <- BenchM (RunResult, [Text])
-> RunOptions
-> Int
-> NominalDiffTime
-> DList (RunResult, [Text])
-> BenchM (DList (RunResult, [Text]))
runMinimum (ExceptT Text IO ()
freeOuts ExceptT Text IO ()
-> BenchM (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a b.
ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BenchM (RunResult, [Text])
doRun) RunOptions
opts Int
0 NominalDiffTime
0 DList (RunResult, [Text])
forall a. Monoid a => a
mempty

    DList (RunResult, [Text])
xs <- BenchM (RunResult, [Text])
-> RunOptions
-> DList (RunResult, [Text])
-> BenchM (DList (RunResult, [Text]))
runConvergence (ExceptT Text IO ()
freeOuts ExceptT Text IO ()
-> BenchM (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a b.
ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BenchM (RunResult, [Text])
doRun) RunOptions
opts DList (RunResult, [Text])
ys

    -- Possibly a profiled run at the end.
    Maybe (RunResult, [Text])
profile_log <-
      if Bool -> Bool
not (RunOptions -> Bool
runProfile RunOptions
opts)
        then Maybe (RunResult, [Text])
-> ExceptT Text IO (Maybe (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (RunResult, [Text])
forall a. Maybe a
Nothing
        else do
          IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> (IO (Maybe CmdFailure) -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> IO (Maybe CmdFailure)
cmdUnpauseProfiling Server
server
          (RunResult, [Text])
profile_log <- ExceptT Text IO ()
freeOuts ExceptT Text IO ()
-> BenchM (RunResult, [Text]) -> BenchM (RunResult, [Text])
forall a b.
ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> BenchM (RunResult, [Text])
doRun
          IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
IO (Maybe CmdFailure) -> m ()
cmdMaybe (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> (IO (Maybe CmdFailure) -> IO (Maybe CmdFailure))
-> IO (Maybe CmdFailure)
-> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe CmdFailure) -> IO (Maybe CmdFailure)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CmdFailure) -> ExceptT Text IO ())
-> IO (Maybe CmdFailure) -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Server -> IO (Maybe CmdFailure)
cmdPauseProfiling Server
server
          Maybe (RunResult, [Text])
-> ExceptT Text IO (Maybe (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (RunResult, [Text])
 -> ExceptT Text IO (Maybe (RunResult, [Text])))
-> Maybe (RunResult, [Text])
-> ExceptT Text IO (Maybe (RunResult, [Text]))
forall a b. (a -> b) -> a -> b
$ (RunResult, [Text]) -> Maybe (RunResult, [Text])
forall a. a -> Maybe a
Just (RunResult, [Text])
profile_log

    [Value]
vs <- Server -> [Text] -> ExceptT Text IO [Value]
forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
Server -> [Text] -> m [Value]
readResults Server
server [Text]
outs ExceptT Text IO [Value]
-> ExceptT Text IO () -> ExceptT Text IO [Value]
forall a b.
ExceptT Text IO a -> ExceptT Text IO b -> ExceptT Text IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ExceptT Text IO ()
freeOuts

    ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value]
vs, DList (RunResult, [Text]) -> [(RunResult, [Text])]
forall a. DList a -> [a]
DL.toList DList (RunResult, [Text])
xs, Maybe (RunResult, [Text])
profile_log)

  ([Value]
vs, [(RunResult, [Text])]
call_logs, Maybe (RunResult, [Text])
profile_log) <- case Maybe
  (Either
     Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
maybe_call_logs of
    Maybe
  (Either
     Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
Nothing ->
      Text
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
forall a. Text -> ExceptT Text IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text
 -> ExceptT
      Text
      IO
      ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
-> ([Char] -> Text)
-> [Char]
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char]
 -> ExceptT
      Text
      IO
      ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text])))
-> [Char]
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
forall a b. (a -> b) -> a -> b
$
        [Char]
"Execution exceeded " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (RunOptions -> Int
runTimeout RunOptions
opts) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" seconds."
    Just Either
  Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
x -> Either
  Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
-> ExceptT
     Text IO ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither Either
  Text ([Value], [(RunResult, [Text])], Maybe (RunResult, [Text]))
x

  ExceptT Text IO ()
freeIns

  [Text]
report <- IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall (m :: * -> *) a.
(MonadError Text m, MonadIO m) =>
IO (Either CmdFailure a) -> m a
cmdEither (IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text])
-> IO (Either CmdFailure [Text]) -> ExceptT Text IO [Text]
forall a b. (a -> b) -> a -> b
$ Server -> IO (Either CmdFailure [Text])
cmdReport Server
server

  ProfilingReport
report' <-
    ExceptT Text IO ProfilingReport
-> (ProfilingReport -> ExceptT Text IO ProfilingReport)
-> Maybe ProfilingReport
-> ExceptT Text IO ProfilingReport
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> ExceptT Text IO ProfilingReport
forall a. Text -> ExceptT Text IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Text
"Program produced invalid profiling report.") ProfilingReport -> ExceptT Text IO ProfilingReport
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProfilingReport -> ExceptT Text IO ProfilingReport)
-> Maybe ProfilingReport -> ExceptT Text IO ProfilingReport
forall a b. (a -> b) -> a -> b
$
      Text -> Maybe ProfilingReport
profilingReportFromText ([Text] -> Text
T.unlines [Text]
report)

  Maybe [Value]
maybe_expected <-
    IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value])
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value]))
-> IO (Maybe [Value]) -> ExceptT Text IO (Maybe [Value])
forall a b. (a -> b) -> a -> b
$ IO (Maybe [Value])
-> (Success -> IO (Maybe [Value]))
-> Maybe Success
-> IO (Maybe [Value])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe [Value] -> IO (Maybe [Value])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Value]
forall a. Maybe a
Nothing) (([Value] -> Maybe [Value]) -> IO [Value] -> IO (Maybe [Value])
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just (IO [Value] -> IO (Maybe [Value]))
-> (Success -> IO [Value]) -> Success -> IO (Maybe [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Success -> IO [Value]
forall {m :: * -> *}.
(MonadFail m, MonadIO m) =>
Success -> m [Value]
getExpectedValues) Maybe Success
expected_spec

  case Maybe [Value]
maybe_expected of
    Just [Value]
expected -> [Char] -> [Value] -> [Value] -> ExceptT Text IO ()
forall (m :: * -> *).
(MonadError Text m, MonadIO m) =>
[Char] -> [Value] -> [Value] -> m ()
checkResult [Char]
program [Value]
expected [Value]
vs
    Maybe [Value]
Nothing -> () -> ExceptT Text IO ()
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  ([RunResult], Text, ProfilingReport)
-> ExceptT Text IO ([RunResult], Text, ProfilingReport)
forall a. a -> ExceptT Text IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ((RunResult, [Text]) -> RunResult)
-> [(RunResult, [Text])] -> [RunResult]
forall a b. (a -> b) -> [a] -> [b]
map (RunResult, [Text]) -> RunResult
forall a b. (a, b) -> a
fst [(RunResult, [Text])]
call_logs,
      [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (RunResult, [Text]) -> [Text]
forall a b. (a, b) -> b
snd ((RunResult, [Text]) -> [Text]) -> (RunResult, [Text]) -> [Text]
forall a b. (a -> b) -> a -> b
$ (RunResult, [Text])
-> Maybe (RunResult, [Text]) -> (RunResult, [Text])
forall a. a -> Maybe a -> a
fromMaybe ([(RunResult, [Text])] -> (RunResult, [Text])
forall a. HasCallStack => [a] -> a
last [(RunResult, [Text])]
call_logs) Maybe (RunResult, [Text])
profile_log,
      ProfilingReport
report'
    )
  where
    getExpectedValues :: Success -> m [Value]
getExpectedValues (SuccessValues Values
vs) =
      FutharkExe -> [Char] -> Values -> m [Value]
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
FutharkExe -> [Char] -> Values -> m [Value]
getValues FutharkExe
futhark [Char]
dir Values
vs
    getExpectedValues Success
SuccessGenerateValues =
      Success -> m [Value]
getExpectedValues (Success -> m [Value]) -> Success -> m [Value]
forall a b. (a -> b) -> a -> b
$ Values -> Success
SuccessValues (Values -> Success) -> Values -> Success
forall a b. (a -> b) -> a -> b
$ [Char] -> Values
InFile [Char]
ref_out

    dir :: [Char]
dir = ShowS
takeDirectory [Char]
program

-- | How to compile a benchmark.
data CompileOptions = CompileOptions
  { CompileOptions -> [Char]
compFuthark :: String,
    CompileOptions -> [Char]
compBackend :: String,
    CompileOptions -> [[Char]]
compOptions :: [String]
  }

progNotFound :: String -> String
progNotFound :: ShowS
progNotFound [Char]
s = [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
": command not found"

-- | Compile and produce reference datasets.
prepareBenchmarkProgram ::
  (MonadIO m) =>
  Maybe Int ->
  CompileOptions ->
  FilePath ->
  [InputOutputs] ->
  m (Either (String, Maybe SBS.ByteString) ())
prepareBenchmarkProgram :: forall (m :: * -> *).
MonadIO m =>
Maybe Int
-> CompileOptions
-> [Char]
-> [InputOutputs]
-> m (Either ([Char], Maybe ByteString) ())
prepareBenchmarkProgram Maybe Int
concurrency CompileOptions
opts [Char]
program [InputOutputs]
cases = do
  let futhark :: [Char]
futhark = CompileOptions -> [Char]
compFuthark CompileOptions
opts

  Either Text ()
ref_res <- ExceptT Text m () -> m (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text m () -> m (Either Text ()))
-> ExceptT Text m () -> m (Either Text ())
forall a b. (a -> b) -> a -> b
$ Maybe Int
-> FutharkExe
-> [Char]
-> [Char]
-> [InputOutputs]
-> ExceptT Text m ()
forall (m :: * -> *).
(MonadIO m, MonadError Text m) =>
Maybe Int
-> FutharkExe -> [Char] -> [Char] -> [InputOutputs] -> m ()
ensureReferenceOutput Maybe Int
concurrency ([Char] -> FutharkExe
FutharkExe [Char]
futhark) [Char]
"c" [Char]
program [InputOutputs]
cases
  case Either Text ()
ref_res of
    Left Text
err ->
      Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ([Char], Maybe ByteString) ()
 -> m (Either ([Char], Maybe ByteString) ()))
-> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$
        ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
forall a b. a -> Either a b
Left
          ( [Char]
"Reference output generation for "
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
program
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" failed:\n"
              [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
err,
            Maybe ByteString
forall a. Maybe a
Nothing
          )
    Right () -> do
      (ExitCode
futcode, ByteString
_, ByteString
futerr) <-
        IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (ExitCode, ByteString, ByteString)
 -> m (ExitCode, ByteString, ByteString))
-> IO (ExitCode, ByteString, ByteString)
-> m (ExitCode, ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$
          [Char]
-> [[Char]] -> ByteString -> IO (ExitCode, ByteString, ByteString)
readProcessWithExitCode
            [Char]
futhark
            ( [CompileOptions -> [Char]
compBackend CompileOptions
opts, [Char]
program, [Char]
"-o", ShowS
binaryName [Char]
program, [Char]
"--server"]
                [[Char]] -> [[Char]] -> [[Char]]
forall a. Semigroup a => a -> a -> a
<> CompileOptions -> [[Char]]
compOptions CompileOptions
opts
            )
            ByteString
""

      case ExitCode
futcode of
        ExitCode
ExitSuccess -> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ([Char], Maybe ByteString) ()
 -> m (Either ([Char], Maybe ByteString) ()))
-> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$ () -> Either ([Char], Maybe ByteString) ()
forall a b. b -> Either a b
Right ()
        ExitFailure Int
127 -> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ([Char], Maybe ByteString) ()
 -> m (Either ([Char], Maybe ByteString) ()))
-> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$ ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
forall a b. a -> Either a b
Left (ShowS
progNotFound [Char]
futhark, Maybe ByteString
forall a. Maybe a
Nothing)
        ExitFailure Int
_ -> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ([Char], Maybe ByteString) ()
 -> m (Either ([Char], Maybe ByteString) ()))
-> Either ([Char], Maybe ByteString) ()
-> m (Either ([Char], Maybe ByteString) ())
forall a b. (a -> b) -> a -> b
$ ([Char], Maybe ByteString) -> Either ([Char], Maybe ByteString) ()
forall a b. a -> Either a b
Left ([Char]
"Compilation of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
program [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" failed:\n", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
futerr)