-- | @futhark bench@
module Futhark.CLI.Bench (main) where

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Bifunctor (first)
import Data.ByteString.Char8 qualified as SBS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Either
import Data.Function ((&))
import Data.IORef
import Data.List (intersect, sortBy)
import Data.Map qualified as M
import Data.Maybe
import Data.Ord
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
import Data.Vector.Unboxed qualified as U
import Futhark.Bench
import Futhark.Server
import Futhark.Test
import Futhark.Util (atMostChars, fancyTerminal, pmapIO, showText)
import Futhark.Util.Options
import Futhark.Util.Pretty (AnsiStyle, Color (..), annotate, bold, color, line, pretty, prettyText, putDoc)
import Futhark.Util.ProgressBar
import Statistics.Resampling (Estimator (..), resample)
import Statistics.Resampling.Bootstrap (bootstrapBCA)
import Statistics.Types (cl95, confIntLDX, confIntUDX, estError, estPoint)
import System.Console.ANSI (clearLine)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Random.MWC (create)
import Text.Printf
import Text.Regex.TDFA

putStyleLn :: AnsiStyle -> T.Text -> IO ()
putStyleLn :: AnsiStyle -> Text -> IO ()
putStyleLn AnsiStyle
s Text
t = Doc AnsiStyle -> IO ()
putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
forall a b. (a -> b) -> a -> b
$ AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
s (Text -> Doc AnsiStyle
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle
forall ann. Doc ann
line)

putRedLn, putBoldRedLn, putBoldLn :: T.Text -> IO ()
putRedLn :: Text -> IO ()
putRedLn = AnsiStyle -> Text -> IO ()
putStyleLn (Color -> AnsiStyle
color Color
Red)
putBoldRedLn :: Text -> IO ()
putBoldRedLn = AnsiStyle -> Text -> IO ()
putStyleLn (Color -> AnsiStyle
color Color
Red AnsiStyle -> AnsiStyle -> AnsiStyle
forall a. Semigroup a => a -> a -> a
<> AnsiStyle
bold)
putBoldLn :: Text -> IO ()
putBoldLn = AnsiStyle -> Text -> IO ()
putStyleLn AnsiStyle
bold

data BenchOptions = BenchOptions
  { BenchOptions -> String
optBackend :: String,
    BenchOptions -> Maybe String
optFuthark :: Maybe String,
    BenchOptions -> String
optRunner :: String,
    BenchOptions -> Int
optMinRuns :: Int,
    BenchOptions -> NominalDiffTime
optMinTime :: NominalDiffTime,
    BenchOptions -> [String]
optExtraOptions :: [String],
    BenchOptions -> [String]
optCompilerOptions :: [String],
    BenchOptions -> Maybe String
optJSON :: Maybe FilePath,
    BenchOptions -> Int
optTimeout :: Int,
    BenchOptions -> Bool
optSkipCompilation :: Bool,
    BenchOptions -> [Text]
optExcludeCase :: [T.Text],
    BenchOptions -> [Regex]
optIgnoreFiles :: [Regex],
    BenchOptions -> Maybe String
optEntryPoint :: Maybe String,
    BenchOptions -> Maybe String
optTuning :: Maybe String,
    BenchOptions -> Maybe String
optCacheExt :: Maybe String,
    BenchOptions -> Bool
optConvergencePhase :: Bool,
    BenchOptions -> NominalDiffTime
optConvergenceMaxTime :: NominalDiffTime,
    BenchOptions -> Maybe Int
optConcurrency :: Maybe Int,
    BenchOptions -> Bool
optProfile :: Bool,
    BenchOptions -> Int
optVerbose :: Int,
    BenchOptions -> Maybe String
optTestSpec :: Maybe FilePath
  }

initialBenchOptions :: BenchOptions
initialBenchOptions :: BenchOptions
initialBenchOptions =
  BenchOptions
    { optBackend :: String
optBackend = String
"c",
      optFuthark :: Maybe String
optFuthark = Maybe String
forall a. Maybe a
Nothing,
      optRunner :: String
optRunner = String
"",
      optMinRuns :: Int
optMinRuns = Int
10,
      optMinTime :: NominalDiffTime
optMinTime = NominalDiffTime
0.5,
      optExtraOptions :: [String]
optExtraOptions = [],
      optCompilerOptions :: [String]
optCompilerOptions = [],
      optJSON :: Maybe String
optJSON = Maybe String
forall a. Maybe a
Nothing,
      optTimeout :: Int
optTimeout = -Int
1,
      optSkipCompilation :: Bool
optSkipCompilation = Bool
False,
      optExcludeCase :: [Text]
optExcludeCase = [Text
"nobench", Text
"disable"],
      optIgnoreFiles :: [Regex]
optIgnoreFiles = [],
      optEntryPoint :: Maybe String
optEntryPoint = Maybe String
forall a. Maybe a
Nothing,
      optTuning :: Maybe String
optTuning = String -> Maybe String
forall a. a -> Maybe a
Just String
"tuning",
      optCacheExt :: Maybe String
optCacheExt = Maybe String
forall a. Maybe a
Nothing,
      optConvergencePhase :: Bool
optConvergencePhase = Bool
True,
      optConvergenceMaxTime :: NominalDiffTime
optConvergenceMaxTime = NominalDiffTime
5 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
60,
      optConcurrency :: Maybe Int
optConcurrency = Maybe Int
forall a. Maybe a
Nothing,
      optProfile :: Bool
optProfile = Bool
False,
      optVerbose :: Int
optVerbose = Int
0,
      optTestSpec :: Maybe String
optTestSpec = Maybe String
forall a. Maybe a
Nothing
    }

runBenchmarks :: BenchOptions -> [FilePath] -> IO ()
runBenchmarks :: BenchOptions -> [String] -> IO ()
runBenchmarks BenchOptions
opts [String]
paths = do
  -- We force line buffering to ensure that we produce running output.
  -- Otherwise, CI tools and the like may believe we are hung and kill
  -- us.
  Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering

  benchmarks <- ((String, ProgramTest) -> Bool)
-> [(String, ProgramTest)] -> [(String, ProgramTest)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, ProgramTest) -> Bool) -> (String, ProgramTest) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall {p}. RegexLike Regex p => p -> Bool
ignored (String -> Bool)
-> ((String, ProgramTest) -> String)
-> (String, ProgramTest)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, ProgramTest) -> String
forall a b. (a, b) -> a
fst) ([(String, ProgramTest)] -> [(String, ProgramTest)])
-> IO [(String, ProgramTest)] -> IO [(String, ProgramTest)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO [(String, ProgramTest)]
testSpecsFromPathsOrDie [String]
paths
  -- Try to avoid concurrency at both program and data set level.
  let opts' =
        if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
paths Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
1
          then BenchOptions
opts {optConcurrency = Just 1}
          else BenchOptions
opts
  (skipped_benchmarks, compiled_benchmarks) <-
    partitionEithers <$> pmapIO (optConcurrency opts) (compileBenchmark opts') benchmarks

  when (anyFailedToCompile skipped_benchmarks) exitFailure

  putStrLn $
    "Reporting arithmetic mean runtime of at least "
      <> show (optMinRuns opts)
      <> " runs for each dataset (min "
      <> show (optMinTime opts)
      <> ")."
  when (optConvergencePhase opts) . putStrLn $
    "More runs automatically performed for up to "
      <> show (optConvergenceMaxTime opts)
      <> " to ensure accurate measurement."

  futhark <- FutharkExe . compFuthark <$> compileOptions opts

  maybe_results <-
    mapM
      (runBenchmark opts futhark)
      (sortBy (comparing fst) compiled_benchmarks)
  let results = [[BenchResult]] -> [BenchResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BenchResult]] -> [BenchResult])
-> [[BenchResult]] -> [BenchResult]
forall a b. (a -> b) -> a -> b
$ [Maybe [BenchResult]] -> [[BenchResult]]
forall a. [Maybe a] -> [a]
catMaybes [Maybe [BenchResult]]
maybe_results
  case optJSON opts of
    Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just String
file -> String -> ByteString -> IO ()
LBS.writeFile String
file (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [BenchResult] -> ByteString
encodeBenchResults [BenchResult]
results
  when (any isNothing maybe_results || anyFailed results) exitFailure
  where
    ignored :: p -> Bool
ignored p
f = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Regex -> p -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`match` p
f) ([Regex] -> Bool) -> [Regex] -> Bool
forall a b. (a -> b) -> a -> b
$ BenchOptions -> [Regex]
optIgnoreFiles BenchOptions
opts

anyFailed :: [BenchResult] -> Bool
anyFailed :: [BenchResult] -> Bool
anyFailed = (BenchResult -> Bool) -> [BenchResult] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BenchResult -> Bool
failedBenchResult
  where
    failedBenchResult :: BenchResult -> Bool
failedBenchResult (BenchResult String
_ [DataResult]
xs) =
      (DataResult -> Bool) -> [DataResult] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DataResult -> Bool
failedResult [DataResult]
xs
    failedResult :: DataResult -> Bool
failedResult (DataResult Text
_ Left {}) = Bool
True
    failedResult DataResult
_ = Bool
False

anyFailedToCompile :: [SkipReason] -> Bool
anyFailedToCompile :: [SkipReason] -> Bool
anyFailedToCompile = Bool -> Bool
not (Bool -> Bool) -> ([SkipReason] -> Bool) -> [SkipReason] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SkipReason -> Bool) -> [SkipReason] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (SkipReason -> SkipReason -> Bool
forall a. Eq a => a -> a -> Bool
== SkipReason
Skipped)

data SkipReason = Skipped | FailedToCompile
  deriving (SkipReason -> SkipReason -> Bool
(SkipReason -> SkipReason -> Bool)
-> (SkipReason -> SkipReason -> Bool) -> Eq SkipReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SkipReason -> SkipReason -> Bool
== :: SkipReason -> SkipReason -> Bool
$c/= :: SkipReason -> SkipReason -> Bool
/= :: SkipReason -> SkipReason -> Bool
Eq)

compileOptions :: BenchOptions -> IO CompileOptions
compileOptions :: BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts = do
  futhark <- IO String -> (String -> IO String) -> Maybe String -> IO String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getExecutablePath String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ BenchOptions -> Maybe String
optFuthark BenchOptions
opts
  pure $
    CompileOptions
      { compFuthark = futhark,
        compBackend = optBackend opts,
        compOptions = optCompilerOptions opts
      }

compileBenchmark ::
  BenchOptions ->
  (FilePath, ProgramTest) ->
  IO (Either SkipReason (FilePath, [InputOutputs]))
compileBenchmark :: BenchOptions
-> (String, ProgramTest)
-> IO (Either SkipReason (String, [InputOutputs]))
compileBenchmark BenchOptions
opts (String
program, ProgramTest
program_spec) = do
  spec <- IO ProgramTest
-> (String -> IO ProgramTest) -> Maybe String -> IO ProgramTest
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProgramTest -> IO ProgramTest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
program_spec) String -> IO ProgramTest
testSpecFromFileOrDie (Maybe String -> IO ProgramTest) -> Maybe String -> IO ProgramTest
forall a b. (a -> b) -> a -> b
$ BenchOptions -> Maybe String
optTestSpec BenchOptions
opts
  case testAction spec of
    RunCases [InputOutputs]
cases [StructureTest]
_ [WarningTest]
_
      | [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$
          BenchOptions -> [Text]
optExcludeCase BenchOptions
opts
            [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` ProgramTest -> [Text]
testTags ProgramTest
spec
            [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> ProgramTest -> [Text]
testTags ProgramTest
program_spec,
        (InputOutputs -> Bool) -> [InputOutputs] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any InputOutputs -> Bool
hasRuns [InputOutputs]
cases ->
          if BenchOptions -> Bool
optSkipCompilation BenchOptions
opts
            then do
              exists <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
program
              if exists
                then pure $ Right (program, cases)
                else do
                  putStrLn $ binaryName program ++ " does not exist, but --skip-compilation passed."
                  pure $ Left FailedToCompile
            else do
              String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Compiling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
program String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"...\n"

              compile_opts <- BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts

              res <- prepareBenchmarkProgram (optConcurrency opts) compile_opts program cases

              case res of
                Left (String
err, Maybe ByteString
errstr) -> do
                  Text -> IO ()
putRedLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
                  IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ByteString -> IO ()
SBS.putStrLn Maybe ByteString
errstr
                  Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SkipReason (String, [InputOutputs])
 -> IO (Either SkipReason (String, [InputOutputs])))
-> Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a b. (a -> b) -> a -> b
$ SkipReason -> Either SkipReason (String, [InputOutputs])
forall a b. a -> Either a b
Left SkipReason
FailedToCompile
                Right () ->
                  Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SkipReason (String, [InputOutputs])
 -> IO (Either SkipReason (String, [InputOutputs])))
-> Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a b. (a -> b) -> a -> b
$ (String, [InputOutputs])
-> Either SkipReason (String, [InputOutputs])
forall a b. b -> Either a b
Right (String
program, [InputOutputs]
cases)
    TestAction
_ ->
      Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SkipReason (String, [InputOutputs])
 -> IO (Either SkipReason (String, [InputOutputs])))
-> Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall a b. (a -> b) -> a -> b
$ SkipReason -> Either SkipReason (String, [InputOutputs])
forall a b. a -> Either a b
Left SkipReason
Skipped
  where
    hasRuns :: InputOutputs -> Bool
hasRuns (InputOutputs Text
_ [TestRun]
runs) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TestRun] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
runs

withProgramServer :: FilePath -> FilePath -> [String] -> (Server -> IO a) -> IO (Maybe a)
withProgramServer :: forall a.
String -> String -> [String] -> (Server -> IO a) -> IO (Maybe a)
withProgramServer String
program String
runner [String]
extra_options Server -> IO a
f = do
  -- Explicitly prefixing the current directory is necessary for
  -- readProcessWithExitCode to find the binary when binOutputf has
  -- no path component.
  let binOutputf :: String
binOutputf = String -> String
dropExtension String
program
      binpath :: String
binpath = String
"." String -> String -> String
</> String
binOutputf

      (String
to_run, [String]
to_run_args)
        | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
runner = (String
binpath, [String]
extra_options)
        | Bool
otherwise = (String
runner, String
binpath String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
extra_options)

  IO (Maybe a) -> IO (Maybe a)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> IO (Maybe a)) -> IO (Maybe a) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> IO a -> IO (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerCfg -> (Server -> IO a) -> IO a
forall a. ServerCfg -> (Server -> IO a) -> IO a
withServer (String -> [String] -> ServerCfg
futharkServerCfg String
to_run [String]
to_run_args) Server -> IO a
f) IO (Maybe a) -> (SomeException -> IO (Maybe a)) -> IO (Maybe a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO (Maybe a)
forall a. SomeException -> IO (Maybe a)
onError
  where
    onError :: SomeException -> IO (Maybe a)
    onError :: forall a. SomeException -> IO (Maybe a)
onError SomeException
e = do
      Text -> IO ()
putBoldRedLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"\nFailed to run " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
program
      Text -> IO ()
putRedLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Text
forall a. Show a => a -> Text
showText SomeException
e
      Maybe a -> IO (Maybe a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing

-- Truncate dataset name display after this many characters.
maxDatasetNameLength :: Int
maxDatasetNameLength :: Int
maxDatasetNameLength = Int
40

runBenchmark :: BenchOptions -> FutharkExe -> (FilePath, [InputOutputs]) -> IO (Maybe [BenchResult])
runBenchmark :: BenchOptions
-> FutharkExe
-> (String, [InputOutputs])
-> IO (Maybe [BenchResult])
runBenchmark BenchOptions
opts FutharkExe
futhark (String
program, [InputOutputs]
cases) = do
  (tuning_opts, tuning_desc) <- Maybe String -> String -> IO ([String], String)
forall (m :: * -> *).
MonadIO m =>
Maybe String -> String -> m ([String], String)
determineTuning (BenchOptions -> Maybe String
optTuning BenchOptions
opts) String
program
  let runopts =
        BenchOptions -> [String]
optExtraOptions BenchOptions
opts
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tuning_opts
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> [String]
determineCache (BenchOptions -> Maybe String
optCacheExt BenchOptions
opts) String
program
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ if BenchOptions -> Bool
optProfile BenchOptions
opts then [String
"--profile", String
"--log"] else []
  withProgramServer program (optRunner opts) runopts $ \Server
server ->
    (InputOutputs -> IO BenchResult)
-> [InputOutputs] -> IO [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 (Server -> String -> InputOutputs -> IO BenchResult
forInputOutputs Server
server String
tuning_desc) ([InputOutputs] -> IO [BenchResult])
-> [InputOutputs] -> IO [BenchResult]
forall a b. (a -> b) -> a -> b
$ (InputOutputs -> Bool) -> [InputOutputs] -> [InputOutputs]
forall a. (a -> Bool) -> [a] -> [a]
filter InputOutputs -> Bool
relevant [InputOutputs]
cases
  where
    forInputOutputs :: Server -> String -> InputOutputs -> IO BenchResult
forInputOutputs Server
server String
tuning_desc (InputOutputs Text
entry_name [TestRun]
runs) = do
      Text -> IO ()
putBoldLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
program' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tuning_desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
      String -> [DataResult] -> BenchResult
BenchResult String
program' ([DataResult] -> BenchResult)
-> ([Maybe DataResult] -> [DataResult])
-> [Maybe DataResult]
-> BenchResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe DataResult] -> [DataResult]
forall a. [Maybe a] -> [a]
catMaybes
        ([Maybe DataResult] -> BenchResult)
-> IO [Maybe DataResult] -> IO BenchResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestRun -> IO (Maybe DataResult))
-> [TestRun] -> IO [Maybe 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 (Server
-> BenchOptions
-> FutharkExe
-> String
-> Text
-> Int
-> TestRun
-> IO (Maybe DataResult)
runBenchmarkCase Server
server BenchOptions
opts FutharkExe
futhark String
program Text
entry_name Int
pad_to) [TestRun]
runs
      where
        program' :: String
program' =
          if Text
entry_name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"main"
            then String
program
            else String
program String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
entry_name

    relevant :: InputOutputs -> Bool
relevant = (String -> Bool)
-> (String -> String -> Bool) -> Maybe String -> String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (BenchOptions -> Maybe String
optEntryPoint BenchOptions
opts) (String -> Bool)
-> (InputOutputs -> String) -> InputOutputs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String)
-> (InputOutputs -> Text) -> InputOutputs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> Text
iosEntryPoint

    len :: TestRun -> Int
len = Text -> Int
T.length (Text -> Int) -> (TestRun -> Text) -> TestRun -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
atMostChars Int
maxDatasetNameLength (Text -> Text) -> (TestRun -> Text) -> TestRun -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> Text
runDescription
    pad_to :: Int
pad_to = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (InputOutputs -> [Int]) -> [InputOutputs] -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((TestRun -> Int) -> [TestRun] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map TestRun -> Int
len ([TestRun] -> [Int])
-> (InputOutputs -> [TestRun]) -> InputOutputs -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> [TestRun]
iosTestRuns) [InputOutputs]
cases

runOptions :: ((Int, Maybe Double) -> IO ()) -> BenchOptions -> RunOptions
runOptions :: ((Int, Maybe Double) -> IO ()) -> BenchOptions -> RunOptions
runOptions (Int, Maybe Double) -> IO ()
f BenchOptions
opts =
  RunOptions
    { runMinRuns :: Int
runMinRuns = BenchOptions -> Int
optMinRuns BenchOptions
opts,
      runMinTime :: NominalDiffTime
runMinTime = BenchOptions -> NominalDiffTime
optMinTime BenchOptions
opts,
      runTimeout :: Int
runTimeout = BenchOptions -> Int
optTimeout BenchOptions
opts,
      runVerbose :: Int
runVerbose = BenchOptions -> Int
optVerbose BenchOptions
opts,
      runConvergencePhase :: Bool
runConvergencePhase = BenchOptions -> Bool
optConvergencePhase BenchOptions
opts,
      runConvergenceMaxTime :: NominalDiffTime
runConvergenceMaxTime = BenchOptions -> NominalDiffTime
optConvergenceMaxTime BenchOptions
opts,
      runResultAction :: (Int, Maybe Double) -> IO ()
runResultAction = (Int, Maybe Double) -> IO ()
f,
      runProfile :: Bool
runProfile = BenchOptions -> Bool
optProfile BenchOptions
opts
    }

descText :: T.Text -> Int -> T.Text
descText :: Text -> Int -> Text
descText Text
desc Int
pad_to = Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
pad_to Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
desc) Text
" "

progress :: Double -> T.Text
progress :: Double -> Text
progress Double
elapsed =
  ProgressBar -> Text
progressBar
    ( ProgressBar
        { progressBarSteps :: Int
progressBarSteps = Int
10,
          progressBarBound :: Double
progressBarBound = Double
1,
          progressBarElapsed :: Double
progressBarElapsed = Double
elapsed
        }
    )

interimResult :: Int -> Int -> Double -> T.Text
interimResult :: Int -> Int -> Double -> Text
interimResult Int
us_sum Int
runs Double
elapsed =
  String -> Text
T.pack (String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%10.0fμs " Double
avg)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
progress Double
elapsed
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Pretty a => a -> Text
prettyText Int
runs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" runs")
  where
    avg :: Double
    avg :: Double
avg = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
us_sum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
runs

convergenceBar :: (T.Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar :: (Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us_sum Int
i Double
rse' = do
  spin_idx <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
spin_count
  let spin = Int -> Text
progressSpinner Int
spin_idx
  p $ T.pack $ printf "%10.0fμs %s (RSE of mean: %2.4f; %4d runs)" avg spin rse' i
  writeIORef spin_count (spin_idx + 1)
  where
    avg :: Double
    avg :: Double
avg = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
us_sum Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

data BenchPhase = Initial | Convergence

mkProgressPrompt :: BenchOptions -> Int -> T.Text -> UTCTime -> IO ((Maybe Int, Maybe Double) -> IO ())
mkProgressPrompt :: BenchOptions
-> Int
-> Text
-> UTCTime
-> IO ((Maybe Int, Maybe Double) -> IO ())
mkProgressPrompt BenchOptions
opts Int
pad_to Text
dataset_desc UTCTime
start_time
  | Bool
fancyTerminal = do
      count <- (Int, Int) -> IO (IORef (Int, Int))
forall a. a -> IO (IORef a)
newIORef (Int
0, Int
0)
      phase_var <- newIORef Initial
      spin_count <- newIORef 0
      pure $ \(Maybe Int
us, Maybe Double
rse) -> do
        Text -> IO ()
T.putStr Text
"\r" -- Go to start of line.
        let p :: Text -> IO ()
p Text
s =
              Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
                Text -> Int -> Text
descText (Int -> Text -> Text
atMostChars Int
maxDatasetNameLength Text
dataset_desc) Int
pad_to Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

        (us_sum, i) <- IORef (Int, Int) -> IO (Int, Int)
forall a. IORef a -> IO a
readIORef IORef (Int, Int)
count

        now <- liftIO getCurrentTime
        let determineProgress p
i' =
              let time_elapsed :: Double
time_elapsed = NominalDiffTime -> Double
toDouble (NominalDiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
start_time) NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Fractional a => a -> a -> a
/ BenchOptions -> NominalDiffTime
optMinTime BenchOptions
opts)
                  runs_elapsed :: Double
runs_elapsed = p -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
i' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BenchOptions -> Int
optMinRuns BenchOptions
opts)
               in -- The progress bar is the _shortest_ of the
                  -- time-based or runs-based estimate.  This is
                  -- intended to avoid a situation where the progress
                  -- bar is full but stuff is still happening.  On the
                  -- other hand, it means it can sometimes shrink.
                  Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
time_elapsed Double
runs_elapsed

        phase <- readIORef phase_var

        case (us, phase, rse) of
          (Maybe Int
Nothing, BenchPhase
_, Maybe Double
_) ->
            let elapsed :: Double
elapsed = Int -> Double
forall {p}. Integral p => p -> Double
determineProgress Int
i
             in Text -> IO ()
p (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
13 Char
' ') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Double -> Text
progress Double
elapsed
          (Just Int
us', BenchPhase
Initial, Maybe Double
Nothing) -> do
            let us_sum' :: Int
us_sum' = Int
us_sum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
us'
                i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us_sum', Int
i')
            let elapsed :: Double
elapsed = Int -> Double
forall {p}. Integral p => p -> Double
determineProgress Int
i'
            Text -> IO ()
p (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double -> Text
interimResult Int
us_sum' Int
i' Double
elapsed
          (Just Int
us', BenchPhase
Initial, Just Double
rse') -> do
            -- Switched from phase 1 to convergence; discard all
            -- prior results.
            IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us', Int
1)
            IORef BenchPhase -> BenchPhase -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef BenchPhase
phase_var BenchPhase
Convergence
            (Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us' Int
1 Double
rse'
          (Just Int
us', BenchPhase
Convergence, Just Double
rse') -> do
            let us_sum' :: Int
us_sum' = Int
us_sum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
us'
                i' :: Int
i' = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
            IORef (Int, Int) -> (Int, Int) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us_sum', Int
i')
            (Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us_sum' Int
i' Double
rse'
          (Just Int
_, BenchPhase
Convergence, Maybe Double
Nothing) ->
            () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- Probably should not happen.
        putStr " " -- Just to move the cursor away from the progress bar.
        hFlush stdout
  | Bool
otherwise = do
      Text -> IO ()
T.putStr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text
descText Text
dataset_desc Int
pad_to
      Handle -> IO ()
hFlush Handle
stdout
      ((Maybe Int, Maybe Double) -> IO ())
-> IO ((Maybe Int, Maybe Double) -> IO ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Maybe Int, Maybe Double) -> IO ())
 -> IO ((Maybe Int, Maybe Double) -> IO ()))
-> ((Maybe Int, Maybe Double) -> IO ())
-> IO ((Maybe Int, Maybe Double) -> IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> (Maybe Int, Maybe Double) -> IO ()
forall a b. a -> b -> a
const (IO () -> (Maybe Int, Maybe Double) -> IO ())
-> IO () -> (Maybe Int, Maybe Double) -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    toDouble :: NominalDiffTime -> Double
toDouble = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double)
-> (NominalDiffTime -> Rational) -> NominalDiffTime -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational

reportResult :: [RunResult] -> (Double, Double) -> IO ()
reportResult :: [RunResult] -> (Double, Double) -> IO ()
reportResult [RunResult]
results (Double
ci_lower, Double
ci_upper) = do
  let runtimes :: [Double]
runtimes = (RunResult -> Double) -> [RunResult] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> (RunResult -> Int) -> RunResult -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds) [RunResult]
results
      avg :: Double
avg = [Double] -> Double
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
runtimes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Double] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
runtimes) :: Double
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Double -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%10.0fμs (95%% CI: [%10.1f, %10.1f])" Double
avg Double
ci_lower Double
ci_upper

runBenchmarkCase ::
  Server ->
  BenchOptions ->
  FutharkExe ->
  FilePath ->
  T.Text ->
  Int ->
  TestRun ->
  IO (Maybe DataResult)
runBenchmarkCase :: Server
-> BenchOptions
-> FutharkExe
-> String
-> Text
-> Int
-> TestRun
-> IO (Maybe DataResult)
runBenchmarkCase Server
_ BenchOptions
_ FutharkExe
_ String
_ Text
_ Int
_ (TestRun [Text]
_ Values
_ RunTimeFailure {} Int
_ Text
_) =
  Maybe DataResult -> IO (Maybe DataResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DataResult
forall a. Maybe a
Nothing -- Not our concern, we are not a testing tool.
runBenchmarkCase Server
_ BenchOptions
opts FutharkExe
_ String
_ Text
_ Int
_ (TestRun [Text]
tags Values
_ ExpectedResult Success
_ Int
_ Text
_)
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
tags) ([Text] -> Bool) -> [Text] -> Bool
forall a b. (a -> b) -> a -> b
$ BenchOptions -> [Text]
optExcludeCase BenchOptions
opts =
      Maybe DataResult -> IO (Maybe DataResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe DataResult
forall a. Maybe a
Nothing
runBenchmarkCase Server
server BenchOptions
opts FutharkExe
futhark String
program Text
entry Int
pad_to TestRun
tr = do
  let (TestRun [Text]
_ Values
input_spec (Succeeds Maybe Success
expected_spec) Int
_ Text
dataset_desc) = TestRun
tr
  start_time <- IO UTCTime -> IO UTCTime
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  prompt <- mkProgressPrompt opts pad_to dataset_desc start_time

  -- Report the dataset name before running the program, so that if an
  -- error occurs it's easier to see where.
  prompt (Nothing, Nothing)

  res <-
    benchmarkDataset
      server
      (runOptions (prompt . first Just) opts)
      futhark
      program
      entry
      input_spec
      expected_spec
      (testRunReferenceOutput program entry tr)

  when fancyTerminal $ do
    clearLine
    T.putStr "\r"
    T.putStr $ descText (atMostChars maxDatasetNameLength dataset_desc) pad_to

  case res of
    Left Text
err -> IO (Maybe DataResult) -> IO (Maybe DataResult)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DataResult) -> IO (Maybe DataResult))
-> IO (Maybe DataResult) -> IO (Maybe DataResult)
forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
putStrLn String
""
      Text -> IO ()
putRedLn Text
err
      Maybe DataResult -> IO (Maybe DataResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe DataResult -> IO (Maybe DataResult))
-> Maybe DataResult -> IO (Maybe DataResult)
forall a b. (a -> b) -> a -> b
$ DataResult -> Maybe DataResult
forall a. a -> Maybe a
Just (DataResult -> Maybe DataResult) -> DataResult -> Maybe DataResult
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Result -> DataResult
DataResult Text
dataset_desc (Either Text Result -> DataResult)
-> Either Text Result -> DataResult
forall a b. (a -> b) -> a -> b
$ Text -> Either Text Result
forall a b. a -> Either a b
Left Text
err
    Right ([RunResult]
runtimes, Text
errout, ProfilingReport
report) -> do
      let vec_runtimes :: Vector Double
vec_runtimes = [Double] -> Vector Double
forall a. Unbox a => [a] -> Vector a
U.fromList ([Double] -> Vector Double) -> [Double] -> Vector Double
forall a b. (a -> b) -> a -> b
$ (RunResult -> Double) -> [RunResult] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> (RunResult -> Int) -> RunResult -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds) [RunResult]
runtimes
      g <- IO (Gen RealWorld)
IO (Gen (PrimState IO))
forall (m :: * -> *). PrimMonad m => m (Gen (PrimState m))
create
      resampled <- liftIO $ resample g [Mean] 70000 vec_runtimes
      let bootstrapCI =
            case CL Double
-> Vector Double
-> [(Estimator, Bootstrap Vector Double)]
-> [Estimate ConfInt Double]
bootstrapBCA CL Double
forall a. Fractional a => CL a
cl95 Vector Double
vec_runtimes [(Estimator, Bootstrap Vector Double)]
resampled of
              Estimate ConfInt Double
boot : [Estimate ConfInt Double]
_ ->
                ( Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
boot Double -> Double -> Double
forall a. Num a => a -> a -> a
- ConfInt Double -> Double
forall a. ConfInt a -> a
confIntLDX (Estimate ConfInt Double -> ConfInt Double
forall (e :: * -> *) a. Estimate e a -> e a
estError Estimate ConfInt Double
boot),
                  Estimate ConfInt Double -> Double
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
boot Double -> Double -> Double
forall a. Num a => a -> a -> a
+ ConfInt Double -> Double
forall a. ConfInt a -> a
confIntUDX (Estimate ConfInt Double -> ConfInt Double
forall (e :: * -> *) a. Estimate e a -> e a
estError Estimate ConfInt Double
boot)
                )
              [Estimate ConfInt Double]
_ -> (Double
0, Double
0)

      reportResult runtimes bootstrapCI

      -- We throw away the 'errout' unless profiling is enabled,
      -- because it is otherwise useless and adds too much to the
      -- .json file size.
      let errout' = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BenchOptions -> Bool
optProfile BenchOptions
opts) Maybe () -> Maybe Text -> Maybe Text
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
errout
          report' = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BenchOptions -> Bool
optProfile BenchOptions
opts) Maybe () -> Maybe ProfilingReport -> Maybe ProfilingReport
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProfilingReport -> Maybe ProfilingReport
forall a. a -> Maybe a
Just ProfilingReport
report
      Result runtimes (getMemoryUsage report) errout' report'
        & Right
        & DataResult dataset_desc
        & Just
        & pure

getMemoryUsage :: ProfilingReport -> M.Map T.Text Int
getMemoryUsage :: ProfilingReport -> Map Text Int
getMemoryUsage = (Integer -> Int) -> Map Text Integer -> Map Text Int
forall a b. (a -> b) -> Map Text a -> Map Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Map Text Integer -> Map Text Int)
-> (ProfilingReport -> Map Text Integer)
-> ProfilingReport
-> Map Text Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfilingReport -> Map Text Integer
profilingMemory

commandLineOptions :: [FunOptDescr BenchOptions]
commandLineOptions :: [FunOptDescr BenchOptions]
commandLineOptions =
  [ String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"r"
      [String
"runs"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
n ->
              case ReadS Int
forall a. Read a => ReadS a
reads String
n of
                [(Int
n', String
"")] | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
                  (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
                    BenchOptions
config
                      { optMinRuns = n'
                      }
                [(Int, String)]
_ ->
                  IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (String -> IO ())
-> String
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
          )
          String
"RUNS"
      )
      String
"Run each test case this many times.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"backend"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
backend -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optBackend = backend})
          String
"PROGRAM"
      )
      String
"The compiler used (defaults to 'futhark-c').",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"futhark"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
prog -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optFuthark = Just prog})
          String
"PROGRAM"
      )
      String
"The binary used for operations (defaults to same binary as 'futhark bench').",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"runner"]
      ((String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
prog -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optRunner = prog}) String
"PROGRAM")
      String
"The program used to run the Futhark-generated programs (defaults to nothing).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"p"
      [String
"pass-option"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
opt ->
              (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
                BenchOptions
config {optExtraOptions = opt : optExtraOptions config}
          )
          String
"OPT"
      )
      String
"Pass this option to programs being run.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"pass-compiler-option"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
opt ->
              (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
                BenchOptions
config {optCompilerOptions = opt : optCompilerOptions config}
          )
          String
"OPT"
      )
      String
"Pass this option to the compiler (or typechecker if in -t mode).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"json"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
file ->
              (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optJSON = Just file}
          )
          String
"FILE"
      )
      String
"Scatter results in JSON format here.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"timeout"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
n ->
              case ReadS Int
forall a. Read a => ReadS a
reads String
n of
                [(Int
n', String
"")]
                  | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
max_timeout ->
                      (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTimeout = fromIntegral n'}
                [(Int, String)]
_ ->
                  IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (String -> IO ())
-> String
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$
                    String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not an integer smaller than" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
max_timeout String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
          )
          String
"SECONDS"
      )
      String
"Number of seconds before a dataset is aborted.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"skip-compilation"]
      (Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (BenchOptions -> BenchOptions)
 -> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions)))
-> Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a b. (a -> b) -> a -> b
$ (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optSkipCompilation = True})
      String
"Use already compiled server-mode program.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"exclude-case"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
              BenchOptions
config {optExcludeCase = T.pack s : optExcludeCase config}
          )
          String
"TAG"
      )
      String
"Do not run test cases with this tag.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"ignore-files"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
              BenchOptions
config {optIgnoreFiles = makeRegex s : optIgnoreFiles config}
          )
          String
"REGEX"
      )
      String
"Ignore files matching this regular expression.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"e"
      [String
"entry-point"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
              BenchOptions
config {optEntryPoint = Just s}
          )
          String
"NAME"
      )
      String
"Only run this entry point.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"tuning"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTuning = Just s})
          String
"EXTENSION"
      )
      String
"Look for tuning files with this extension (defaults to .tuning).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"cache-extension"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          (\String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optCacheExt = Just s})
          String
"EXTENSION"
      )
      String
"Use cache files with this extension (none by default).",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"no-tuning"]
      (Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (BenchOptions -> BenchOptions)
 -> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions)))
-> Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a b. (a -> b) -> a -> b
$ (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTuning = Nothing})
      String
"Do not load tuning files.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"no-convergence-phase"]
      (Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (BenchOptions -> BenchOptions)
 -> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions)))
-> Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a b. (a -> b) -> a -> b
$ (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConvergencePhase = False})
      String
"Do not run convergence phase.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"convergence-max-seconds"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
n ->
              case ReadS Integer
forall a. Read a => ReadS a
reads String
n of
                [(Integer
n', String
"")]
                  | Integer
n' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 ->
                      (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConvergenceMaxTime = fromInteger n'}
                [(Integer, String)]
_ ->
                  IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (String -> IO ())
-> String
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
          )
          String
"NUM"
      )
      String
"Limit convergence phase to this number of seconds.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"concurrency"]
      ( (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg
          ( \String
n ->
              case ReadS Int
forall a. Read a => ReadS a
reads String
n of
                [(Int
n', String
"")]
                  | Int
n' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
                      (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConcurrency = Just n'}
                [(Int, String)]
_ ->
                  IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (String -> IO ())
-> String
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError (String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
          )
          String
"NUM"
      )
      String
"Number of benchmarks to prepare (not run) concurrently.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      []
      [String
"spec-file"]
      ((String -> Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTestSpec = Just s}) String
"FILE")
      String
"Use test specification from this file.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"v"
      [String
"verbose"]
      (Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (BenchOptions -> BenchOptions)
 -> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions)))
-> Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a b. (a -> b) -> a -> b
$ (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optVerbose = optVerbose config + 1})
      String
"Enable logging.  Pass multiple times for more.",
    String
-> [String]
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
-> String
-> FunOptDescr BenchOptions
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
      String
"P"
      [String
"profile"]
      (Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a. a -> ArgDescr a
NoArg (Either (IO ()) (BenchOptions -> BenchOptions)
 -> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions)))
-> Either (IO ()) (BenchOptions -> BenchOptions)
-> ArgDescr (Either (IO ()) (BenchOptions -> BenchOptions))
forall a b. (a -> b) -> a -> b
$ (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. b -> Either a b
Right ((BenchOptions -> BenchOptions)
 -> Either (IO ()) (BenchOptions -> BenchOptions))
-> (BenchOptions -> BenchOptions)
-> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optProfile = True})
      String
"Collect profiling information."
  ]
  where
    max_timeout :: Int
    max_timeout :: Int
max_timeout = Int
forall a. Bounded a => a
maxBound Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
1000000

excludeBackend :: BenchOptions -> BenchOptions
excludeBackend :: BenchOptions -> BenchOptions
excludeBackend BenchOptions
config =
  BenchOptions
config
    { optExcludeCase =
        "no_" <> T.pack (optBackend config)
          : optExcludeCase config
    }

-- | Run @futhark bench@.
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = BenchOptions
-> [FunOptDescr BenchOptions]
-> String
-> ([String] -> BenchOptions -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions BenchOptions
initialBenchOptions [FunOptDescr BenchOptions]
commandLineOptions String
"options... programs..." (([String] -> BenchOptions -> Maybe (IO ()))
 -> String -> [String] -> IO ())
-> ([String] -> BenchOptions -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
forall a b. (a -> b) -> a -> b
$ \[String]
progs BenchOptions
config ->
  case [String]
progs of
    [] -> Maybe (IO ())
forall a. Maybe a
Nothing
    [String]
_
      | BenchOptions -> Bool
optProfile BenchOptions
config Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (BenchOptions -> Maybe String
optJSON BenchOptions
config) ->
          IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ String -> IO ()
optionsError String
"--profile cannot be used without --json."
      | Bool
otherwise ->
          IO () -> Maybe (IO ())
forall a. a -> Maybe a
Just (IO () -> Maybe (IO ())) -> IO () -> Maybe (IO ())
forall a b. (a -> b) -> a -> b
$ BenchOptions -> [String] -> IO ()
runBenchmarks (BenchOptions -> BenchOptions
excludeBackend BenchOptions
config) [String]
progs