module Futhark.CLI.Bench (main) where
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class (liftIO)
import Data.Bifunctor (first)
import Data.ByteString.Char8 qualified as SBS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Either
import Data.Function ((&))
import Data.IORef
import Data.List (sortBy)
import Data.Map qualified as M
import Data.Maybe
import Data.Ord
import Data.Text qualified as T
import Data.Text.IO qualified as T
import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
import Data.Vector.Unboxed qualified as U
import Futhark.Bench
import Futhark.Server
import Futhark.Test
import Futhark.Util (atMostChars, fancyTerminal, pmapIO, showText)
import Futhark.Util.Options
import Futhark.Util.Pretty (AnsiStyle, Color (..), annotate, bold, color, line, pretty, prettyText, putDoc)
import Futhark.Util.ProgressBar
import Statistics.Resampling (Estimator (..), resample)
import Statistics.Resampling.Bootstrap (bootstrapBCA)
import Statistics.Types (cl95, confIntLDX, confIntUDX, estError, estPoint)
import System.Console.ANSI (clearLine)
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Random.MWC (create)
import Text.Printf
import Text.Regex.TDFA
putStyleLn :: AnsiStyle -> T.Text -> IO ()
putStyleLn :: AnsiStyle -> Text -> IO ()
putStyleLn AnsiStyle
s Text
t = Doc AnsiStyle -> IO ()
putDoc forall a b. (a -> b) -> a -> b
$ forall ann. ann -> Doc ann -> Doc ann
annotate AnsiStyle
s (forall a ann. Pretty a => a -> Doc ann
pretty Text
t forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
line)
putRedLn, putBoldRedLn, putBoldLn :: T.Text -> IO ()
putRedLn :: Text -> IO ()
putRedLn = AnsiStyle -> Text -> IO ()
putStyleLn (Color -> AnsiStyle
color Color
Red)
putBoldRedLn :: Text -> IO ()
putBoldRedLn = AnsiStyle -> Text -> IO ()
putStyleLn (Color -> AnsiStyle
color Color
Red forall a. Semigroup a => a -> a -> a
<> AnsiStyle
bold)
putBoldLn :: Text -> IO ()
putBoldLn = AnsiStyle -> Text -> IO ()
putStyleLn AnsiStyle
bold
data BenchOptions = BenchOptions
{ BenchOptions -> String
optBackend :: String,
BenchOptions -> Maybe String
optFuthark :: Maybe String,
BenchOptions -> String
optRunner :: String,
BenchOptions -> Int
optMinRuns :: Int,
BenchOptions -> NominalDiffTime
optMinTime :: NominalDiffTime,
:: [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 String
optCacheExt :: Maybe String,
BenchOptions -> Bool
optConvergencePhase :: Bool,
BenchOptions -> NominalDiffTime
optConvergenceMaxTime :: NominalDiffTime,
BenchOptions -> Maybe Int
optConcurrency :: Maybe Int,
BenchOptions -> Bool
optProfile :: Bool,
BenchOptions -> Int
optVerbose :: Int,
BenchOptions -> Maybe String
optTestSpec :: Maybe FilePath
}
initialBenchOptions :: BenchOptions
initialBenchOptions :: BenchOptions
initialBenchOptions =
BenchOptions
{ optBackend :: String
optBackend = String
"c",
optFuthark :: Maybe String
optFuthark = forall a. Maybe a
Nothing,
optRunner :: String
optRunner = String
"",
optMinRuns :: Int
optMinRuns = Int
10,
optMinTime :: NominalDiffTime
optMinTime = NominalDiffTime
0.5,
optExtraOptions :: [String]
optExtraOptions = [],
optCompilerOptions :: [String]
optCompilerOptions = [],
optJSON :: Maybe String
optJSON = forall a. Maybe a
Nothing,
optTimeout :: Int
optTimeout = -Int
1,
optSkipCompilation :: Bool
optSkipCompilation = Bool
False,
optExcludeCase :: [String]
optExcludeCase = [String
"nobench", String
"disable"],
optIgnoreFiles :: [Regex]
optIgnoreFiles = [],
optEntryPoint :: Maybe String
optEntryPoint = forall a. Maybe a
Nothing,
optTuning :: Maybe String
optTuning = forall a. a -> Maybe a
Just String
"tuning",
optCacheExt :: Maybe String
optCacheExt = forall a. Maybe a
Nothing,
optConvergencePhase :: Bool
optConvergencePhase = Bool
True,
optConvergenceMaxTime :: NominalDiffTime
optConvergenceMaxTime = NominalDiffTime
5 forall a. Num a => a -> a -> a
* NominalDiffTime
60,
optConcurrency :: Maybe Int
optConcurrency = forall a. Maybe a
Nothing,
optProfile :: Bool
optProfile = Bool
False,
optVerbose :: Int
optVerbose = Int
0,
optTestSpec :: Maybe String
optTestSpec = forall a. Maybe a
Nothing
}
runBenchmarks :: BenchOptions -> [FilePath] -> IO ()
runBenchmarks :: BenchOptions -> [String] -> IO ()
runBenchmarks BenchOptions
opts [String]
paths = do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
[(String, ProgramTest)]
benchmarks <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {p}. RegexLike Regex p => p -> Bool
ignored forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> IO [(String, ProgramTest)]
testSpecsFromPathsOrDie [String]
paths
let opts' :: BenchOptions
opts' =
if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
paths forall a. Eq a => a -> a -> Bool
/= Int
1
then BenchOptions
opts {optConcurrency :: Maybe Int
optConcurrency = forall a. a -> Maybe a
Just Int
1}
else BenchOptions
opts
([SkipReason]
skipped_benchmarks, [(String, [InputOutputs])]
compiled_benchmarks) <-
forall a b. [Either a b] -> ([a], [b])
partitionEithers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([SkipReason] -> Bool
anyFailedToCompile [SkipReason]
skipped_benchmarks) forall a. IO a
exitFailure
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
String
"Reporting arithmetic mean runtime of at least "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (BenchOptions -> Int
optMinRuns BenchOptions
opts)
forall a. Semigroup a => a -> a -> a
<> String
" runs for each dataset (min "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (BenchOptions -> NominalDiffTime
optMinTime BenchOptions
opts)
forall a. Semigroup a => a -> a -> a
<> String
")."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BenchOptions -> Bool
optConvergencePhase BenchOptions
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$
String
"More runs automatically performed for up to "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (BenchOptions -> NominalDiffTime
optConvergenceMaxTime BenchOptions
opts)
forall a. Semigroup a => a -> a -> a
<> String
" to ensure accurate measurement."
FutharkExe
futhark <- String -> FutharkExe
FutharkExe forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompileOptions -> String
compFuthark forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts
[Maybe [BenchResult]]
maybe_results <-
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM
(BenchOptions
-> FutharkExe
-> (String, [InputOutputs])
-> IO (Maybe [BenchResult])
runBenchmark BenchOptions
opts FutharkExe
futhark)
(forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst) [(String, [InputOutputs])]
compiled_benchmarks)
let results :: [BenchResult]
results = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [Maybe [BenchResult]]
maybe_results
case BenchOptions -> Maybe String
optJSON BenchOptions
opts of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
file -> String -> ByteString -> IO ()
LBS.writeFile String
file forall a b. (a -> b) -> a -> b
$ [BenchResult] -> ByteString
encodeBenchResults [BenchResult]
results
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any forall a. Maybe a -> Bool
isNothing [Maybe [BenchResult]]
maybe_results Bool -> Bool -> Bool
|| [BenchResult] -> Bool
anyFailed [BenchResult]
results) forall a. IO a
exitFailure
where
ignored :: p -> Bool
ignored p
f = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall regex source target.
RegexContext regex source target =>
regex -> source -> target
`match` p
f) forall a b. (a -> b) -> a -> b
$ BenchOptions -> [Regex]
optIgnoreFiles BenchOptions
opts
anyFailed :: [BenchResult] -> Bool
anyFailed :: [BenchResult] -> Bool
anyFailed = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any BenchResult -> Bool
failedBenchResult
where
failedBenchResult :: BenchResult -> Bool
failedBenchResult (BenchResult String
_ [DataResult]
xs) =
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DataResult -> Bool
failedResult [DataResult]
xs
failedResult :: DataResult -> Bool
failedResult (DataResult Text
_ Left {}) = Bool
True
failedResult DataResult
_ = Bool
False
anyFailedToCompile :: [SkipReason] -> Bool
anyFailedToCompile :: [SkipReason] -> Bool
anyFailedToCompile = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== SkipReason
Skipped)
data SkipReason = Skipped | FailedToCompile
deriving (SkipReason -> SkipReason -> Bool
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 <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO String
getExecutablePath forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BenchOptions -> Maybe String
optFuthark BenchOptions
opts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
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
program_spec) = do
ProgramTest
spec <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ProgramTest
program_spec) String -> IO ProgramTest
testSpecFromFileOrDie forall a b. (a -> b) -> a -> b
$ BenchOptions -> Maybe String
optTestSpec BenchOptions
opts
case ProgramTest -> TestAction
testAction ProgramTest
spec of
RunCases [InputOutputs]
cases [StructureTest]
_ [WarningTest]
_
| Text
"nobench" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ProgramTest -> [Text]
testTags ProgramTest
spec,
Text
"disable" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ProgramTest -> [Text]
testTags ProgramTest
spec,
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 forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
program
if Bool
exists
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
program, [InputOutputs]
cases)
else do
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String -> String
binaryName String
program forall a. [a] -> [a] -> [a]
++ String
" does not exist, but --skip-compilation passed."
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SkipReason
FailedToCompile
else do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ String
"Compiling " forall a. [a] -> [a] -> [a]
++ String
program forall a. [a] -> [a] -> [a]
++ String
"...\n"
CompileOptions
compile_opts <- BenchOptions -> IO CompileOptions
compileOptions BenchOptions
opts
Either (String, Maybe ByteString) ()
res <- 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
Text -> IO ()
putRedLn forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
err
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ByteString -> IO ()
SBS.putStrLn Maybe ByteString
errstr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SkipReason
FailedToCompile
Right () ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (String
program, [InputOutputs]
cases)
TestAction
_ ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left SkipReason
Skipped
where
hasRuns :: InputOutputs -> Bool
hasRuns (InputOutputs Text
_ [TestRun]
runs) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestRun]
runs
withProgramServer :: FilePath -> FilePath -> [String] -> (Server -> IO a) -> IO (Maybe a)
withProgramServer :: forall a.
String -> String -> [String] -> (Server -> IO a) -> IO (Maybe a)
withProgramServer String
program String
runner [String]
extra_options Server -> IO a
f = do
let binOutputf :: String
binOutputf = String -> String
dropExtension String
program
binpath :: String
binpath = String
"." String -> String -> String
</> String
binOutputf
(String
to_run, [String]
to_run_args)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
runner = (String
binpath, [String]
extra_options)
| Bool
otherwise = (String
runner, String
binpath forall a. a -> [a] -> [a]
: [String]
extra_options)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ServerCfg -> (Server -> IO a) -> IO a
withServer (String -> [String] -> ServerCfg
futharkServerCfg String
to_run [String]
to_run_args) Server -> IO a
f) forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` forall a. SomeException -> IO (Maybe a)
onError
where
onError :: SomeException -> IO (Maybe a)
onError :: forall a. SomeException -> IO (Maybe a)
onError SomeException
e = do
Text -> IO ()
putBoldRedLn forall a b. (a -> b) -> a -> b
$ Text
"\nFailed to run " forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
program
Text -> IO ()
putRedLn forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> Text
showText SomeException
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
maxDatasetNameLength :: Int
maxDatasetNameLength :: Int
maxDatasetNameLength = Int
40
runBenchmark :: BenchOptions -> FutharkExe -> (FilePath, [InputOutputs]) -> IO (Maybe [BenchResult])
runBenchmark :: BenchOptions
-> FutharkExe
-> (String, [InputOutputs])
-> IO (Maybe [BenchResult])
runBenchmark BenchOptions
opts FutharkExe
futhark (String
program, [InputOutputs]
cases) = do
([String]
tuning_opts, String
tuning_desc) <- forall (m :: * -> *).
MonadIO m =>
Maybe String -> String -> m ([String], String)
determineTuning (BenchOptions -> Maybe String
optTuning BenchOptions
opts) String
program
let runopts :: [String]
runopts =
BenchOptions -> [String]
optExtraOptions BenchOptions
opts
forall a. [a] -> [a] -> [a]
++ [String]
tuning_opts
forall a. [a] -> [a] -> [a]
++ Maybe String -> String -> [String]
determineCache (BenchOptions -> Maybe String
optCacheExt BenchOptions
opts) String
program
forall a. [a] -> [a] -> [a]
++ if BenchOptions -> Bool
optProfile BenchOptions
opts then [String
"--profile", String
"--log"] else []
forall a.
String -> String -> [String] -> (Server -> IO a) -> IO (Maybe a)
withProgramServer String
program (BenchOptions -> String
optRunner BenchOptions
opts) [String]
runopts forall a b. (a -> b) -> a -> b
$ \Server
server ->
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Server -> String -> InputOutputs -> IO BenchResult
forInputOutputs Server
server String
tuning_desc) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter InputOutputs -> Bool
relevant [InputOutputs]
cases
where
forInputOutputs :: Server -> String -> InputOutputs -> IO BenchResult
forInputOutputs Server
server String
tuning_desc (InputOutputs Text
entry_name [TestRun]
runs) = do
Text -> IO ()
putBoldLn forall a b. (a -> b) -> a -> b
$ Text
"\n" forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
program' forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
tuning_desc forall a. Semigroup a => a -> a -> a
<> Text
":"
String -> [DataResult] -> BenchResult
BenchResult String
program' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Server
-> BenchOptions
-> FutharkExe
-> String
-> Text
-> Int
-> TestRun
-> IO (Maybe DataResult)
runBenchmarkCase Server
server BenchOptions
opts FutharkExe
futhark String
program Text
entry_name Int
pad_to) [TestRun]
runs
where
program' :: String
program' =
if Text
entry_name forall a. Eq a => a -> a -> Bool
== Text
"main"
then String
program
else String
program forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
entry_name
relevant :: InputOutputs -> Bool
relevant = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> b -> a
const Bool
True) forall a. Eq a => a -> a -> Bool
(==) (BenchOptions -> Maybe String
optEntryPoint BenchOptions
opts) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> Text
iosEntryPoint
len :: TestRun -> Int
len = Text -> Int
T.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
atMostChars Int
maxDatasetNameLength forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestRun -> Text
runDescription
pad_to :: Int
pad_to = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map TestRun -> Int
len forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOutputs -> [TestRun]
iosTestRuns) [InputOutputs]
cases
runOptions :: ((Int, Maybe Double) -> IO ()) -> BenchOptions -> RunOptions
runOptions :: ((Int, Maybe Double) -> IO ()) -> BenchOptions -> RunOptions
runOptions (Int, Maybe Double) -> IO ()
f BenchOptions
opts =
RunOptions
{ runMinRuns :: Int
runMinRuns = BenchOptions -> Int
optMinRuns BenchOptions
opts,
runMinTime :: NominalDiffTime
runMinTime = BenchOptions -> NominalDiffTime
optMinTime BenchOptions
opts,
runTimeout :: Int
runTimeout = BenchOptions -> Int
optTimeout BenchOptions
opts,
runVerbose :: Int
runVerbose = BenchOptions -> Int
optVerbose BenchOptions
opts,
runConvergencePhase :: Bool
runConvergencePhase = BenchOptions -> Bool
optConvergencePhase BenchOptions
opts,
runConvergenceMaxTime :: NominalDiffTime
runConvergenceMaxTime = BenchOptions -> NominalDiffTime
optConvergenceMaxTime BenchOptions
opts,
runResultAction :: (Int, Maybe Double) -> IO ()
runResultAction = (Int, Maybe Double) -> IO ()
f,
runProfile :: Bool
runProfile = BenchOptions -> Bool
optProfile BenchOptions
opts
}
descText :: T.Text -> Int -> T.Text
descText :: Text -> Int -> Text
descText Text
desc Int
pad_to = Text
desc forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (Int
pad_to forall a. Num a => a -> a -> a
- Text -> Int
T.length Text
desc) Text
" "
progress :: Double -> T.Text
progress :: Double -> Text
progress Double
elapsed =
ProgressBar -> Text
progressBar
( ProgressBar
{ progressBarSteps :: Int
progressBarSteps = Int
10,
progressBarBound :: Double
progressBarBound = Double
1,
progressBarElapsed :: Double
progressBarElapsed = Double
elapsed
}
)
interimResult :: Int -> Int -> Double -> T.Text
interimResult :: Int -> Int -> Double -> Text
interimResult Int
us_sum Int
runs Double
elapsed =
String -> Text
T.pack (forall r. PrintfType r => String -> r
printf String
"%10.0fμs " Double
avg)
forall a. Semigroup a => a -> a -> a
<> Double -> Text
progress Double
elapsed
forall a. Semigroup a => a -> a -> a
<> (Text
" " forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
prettyText Int
runs forall a. Semigroup a => a -> a -> a
<> Text
" runs")
where
avg :: Double
avg :: Double
avg = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
us_sum forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
runs
convergenceBar :: (T.Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar :: (Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us_sum Int
i Double
rse' = do
Int
spin_idx <- forall a. IORef a -> IO a
readIORef IORef Int
spin_count
let spin :: Text
spin = Int -> Text
progressSpinner Int
spin_idx
Text -> IO ()
p forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%10.0fμs %s (RSE of mean: %2.4f; %4d runs)" Double
avg Text
spin Double
rse' Int
i
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
spin_count (Int
spin_idx forall a. Num a => a -> a -> a
+ Int
1)
where
avg :: Double
avg :: Double
avg = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
us_sum forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
data BenchPhase = Initial | Convergence
mkProgressPrompt :: BenchOptions -> Int -> T.Text -> UTCTime -> IO ((Maybe Int, Maybe Double) -> IO ())
mkProgressPrompt :: BenchOptions
-> Int
-> Text
-> UTCTime
-> IO ((Maybe Int, Maybe Double) -> IO ())
mkProgressPrompt BenchOptions
opts Int
pad_to Text
dataset_desc UTCTime
start_time
| Bool
fancyTerminal = do
IORef (Int, Int)
count <- forall a. a -> IO (IORef a)
newIORef (Int
0, Int
0)
IORef BenchPhase
phase_var <- forall a. a -> IO (IORef a)
newIORef BenchPhase
Initial
IORef Int
spin_count <- forall a. a -> IO (IORef a)
newIORef Int
0
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \(Maybe Int
us, Maybe Double
rse) -> do
Text -> IO ()
T.putStr Text
"\r"
let p :: Text -> IO ()
p Text
s =
Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$
Text -> Int -> Text
descText (Int -> Text -> Text
atMostChars Int
maxDatasetNameLength Text
dataset_desc) Int
pad_to forall a. Semigroup a => a -> a -> a
<> Text
s
(Int
us_sum, Int
i) <- forall a. IORef a -> IO a
readIORef IORef (Int, Int)
count
UTCTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
let determineProgress :: p -> Double
determineProgress p
i' =
let time_elapsed :: Double
time_elapsed = NominalDiffTime -> Double
toDouble (forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
now UTCTime
start_time) forall a. Fractional a => a -> a -> a
/ BenchOptions -> NominalDiffTime
optMinTime BenchOptions
opts)
runs_elapsed :: Double
runs_elapsed = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
i' forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (BenchOptions -> Int
optMinRuns BenchOptions
opts)
in
forall a. Ord a => a -> a -> a
min Double
time_elapsed Double
runs_elapsed
BenchPhase
phase <- forall a. IORef a -> IO a
readIORef IORef BenchPhase
phase_var
case (Maybe Int
us, BenchPhase
phase, Maybe Double
rse) of
(Maybe Int
Nothing, BenchPhase
_, Maybe Double
_) ->
let elapsed :: Double
elapsed = forall {p}. Integral p => p -> Double
determineProgress Int
i
in Text -> IO ()
p forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall a. Int -> a -> [a]
replicate Int
13 Char
' ') forall a. Semigroup a => a -> a -> a
<> Double -> Text
progress Double
elapsed
(Just Int
us', BenchPhase
Initial, Maybe Double
Nothing) -> do
let us_sum' :: Int
us_sum' = Int
us_sum forall a. Num a => a -> a -> a
+ Int
us'
i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
1
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us_sum', Int
i')
let elapsed :: Double
elapsed = forall {p}. Integral p => p -> Double
determineProgress Int
i'
Text -> IO ()
p forall a b. (a -> b) -> a -> b
$ Int -> Int -> Double -> Text
interimResult Int
us_sum' Int
i' Double
elapsed
(Just Int
us', BenchPhase
Initial, Just Double
rse') -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us', Int
1)
forall a. IORef a -> a -> IO ()
writeIORef IORef BenchPhase
phase_var BenchPhase
Convergence
(Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us' Int
1 Double
rse'
(Just Int
us', BenchPhase
Convergence, Just Double
rse') -> do
let us_sum' :: Int
us_sum' = Int
us_sum forall a. Num a => a -> a -> a
+ Int
us'
i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
1
forall a. IORef a -> a -> IO ()
writeIORef IORef (Int, Int)
count (Int
us_sum', Int
i')
(Text -> IO ()) -> IORef Int -> Int -> Int -> Double -> IO ()
convergenceBar Text -> IO ()
p IORef Int
spin_count Int
us_sum' Int
i' Double
rse'
(Just Int
_, BenchPhase
Convergence, Maybe Double
Nothing) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
String -> IO ()
putStr String
" "
Handle -> IO ()
hFlush Handle
stdout
| Bool
otherwise = do
Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text
descText Text
dataset_desc Int
pad_to
Handle -> IO ()
hFlush Handle
stdout
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
where
toDouble :: NominalDiffTime -> Double
toDouble = forall a. Fractional a => Rational -> a
fromRational forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Real a => a -> Rational
toRational
reportResult :: [RunResult] -> (Double, Double) -> IO ()
reportResult :: [RunResult] -> (Double, Double) -> IO ()
reportResult [RunResult]
results (Double
ci_lower, Double
ci_upper) = do
let runtimes :: [Double]
runtimes = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds) [RunResult]
results
avg :: Double
avg = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
runtimes forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
runtimes) :: Double
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%10.0fμs (95%% CI: [%10.1f, %10.1f])" Double
avg Double
ci_lower Double
ci_upper
runBenchmarkCase ::
Server ->
BenchOptions ->
FutharkExe ->
FilePath ->
T.Text ->
Int ->
TestRun ->
IO (Maybe DataResult)
runBenchmarkCase :: Server
-> BenchOptions
-> FutharkExe
-> String
-> Text
-> Int
-> TestRun
-> IO (Maybe DataResult)
runBenchmarkCase Server
_ BenchOptions
_ FutharkExe
_ String
_ Text
_ Int
_ (TestRun [String]
_ Values
_ RunTimeFailure {} Int
_ Text
_) =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
runBenchmarkCase Server
_ BenchOptions
opts FutharkExe
_ String
_ Text
_ Int
_ (TestRun [String]
tags Values
_ ExpectedResult Success
_ Int
_ Text
_)
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
tags) forall a b. (a -> b) -> a -> b
$ BenchOptions -> [String]
optExcludeCase BenchOptions
opts =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
runBenchmarkCase Server
server BenchOptions
opts FutharkExe
futhark String
program Text
entry Int
pad_to TestRun
tr = do
let (TestRun [String]
_ Values
input_spec (Succeeds Maybe Success
expected_spec) Int
_ Text
dataset_desc) = TestRun
tr
UTCTime
start_time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
(Maybe Int, Maybe Double) -> IO ()
prompt <- BenchOptions
-> Int
-> Text
-> UTCTime
-> IO ((Maybe Int, Maybe Double) -> IO ())
mkProgressPrompt BenchOptions
opts Int
pad_to Text
dataset_desc UTCTime
start_time
(Maybe Int, Maybe Double) -> IO ()
prompt (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
Either Text ([RunResult], Text, ProfilingReport)
res <-
Server
-> RunOptions
-> FutharkExe
-> String
-> Text
-> Values
-> Maybe Success
-> String
-> IO (Either Text ([RunResult], Text, ProfilingReport))
benchmarkDataset
Server
server
(((Int, Maybe Double) -> IO ()) -> BenchOptions -> RunOptions
runOptions ((Maybe Int, Maybe Double) -> IO ()
prompt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. a -> Maybe a
Just) BenchOptions
opts)
FutharkExe
futhark
String
program
Text
entry
Values
input_spec
Maybe Success
expected_spec
(String -> Text -> TestRun -> String
testRunReferenceOutput String
program Text
entry TestRun
tr)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fancyTerminal forall a b. (a -> b) -> a -> b
$ do
IO ()
clearLine
Text -> IO ()
T.putStr Text
"\r"
Text -> IO ()
T.putStr forall a b. (a -> b) -> a -> b
$ Text -> Int -> Text
descText (Int -> Text -> Text
atMostChars Int
maxDatasetNameLength Text
dataset_desc) Int
pad_to
case Either Text ([RunResult], Text, ProfilingReport)
res of
Left Text
err -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
""
Text -> IO ()
putRedLn Text
err
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Either Text Result -> DataResult
DataResult Text
dataset_desc forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Text
err
Right ([RunResult]
runtimes, Text
errout, ProfilingReport
report) -> do
let vec_runtimes :: Vector Double
vec_runtimes = forall a. Unbox a => [a] -> Vector a
U.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunResult -> Int
runMicroseconds) [RunResult]
runtimes
Gen RealWorld
g <- forall (m :: * -> *). PrimMonad m => m (Gen (PrimState m))
create
[(Estimator, Bootstrap Vector Double)]
resampled <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ GenIO
-> [Estimator]
-> Int
-> Vector Double
-> IO [(Estimator, Bootstrap Vector Double)]
resample Gen RealWorld
g [Estimator
Mean] Int
70000 Vector Double
vec_runtimes
let bootstrapCI :: (Double, Double)
bootstrapCI =
case CL Double
-> Vector Double
-> [(Estimator, Bootstrap Vector Double)]
-> [Estimate ConfInt Double]
bootstrapBCA forall a. Fractional a => CL a
cl95 Vector Double
vec_runtimes [(Estimator, Bootstrap Vector Double)]
resampled of
Estimate ConfInt Double
boot : [Estimate ConfInt Double]
_ ->
( forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
boot forall a. Num a => a -> a -> a
- forall a. ConfInt a -> a
confIntLDX (forall (e :: * -> *) a. Estimate e a -> e a
estError Estimate ConfInt Double
boot),
forall (e :: * -> *) a. Estimate e a -> a
estPoint Estimate ConfInt Double
boot forall a. Num a => a -> a -> a
+ forall a. ConfInt a -> a
confIntUDX (forall (e :: * -> *) a. Estimate e a -> e a
estError Estimate ConfInt Double
boot)
)
[Estimate ConfInt Double]
_ -> (Double
0, Double
0)
[RunResult] -> (Double, Double) -> IO ()
reportResult [RunResult]
runtimes (Double, Double)
bootstrapCI
let errout' :: Maybe Text
errout' = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BenchOptions -> Bool
optProfile BenchOptions
opts) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just Text
errout
report' :: Maybe ProfilingReport
report' = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (BenchOptions -> Bool
optProfile BenchOptions
opts) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just ProfilingReport
report
[RunResult]
-> Map Text Int -> Maybe Text -> Maybe ProfilingReport -> Result
Result [RunResult]
runtimes (ProfilingReport -> Map Text Int
getMemoryUsage ProfilingReport
report) Maybe Text
errout' Maybe ProfilingReport
report'
forall a b. a -> (a -> b) -> b
& forall a b. b -> Either a b
Right
forall a b. a -> (a -> b) -> b
& Text -> Either Text Result -> DataResult
DataResult Text
dataset_desc
forall a b. a -> (a -> b) -> b
& forall a. a -> Maybe a
Just
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a. Applicative f => a -> f a
pure
getMemoryUsage :: ProfilingReport -> M.Map T.Text Int
getMemoryUsage :: ProfilingReport -> Map Text Int
getMemoryUsage = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProfilingReport -> Map Text Integer
profilingMemory
commandLineOptions :: [FunOptDescr BenchOptions]
commandLineOptions :: [FunOptDescr BenchOptions]
commandLineOptions =
[ forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"r"
[String
"runs"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")] | Int
n' forall a. Ord a => a -> a -> Bool
> Int
0 ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config
{ optMinRuns :: Int
optMinRuns = Int
n'
}
[(Int, String)]
_ ->
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
)
String
"RUNS"
)
String
"Run each test case this many times.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"backend"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
backend -> forall a b. b -> Either a b
Right 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').",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"futhark"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
prog -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optFuthark :: Maybe String
optFuthark = forall a. a -> Maybe a
Just String
prog})
String
"PROGRAM"
)
String
"The binary used for operations (defaults to same binary as 'futhark bench').",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"runner"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
prog -> forall a b. b -> Either a b
Right 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).",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"p"
[String
"pass-option"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
opt ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config {optExtraOptions :: [String]
optExtraOptions = String
opt forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optExtraOptions BenchOptions
config}
)
String
"OPT"
)
String
"Pass this option to programs being run.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"pass-compiler-option"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
opt ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config {optCompilerOptions :: [String]
optCompilerOptions = String
opt 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).",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"json"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
file ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optJSON :: Maybe String
optJSON = forall a. a -> Maybe a
Just String
file}
)
String
"FILE"
)
String
"Scatter results in JSON format here.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"timeout"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")]
| Int
n' forall a. Ord a => a -> a -> Bool
< Int
max_timeout ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTimeout :: Int
optTimeout = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n'}
[(Int, String)]
_ ->
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$
String
"'" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' is not an integer smaller than" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
max_timeout forall a. [a] -> [a] -> [a]
++ String
"."
)
String
"SECONDS"
)
String
"Number of seconds before a dataset is aborted.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"skip-compilation"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optSkipCompilation :: Bool
optSkipCompilation = Bool
True})
String
"Use already compiled program.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"exclude-case"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config {optExcludeCase :: [String]
optExcludeCase = String
s forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optExcludeCase BenchOptions
config}
)
String
"TAG"
)
String
"Do not run test cases with this tag.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"ignore-files"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config {optIgnoreFiles :: [Regex]
optIgnoreFiles = forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
source -> regex
makeRegex String
s forall a. a -> [a] -> [a]
: BenchOptions -> [Regex]
optIgnoreFiles BenchOptions
config}
)
String
"REGEX"
)
String
"Ignore files matching this regular expression.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"e"
[String
"entry-point"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config ->
BenchOptions
config {optEntryPoint :: Maybe String
optEntryPoint = forall a. a -> Maybe a
Just String
s}
)
String
"NAME"
)
String
"Only run this entry point.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"tuning"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTuning :: Maybe String
optTuning = forall a. a -> Maybe a
Just String
s})
String
"EXTENSION"
)
String
"Look for tuning files with this extension (defaults to .tuning).",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"cache-extension"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
(\String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optCacheExt :: Maybe String
optCacheExt = forall a. a -> Maybe a
Just String
s})
String
"EXTENSION"
)
String
"Use cache files with this extension (none by default).",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"no-tuning"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTuning :: Maybe String
optTuning = forall a. Maybe a
Nothing})
String
"Do not load tuning files.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"no-convergence-phase"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConvergencePhase :: Bool
optConvergencePhase = Bool
False})
String
"Do not run convergence phase.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"convergence-max-seconds"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Integer
n', String
"")]
| Integer
n' forall a. Ord a => a -> a -> Bool
> Integer
0 ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConvergenceMaxTime :: NominalDiffTime
optConvergenceMaxTime = forall a. Num a => Integer -> a
fromInteger Integer
n'}
[(Integer, String)]
_ ->
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
)
String
"NUM"
)
String
"Limit convergence phase to this number of seconds.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"concurrency"]
( forall a. (String -> a) -> String -> ArgDescr a
ReqArg
( \String
n ->
case forall a. Read a => ReadS a
reads String
n of
[(Int
n', String
"")]
| Int
n' forall a. Ord a => a -> a -> Bool
> Int
0 ->
forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optConcurrency :: Maybe Int
optConcurrency = forall a. a -> Maybe a
Just Int
n'}
[(Int, String)]
_ ->
forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
optionsError forall a b. (a -> b) -> a -> b
$ String
"'" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' is not a positive integer."
)
String
"NUM"
)
String
"Number of benchmarks to prepare (not run) concurrently.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
[]
[String
"spec-file"]
(forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optTestSpec :: Maybe String
optTestSpec = forall a. a -> Maybe a
Just String
s}) String
"FILE")
String
"Use test specification from this file.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"v"
[String
"verbose"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optVerbose :: Int
optVerbose = BenchOptions -> Int
optVerbose BenchOptions
config forall a. Num a => a -> a -> a
+ Int
1})
String
"Enable logging. Pass multiple times for more.",
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option
String
"P"
[String
"profile"]
(forall a. a -> ArgDescr a
NoArg forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \BenchOptions
config -> BenchOptions
config {optProfile :: Bool
optProfile = Bool
True})
String
"Collect profiling information."
]
where
max_timeout :: Int
max_timeout :: Int
max_timeout = forall a. Bounded a => a
maxBound forall a. Integral a => a -> a -> a
`div` Int
1000000
excludeBackend :: BenchOptions -> BenchOptions
excludeBackend :: BenchOptions -> BenchOptions
excludeBackend BenchOptions
config =
BenchOptions
config {optExcludeCase :: [String]
optExcludeCase = String
"no_" forall a. Semigroup a => a -> a -> a
<> BenchOptions -> String
optBackend BenchOptions
config forall a. a -> [a] -> [a]
: BenchOptions -> [String]
optExcludeCase BenchOptions
config}
main :: String -> [String] -> IO ()
main :: String -> [String] -> IO ()
main = forall cfg.
cfg
-> [FunOptDescr cfg]
-> String
-> ([String] -> cfg -> Maybe (IO ()))
-> String
-> [String]
-> IO ()
mainWithOptions BenchOptions
initialBenchOptions [FunOptDescr BenchOptions]
commandLineOptions String
"options... programs..." forall a b. (a -> b) -> a -> b
$ \[String]
progs BenchOptions
config ->
case [String]
progs of
[] -> forall a. Maybe a
Nothing
[String]
_
| BenchOptions -> Bool
optProfile BenchOptions
config Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing (BenchOptions -> Maybe String
optJSON BenchOptions
config) ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> IO ()
optionsError String
"--profile cannot be used without --json."
| Bool
otherwise ->
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ BenchOptions -> [String] -> IO ()
runBenchmarks (BenchOptions -> BenchOptions
excludeBackend BenchOptions
config) [String]
progs