{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
-- | @futhark bench@
module Futhark.CLI.Bench ( main ) where

import Control.Monad
import Control.Monad.Except
import qualified Data.ByteString.Char8 as SBS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Either
import Data.Maybe
import Data.List (foldl', sortBy)
import Data.Ord
import qualified Data.Text as T
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.IO
import System.Exit
import Text.Printf
import Text.Regex.TDFA

import Futhark.Bench
import Futhark.Test
import Futhark.Util (pmapIO)
import Futhark.Util.Console
import Futhark.Util.Options

data BenchOptions = BenchOptions
                   { BenchOptions -> String
optBackend :: String
                   , BenchOptions -> Maybe String
optFuthark :: Maybe String
                   , BenchOptions -> String
optRunner :: String
                   , BenchOptions -> Int
optRuns :: Int
                   , BenchOptions -> [String]
optExtraOptions :: [String]
                   , BenchOptions -> [String]
optCompilerOptions :: [String]
                   , BenchOptions -> Maybe String
optJSON :: Maybe FilePath
                   , BenchOptions -> Int
optTimeout :: Int
                   , BenchOptions -> Bool
optSkipCompilation :: Bool
                   , BenchOptions -> [String]
optExcludeCase :: [String]
                   , BenchOptions -> [Regex]
optIgnoreFiles :: [Regex]
                   , BenchOptions -> Maybe String
optEntryPoint :: Maybe String
                   , BenchOptions -> Maybe String
optTuning :: Maybe String
                   , BenchOptions -> Maybe Int
optConcurrency :: Maybe Int
                   , BenchOptions -> Int
optVerbose :: Int
                   }

initialBenchOptions :: BenchOptions
initialBenchOptions :: BenchOptions
initialBenchOptions = String
-> Maybe String
-> String
-> Int
-> [String]
-> [String]
-> Maybe String
-> Int
-> Bool
-> [String]
-> [Regex]
-> Maybe String
-> Maybe String
-> Maybe Int
-> Int
-> BenchOptions
BenchOptions String
"c" Maybe String
forall a. Maybe a
Nothing String
"" Int
10 [] [] Maybe String
forall a. Maybe a
Nothing (-Int
1) Bool
False
                      [String
"nobench", String
"disable"] [] Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"tuning") Maybe Int
forall a. Maybe a
Nothing Int
0

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

  [(String, ProgramTest)]
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 source. RegexLike Regex source => source -> 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' :: BenchOptions
opts' = if [String] -> 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 :: Maybe Int
optConcurrency = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1}
              else BenchOptions
opts
  ([SkipReason]
skipped_benchmarks, [(String, [InputOutputs])]
compiled_benchmarks) <-
    [Either SkipReason (String, [InputOutputs])]
-> ([SkipReason], [(String, [InputOutputs])])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either SkipReason (String, [InputOutputs])]
 -> ([SkipReason], [(String, [InputOutputs])]))
-> IO [Either SkipReason (String, [InputOutputs])]
-> IO ([SkipReason], [(String, [InputOutputs])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
-> ((String, ProgramTest)
    -> IO (Either SkipReason (String, [InputOutputs])))
-> [(String, ProgramTest)]
-> IO [Either SkipReason (String, [InputOutputs])]
forall a b. Maybe Int -> (a -> IO b) -> [a] -> IO [b]
pmapIO (BenchOptions -> Maybe Int
optConcurrency BenchOptions
opts) (BenchOptions
-> (String, ProgramTest)
-> IO (Either SkipReason (String, [InputOutputs]))
compileBenchmark BenchOptions
opts') [(String, ProgramTest)]
benchmarks

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SkipReason] -> Bool
anyFailedToCompile [SkipReason]
skipped_benchmarks) IO ()
forall a. IO a
exitFailure

  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Reporting average runtime of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (BenchOptions -> Int
optRuns BenchOptions
opts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" runs for each dataset."

  [BenchResult]
results <- [[BenchResult]] -> [BenchResult]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BenchResult]] -> [BenchResult])
-> IO [[BenchResult]] -> IO [BenchResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String, [InputOutputs]) -> IO [BenchResult])
-> [(String, [InputOutputs])] -> IO [[BenchResult]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BenchOptions -> (String, [InputOutputs]) -> IO [BenchResult]
runBenchmark BenchOptions
opts)
             (((String, [InputOutputs]) -> (String, [InputOutputs]) -> Ordering)
-> [(String, [InputOutputs])] -> [(String, [InputOutputs])]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((String, [InputOutputs]) -> String)
-> (String, [InputOutputs]) -> (String, [InputOutputs]) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (String, [InputOutputs]) -> String
forall a b. (a, b) -> a
fst) [(String, [InputOutputs])]
compiled_benchmarks)
  case BenchOptions -> Maybe String
optJSON BenchOptions
opts of
    Maybe String
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([BenchResult] -> Bool
anyFailed [BenchResult]
results) IO ()
forall a. IO a
exitFailure

  where ignored :: source -> Bool
ignored source
f = (Regex -> Bool) -> [Regex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Regex -> source -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`match` source
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 String
_ 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
/= :: SkipReason -> SkipReason -> Bool
$c/= :: SkipReason -> SkipReason -> Bool
== :: SkipReason -> SkipReason -> Bool
$c== :: SkipReason -> SkipReason -> Bool
Eq)

compileOptions :: BenchOptions -> IO CompileOptions
compileOptions :: BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts = do
  String
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 (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO String) -> Maybe String -> IO String
forall a b. (a -> b) -> a -> b
$ BenchOptions -> Maybe String
optFuthark BenchOptions
opts
  CompileOptions -> IO CompileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileOptions -> IO CompileOptions)
-> CompileOptions -> IO CompileOptions
forall a b. (a -> b) -> a -> b
$ CompileOptions :: String -> String -> [String] -> CompileOptions
CompileOptions { compFuthark :: String
compFuthark = String
futhark
                          , compBackend :: String
compBackend = BenchOptions -> String
optBackend BenchOptions
opts
                          , compOptions :: [String]
compOptions = BenchOptions -> [String]
optCompilerOptions BenchOptions
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
spec) =
  case ProgramTest -> TestAction
testAction ProgramTest
spec of
    RunCases [InputOutputs]
cases [StructureTest]
_ [WarningTest]
_ | Text
"nobench" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ProgramTest -> [Text]
testTags ProgramTest
spec,
                         Text
"disable" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ProgramTest -> [Text]
testTags ProgramTest
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
        Bool
exists <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
program
        if Bool
exists
          then Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (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)
          else do String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
program String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" does not exist, but --skip-compilation passed."
                  Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (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
        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"

        CompileOptions
compile_opts <- BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts

        Either (String, Maybe ByteString) ()
res <- Maybe Int
-> CompileOptions
-> String
-> [InputOutputs]
-> IO (Either (String, Maybe ByteString) ())
forall (m :: * -> *).
MonadIO m =>
Maybe Int
-> CompileOptions
-> String
-> [InputOutputs]
-> m (Either (String, Maybe ByteString) ())
prepareBenchmarkProgram (BenchOptions -> Maybe Int
optConcurrency BenchOptions
opts) CompileOptions
compile_opts String
program [InputOutputs]
cases

        case Either (String, Maybe ByteString) ()
res of
          Left (String
err, Maybe ByteString
errstr) -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
inRed String
err
            IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> IO ()
SBS.putStrLn Maybe ByteString
errstr
            Either SkipReason (String, [InputOutputs])
-> IO (Either SkipReason (String, [InputOutputs]))
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return (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 (m :: * -> *) a. Monad m => a -> m a
return (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 (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
runs

runBenchmark :: BenchOptions -> (FilePath, [InputOutputs]) -> IO [BenchResult]
runBenchmark :: BenchOptions -> (String, [InputOutputs]) -> IO [BenchResult]
runBenchmark BenchOptions
opts (String
program, [InputOutputs]
cases) = (InputOutputs -> IO BenchResult)
-> [InputOutputs] -> IO [BenchResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM InputOutputs -> IO BenchResult
forInputOutputs ([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 :: InputOutputs -> IO BenchResult
forInputOutputs (InputOutputs Text
entry_name [TestRun]
runs) = do
          ([String]
tuning_opts, String
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

          String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
inBold (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"\nResults for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
program' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tuning_desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n"
          let opts' :: BenchOptions
opts' = BenchOptions
opts { optExtraOptions :: [String]
optExtraOptions =
                               BenchOptions -> [String]
optExtraOptions BenchOptions
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
tuning_opts }
          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)
mapM (BenchOptions
-> String -> Text -> Int -> TestRun -> IO (Maybe DataResult)
runBenchmarkCase BenchOptions
opts' 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

        pad_to :: Int
pad_to = (Int -> Int -> Int) -> Int -> [Int] -> Int
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 (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (TestRun -> String) -> TestRun -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> String
runDescription) ([TestRun] -> [Int])
-> (InputOutputs -> [TestRun]) -> InputOutputs -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> [TestRun]
iosTestRuns) [InputOutputs]
cases

reportResult :: [RunResult] -> IO ()
reportResult :: [RunResult] -> IO ()
reportResult [] =
  Int -> IO ()
forall a. Show a => a -> IO ()
print (Int
0::Int)
reportResult [RunResult]
results = 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 (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 (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
runtimes)
      rsd :: Double
rsd = [Double] -> Double
forall a. Floating a => [a] -> a
stddevp [Double]
runtimes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ [Double] -> Double
forall a. Floating a => [a] -> a
mean [Double]
runtimes :: Double
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Double -> Double -> Double -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%10.0fμs (RSD: %.3f; min: %3.0f%%; max: %+3.0f%%)"
    Double
avg Double
rsd (([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double]
runtimes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
avg Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) (([Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double]
runtimes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
avg Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)

runOptions :: BenchOptions -> RunOptions
runOptions :: BenchOptions -> RunOptions
runOptions BenchOptions
opts = RunOptions :: String -> Int -> [String] -> Int -> Int -> RunOptions
RunOptions { runRunner :: String
runRunner = BenchOptions -> String
optRunner BenchOptions
opts
                             , runRuns :: Int
runRuns = BenchOptions -> Int
optRuns BenchOptions
opts
                             , runExtraOptions :: [String]
runExtraOptions = BenchOptions -> [String]
optExtraOptions BenchOptions
opts
                             , runTimeout :: Int
runTimeout = BenchOptions -> Int
optTimeout BenchOptions
opts
                             , runVerbose :: Int
runVerbose = BenchOptions -> Int
optVerbose BenchOptions
opts
                             }

runBenchmarkCase :: BenchOptions -> FilePath -> T.Text -> Int -> TestRun
                 -> IO (Maybe DataResult)
runBenchmarkCase :: BenchOptions
-> String -> Text -> Int -> TestRun -> IO (Maybe DataResult)
runBenchmarkCase BenchOptions
_ String
_ Text
_ Int
_ (TestRun [String]
_ Values
_ RunTimeFailure{} Int
_ String
_) =
  Maybe DataResult -> IO (Maybe DataResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DataResult
forall a. Maybe a
Nothing -- Not our concern, we are not a testing tool.
runBenchmarkCase BenchOptions
opts String
_ Text
_ Int
_ (TestRun [String]
tags Values
_ ExpectedResult Success
_ Int
_ String
_)
  | (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags) ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ BenchOptions -> [String]
optExcludeCase BenchOptions
opts =
      Maybe DataResult -> IO (Maybe DataResult)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DataResult
forall a. Maybe a
Nothing
runBenchmarkCase BenchOptions
opts String
program Text
entry Int
pad_to tr :: TestRun
tr@(TestRun [String]
_ Values
input_spec (Succeeds Maybe Success
expected_spec) Int
_ String
dataset_desc) = do
  -- Report the dataset name before running the program, so that if an
  -- error occurs it's easier to see where.
  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
dataset_desc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
    Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
pad_to Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
dataset_desc) Char
' '
  Handle -> IO ()
hFlush Handle
stdout

  Either Text ([RunResult], Text)
res <- RunOptions
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text))
benchmarkDataset (BenchOptions -> RunOptions
runOptions BenchOptions
opts) String
program Text
entry Values
input_spec Maybe Success
expected_spec
         (String -> Text -> TestRun -> String
testRunReferenceOutput String
program Text
entry TestRun
tr)
  case Either Text ([RunResult], Text)
res of
    Left Text
err -> do
      IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String
inRed (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
err
      Maybe DataResult -> IO (Maybe DataResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
$ String -> Either Text ([RunResult], Text) -> DataResult
DataResult String
dataset_desc (Either Text ([RunResult], Text) -> DataResult)
-> Either Text ([RunResult], Text) -> DataResult
forall a b. (a -> b) -> a -> b
$ Text -> Either Text ([RunResult], Text)
forall a b. a -> Either a b
Left Text
err
    Right ([RunResult]
runtimes, Text
errout) -> do
      [RunResult] -> IO ()
reportResult [RunResult]
runtimes
      Maybe DataResult -> IO (Maybe DataResult)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
$ String -> Either Text ([RunResult], Text) -> DataResult
DataResult String
dataset_desc (Either Text ([RunResult], Text) -> DataResult)
-> Either Text ([RunResult], Text) -> DataResult
forall a b. (a -> b) -> a -> b
$ ([RunResult], Text) -> Either Text ([RunResult], Text)
forall a b. b -> Either a b
Right ([RunResult]
runtimes, Text
errout)

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 { optRuns :: Int
optRuns = Int
n'
                         }
                [(Int, String)]
_ ->
                  IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
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 :: String
optBackend = String
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 :: Maybe String
optFuthark = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: String
optRunner = String
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 :: [String]
optExtraOptions = String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optExtraOptions BenchOptions
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 :: [String]
optCompilerOptions = String
opt String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optCompilerOptions BenchOptions
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 :: Maybe String
optJSON = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Int
optTimeout = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n' }
                 [(Int, String)]
_ ->
                   IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
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 :: Bool
optSkipCompilation = Bool
True })
    String
"Use already compiled 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 :: [String]
optExcludeCase = String
s String -> [String] -> [String]
forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optExcludeCase BenchOptions
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 :: [Regex]
optIgnoreFiles = String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex String
s Regex -> [Regex] -> [Regex]
forall a. a -> [a] -> [a]
: BenchOptions -> [Regex]
optIgnoreFiles BenchOptions
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 :: Maybe String
optEntryPoint = String -> Maybe String
forall a. a -> Maybe a
Just String
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 :: Maybe String
optTuning = String -> Maybe String
forall a. a -> Maybe a
Just String
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
"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 :: Maybe String
optTuning = Maybe String
forall a. Maybe a
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
"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 :: Maybe Int
optConcurrency = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n' }
                 [(Int, String)]
_ ->
                   IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. a -> Either a b
Left (IO () -> Either (IO ()) (BenchOptions -> BenchOptions))
-> IO () -> Either (IO ()) (BenchOptions -> BenchOptions)
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> a
error (String -> IO ()) -> String -> IO ()
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
"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 :: Int
optVerbose = BenchOptions -> Int
optVerbose BenchOptions
config Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 })
    String
"Enable logging.  Pass multiple times for more."
  ]
  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

-- | 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 ->
  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
config [String]
progs

--- The following extracted from hstats package by Marshall Beddoe:
--- https://hackage.haskell.org/package/hstats-0.3

-- | Numerically stable mean
mean :: Floating a => [a] -> a
mean :: [a] -> a
mean [a]
x = (a, a) -> a
forall a b. (a, b) -> a
fst ((a, a) -> a) -> (a, a) -> a
forall a b. (a -> b) -> a -> b
$ ((a, a) -> a -> (a, a)) -> (a, a) -> [a] -> (a, a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(!a
m, !a
n) a
x' -> (a
ma -> a -> a
forall a. Num a => a -> a -> a
+(a
x'a -> a -> a
forall a. Num a => a -> a -> a
-a
m)a -> a -> a
forall a. Fractional a => a -> a -> a
/(a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1),a
na -> a -> a
forall a. Num a => a -> a -> a
+a
1)) (a
0,a
0) [a]
x

-- | Standard deviation of population
stddevp :: (Floating a) => [a] -> a
stddevp :: [a] -> a
stddevp [a]
xs = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. Floating a => [a] -> a
pvar [a]
xs

-- | Population variance
pvar :: (Floating a) => [a] -> a
pvar :: [a] -> a
pvar [a]
xs = [a] -> Int -> a
forall b t. (Floating b, Integral t) => [b] -> t -> b
centralMoment [a]
xs (Int
2::Int)

-- | Central moments
centralMoment :: (Floating b, Integral t) => [b] -> t -> b
centralMoment :: [b] -> t -> b
centralMoment [b]
_  t
1 = b
0
centralMoment [b]
xs t
r = [b] -> b
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((b -> b) -> [b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\b
x -> (b
xb -> b -> b
forall a. Num a => a -> a -> a
-b
m)b -> t -> b
forall a b. (Num a, Integral b) => a -> b -> a
^t
r) [b]
xs) b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
n
    where
      m :: b
m = [b] -> b
forall a. Floating a => [a] -> a
mean [b]
xs
      n :: b
n = Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> b) -> Int -> b
forall a b. (a -> b) -> a -> b
$ [b] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
xs