{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Miniterion
(
Benchmark
, Benchmarkable
, env
, envWithCleanup
, perBatchEnv
, perBatchEnvWithCleanup
, perRunEnv
, perRunEnvWithCleanup
, toBenchmarkable
, bench
, bgroup
, nf
, whnf
, nfIO
, whnfIO
, nfAppIO
, whnfAppIO
, defaultMain
, benchmark
#ifdef DEV
, showPicos5
, showBytes
, mu
#endif
) where
import Control.Exception (Exception (..), SomeException (..),
bracket, evaluate, handle, throw,
throwIO)
import Control.Monad (guard, replicateM, void, when)
import Data.Char (toLower)
import Data.Foldable (find, foldl')
import Data.Int (Int64)
import Data.List (intercalate, isPrefixOf, nub,
stripPrefix, tails)
import Data.Word (Word64)
import GHC.Clock (getMonotonicTime)
import GHC.Stats (RTSStats (..), getRTSStats,
getRTSStatsEnabled)
import System.CPUTime (cpuTimePrecision, getCPUTime)
import System.Console.GetOpt (ArgDescr (..), ArgOrder (..),
OptDescr (..), getOpt', usageInfo)
import System.Environment (getArgs, getProgName)
import System.Exit (die, exitFailure)
import System.IO (BufferMode (..), Handle, IOMode (..),
hFlush, hIsTerminalDevice, hPutStrLn,
hSetBuffering, stderr, stdout, withFile)
import System.IO.Unsafe (unsafePerformIO)
import System.Mem (performGC)
import System.Timeout (timeout)
import Text.Printf (printf)
import Text.Read (readMaybe)
#if MIN_VERSION_base(4,15,0)
import GHC.Exts (SPEC (..))
#else
import GHC.Exts (SpecConstrAnnotation (..))
#endif
#if MIN_VERSION_base(4,5,0)
import GHC.IO.Encoding (getLocaleEncoding, setLocaleEncoding,
textEncodingName, utf8)
#endif
#if defined(mingw32_HOST_OS)
import Data.Word (Word32)
#endif
import Control.DeepSeq (NFData, force, rnf)
data Benchmark
= Bench String Benchmarkable
| Bgroup String [Benchmark]
| forall e. NFData e => Environment (IO e) (e -> IO ()) (e -> Benchmark)
data Benchmarkable = forall a. NFData a =>
Benchmarkable { ()
allocEnv :: Word64 -> IO a
, ()
cleanEnv :: Word64 -> a -> IO ()
, ()
runRepeatedly :: a -> Word64 -> IO ()
, Benchmarkable -> Bool
perRun :: Bool }
toBenchmarkable :: (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable :: (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable Word64 -> IO ()
f = forall a.
NFData a =>
(Word64 -> IO a)
-> (Word64 -> a -> IO ())
-> (a -> Word64 -> IO ())
-> Bool
-> Benchmarkable
Benchmarkable forall (m :: * -> *) a. Applicative m => a -> m ()
noop (forall a b. a -> b -> a
const forall (m :: * -> *) a. Applicative m => a -> m ()
noop) (forall a b. a -> b -> a
const Word64 -> IO ()
f) Bool
False
{-# INLINE toBenchmarkable #-}
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain [Benchmark]
bs = do
let act :: IO ()
act = Config -> [Benchmark] -> IO ()
defaultMainWith Config
defaultConfig [Benchmark]
bs
#if MIN_VERSION_base(4,5,0)
TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
#endif
#if defined(mingw32_HOST_OS)
codePage <- getConsoleOutputCP
bracket (setConsoleOutputCP 65001) (\_ -> setConsoleOutputCP codePage)
(const act)
#else
IO ()
act
#endif
bench
:: String
-> Benchmarkable
-> Benchmark
bench :: [Char] -> Benchmarkable -> Benchmark
bench = [Char] -> Benchmarkable -> Benchmark
Bench
bgroup
:: String
-> [Benchmark]
-> Benchmark
bgroup :: [Char] -> [Benchmark] -> Benchmark
bgroup = [Char] -> [Benchmark] -> Benchmark
Bgroup
env
:: NFData env
=> IO env
-> (env -> Benchmark)
-> Benchmark
env :: forall env. NFData env => IO env -> (env -> Benchmark) -> Benchmark
env IO env
alloc = forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
alloc forall (m :: * -> *) a. Applicative m => a -> m ()
noop
envWithCleanup
:: NFData env
=> IO env
-> (env -> IO a)
-> (env -> Benchmark)
-> Benchmark
envWithCleanup :: forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
alloc env -> IO a
clean = forall e.
NFData e =>
IO e -> (e -> IO ()) -> (e -> Benchmark) -> Benchmark
Environment IO env
alloc (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> IO a
clean)
perBatchEnv
:: (NFData env, NFData b)
=> (Word64 -> IO env)
-> (env -> IO b)
-> Benchmarkable
perBatchEnv :: forall env b.
(NFData env, NFData b) =>
(Word64 -> IO env) -> (env -> IO b) -> Benchmarkable
perBatchEnv Word64 -> IO env
alloc = forall env b.
(NFData env, NFData b) =>
(Word64 -> IO env)
-> (Word64 -> env -> IO ()) -> (env -> IO b) -> Benchmarkable
perBatchEnvWithCleanup Word64 -> IO env
alloc (forall a b. a -> b -> a
const forall (m :: * -> *) a. Applicative m => a -> m ()
noop)
perBatchEnvWithCleanup
:: (NFData env, NFData b)
=> (Word64 -> IO env)
-> (Word64 -> env -> IO ())
-> (env -> IO b)
-> Benchmarkable
perBatchEnvWithCleanup :: forall env b.
(NFData env, NFData b) =>
(Word64 -> IO env)
-> (Word64 -> env -> IO ()) -> (env -> IO b) -> Benchmarkable
perBatchEnvWithCleanup Word64 -> IO env
alloc Word64 -> env -> IO ()
clean env -> IO b
run = forall a.
NFData a =>
(Word64 -> IO a)
-> (Word64 -> a -> IO ())
-> (a -> Word64 -> IO ())
-> Bool
-> Benchmarkable
Benchmarkable Word64 -> IO env
alloc Word64 -> env -> IO ()
clean env -> Word64 -> IO ()
run' Bool
False
where
run' :: env -> Word64 -> IO ()
run' = forall a b. (a -> b) -> IO a -> Word64 -> IO ()
ioToBench forall a. NFData a => a -> ()
rnf forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> IO b
run
perRunEnv
:: (NFData env, NFData b)
=> IO env
-> (env -> IO b)
-> Benchmarkable
perRunEnv :: forall env b.
(NFData env, NFData b) =>
IO env -> (env -> IO b) -> Benchmarkable
perRunEnv IO env
alloc = forall env b.
(NFData env, NFData b) =>
IO env -> (env -> IO ()) -> (env -> IO b) -> Benchmarkable
perRunEnvWithCleanup IO env
alloc forall (m :: * -> *) a. Applicative m => a -> m ()
noop
perRunEnvWithCleanup
:: (NFData env, NFData b)
=> IO env
-> (env -> IO ())
-> (env -> IO b)
-> Benchmarkable
perRunEnvWithCleanup :: forall env b.
(NFData env, NFData b) =>
IO env -> (env -> IO ()) -> (env -> IO b) -> Benchmarkable
perRunEnvWithCleanup IO env
alloc env -> IO ()
clean env -> IO b
run = Benchmarkable
bm {perRun :: Bool
perRun = Bool
True}
where
bm :: Benchmarkable
bm = forall env b.
(NFData env, NFData b) =>
(Word64 -> IO env)
-> (Word64 -> env -> IO ()) -> (env -> IO b) -> Benchmarkable
perBatchEnvWithCleanup (forall a b. a -> b -> a
const IO env
alloc) (forall a b. a -> b -> a
const env -> IO ()
clean) env -> IO b
run
nf :: NFData b => (a -> b) -> a -> Benchmarkable
nf :: forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> Word64 -> IO ()
funcToBench forall a. NFData a => a -> ()
rnf
{-# INLINE nf #-}
whnf :: (a -> b) -> a -> Benchmarkable
whnf :: forall a b. (a -> b) -> a -> Benchmarkable
whnf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> b) -> a -> Word64 -> IO ()
funcToBench forall a. a -> a
id
{-# INLINE whnf #-}
nfIO :: NFData a => IO a -> Benchmarkable
nfIO :: forall a. NFData a => IO a -> Benchmarkable
nfIO = (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> IO a -> Word64 -> IO ()
ioToBench forall a. NFData a => a -> ()
rnf
{-# INLINE nfIO #-}
whnfIO :: IO a -> Benchmarkable
whnfIO :: forall a. IO a -> Benchmarkable
whnfIO = (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> IO a -> Word64 -> IO ()
ioToBench forall a. a -> a
id
{-# INLINE whnfIO #-}
nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO :: forall b a. NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBench forall a. NFData a => a -> ()
rnf
{-# INLINE nfAppIO #-}
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO :: forall a b. (a -> IO b) -> a -> Benchmarkable
whnfAppIO = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word64 -> IO ()) -> Benchmarkable
toBenchmarkable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b c a. (b -> c) -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBench forall a. a -> a
id
{-# INLINE whnfAppIO #-}
benchmark :: Benchmarkable -> IO ()
benchmark :: Benchmarkable -> IO ()
benchmark = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Benchmark -> IO [Result]
runBenchmark Config
defaultConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Benchmarkable -> Benchmark
bench [Char]
"..."
defaultMainWith :: Config -> [Benchmark] -> IO ()
defaultMainWith :: Config -> [Benchmark] -> IO ()
defaultMainWith Config
cfg0 [Benchmark]
bs = forall a. IO a -> IO a
handleMiniterionException forall a b. (a -> b) -> a -> b
$ do
Baseline
args <- IO Baseline
getArgs
let ([Config -> Config]
opts, Baseline
_pats, Baseline
invalids, Baseline
errs) = forall a.
ArgOrder a
-> [OptDescr a] -> Baseline -> ([a], Baseline, Baseline, Baseline)
getOpt' ArgOrder (Config -> Config)
order [OptDescr (Config -> Config)]
options Baseline
args
order :: ArgOrder (Config -> Config)
order = forall a. ([Char] -> a) -> ArgOrder a
ReturnInOrder forall a b. (a -> b) -> a -> b
$ \[Char]
str Config
o ->
Config
o {cfgPatterns :: [(MatchMode, [Char])]
cfgPatterns = (Config -> MatchMode
cfgMatch Config
o, [Char]
str) forall a. a -> [a] -> [a]
: Config -> [(MatchMode, [Char])]
cfgPatterns Config
o}
cfg1 :: Config
cfg1 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a
id) Config
cfg0 [Config -> Config]
opts
cfg2 :: Config
cfg2 = Config
cfg1 {cfgPatterns :: [(MatchMode, [Char])]
cfgPatterns = forall a. [a] -> [a]
reverse (Config -> [(MatchMode, [Char])]
cfgPatterns Config
cfg1)}
with_csv_cfg :: (Config -> IO r) -> IO r
with_csv_cfg Config -> IO r
act =
case Config -> Maybe [Char]
cfgCsvPath Config
cfg2 of
Maybe [Char]
Nothing -> Config -> IO r
act Config
cfg2
Just [Char]
path -> forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
path IOMode
WriteMode forall a b. (a -> b) -> a -> b
$ \Handle
hdl -> do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
hdl BufferMode
LineBuffering
let extras :: [Char]
extras | Bool
hasGCStats = [Char]
",Allocated,Copied,Peak Memory"
| Bool
otherwise = [Char]
""
Handle -> [Char] -> IO ()
hPutStrLn Handle
hdl ([Char]
"Name,Mean (ps),2*Stdev (ps)" forall a. [a] -> [a] -> [a]
++ [Char]
extras)
Config -> IO r
act Config
cfg2 {cfgCsvHandle :: Maybe Handle
cfgCsvHandle = forall a. a -> Maybe a
Just Handle
hdl}
root_bs :: Benchmark
root_bs = [Char] -> [Benchmark] -> Benchmark
bgroup [Char]
"" [Benchmark]
bs
do_bench :: IO ()
do_bench = forall {r}. (Config -> IO r) -> IO r
with_csv_cfg forall a b. (a -> b) -> a -> b
$ \Config
cfg -> do
Baseline
baseline <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty [Char] -> IO Baseline
readBaseline (Config -> Maybe [Char]
cfgBaselinePath Config
cfg)
[Result]
rs <- Config -> Benchmark -> IO [Result]
runBenchmark (Config
cfg {cfgBaselineSet :: Baseline
cfgBaselineSet = Baseline
baseline}) Benchmark
root_bs
[Result] -> IO ()
summariseResults [Result]
rs
case () of
()
_ | Config -> Bool
cfgHelp Config
cfg2 -> IO ()
showHelp
| Config -> Bool
cfgVersion Config
cfg2 -> [Char] -> IO ()
putStrLn [Char]
builtWithMiniterion
| Config -> Bool
cfgList Config
cfg2 -> Config -> Benchmark -> IO ()
showNames Config
cfg2 Benchmark
root_bs
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Baseline
errs) -> Baseline -> IO ()
errorOptions Baseline
errs
| Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Baseline
invalids) -> Baseline -> IO ()
invalidOptions Baseline
invalids
| Bool
otherwise -> IO ()
do_bench
showHelp :: IO ()
showHelp :: IO ()
showHelp = do
[Char]
me <- IO [Char]
getProgName
[Char] -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [Char] -> [OptDescr a] -> [Char]
`usageInfo` [OptDescr (Config -> Config)]
options) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"\n"
[ [Char]
"Microbenchmark suite - " forall a. [a] -> [a] -> [a]
++ [Char]
builtWithMiniterion forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
, [Char] -> [Char]
yellow [Char]
"USAGE:"
, [Char]
" " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
green [Char]
me forall a. [a] -> [a] -> [a]
++ [Char]
" [OPTIONS] [PATTERN]...\n"
, [Char] -> [Char]
yellow [Char]
"ARGS:"
, [Char]
" <PATTERN>... Pattern(s) to select running benchmarks. If no pattern was"
, [Char]
" given, run all benchmarks. Multiple patterns are combined"
, [Char]
" with 'OR'. Selections are done by prefix match by default."
, [Char]
" See also \"--match\" option below.\n"
, [Char] -> [Char]
yellow [Char]
"OPTIONS:"
]
#ifndef VERSION_miniterion
#define VERSION_miniterion "development version"
#endif
builtWithMiniterion :: String
builtWithMiniterion :: [Char]
builtWithMiniterion = [Char]
"built with miniterion " forall a. [a] -> [a] -> [a]
++ VERSION_miniterion
errorOptions :: [String] -> IO ()
errorOptions :: Baseline -> IO ()
errorOptions = ([Char] -> [Char]) -> Baseline -> IO ()
exitWithOptions forall a. a -> a
id
invalidOptions :: [String] -> IO ()
invalidOptions :: Baseline -> IO ()
invalidOptions = ([Char] -> [Char]) -> Baseline -> IO ()
exitWithOptions (\[Char]
o -> [Char]
"invalid option `" forall a. [a] -> [a] -> [a]
++ [Char]
o forall a. [a] -> [a] -> [a]
++ [Char]
"'\n")
exitWithOptions :: (String -> String) -> [String] -> IO ()
exitWithOptions :: ([Char] -> [Char]) -> Baseline -> IO ()
exitWithOptions [Char] -> [Char]
f Baseline
opts = do
[Char]
me <- IO [Char]
getProgName
let f' :: [Char] -> [Char]
f' [Char]
opt = [Char]
me forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
f [Char]
opt
forall a. [Char] -> IO a
die (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Char] -> [Char]
f' Baseline
opts forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
briefUsageOf [Char]
me)
briefUsageOf :: String -> String
briefUsageOf :: [Char] -> [Char]
briefUsageOf [Char]
me = [Char]
"Try `" forall a. [a] -> [a] -> [a]
++ [Char]
me forall a. [a] -> [a] -> [a]
++ [Char]
" --help' for more information."
showNames :: Config -> Benchmark -> IO ()
showNames :: Config -> Benchmark -> IO ()
showNames Config
cfg = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[Char]
n -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> [Char] -> Bool
isMatched Config
cfg [Char]
n) ([Char] -> IO ()
putStrLn [Char]
n)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baseline -> Benchmark -> Baseline
benchNames []
data Result
= Done
| TooSlow String
| TooFast String
| TimedOut String
summariseResults :: [Result] -> IO ()
summariseResults :: [Result] -> IO ()
summariseResults [Result]
rs = do
let (Int
num_result, Int
num_failed) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall {a} {b}. (Num a, Num b) => (a, b) -> Result -> (a, b)
f (Int, Int)
z [Result]
rs
z :: (Int, Int)
z :: (Int, Int)
z = (Int
0, Int
0)
f :: (a, b) -> Result -> (a, b)
f (!a
done, !b
fl) Result
r = case Result
r of
Result
Done -> (a
done forall a. Num a => a -> a -> a
+ a
1, b
fl)
Result
_ -> (a
done forall a. Num a => a -> a -> a
+ a
1, b
fl forall a. Num a => a -> a -> a
+ b
1)
bs :: [Char]
bs = if Int
1 forall a. Ord a => a -> a -> Bool
< Int
num_result then [Char]
"benchmarks" else [Char]
"benchmark"
pr :: ([Char], [Char]) -> IO ()
pr ([Char]
name, [Char]
why) = [Char] -> IO ()
putStrLn ([Char]
" - " forall a. [a] -> [a] -> [a]
++ [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
" (" forall a. [a] -> [a] -> [a]
++ [Char]
why forall a. [a] -> [a] -> [a]
++ [Char]
")")
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
0 forall a. Ord a => a -> a -> Bool
< Int
num_failed) forall a b. (a -> b) -> a -> b
$ do
forall r. PrintfType r => [Char] -> r
printf [Char]
"\n%d out of %d %s failed:\n" Int
num_failed Int
num_result [Char]
bs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Char], [Char]) -> IO ()
pr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Maybe ([Char], [Char])
failedNameAndReason) [Result]
rs
forall a. IO a
exitFailure
isTooFast, isTooSlow :: Result -> Bool
isTooFast :: Result -> Bool
isTooFast TooFast {} = Bool
True
isTooFast Result
_ = Bool
False
isTooSlow :: Result -> Bool
isTooSlow TooSlow {} = Bool
True
isTooSlow Result
_ = Bool
False
failedNameAndReason :: Result -> Maybe (String, String)
failedNameAndReason :: Result -> Maybe ([Char], [Char])
failedNameAndReason = \case
Result
Done -> forall a. Maybe a
Nothing
TooSlow [Char]
name -> forall a. a -> Maybe a
Just ([Char]
name, [Char]
"too slow")
TooFast [Char]
name -> forall a. a -> Maybe a
Just ([Char]
name, [Char]
"too fast")
TimedOut [Char]
name -> forall a. a -> Maybe a
Just ([Char]
name, [Char]
"timed out")
runBenchmark :: Config -> Benchmark -> IO [Result]
runBenchmark :: Config -> Benchmark -> IO [Result]
runBenchmark Config
cfg = Baseline -> Benchmark -> IO [Result]
go []
where
go :: Baseline -> Benchmark -> IO [Result]
go Baseline
acc0 Benchmark
bnch = case Benchmark
bnch of
Bench [Char]
name Benchmarkable
act -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Baseline -> [Char] -> Benchmarkable -> IO Result
runBenchmarkable Config
cfg Baseline
acc0 [Char]
name Benchmarkable
act
Bgroup [Char]
name [Benchmark]
bs ->
let acc1 :: Baseline
acc1 = [Char] -> Baseline -> Baseline
consNonNull [Char]
name Baseline
acc0
to_run :: [Benchmark]
to_run = forall a. (a -> Bool) -> [a] -> [a]
filter (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Config -> [Char] -> Bool
isMatched Config
cfg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baseline -> Benchmark -> Baseline
benchNames Baseline
acc1) [Benchmark]
bs
in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat 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 (Baseline -> Benchmark -> IO [Result]
go Baseline
acc1) [Benchmark]
to_run
Environment IO e
alloc e -> IO ()
clean e -> Benchmark
f ->
let alloc' :: IO e
alloc' = IO e
alloc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \e
e -> forall a. a -> IO a
evaluate (forall a. NFData a => a -> ()
rnf e
e) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e
in forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO e
alloc' e -> IO ()
clean (Baseline -> Benchmark -> IO [Result]
go Baseline
acc0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Benchmark
f)
runBenchmarkable :: Config -> [String] -> String -> Benchmarkable -> IO Result
runBenchmarkable :: Config -> Baseline -> [Char] -> Benchmarkable -> IO Result
runBenchmarkable Config
cfg Baseline
parents [Char]
name Benchmarkable
b = do
let fullname :: [Char]
fullname = Baseline -> [Char] -> [Char]
pathToName Baseline
parents [Char]
name
Config -> [Char] -> IO ()
infoStr Config
cfg ([Char] -> [Char]
white [Char]
"benchmarking " forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
boldCyan [Char]
fullname forall a. [a] -> [a] -> [a]
++ [Char]
" ")
Config -> [Char] -> IO ()
debugStr Config
cfg [Char]
"\n"
Handle -> IO ()
hFlush Handle
stdout
Maybe Estimate
mb_est <- forall a. Timeout -> IO a -> IO (Maybe a)
withTimeout (Config -> Timeout
cfgTimeout Config
cfg) (Config -> Benchmarkable -> IO Estimate
measureUntil Config
cfg Benchmarkable
b)
let upper :: Double
upper = Double
1 forall a. Num a => a -> a -> a
+ Config -> Double
cfgFailIfSlower Config
cfg
lower :: Double
lower = Double
1 forall a. Num a => a -> a -> a
- Config -> Double
cfgFailIfFaster Config
cfg
is_acceptable :: Double -> Result
is_acceptable Double
cmp
| Double
upper forall a. Ord a => a -> a -> Bool
<= Double
cmp = [Char] -> Result
TooSlow [Char]
fullname
| Double
cmp forall a. Ord a => a -> a -> Bool
<= Double
lower = [Char] -> Result
TooFast [Char]
fullname
| Bool
otherwise = Result
Done
(Result
result, Maybe Double
mb_cmp) = case Maybe Estimate
mb_est of
Maybe Estimate
Nothing -> ([Char] -> Result
TimedOut [Char]
fullname, forall a. Maybe a
Nothing)
Just Estimate
est -> case Baseline -> [Char] -> Estimate -> Maybe Double
compareVsBaseline (Config -> Baseline
cfgBaselineSet Config
cfg) [Char]
fullname Estimate
est of
Maybe Double
Nothing -> (Result
Done, forall a. Maybe a
Nothing)
Just Double
cmp -> (Double -> Result
is_acceptable Double
cmp, forall a. a -> Maybe a
Just Double
cmp)
csvname :: [Char]
csvname = [Char] -> [Char]
encodeCsv [Char]
fullname
put_csv_line :: Handle -> IO ()
put_csv_line Handle
hdl =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Estimate
e -> Handle -> [Char] -> IO ()
hPutStrLn Handle
hdl ([Char]
csvname forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ Estimate -> [Char]
csvEstimate Estimate
e)) Maybe Estimate
mb_est
Config -> [Char] -> IO ()
infoStr Config
cfg (Result -> Maybe Estimate -> Maybe Double -> [Char]
formatResult Result
result Maybe Estimate
mb_est Maybe Double
mb_cmp)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
put_csv_line (Config -> Maybe Handle
cfgCsvHandle Config
cfg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
result
withTimeout :: Timeout -> IO a -> IO (Maybe a)
withTimeout :: forall a. Timeout -> IO a -> IO (Maybe a)
withTimeout Timeout
tout IO a
act = case Timeout
tout of
Timeout Integer
micro -> forall a. Int -> IO a -> IO (Maybe a)
timeout (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
micro) IO a
act
Timeout
NoTimeout -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just IO a
act
benchNames :: [String] -> Benchmark -> [String]
benchNames :: Baseline -> Benchmark -> Baseline
benchNames = Baseline -> Benchmark -> Baseline
go
where
go :: Baseline -> Benchmark -> Baseline
go Baseline
acc Benchmark
b = case Benchmark
b of
Bench [Char]
name Benchmarkable
_ -> [Baseline -> [Char] -> [Char]
pathToName Baseline
acc [Char]
name]
Bgroup [Char]
name [Benchmark]
bs -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Baseline -> Benchmark -> Baseline
go ([Char] -> Baseline -> Baseline
consNonNull [Char]
name Baseline
acc)) [Benchmark]
bs
Environment IO e
_ e -> IO ()
_ e -> Benchmark
f -> Baseline -> Benchmark -> Baseline
go Baseline
acc (e -> Benchmark
f (forall a e. Exception e => e -> a
throw (Baseline -> MiniterionException
UninitializedEnv Baseline
acc)))
pathToName :: [String] -> String -> String
pathToName :: Baseline -> [Char] -> [Char]
pathToName Baseline
prevs [Char]
me = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\[Char]
a [Char]
b -> [Char]
a forall a. [a] -> [a] -> [a]
++ [Char]
"/" forall a. [a] -> [a] -> [a]
++ [Char]
b) [Char]
me (forall a. [a] -> [a]
reverse Baseline
prevs)
groupsToName :: [String] -> String
groupsToName :: Baseline -> [Char]
groupsToName = \case
[] -> [Char]
""
([Char]
hd:Baseline
tl) -> Baseline -> [Char] -> [Char]
pathToName Baseline
tl [Char]
hd
consNonNull :: String -> [String] -> [String]
consNonNull :: [Char] -> Baseline -> Baseline
consNonNull [Char]
x Baseline
xs = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
x then Baseline
xs else [Char]
x forall a. a -> [a] -> [a]
: Baseline
xs
noop :: Applicative m => a -> m ()
noop :: forall (m :: * -> *) a. Applicative m => a -> m ()
noop = forall a b. a -> b -> a
const (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
{-# INLINE noop #-}
infoStr, debugStr :: Config -> String -> IO ()
infoStr :: Config -> [Char] -> IO ()
infoStr = forall (m :: * -> *) a.
Applicative m =>
Int -> (a -> m ()) -> Config -> a -> m ()
putWith Int
1 [Char] -> IO ()
putStr
debugStr :: Config -> [Char] -> IO ()
debugStr = forall (m :: * -> *) a.
Applicative m =>
Int -> (a -> m ()) -> Config -> a -> m ()
putWith Int
2 [Char] -> IO ()
putStr
putWith :: Applicative m => Int -> (a -> m ()) -> Config -> a -> m ()
putWith :: forall (m :: * -> *) a.
Applicative m =>
Int -> (a -> m ()) -> Config -> a -> m ()
putWith Int
n a -> m ()
act Config
cfg a
x = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n forall a. Ord a => a -> a -> Bool
<= Config -> Int
cfgVerbosity Config
cfg) forall a b. (a -> b) -> a -> b
$ a -> m ()
act a
x
formatResult :: Result -> Maybe Estimate -> Maybe Double -> String
formatResult :: Result -> Maybe Estimate -> Maybe Double -> [Char]
formatResult Result
_ Maybe Estimate
Nothing Maybe Double
_ =
[Char] -> [Char]
red [Char]
"FAIL" forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char] -> [Char]
yellow [Char]
"Timed out while running this benchmark\n\n"
formatResult Result
res (Just (Estimate Measurement
m Word64
stdev)) Maybe Double
mb_cmp =
[Char]
fail_or_blank forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char] -> [Char]
white [Char]
"mean " forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
showPicos5 (Measurement -> Word64
measTime Measurement
m) forall a. [a] -> [a] -> [a]
++
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (Result -> Double -> [Char]
formatSlowDown Result
res) Maybe Double
mb_cmp forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char] -> [Char]
white [Char]
"std dev " forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
showPicos5 (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev) forall a. [a] -> [a] -> [a]
++
Measurement -> [Char]
formatGC Measurement
m forall a. [a] -> [a] -> [a]
++ [Char]
"\n\n"
where
fail_or_blank :: [Char]
fail_or_blank
| Result -> Bool
isTooFast Result
res Bool -> Bool -> Bool
|| Result -> Bool
isTooSlow Result
res = [Char] -> [Char]
red [Char]
"FAIL"
| Bool
otherwise = [Char]
""
formatSlowDown :: Result -> Double -> String
formatSlowDown :: Result -> Double -> [Char]
formatSlowDown Result
result Double
ratio = case Int64
percents forall a. Ord a => a -> a -> Ordering
`compare` Int64
0 of
Ordering
LT -> (Result -> Bool) -> [Char] -> [Char]
in_yellow Result -> Bool
isTooFast forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
" (%2i%% less than baseline)" (-Int64
percents)
Ordering
EQ -> [Char] -> [Char]
white [Char]
" (same as baseline)"
Ordering
GT -> (Result -> Bool) -> [Char] -> [Char]
in_yellow Result -> Bool
isTooSlow forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => [Char] -> r
printf [Char]
" (%2i%% more than baseline)" Int64
percents
where
percents :: Int64
percents :: Int64
percents = forall a b. (RealFrac a, Integral b) => a -> b
truncate ((Double
ratio forall a. Num a => a -> a -> a
- Double
1) forall a. Num a => a -> a -> a
* Double
100)
in_yellow :: (Result -> Bool) -> [Char] -> [Char]
in_yellow Result -> Bool
test = if Result -> Bool
test Result
result then [Char] -> [Char]
yellow else [Char] -> [Char]
white
showPicos5 :: Word64 -> String
showPicos5 :: Word64 -> [Char]
showPicos5 Word64
i
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f ps" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
100 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f ps" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1000 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f ps" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e1 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e2 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e3 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f ns" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e3)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e4 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e5 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e6 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f %cs" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e7 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e8 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e9 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.1f ms" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e9)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e10 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.3f s" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e12)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
999e11 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%.2f s" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e12)
| Bool
otherwise = forall r. PrintfType r => [Char] -> r
printf [Char]
"%4.1f s" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1e12)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
formatGC :: Measurement -> String
formatGC :: Measurement -> [Char]
formatGC (Measurement Word64
_ Word64
a Word64
c Word64
p)
| Bool
hasGCStats = [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char] -> [Char]
white [Char]
" alloc copied peak" forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char] -> [Char]
white [Char]
"gc " forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
sb Word64
a forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
sb Word64
c forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ Word64 -> [Char]
sb Word64
p
| Bool
otherwise = [Char]
""
where
sb :: Word64 -> [Char]
sb = Word64 -> [Char]
showBytes
showBytes :: Word64 -> String
showBytes :: Word64 -> [Char]
showBytes Word64
i
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1000 = forall r. PrintfType r => [Char] -> r
printf [Char]
" %3.0f B" Double
t
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10189 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f KB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1023488 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f KB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1024)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10433332 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f MB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1048051712 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f MB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1048576)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10683731149 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f GB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1073204953088 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f GB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1073741824)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
10940140696372 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f TB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1098961871962112 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f TB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
11202704073084108 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f PB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
1125336956889202624 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f PB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
| Double
t forall a. Ord a => a -> a -> Bool
< Double
11471568970838126592 = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.1f EB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
| Bool
otherwise = forall r. PrintfType r => [Char] -> r
printf [Char]
"%3.0f EB" (Double
t forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
where
t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
formatMeasurement :: Measurement -> String
formatMeasurement :: Measurement -> [Char]
formatMeasurement (Measurement Word64
t Word64
a Word64
c Word64
m) =
forall r. PrintfType r => [Char] -> r
printf [Char]
"%d ps, alloc: %d copied: %d max: %d" Word64
t Word64
a Word64
c Word64
m
data MatchMode
= Pattern
| Prefix
| IPattern
| Glob
isMatched :: Config -> String -> Bool
isMatched :: Config -> [Char] -> Bool
isMatched Config{Bool
Double
Int
Baseline
[(MatchMode, [Char])]
Maybe [Char]
Maybe Handle
Timeout
TimeMode
MatchMode
cfgTimeMode :: Config -> TimeMode
cfgRelStDev :: Config -> Double
cfgVersion :: Bool
cfgVerbosity :: Int
cfgTimeout :: Timeout
cfgTimeMode :: TimeMode
cfgRelStDev :: Double
cfgPatterns :: [(MatchMode, [Char])]
cfgMatch :: MatchMode
cfgFailIfSlower :: Double
cfgFailIfFaster :: Double
cfgCsvHandle :: Maybe Handle
cfgCsvPath :: Maybe [Char]
cfgBaselineSet :: Baseline
cfgBaselinePath :: Maybe [Char]
cfgList :: Bool
cfgHelp :: Bool
cfgVerbosity :: Config -> Int
cfgFailIfFaster :: Config -> Double
cfgFailIfSlower :: Config -> Double
cfgTimeout :: Config -> Timeout
cfgList :: Config -> Bool
cfgVersion :: Config -> Bool
cfgHelp :: Config -> Bool
cfgBaselineSet :: Config -> Baseline
cfgBaselinePath :: Config -> Maybe [Char]
cfgCsvHandle :: Config -> Maybe Handle
cfgCsvPath :: Config -> Maybe [Char]
cfgMatch :: Config -> MatchMode
cfgPatterns :: Config -> [(MatchMode, [Char])]
..} [Char]
fullname = Bool
no_pat Bool -> Bool -> Bool
|| Bool
has_match
where
no_pat :: Bool
no_pat = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(MatchMode, [Char])]
cfgPatterns
has_match :: Bool
has_match = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (MatchMode, [Char]) -> Bool
is_match [(MatchMode, [Char])]
cfgPatterns
is_match :: (MatchMode, [Char]) -> Bool
is_match (MatchMode
mode, [Char]
str) = case MatchMode
mode of
MatchMode
Glob -> [Char] -> [Char] -> Bool
glob [Char]
str [Char]
fullname
MatchMode
IPattern -> [Char] -> [Char] -> Bool
substring (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
str) (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower [Char]
fullname)
MatchMode
Pattern -> [Char] -> [Char] -> Bool
substring [Char]
str [Char]
fullname
MatchMode
Prefix -> [Char]
str forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
fullname
substring :: String -> String -> Bool
substring :: [Char] -> [Char] -> Bool
substring [Char]
pat = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char]
pat forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
tails
glob :: String -> String -> Bool
glob :: [Char] -> [Char] -> Bool
glob [Char]
pat0 = [Char] -> [Char] -> Bool
go [Char]
pat0
where
go :: [Char] -> [Char] -> Bool
go [] [] = Bool
True
go (Char
'\\':Char
p:[Char]
ps) (Char
c:[Char]
cs) = Char
p forall a. Eq a => a -> a -> Bool
== Char
c Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
go [Char]
ps [Char]
cs
go (Char
'?':[Char]
ps) (Char
_:[Char]
cs) = [Char] -> [Char] -> Bool
go [Char]
ps [Char]
cs
go [Char
'*'] [Char]
_ = Bool
True
go (Char
'*':[Char]
ps) [Char]
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> [Char] -> Bool
go [Char]
ps) ([Char]
cs forall a. a -> [a] -> [a]
: forall a. [a] -> [[a]]
tails [Char]
cs)
go (Char
'[':Char
'!':[Char]
ps) (Char
c:[Char]
cs) = (Char -> [Char] -> Bool) -> Char -> [Char] -> [Char] -> Bool
cclass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem Char
c [Char]
ps [Char]
cs
go (Char
'[':[Char]
ps) (Char
c:[Char]
cs) = (Char -> [Char] -> Bool) -> Char -> [Char] -> [Char] -> Bool
cclass forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c [Char]
ps [Char]
cs
go (Char
p:[Char]
ps) (Char
c:[Char]
cs) | Char
p forall a. Eq a => a -> a -> Bool
== Char
c = [Char] -> [Char] -> Bool
go [Char]
ps [Char]
cs
go [Char]
_ [Char]
_ = Bool
False
cclass :: (Char -> [Char] -> Bool) -> Char -> [Char] -> [Char] -> Bool
cclass Char -> [Char] -> Bool
test Char
c [Char]
ps [Char]
cs =
let lp :: Bool -> [Char] -> [Char] -> Bool
lp Bool
close [Char]
acc [Char]
xs =
case [Char]
xs of
[] -> forall a e. Exception e => e -> a
throw ([Char] -> MiniterionException
GlobUnbalancedBracket [Char]
pat0)
Char
'\\':Char
x:[Char]
xs' -> Bool -> [Char] -> [Char] -> Bool
lp Bool
True (Char
xforall a. a -> [a] -> [a]
:[Char]
acc) [Char]
xs'
Char
']':[Char]
xs' | Bool
close -> Char -> [Char] -> Bool
test Char
c [Char]
acc Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
go [Char]
xs' [Char]
cs
Char
x0:Char
'-':Char
']':[Char]
xs' -> Char -> [Char] -> Bool
test Char
c (Char
'-'forall a. a -> [a] -> [a]
:Char
x0forall a. a -> [a] -> [a]
:[Char]
acc) Bool -> Bool -> Bool
&& [Char] -> [Char] -> Bool
go [Char]
xs' [Char]
cs
Char
x0:Char
'-':Char
x1:[Char]
xs' -> Bool -> [Char] -> [Char] -> Bool
lp Bool
True ([Char
x0 .. Char
x1] forall a. [a] -> [a] -> [a]
++ [Char]
acc) [Char]
xs'
Char
x:[Char]
xs' -> Bool -> [Char] -> [Char] -> Bool
lp Bool
True (Char
xforall a. a -> [a] -> [a]
:[Char]
acc) [Char]
xs'
in Bool -> [Char] -> [Char] -> Bool
lp Bool
False [] [Char]
ps
red, green, yellow, boldCyan, white :: String -> String
red :: [Char] -> [Char]
red = [Char] -> [Char] -> [Char]
coloredString [Char]
"1;31"
green :: [Char] -> [Char]
green = [Char] -> [Char] -> [Char]
coloredString [Char]
"0;32"
yellow :: [Char] -> [Char]
yellow = [Char] -> [Char] -> [Char]
coloredString [Char]
"0;33"
boldCyan :: [Char] -> [Char]
boldCyan = [Char] -> [Char] -> [Char]
coloredString [Char]
"1;36"
white :: [Char] -> [Char]
white = [Char] -> [Char] -> [Char]
coloredString [Char]
"0;37"
coloredString :: String -> String -> String
coloredString :: [Char] -> [Char] -> [Char]
coloredString [Char]
param [Char]
str
| Bool
isTerminalDevice = [Char]
"\ESC[" forall a. [a] -> [a] -> [a]
++ [Char]
param forall a. [a] -> [a] -> [a]
++ [Char]
"m" forall a. [a] -> [a] -> [a]
++ [Char]
str forall a. [a] -> [a] -> [a]
++ [Char]
"\ESC[0m"
| Bool
otherwise = [Char]
str
isTerminalDevice :: Bool
isTerminalDevice :: Bool
isTerminalDevice = forall a. IO a -> a
unsafePerformIO (Handle -> IO Bool
hIsTerminalDevice Handle
stdout)
{-# NOINLINE isTerminalDevice #-}
mu :: Char
mu :: Char
mu = if Bool
hasUnicodeSupport then Char
'μ' else Char
'u'
hasUnicodeSupport :: Bool
#if MIN_VERSION_base(4,5,0)
hasUnicodeSupport :: Bool
hasUnicodeSupport = forall a. Int -> [a] -> [a]
take Int
3 (TextEncoding -> [Char]
textEncodingName TextEncoding
enc) forall a. Eq a => a -> a -> Bool
== [Char]
"UTF"
#if defined(mingw32_HOST_OS)
&& unsafePerformIO getConsoleOutputCP == 65001
#endif
where
enc :: TextEncoding
enc = forall a. IO a -> a
unsafePerformIO IO TextEncoding
getLocaleEncoding
#else
hasUnicodeSupport = False
#endif
{-# NOINLINE hasUnicodeSupport #-}
type Baseline = [String]
csvEstimate :: Estimate -> String
csvEstimate :: Estimate -> [Char]
csvEstimate (Estimate Measurement
m Word64
stdev)
| Bool
hasGCStats = [Char]
time forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ [Char]
gc
| Bool
otherwise = [Char]
time
where
time :: [Char]
time = forall a. Show a => a -> [Char]
show (Measurement -> Word64
measTime Measurement
m) forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Word64
2 forall a. Num a => a -> a -> a
* Word64
stdev)
gc :: [Char]
gc = forall a. Show a => a -> [Char]
show (Measurement -> Word64
measAllocs Measurement
m) forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Measurement -> Word64
measCopied Measurement
m) forall a. [a] -> [a] -> [a]
++ [Char]
"," forall a. [a] -> [a] -> [a]
++
forall a. Show a => a -> [Char]
show (Measurement -> Word64
measMaxMem Measurement
m)
readBaseline :: FilePath -> IO Baseline
readBaseline :: [Char] -> IO Baseline
readBaseline [Char]
path = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. SomeException -> IO a
handler IO Baseline
go
where
handler :: SomeException -> IO a
handler :: forall a. SomeException -> IO a
handler SomeException
_ = forall e a. Exception e => e -> IO a
throwIO (Maybe [Char] -> [Char] -> MiniterionException
CannotReadFile (forall a. a -> Maybe a
Just [Char]
"baseline") [Char]
path)
go :: IO Baseline
go = [Char] -> IO [Char]
readFile [Char]
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baseline -> Baseline
joinQuotedFields forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Baseline
lines
joinQuotedFields :: [String] -> [String]
joinQuotedFields :: Baseline -> Baseline
joinQuotedFields [] = []
joinQuotedFields ([Char]
x : Baseline
xs)
| [Char] -> Bool
areQuotesBalanced [Char]
x = [Char]
x forall a. a -> [a] -> [a]
: Baseline -> Baseline
joinQuotedFields Baseline
xs
| Bool
otherwise = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span [Char] -> Bool
areQuotesBalanced Baseline
xs of
(Baseline
_, []) -> []
(Baseline
ys, [Char]
z : Baseline
zs) -> Baseline -> [Char]
unlines ([Char]
x forall a. a -> [a] -> [a]
: Baseline
ys forall a. [a] -> [a] -> [a]
++ [[Char]
z]) forall a. a -> [a] -> [a]
: Baseline -> Baseline
joinQuotedFields Baseline
zs
where
areQuotesBalanced :: [Char] -> Bool
areQuotesBalanced = forall a. Integral a => a -> Bool
even forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
== Char
'"')
compareVsBaseline :: Baseline -> String -> Estimate -> Maybe Double
compareVsBaseline :: Baseline -> [Char] -> Estimate -> Maybe Double
compareVsBaseline Baseline
baseline [Char]
name (Estimate Measurement
m Word64
stdev) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int64, Int64) -> Double
comp Maybe (Int64, Int64)
mb_old
where
comp :: (Int64, Int64) -> Double
comp (Int64
old_time, Int64
old_sigma_x_2) =
if forall a. Num a => a -> a
abs (Int64
time forall a. Num a => a -> a -> a
- Int64
old_time) forall a. Ord a => a -> a -> Bool
< forall a. Ord a => a -> a -> a
max (Int64
2 forall a. Num a => a -> a -> a
* Word64 -> Int64
word64ToInt64 Word64
stdev) Int64
old_sigma_x_2
then Double
1
else Int64 -> Double
int64ToDouble Int64
time forall a. Fractional a => a -> a -> a
/ Int64 -> Double
int64ToDouble Int64
old_time
time :: Int64
time = Word64 -> Int64
word64ToInt64 forall a b. (a -> b) -> a -> b
$ Measurement -> Word64
measTime Measurement
m
mb_old :: Maybe (Int64, Int64)
mb_old :: Maybe (Int64, Int64)
mb_old = do
let prefix :: [Char]
prefix = [Char] -> [Char]
encodeCsv [Char]
name forall a. [a] -> [a] -> [a]
++ [Char]
","
(Baseline
_, Baseline
breaked) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
prefix) Baseline
baseline
[Char]
line <- case Baseline
breaked of
[] -> forall a. Maybe a
Nothing
[Char]
hd:Baseline
tl -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [Char]
prefix) Baseline
tl of
(Baseline
_, []) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Char]
hd
(Baseline, Baseline)
_ -> forall a. Maybe a
Nothing
([Char]
time_cell, Char
',' : [Char]
rest) <- forall a. (a -> Bool) -> [a] -> ([a], [a])
span (forall a. Eq a => a -> a -> Bool
/= Char
',') forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix [Char]
prefix [Char]
line
let sigma_x_2_cell :: [Char]
sigma_x_2_cell = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
',') [Char]
rest
(,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
time_cell forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
sigma_x_2_cell
encodeCsv :: String -> String
encodeCsv :: [Char] -> [Char]
encodeCsv [Char]
xs
| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
xs) [Char]
",\"\n\r" = Char
'"' forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
xs
| Bool
otherwise = [Char]
xs
where
go :: [Char] -> [Char]
go [] = [Char
'"']
go (Char
'"' : [Char]
ys) = Char
'"' forall a. a -> [a] -> [a]
: Char
'"' forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
ys
go (Char
y : [Char]
ys) = Char
y forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
ys
data Config = Config
{ Config -> Bool
cfgHelp :: Bool
, Config -> Bool
cfgList :: Bool
, Config -> Maybe [Char]
cfgBaselinePath :: Maybe FilePath
, Config -> Baseline
cfgBaselineSet :: Baseline
, Config -> Maybe [Char]
cfgCsvPath :: Maybe FilePath
, Config -> Maybe Handle
cfgCsvHandle :: Maybe Handle
, Config -> Double
cfgFailIfFaster :: Double
, Config -> Double
cfgFailIfSlower :: Double
, Config -> MatchMode
cfgMatch :: MatchMode
, Config -> [(MatchMode, [Char])]
cfgPatterns :: [(MatchMode,String)]
, Config -> Double
cfgRelStDev :: Double
, Config -> TimeMode
cfgTimeMode :: TimeMode
, Config -> Timeout
cfgTimeout :: Timeout
, Config -> Int
cfgVerbosity :: Int
, Config -> Bool
cfgVersion :: Bool
}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
{ cfgHelp :: Bool
cfgHelp = Bool
False
, cfgList :: Bool
cfgList = Bool
False
, cfgBaselinePath :: Maybe [Char]
cfgBaselinePath = forall a. Maybe a
Nothing
, cfgBaselineSet :: Baseline
cfgBaselineSet = forall a. Monoid a => a
mempty
, cfgCsvPath :: Maybe [Char]
cfgCsvPath = forall a. Maybe a
Nothing
, cfgCsvHandle :: Maybe Handle
cfgCsvHandle = forall a. Maybe a
Nothing
, cfgFailIfFaster :: Double
cfgFailIfFaster = Double
1.0 forall a. Fractional a => a -> a -> a
/ Double
0.0
, cfgFailIfSlower :: Double
cfgFailIfSlower = Double
1.0 forall a. Fractional a => a -> a -> a
/ Double
0.0
, cfgPatterns :: [(MatchMode, [Char])]
cfgPatterns = []
, cfgMatch :: MatchMode
cfgMatch = MatchMode
Prefix
, cfgRelStDev :: Double
cfgRelStDev = Double
0.05
, cfgTimeMode :: TimeMode
cfgTimeMode = TimeMode
CpuTime
, cfgTimeout :: Timeout
cfgTimeout = Timeout
NoTimeout
, cfgVerbosity :: Int
cfgVerbosity = Int
1
, cfgVersion :: Bool
cfgVersion = Bool
False
}
options :: [OptDescr (Config -> Config)]
options :: [OptDescr (Config -> Config)]
options =
[ forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'h'] [[Char]
"help"]
(forall a. a -> ArgDescr a
NoArg (\Config
o -> Config
o {cfgHelp :: Bool
cfgHelp = Bool
True}))
[Char]
"Show this help text"
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'L'] [[Char]
"time-limit"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Double of
Just Double
n -> Config
o {cfgTimeout :: Timeout
cfgTimeout = Integer -> Timeout
Timeout (forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
1e6 forall a. Num a => a -> a -> a
* Double
n))}
Maybe Double
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"time-limit" [Char]
str))
[Char]
"SECS")
(Baseline -> [Char]
unlines
[[Char]
"Time limit to run a benchmark"
,[Char]
"(default: no timeout)"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"baseline"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> Config
o {cfgBaselinePath :: Maybe [Char]
cfgBaselinePath = forall a. a -> Maybe a
Just [Char]
str})
[Char]
"FILE")
[Char]
"File to read CSV summary from as baseline"
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"csv"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> Config
o {cfgCsvPath :: Maybe [Char]
cfgCsvPath = forall a. a -> Maybe a
Just [Char]
str})
[Char]
"FILE")
[Char]
"File to write CSV summary to"
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"fail-if-faster"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case [Char] -> Maybe Double
parsePositivePercents [Char]
str of
Just Double
x -> Config
o {cfgFailIfFaster :: Double
cfgFailIfFaster = Double
x}
Maybe Double
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"fail-if-faster" [Char]
str))
[Char]
"NUM")
(Baseline -> [Char]
unlines
[[Char]
"Upper bound acceptable speed up in percents. If a"
,[Char]
"benchmark is unacceptable faster than baseline (see"
,[Char]
"--baseline), it will be reported as failed"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"fail-if-slower"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case [Char] -> Maybe Double
parsePositivePercents [Char]
str of
Just Double
x -> Config
o {cfgFailIfSlower :: Double
cfgFailIfSlower = Double
x}
Maybe Double
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"fail-if-slower" [Char]
str))
[Char]
"NUM")
(Baseline -> [Char]
unlines
[[Char]
"Upper bound acceptable slow down in percents. If a"
,[Char]
"benchmark is unacceptable slower than baseline (see"
,[Char]
"--baseline), it will be reported as failed"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
's'] [[Char]
"stdev"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case [Char] -> Maybe Double
parsePositivePercents [Char]
str of
Just Double
x -> Config
o {cfgRelStDev :: Double
cfgRelStDev = Double
x}
Maybe Double
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"stdev" [Char]
str))
[Char]
"NUM")
(Baseline -> [Char]
unlines
[[Char]
"Target relative standard deviation of measurement"
,[Char]
"in percents (default: 5)"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"time-mode"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case [Char]
str of
[Char]
"cpu" -> Config
o {cfgTimeMode :: TimeMode
cfgTimeMode = TimeMode
CpuTime}
[Char]
"wall" -> Config
o {cfgTimeMode :: TimeMode
cfgTimeMode = TimeMode
WallTime}
[Char]
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"time-mode" [Char]
str))
[Char]
"cpu|wall")
(Baseline -> [Char]
unlines
[[Char]
"Whether to measure CPU (\"cpu\") time or wall-clock"
,[Char]
"time (\"wall\") (default: cpu)"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'v'] [[Char]
"verbosity"]
(forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
str :: Maybe Int of
Just Int
n | Int
0 forall a. Ord a => a -> a -> Bool
<= Int
n Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
2 -> Config
o {cfgVerbosity :: Int
cfgVerbosity = Int
n}
Maybe Int
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"verbosity" [Char]
str))
[Char]
"INT")
[Char]
"Verbosity level (default: 1)"
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'm'] [[Char]
"match"]
(let modes :: [([Char], MatchMode)]
modes = [([Char]
"glob", MatchMode
Glob)
,([Char]
"pattern", MatchMode
Pattern)
,([Char]
"prefix", MatchMode
Prefix)
,([Char]
"ipattern", MatchMode
IPattern)]
match :: [a] -> ([a], b) -> Bool
match [a]
str = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
str forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
in forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
str Config
o -> case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall {a} {b}. Eq a => [a] -> ([a], b) -> Bool
match [Char]
str) [([Char], MatchMode)]
modes of
Just ([Char]
_, MatchMode
mode) -> Config
o {cfgMatch :: MatchMode
cfgMatch = MatchMode
mode}
Maybe ([Char], MatchMode)
_ -> forall a e. Exception e => e -> a
throw ([Char] -> [Char] -> MiniterionException
InvalidArgument [Char]
"match" [Char]
str))
[Char]
"MODE")
(Baseline -> [Char]
unlines
[[Char]
"How to match benchmark names (\"prefix\", \"glob\","
,[Char]
"\"pattern\" (substring), or \"ipattern\")"])
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'l'] [[Char]
"list"]
(forall a. a -> ArgDescr a
NoArg (\Config
o -> Config
o {cfgList :: Bool
cfgList = Bool
True}))
[Char]
"List benchmarks"
, forall a. [Char] -> Baseline -> ArgDescr a -> [Char] -> OptDescr a
Option [] [[Char]
"version"]
(forall a. a -> ArgDescr a
NoArg (\Config
o -> Config
o {cfgVersion :: Bool
cfgVersion = Bool
True}))
[Char]
"Show version info"
]
parsePositivePercents :: String -> Maybe Double
parsePositivePercents :: [Char] -> Maybe Double
parsePositivePercents [Char]
xs = do
Double
x <- forall a. Read a => [Char] -> Maybe a
readMaybe [Char]
xs
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Double
x forall a. Ord a => a -> a -> Bool
> Double
0)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x forall a. Fractional a => a -> a -> a
/ Double
100)
data MiniterionException
= InvalidArgument String String
| CannotReadFile (Maybe String) String
| UninitializedEnv [String]
| GlobUnbalancedBracket String
deriving (Int -> MiniterionException -> [Char] -> [Char]
[MiniterionException] -> [Char] -> [Char]
MiniterionException -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [MiniterionException] -> [Char] -> [Char]
$cshowList :: [MiniterionException] -> [Char] -> [Char]
show :: MiniterionException -> [Char]
$cshow :: MiniterionException -> [Char]
showsPrec :: Int -> MiniterionException -> [Char] -> [Char]
$cshowsPrec :: Int -> MiniterionException -> [Char] -> [Char]
Show)
instance Exception MiniterionException where
displayException :: MiniterionException -> [Char]
displayException = MiniterionException -> [Char]
displayMiniterionException
displayMiniterionException :: MiniterionException -> String
displayMiniterionException :: MiniterionException -> [Char]
displayMiniterionException = \case
InvalidArgument [Char]
lbl [Char]
arg ->
[Char]
"invalid argument `" forall a. [a] -> [a] -> [a]
++ [Char]
arg forall a. [a] -> [a] -> [a]
++ [Char]
"'" forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
maybe_label (forall a. a -> Maybe a
Just [Char]
lbl)
CannotReadFile Maybe [Char]
mb_lbl [Char]
path ->
[Char]
"cannot read file `" forall a. [a] -> [a] -> [a]
++ [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"'" forall a. [a] -> [a] -> [a]
++ Maybe [Char] -> [Char]
maybe_label Maybe [Char]
mb_lbl
UninitializedEnv Baseline
groups ->
[Char]
"uninitialized env" forall a. [a] -> [a] -> [a]
++
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Baseline
groups then [Char]
"" else [Char]
" under `" forall a. [a] -> [a] -> [a]
++ Baseline -> [Char]
groupsToName Baseline
groups forall a. [a] -> [a] -> [a]
++ [Char]
"'") forall a. [a] -> [a] -> [a]
++
[Char]
"\nuse irrefutable pattern in the function taking the env."
GlobUnbalancedBracket [Char]
pat ->
[Char]
"unbalanced bracket in glob pattern `" forall a. [a] -> [a] -> [a]
++ [Char]
pat forall a. [a] -> [a] -> [a]
++ [Char]
"'"
where
maybe_label :: Maybe [Char] -> [Char]
maybe_label = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" (\[Char]
lbl -> [Char]
" for `--" forall a. [a] -> [a] -> [a]
++ [Char]
lbl forall a. [a] -> [a] -> [a]
++ [Char]
"'")
handleMiniterionException :: IO a -> IO a
handleMiniterionException :: forall a. IO a -> IO a
handleMiniterionException =
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a b. (a -> b) -> a -> b
$ \SomeException
e -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO SomeException
e) forall a. MiniterionException -> IO a
complain_and_die (forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e)
where
complain_and_die :: MiniterionException -> IO a
complain_and_die :: forall a. MiniterionException -> IO a
complain_and_die MiniterionException
he = do
[Char]
me <- IO [Char]
getProgName
forall a. [Char] -> IO a
die ([Char]
me forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ forall e. Exception e => e -> [Char]
displayException MiniterionException
he forall a. [a] -> [a] -> [a]
++ [Char]
"\n" forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
briefUsageOf [Char]
me)
data TimeMode
= CpuTime
| WallTime
getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs = \case
TimeMode
CpuTime -> forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
TimeMode
WallTime -> forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
1e12 forall a. Num a => a -> a -> a
*) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Double
getMonotonicTime
getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied =
#if MIN_VERSION_base(4,10,0)
if Bool -> Bool
not Bool
hasGCStats then forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
0, Word64
0, Word64
0) else
(\RTSStats
s -> (RTSStats -> Word64
allocated_bytes RTSStats
s, RTSStats -> Word64
copied_bytes RTSStats
s, RTSStats -> Word64
max_mem_in_use_bytes RTSStats
s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
getRTSStats
#elif MIN_VERSION_base(4,6,0)
if not hasGCStats then pure (0, 0, 0) else
(\s -> (int64ToWord64 $ bytesAllocated s,
int64ToWord64 $ bytesCopied s,
int64ToWord64 $ peakMegabytesAllocated s * 1024 * 1024))
<$> getGCStats
#else
pure (0, 0, 0)
#endif
hasGCStats :: Bool
#if MIN_VERSION_base(4,10,0)
hasGCStats :: Bool
hasGCStats = forall a. IO a -> a
unsafePerformIO IO Bool
getRTSStatsEnabled
#elif MIN_VERSION_base(4,6,0)
hasGCStats = unsafePerformIO getGCStatsEnabled
#else
hasGCStats = False
#endif
{-# NOINLINE hasGCStats #-}
data Timeout
= Timeout Prelude.Integer
| NoTimeout
data Measurement = Measurement
{ Measurement -> Word64
measTime :: {-# UNPACK #-} !Word64
, Measurement -> Word64
measAllocs :: {-# UNPACK #-} !Word64
, Measurement -> Word64
measCopied :: {-# UNPACK #-} !Word64
, Measurement -> Word64
measMaxMem :: {-# UNPACK #-} !Word64
}
data Estimate = Estimate
{ Estimate -> Measurement
estMean :: {-# UNPACK #-} !Measurement
, Estimate -> Word64
estStdev :: {-# UNPACK #-} !Word64
}
sqr :: Num a => a -> a
sqr :: forall a. Num a => a -> a
sqr a
x = a
x forall a. Num a => a -> a -> a
* a
x
{-# INLINE sqr #-}
predict
:: Measurement
-> Measurement
-> Estimate
predict :: Measurement -> Measurement -> Estimate
predict (Measurement Word64
t1 Word64
a1 Word64
c1 Word64
m1) (Measurement Word64
t2 Word64
a2 Word64
c2 Word64
m2) = Estimate
{ estMean :: Measurement
estMean = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
t (forall {a}. Integral a => a -> a -> a
fit Word64
a1 Word64
a2) (forall {a}. Integral a => a -> a -> a
fit Word64
c1 Word64
c2) (forall a. Ord a => a -> a -> a
max Word64
m1 Word64
m2)
, estStdev :: Word64
estStdev = forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Floating a => a -> a
sqrt Double
d)
}
where
fit :: a -> a -> a
fit a
x1 a
x2 = a
x1 forall {a}. Integral a => a -> a -> a
`quot` a
5 forall a. Num a => a -> a -> a
+ a
2 forall a. Num a => a -> a -> a
* (a
x2 forall {a}. Integral a => a -> a -> a
`quot` a
5)
t :: Word64
t = forall {a}. Integral a => a -> a -> a
fit Word64
t1 Word64
t2
t' :: Double
t' = Word64 -> Double
word64ToDouble Word64
t
d :: Double
d = forall a. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t1 forall a. Num a => a -> a -> a
- Double
t') forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t2 forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Double
t')
predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2 = Estimate
{ estMean :: Measurement
estMean = Estimate -> Measurement
estMean (Measurement -> Measurement -> Estimate
predict Measurement
t1 Measurement
t2)
, estStdev :: Word64
estStdev = forall a. Ord a => a -> a -> a
max
(Estimate -> Word64
estStdev (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
lo Measurement
t1) (Measurement -> Measurement
hi Measurement
t2)))
(Estimate -> Word64
estStdev (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
hi Measurement
t1) (Measurement -> Measurement
lo Measurement
t2)))
}
where
prec :: Word64
prec = forall a. Ord a => a -> a -> a
max (forall a. Num a => Integer -> a
fromInteger Integer
cpuTimePrecision) Word64
1000000000
hi :: Measurement -> Measurement
hi Measurement
meas = Measurement
meas { measTime :: Word64
measTime = Measurement -> Word64
measTime Measurement
meas forall a. Num a => a -> a -> a
+ Word64
prec }
lo :: Measurement -> Measurement
lo Measurement
meas = Measurement
meas { measTime :: Word64
measTime = Measurement -> Word64
measTime Measurement
meas forall a. Num a => a -> a -> a
- Word64
prec }
measure :: Config -> Word64 -> Benchmarkable -> IO Measurement
measure :: Config -> Word64 -> Benchmarkable -> IO Measurement
measure Config
cfg Word64
n Benchmarkable{Bool
a -> Word64 -> IO ()
Word64 -> IO a
Word64 -> a -> IO ()
perRun :: Bool
runRepeatedly :: a -> Word64 -> IO ()
cleanEnv :: Word64 -> a -> IO ()
allocEnv :: Word64 -> IO a
perRun :: Benchmarkable -> Bool
runRepeatedly :: ()
cleanEnv :: ()
allocEnv :: ()
..} =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (Word64 -> IO a
allocEnv Word64
n) (Word64 -> a -> IO ()
cleanEnv Word64
n) forall a b. (a -> b) -> a -> b
$ \a
env0 -> do
let getTimePicoSecs' :: IO Word64
getTimePicoSecs' = TimeMode -> IO Word64
getTimePicoSecs (Config -> TimeMode
cfgTimeMode Config
cfg)
IO ()
performGC
Word64
startTime <- IO Word64
getTimePicoSecs'
(Word64
startAllocs, Word64
startCopied, Word64
startMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
a -> Word64 -> IO ()
runRepeatedly a
env0 Word64
n
Word64
endTime <- IO Word64
getTimePicoSecs'
(Word64
endAllocs, Word64
endCopied, Word64
endMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
let meas :: Measurement
meas = Measurement
{ measTime :: Word64
measTime = Word64
endTime forall a. Num a => a -> a -> a
- Word64
startTime
, measAllocs :: Word64
measAllocs = Word64
endAllocs forall a. Num a => a -> a -> a
- Word64
startAllocs
, measCopied :: Word64
measCopied = Word64
endCopied forall a. Num a => a -> a -> a
- Word64
startCopied
, measMaxMem :: Word64
measMaxMem = forall a. Ord a => a -> a -> a
max Word64
endMaxMemInUse Word64
startMaxMemInUse
}
Config -> [Char] -> IO ()
debugStr Config
cfg forall a b. (a -> b) -> a -> b
$
forall a. Show a => a -> [Char]
show Word64
n
forall a. [a] -> [a] -> [a]
++ (if Word64
n forall a. Eq a => a -> a -> Bool
== Word64
1 then [Char]
" iteration gives " else [Char]
" iterations give ")
forall a. [a] -> [a] -> [a]
++ Measurement -> [Char]
formatMeasurement Measurement
meas forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
forall (f :: * -> *) a. Applicative f => a -> f a
pure Measurement
meas
measureUntil :: Config -> Benchmarkable -> IO Estimate
measureUntil :: Config -> Benchmarkable -> IO Estimate
measureUntil cfg :: Config
cfg@Config{Bool
Double
Int
Baseline
[(MatchMode, [Char])]
Maybe [Char]
Maybe Handle
Timeout
TimeMode
MatchMode
cfgVersion :: Bool
cfgVerbosity :: Int
cfgTimeout :: Timeout
cfgTimeMode :: TimeMode
cfgRelStDev :: Double
cfgPatterns :: [(MatchMode, [Char])]
cfgMatch :: MatchMode
cfgFailIfSlower :: Double
cfgFailIfFaster :: Double
cfgCsvHandle :: Maybe Handle
cfgCsvPath :: Maybe [Char]
cfgBaselineSet :: Baseline
cfgBaselinePath :: Maybe [Char]
cfgList :: Bool
cfgHelp :: Bool
cfgTimeMode :: Config -> TimeMode
cfgRelStDev :: Config -> Double
cfgVerbosity :: Config -> Int
cfgFailIfFaster :: Config -> Double
cfgFailIfSlower :: Config -> Double
cfgTimeout :: Config -> Timeout
cfgList :: Config -> Bool
cfgVersion :: Config -> Bool
cfgHelp :: Config -> Bool
cfgBaselineSet :: Config -> Baseline
cfgBaselinePath :: Config -> Maybe [Char]
cfgCsvHandle :: Config -> Maybe Handle
cfgCsvPath :: Config -> Maybe [Char]
cfgMatch :: Config -> MatchMode
cfgPatterns :: Config -> [(MatchMode, [Char])]
..} Benchmarkable
b = do
Measurement
t1 <- Word64 -> Benchmarkable -> IO Measurement
measure' Word64
1 Benchmarkable
b
if forall a. RealFloat a => a -> Bool
isInfinite Double
cfgRelStDev Bool -> Bool -> Bool
&& Double
cfgRelStDev forall a. Ord a => a -> a -> Bool
> Double
0
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Estimate {estMean :: Measurement
estMean = Measurement
t1, estStdev :: Word64
estStdev = Word64
0}
else Measurement -> IO (Maybe Aggregate)
getAggregateMaybe Measurement
t1 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word64 -> Measurement -> Word64 -> Maybe Aggregate -> IO Estimate
go Word64
1 Measurement
t1 Word64
0
where
measure' :: Word64 -> Benchmarkable -> IO Measurement
measure' = Config -> Word64 -> Benchmarkable -> IO Measurement
measure Config
cfg
numInit :: Num a => a
numInit :: forall a. Num a => a
numInit = a
8
getAggregateMaybe :: Measurement -> IO (Maybe Aggregate)
getAggregateMaybe Measurement
t1
| Benchmarkable -> Bool
perRun Benchmarkable
b = do
[Measurement]
ts <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a. Num a => a
numInit forall a. Num a => a -> a -> a
- Int
1) (Word64 -> Benchmarkable -> IO Measurement
measure' Word64
1 Benchmarkable
b)
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
$ [Measurement] -> Aggregate
initAgg (Measurement
t1forall a. a -> [a] -> [a]
:[Measurement]
ts)
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
go :: Word64 -> Measurement -> Word64 -> Maybe Aggregate -> IO Estimate
go :: Word64 -> Measurement -> Word64 -> Maybe Aggregate -> IO Estimate
go Word64
n Measurement
t1 Word64
sumOfTs Maybe Aggregate
mb_agg = do
let n' :: Word64
n' | Benchmarkable -> Bool
perRun Benchmarkable
b = Word64
1
| Bool
otherwise = Word64
2 forall a. Num a => a -> a -> a
* Word64
n
scale :: Word64 -> Word64
scale = (forall {a}. Integral a => a -> a -> a
`quot` Word64
n)
sumOfTs' :: Word64
sumOfTs' = Word64
sumOfTs forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t1
Measurement
t2 <- Word64 -> Benchmarkable -> IO Measurement
measure' Word64
n' Benchmarkable
b
let Estimate (Measurement Word64
meanN Word64
allocN Word64
copiedN Word64
maxMemN) Word64
stdevN =
case Maybe Aggregate
mb_agg of
Maybe Aggregate
Nothing -> Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2
Just Aggregate
agg -> Measurement -> Measurement -> Aggregate -> Estimate
aggToEstimate Measurement
t1 Measurement
t2 Aggregate
agg
isTimeoutSoon :: Bool
isTimeoutSoon =
case Timeout
cfgTimeout of
Timeout
NoTimeout -> Bool
False
Timeout Integer
us ->
let extra :: Word64
extra | Benchmarkable -> Bool
perRun Benchmarkable
b = (Word64
3 forall a. Num a => a -> a -> a
+ forall a. Num a => a
numInit) forall a. Num a => a -> a -> a
* Word64
meanN
| Bool
otherwise = Word64
3 forall a. Num a => a -> a -> a
* Measurement -> Word64
measTime Measurement
t2
divis :: Word64
divis = Word64
1000000 forall a. Num a => a -> a -> a
* Word64
10 forall {a}. Integral a => a -> a -> a
`quot` Word64
12
in (Word64
sumOfTs' forall a. Num a => a -> a -> a
+ Word64
extra) forall {a}. Integral a => a -> a -> a
`quot` Word64
divis forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
us
isStDevInTargetRange :: Bool
isStDevInTargetRange =
Word64
stdevN forall a. Ord a => a -> a -> Bool
< forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
cfgRelStDev forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
meanN)
meas :: Measurement
meas = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement (Word64 -> Word64
scale Word64
meanN) (Word64 -> Word64
scale Word64
allocN) (Word64 -> Word64
scale Word64
copiedN) Word64
maxMemN
mb_agg' :: Maybe Aggregate
mb_agg' = Word64 -> Aggregate -> Aggregate
updateAgg (Measurement -> Word64
measTime Measurement
t2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Aggregate
mb_agg
case Timeout
cfgTimeout of
Timeout
NoTimeout | Word64
sumOfTs' forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t2 forall a. Ord a => a -> a -> Bool
> Word64
100 forall a. Num a => a -> a -> a
* Word64
1000000000000 ->
Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$
[Char]
"\n" forall a. [a] -> [a] -> [a]
++
[Char]
"This benchmark takes more than 100 seconds.\n" forall a. [a] -> [a] -> [a]
++
[Char]
"Conosider setting --time-limit, if this is\n" forall a. [a] -> [a] -> [a]
++
[Char]
"unexpected (or to silence this warning)."
Timeout
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
if Bool
isStDevInTargetRange Bool -> Bool -> Bool
|| Bool
isTimeoutSoon
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Estimate {estMean :: Measurement
estMean = Measurement
meas, estStdev :: Word64
estStdev = Word64 -> Word64
scale Word64
stdevN}
else Word64 -> Measurement -> Word64 -> Maybe Aggregate -> IO Estimate
go Word64
n' Measurement
t2 Word64
sumOfTs' Maybe Aggregate
mb_agg'
data Aggregate = Aggregate
{ Aggregate -> Word64
aggCount :: {-# UNPACK #-} !Word64
, Aggregate -> Double
aggMean :: {-# UNPACK #-} !Double
, Aggregate -> Double
aggM2 :: {-# UNPACK #-} !Double
}
aggToEstimate :: Measurement -> Measurement -> Aggregate -> Estimate
aggToEstimate :: Measurement -> Measurement -> Aggregate -> Estimate
aggToEstimate (Measurement Word64
_ Word64
a1 Word64
c1 Word64
m1) (Measurement Word64
_ Word64
a2 Word64
c2 Word64
m2) Aggregate
agg = Estimate
est
where
est :: Estimate
est = Measurement -> Word64 -> Estimate
Estimate Measurement
mean Word64
stdev
mean :: Measurement
mean | Bool
hasGCStats = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
am' (forall {a}. Integral a => a -> a -> a
avg Word64
a1 Word64
a2) (forall {a}. Integral a => a -> a -> a
avg Word64
c1 Word64
c2) (forall a. Ord a => a -> a -> a
max Word64
m1 Word64
m2)
| Bool
otherwise = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
am' Word64
0 Word64
0 Word64
0
avg :: a -> a -> a
avg a
a a
b = (a
a forall a. Num a => a -> a -> a
+ a
b) forall {a}. Integral a => a -> a -> a
`quot` a
2
stdev :: Word64
stdev = forall a b. (RealFrac a, Integral b) => a -> b
truncate (forall a. Floating a => a -> a
sqrt (Aggregate -> Double
aggM2 Aggregate
agg forall a. Fractional a => a -> a -> a
/ Word64 -> Double
word64ToDouble (Aggregate -> Word64
aggCount Aggregate
agg forall a. Num a => a -> a -> a
- Word64
1)))
am' :: Word64
am' = forall a b. (RealFrac a, Integral b) => a -> b
truncate (Aggregate -> Double
aggMean Aggregate
agg)
updateAgg :: Word64 -> Aggregate -> Aggregate
updateAgg :: Word64 -> Aggregate -> Aggregate
updateAgg Word64
t (Aggregate Word64
n Double
am Double
am2) = Word64 -> Double -> Double -> Aggregate
Aggregate Word64
n' Double
am' Double
am2'
where
n' :: Word64
n' = Word64
n forall a. Num a => a -> a -> a
+ Word64
1
am' :: Double
am' = Double
am forall a. Num a => a -> a -> a
+ (Double
delta forall a. Fractional a => a -> a -> a
/ Word64 -> Double
word64ToDouble Word64
n')
am2' :: Double
am2' = Double
am2 forall a. Num a => a -> a -> a
+ (Double
delta forall a. Num a => a -> a -> a
* Double
delta2)
delta :: Double
delta = Double
t' forall a. Num a => a -> a -> a
- Double
am
delta2 :: Double
delta2 = Double
t' forall a. Num a => a -> a -> a
- Double
am'
t' :: Double
t' = Word64 -> Double
word64ToDouble Word64
t
initAgg :: [Measurement] -> Aggregate
initAgg :: [Measurement] -> Aggregate
initAgg [Measurement]
ms = Aggregate {aggCount :: Word64
aggCount = forall a. Num a => a
n, aggMean :: Double
aggMean = Double
mean0, aggM2 :: Double
aggM2 = Double
m20}
where
n :: Num a => a
n :: forall a. Num a => a
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Measurement]
ms)
mean0 :: Double
mean0 = Word64 -> Double
word64ToDouble (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime) Word64
0 [Measurement]
ms) forall a. Fractional a => a -> a -> a
/ forall a. Num a => a
n
m20 :: Double
m20 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. Num a => a -> a -> a
(+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Double
sqrdiff) Double
0 [Measurement]
ms forall a. Fractional a => a -> a -> a
/ (forall a. Num a => a
n forall a. Num a => a -> a -> a
- Double
1)
sqrdiff :: Measurement -> Double
sqrdiff Measurement
t = forall a. Num a => a -> a
sqr (Double
mean0 forall a. Num a => a -> a -> a
- Word64 -> Double
word64ToDouble (Measurement -> Word64
measTime Measurement
t))
#if !MIN_VERSION_base(4,10,0) && MIN_VERSION_base(4,6,0)
int64ToWord64 :: Int64 -> Word64
int64ToWord64 = fromIntegral
{-# INLINE int64ToWord64 #-}
#endif
int64ToDouble :: Int64 -> Double
int64ToDouble :: Int64 -> Double
int64ToDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE int64ToDouble #-}
word64ToInt64 :: Word64 -> Int64
word64ToInt64 :: Word64 -> Int64
word64ToInt64 = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE word64ToInt64 #-}
word64ToDouble :: Word64 -> Double
word64ToDouble :: Word64 -> Double
word64ToDouble = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE word64ToDouble #-}
#if !MIN_VERSION_base(4,15,0)
data SPEC = SPEC
{-# ANN type SPEC ForceSpecConstr #-}
#endif
funcToBench :: (b -> c) -> (a -> b) -> a -> Word64 -> IO ()
funcToBench :: forall b c a. (b -> c) -> (a -> b) -> a -> Word64 -> IO ()
funcToBench b -> c
frc = forall {t} {t}.
(Eq t, Num t) =>
SPEC -> (t -> b) -> t -> t -> IO ()
benchLoop SPEC
SPEC
where
benchLoop :: SPEC -> (t -> b) -> t -> t -> IO ()
benchLoop !SPEC
_ t -> b
f t
x t
n
| t
n forall a. Eq a => a -> a -> Bool
== t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- forall a. a -> IO a
evaluate (t -> b
f t
x)
b -> c
frc b
val seq :: forall a b. a -> b -> b
`seq` SPEC -> (t -> b) -> t -> t -> IO ()
benchLoop SPEC
SPEC t -> b
f t
x (t
n forall a. Num a => a -> a -> a
- t
1)
{-# NOINLINE funcToBench #-}
ioToBench :: (a -> b) -> IO a -> (Word64 -> IO ())
ioToBench :: forall a b. (a -> b) -> IO a -> Word64 -> IO ()
ioToBench a -> b
frc IO a
a = forall {t}. (Eq t, Num t) => t -> IO ()
go
where
go :: t -> IO ()
go t
n
| t
n forall a. Eq a => a -> a -> Bool
== t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
a
val <- IO a
a
a -> b
frc a
val seq :: forall a b. a -> b -> b
`seq` t -> IO ()
go (t
n forall a. Num a => a -> a -> a
- t
1)
{-# NOINLINE ioToBench #-}
ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBench :: forall b c a. (b -> c) -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBench b -> c
frc a -> IO b
f a
x = forall {t}. (Ord t, Num t) => t -> IO ()
go
where
go :: t -> IO ()
go t
n
| t
n forall a. Ord a => a -> a -> Bool
<= t
0 = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
b
val <- a -> IO b
f a
x
b -> c
frc b
val seq :: forall a b. a -> b -> b
`seq` t -> IO ()
go (t
n forall a. Num a => a -> a -> a
- t
1)
{-# NOINLINE ioFuncToBench #-}
#if defined(mingw32_HOST_OS)
# if defined(i386_HOST_ARCH)
foreign import stdcall unsafe "windows.h GetConsoleOutputCP"
getConsoleOutputCP :: IO Word32
foreign import stdcall unsafe "windows.h SetConsoleOutputCP"
setConsoleOutputCP :: Word32 -> IO ()
# else
foreign import ccall unsafe "windows.h GetConsoleOutputCP"
getConsoleOutputCP :: IO Word32
foreign import ccall unsafe "windows.h SetConsoleOutputCP"
setConsoleOutputCP :: Word32 -> IO ()
# endif
#endif