{-# 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.IORef
import Data.Maybe
import Data.List (foldl', sortBy)
import Data.Ord
import qualified Data.Text as T
import System.Console.ANSI (clearLine)
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 (fancyTerminal, maybeNth, maxinum, 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

runOptions :: (Int -> IO ()) -> BenchOptions -> RunOptions
runOptions :: (Int -> IO ()) -> BenchOptions -> RunOptions
runOptions Int -> IO ()
f BenchOptions
opts =
  RunOptions :: String
-> Int
-> [String]
-> Int
-> Int
-> Maybe (Int -> IO ())
-> 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
             , runResultAction :: Maybe (Int -> IO ())
runResultAction = (Int -> IO ()) -> Maybe (Int -> IO ())
forall a. a -> Maybe a
Just Int -> IO ()
f
             }

progressBar :: Int -> Int -> Int -> String
progressBar :: Int -> Int -> Int -> String
progressBar Int
cur Int
bound Int
steps =
  String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map Int -> Char
cell [Int
1..Int
steps] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
cur String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
bound
  where step_size :: Double
        step_size :: Double
step_size = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bound Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
steps
        cur' :: Double
cur' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cur
        chars :: String
chars = String
" ▏▎▍▍▌▋▊▉█"
        char :: Int -> Char
char Int
i = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe Char
' ' (Maybe Char -> Char) -> Maybe Char -> Char
forall a b. (a -> b) -> a -> b
$ Int -> String -> Maybe Char
forall int a. Integral int => int -> [a] -> Maybe a
maybeNth (Int
i::Int) String
chars
        num_chars :: Double
num_chars = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
chars

        cell :: Int -> Char
        cell :: Int -> Char
cell Int
i
          | Double
i' Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step_size Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
cur' = Int -> Char
char Int
9
          | Bool
otherwise = Int -> Char
char (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (((Double
cur' Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
i'Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
step_size) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
num_chars)
                                     Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
step_size))
          where i' :: Double
i' = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i

descString :: String -> Int -> String
descString :: String -> Int -> String
descString String
desc Int
pad_to = String
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
desc) Char
' '

mkProgressPrompt :: Int -> Int -> String -> IO (Maybe Int -> IO ())
mkProgressPrompt :: Int -> Int -> String -> IO (Maybe Int -> IO ())
mkProgressPrompt Int
runs Int
pad_to String
dataset_desc
  | Bool
fancyTerminal = do
      IORef Int
count <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0::Int)
      (Maybe Int -> IO ()) -> IO (Maybe Int -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Int -> IO ()) -> IO (Maybe Int -> IO ()))
-> (Maybe Int -> IO ()) -> IO (Maybe Int -> IO ())
forall a b. (a -> b) -> a -> b
$ \Maybe Int
us -> do
        String -> IO ()
putStr String
"\r" -- Go to start of line.
        Int
i <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
count
        let i' :: Int
i' = if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
us then Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1 else Int
i
        IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
count Int
i'
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
descString String
dataset_desc Int
pad_to String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> Int -> String
progressBar Int
i' Int
runs Int
10
        String -> IO ()
putStr String
" " -- Just to move the cursor away from the progress bar.
        Handle -> IO ()
hFlush Handle
stdout

  | Bool
otherwise = do
      String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
descString String
dataset_desc Int
pad_to
      Handle -> IO ()
hFlush Handle
stdout
      (Maybe Int -> IO ()) -> IO (Maybe Int -> IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe Int -> IO ()) -> IO (Maybe Int -> IO ()))
-> (Maybe Int -> IO ()) -> IO (Maybe Int -> IO ())
forall a b. (a -> b) -> a -> b
$ IO () -> Maybe Int -> IO ()
forall a b. a -> b -> a
const (IO () -> Maybe Int -> IO ()) -> IO () -> Maybe Int -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

reportResult :: [RunResult] -> IO ()
reportResult :: [RunResult] -> IO ()
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 a (f :: * -> *). (Num a, Ord a, Foldable f) => f a -> a
maxinum [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)

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
  Maybe Int -> IO ()
prompt <- Int -> Int -> String -> IO (Maybe Int -> IO ())
mkProgressPrompt (BenchOptions -> Int
optRuns BenchOptions
opts) Int
pad_to String
dataset_desc

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

  Either Text ([RunResult], Text)
res <- RunOptions
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text))
benchmarkDataset ((Int -> IO ()) -> BenchOptions -> RunOptions
runOptions (Maybe Int -> IO ()
prompt (Maybe Int -> IO ()) -> (Int -> Maybe Int) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just) BenchOptions
opts)
         String
program Text
entry Values
input_spec Maybe Success
expected_spec
         (String -> Text -> TestRun -> String
testRunReferenceOutput String
program Text
entry TestRun
tr)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fancyTerminal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IO ()
clearLine
    String -> IO ()
putStr String
"\r"

  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 -> Int -> String
descString String
dataset_desc Int
pad_to
      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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fancyTerminal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Int -> String
descString String
dataset_desc Int
pad_to

      [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