{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface,
ScopedTypeVariables #-}
module Criterion.Measurement
(
initializeTime
, getTime
, getCPUTime
, getCycles
, getGCStatistics
, GCStatistics(..)
, secs
, measure
, runBenchmark
, runBenchmarkable
, runBenchmarkable_
, measured
, applyGCStatistics
, threshold
) where
import Criterion.Measurement.Types (Benchmarkable(..), Measured(..))
import Control.DeepSeq (NFData(rnf))
import Control.Exception (finally,evaluate)
import Data.Data (Data, Typeable)
import Data.Int (Int64)
import Data.List (unfoldr)
import Data.Word (Word64)
import GHC.Generics (Generic)
#if MIN_VERSION_base(4,10,0)
import GHC.Stats (RTSStats(..), GCDetails(..))
#else
import GHC.Stats (GCStats(..))
#endif
import Prelude ()
import Prelude.Compat
#if MIN_VERSION_base(4,7,0)
import System.Mem (performGC, performMinorGC)
# else
import System.Mem (performGC)
#endif
import Text.Printf (printf)
import qualified Control.Exception as Exc
import qualified Data.Vector as V
import qualified GHC.Stats as Stats
#if !(MIN_VERSION_base(4,7,0))
foreign import ccall "performGC" performMinorGC :: IO ()
#endif
data GCStatistics = GCStatistics
{
GCStatistics -> Int64
gcStatsBytesAllocated :: !Int64
, GCStatistics -> Int64
gcStatsNumGcs :: !Int64
, GCStatistics -> Int64
gcStatsMaxBytesUsed :: !Int64
, GCStatistics -> Int64
gcStatsNumByteUsageSamples :: !Int64
, GCStatistics -> Int64
gcStatsCumulativeBytesUsed :: !Int64
, GCStatistics -> Int64
gcStatsBytesCopied :: !Int64
, GCStatistics -> Int64
gcStatsCurrentBytesUsed :: !Int64
, GCStatistics -> Int64
gcStatsCurrentBytesSlop :: !Int64
, GCStatistics -> Int64
gcStatsMaxBytesSlop :: !Int64
, GCStatistics -> Int64
gcStatsPeakMegabytesAllocated :: !Int64
, GCStatistics -> Double
gcStatsMutatorCpuSeconds :: !Double
, GCStatistics -> Double
gcStatsMutatorWallSeconds :: !Double
, GCStatistics -> Double
gcStatsGcCpuSeconds :: !Double
, GCStatistics -> Double
gcStatsGcWallSeconds :: !Double
, GCStatistics -> Double
gcStatsCpuSeconds :: !Double
, GCStatistics -> Double
gcStatsWallSeconds :: !Double
} deriving (GCStatistics -> GCStatistics -> Bool
(GCStatistics -> GCStatistics -> Bool)
-> (GCStatistics -> GCStatistics -> Bool) -> Eq GCStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GCStatistics -> GCStatistics -> Bool
$c/= :: GCStatistics -> GCStatistics -> Bool
== :: GCStatistics -> GCStatistics -> Bool
$c== :: GCStatistics -> GCStatistics -> Bool
Eq, ReadPrec [GCStatistics]
ReadPrec GCStatistics
Int -> ReadS GCStatistics
ReadS [GCStatistics]
(Int -> ReadS GCStatistics)
-> ReadS [GCStatistics]
-> ReadPrec GCStatistics
-> ReadPrec [GCStatistics]
-> Read GCStatistics
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GCStatistics]
$creadListPrec :: ReadPrec [GCStatistics]
readPrec :: ReadPrec GCStatistics
$creadPrec :: ReadPrec GCStatistics
readList :: ReadS [GCStatistics]
$creadList :: ReadS [GCStatistics]
readsPrec :: Int -> ReadS GCStatistics
$creadsPrec :: Int -> ReadS GCStatistics
Read, Int -> GCStatistics -> ShowS
[GCStatistics] -> ShowS
GCStatistics -> String
(Int -> GCStatistics -> ShowS)
-> (GCStatistics -> String)
-> ([GCStatistics] -> ShowS)
-> Show GCStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GCStatistics] -> ShowS
$cshowList :: [GCStatistics] -> ShowS
show :: GCStatistics -> String
$cshow :: GCStatistics -> String
showsPrec :: Int -> GCStatistics -> ShowS
$cshowsPrec :: Int -> GCStatistics -> ShowS
Show, Typeable, Typeable GCStatistics
DataType
Constr
Typeable GCStatistics
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCStatistics -> c GCStatistics)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCStatistics)
-> (GCStatistics -> Constr)
-> (GCStatistics -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCStatistics))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCStatistics))
-> ((forall b. Data b => b -> b) -> GCStatistics -> GCStatistics)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r)
-> (forall u. (forall d. Data d => d -> u) -> GCStatistics -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> GCStatistics -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics)
-> Data GCStatistics
GCStatistics -> DataType
GCStatistics -> Constr
(forall b. Data b => b -> b) -> GCStatistics -> GCStatistics
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCStatistics -> c GCStatistics
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCStatistics
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> GCStatistics -> u
forall u. (forall d. Data d => d -> u) -> GCStatistics -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCStatistics
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCStatistics -> c GCStatistics
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCStatistics)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCStatistics)
$cGCStatistics :: Constr
$tGCStatistics :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
gmapMp :: (forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
gmapM :: (forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> GCStatistics -> m GCStatistics
gmapQi :: Int -> (forall d. Data d => d -> u) -> GCStatistics -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GCStatistics -> u
gmapQ :: (forall d. Data d => d -> u) -> GCStatistics -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GCStatistics -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GCStatistics -> r
gmapT :: (forall b. Data b => b -> b) -> GCStatistics -> GCStatistics
$cgmapT :: (forall b. Data b => b -> b) -> GCStatistics -> GCStatistics
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCStatistics)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GCStatistics)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GCStatistics)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GCStatistics)
dataTypeOf :: GCStatistics -> DataType
$cdataTypeOf :: GCStatistics -> DataType
toConstr :: GCStatistics -> Constr
$ctoConstr :: GCStatistics -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCStatistics
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GCStatistics
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCStatistics -> c GCStatistics
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GCStatistics -> c GCStatistics
$cp1Data :: Typeable GCStatistics
Data, (forall x. GCStatistics -> Rep GCStatistics x)
-> (forall x. Rep GCStatistics x -> GCStatistics)
-> Generic GCStatistics
forall x. Rep GCStatistics x -> GCStatistics
forall x. GCStatistics -> Rep GCStatistics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GCStatistics x -> GCStatistics
$cfrom :: forall x. GCStatistics -> Rep GCStatistics x
Generic)
getGCStatistics :: IO (Maybe GCStatistics)
#if MIN_VERSION_base(4,10,0)
getGCStatistics :: IO (Maybe GCStatistics)
getGCStatistics = do
RTSStats
stats <- IO RTSStats
Stats.getRTSStats
let gcdetails :: Stats.GCDetails
gcdetails :: GCDetails
gcdetails = RTSStats -> GCDetails
gc RTSStats
stats
nsToSecs :: Int64 -> Double
nsToSecs :: Int64 -> Double
nsToSecs Int64
ns = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ns Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.0E-9
Maybe GCStatistics -> IO (Maybe GCStatistics)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe GCStatistics -> IO (Maybe GCStatistics))
-> Maybe GCStatistics -> IO (Maybe GCStatistics)
forall a b. (a -> b) -> a -> b
$ GCStatistics -> Maybe GCStatistics
forall a. a -> Maybe a
Just GCStatistics :: Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> GCStatistics
GCStatistics {
gcStatsBytesAllocated :: Int64
gcStatsBytesAllocated = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
allocated_bytes RTSStats
stats
, gcStatsNumGcs :: Int64
gcStatsNumGcs = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Word32 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
gcs RTSStats
stats
, gcStatsMaxBytesUsed :: Int64
gcStatsMaxBytesUsed = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
max_live_bytes RTSStats
stats
, gcStatsNumByteUsageSamples :: Int64
gcStatsNumByteUsageSamples = Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int64) -> Word32 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
major_gcs RTSStats
stats
, gcStatsCumulativeBytesUsed :: Int64
gcStatsCumulativeBytesUsed = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
cumulative_live_bytes RTSStats
stats
, gcStatsBytesCopied :: Int64
gcStatsBytesCopied = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
copied_bytes RTSStats
stats
, gcStatsCurrentBytesUsed :: Int64
gcStatsCurrentBytesUsed = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ GCDetails -> Word64
gcdetails_live_bytes GCDetails
gcdetails
, gcStatsCurrentBytesSlop :: Int64
gcStatsCurrentBytesSlop = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ GCDetails -> Word64
gcdetails_slop_bytes GCDetails
gcdetails
, gcStatsMaxBytesSlop :: Int64
gcStatsMaxBytesSlop = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
max_slop_bytes RTSStats
stats
, gcStatsPeakMegabytesAllocated :: Int64
gcStatsPeakMegabytesAllocated = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (RTSStats -> Word64
max_mem_in_use_bytes RTSStats
stats) Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`quot` (Int64
1024Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
*Int64
1024)
, gcStatsMutatorCpuSeconds :: Double
gcStatsMutatorCpuSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
mutator_cpu_ns RTSStats
stats
, gcStatsMutatorWallSeconds :: Double
gcStatsMutatorWallSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
mutator_elapsed_ns RTSStats
stats
, gcStatsGcCpuSeconds :: Double
gcStatsGcCpuSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
gc_cpu_ns RTSStats
stats
, gcStatsGcWallSeconds :: Double
gcStatsGcWallSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
gc_elapsed_ns RTSStats
stats
, gcStatsCpuSeconds :: Double
gcStatsCpuSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
cpu_ns RTSStats
stats
, gcStatsWallSeconds :: Double
gcStatsWallSeconds = Int64 -> Double
nsToSecs (Int64 -> Double) -> Int64 -> Double
forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
elapsed_ns RTSStats
stats
}
IO (Maybe GCStatistics)
-> (SomeException -> IO (Maybe GCStatistics))
-> IO (Maybe GCStatistics)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exc.catch`
\(SomeException
_::Exc.SomeException) -> Maybe GCStatistics -> IO (Maybe GCStatistics)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GCStatistics
forall a. Maybe a
Nothing
#else
getGCStatistics = do
stats <- Stats.getGCStats
return $ Just GCStatistics {
gcStatsBytesAllocated = bytesAllocated stats
, gcStatsNumGcs = numGcs stats
, gcStatsMaxBytesUsed = maxBytesUsed stats
, gcStatsNumByteUsageSamples = numByteUsageSamples stats
, gcStatsCumulativeBytesUsed = cumulativeBytesUsed stats
, gcStatsBytesCopied = bytesCopied stats
, gcStatsCurrentBytesUsed = currentBytesUsed stats
, gcStatsCurrentBytesSlop = currentBytesSlop stats
, gcStatsMaxBytesSlop = maxBytesSlop stats
, gcStatsPeakMegabytesAllocated = peakMegabytesAllocated stats
, gcStatsMutatorCpuSeconds = mutatorCpuSeconds stats
, gcStatsMutatorWallSeconds = mutatorWallSeconds stats
, gcStatsGcCpuSeconds = gcCpuSeconds stats
, gcStatsGcWallSeconds = gcWallSeconds stats
, gcStatsCpuSeconds = cpuSeconds stats
, gcStatsWallSeconds = wallSeconds stats
}
`Exc.catch`
\(_::Exc.SomeException) -> return Nothing
#endif
measure :: Benchmarkable
-> Int64
-> IO (Measured, Double)
measure :: Benchmarkable -> Int64 -> IO (Measured, Double)
measure Benchmarkable
bm Int64
iters = Benchmarkable
-> Int64
-> ((Measured, Double) -> (Measured, Double) -> (Measured, Double))
-> (Int64 -> IO () -> IO (Measured, Double))
-> IO (Measured, Double)
forall a.
Benchmarkable
-> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable Benchmarkable
bm Int64
iters (Measured, Double) -> (Measured, Double) -> (Measured, Double)
addResults ((Int64 -> IO () -> IO (Measured, Double))
-> IO (Measured, Double))
-> (Int64 -> IO () -> IO (Measured, Double))
-> IO (Measured, Double)
forall a b. (a -> b) -> a -> b
$ \ !Int64
n IO ()
act -> do
IO ()
performMinorGC
IO ()
initializeTime
Maybe GCStatistics
startStats <- IO (Maybe GCStatistics)
getGCStatistics
Double
startTime <- IO Double
getTime
Double
startCpuTime <- IO Double
getCPUTime
Word64
startCycles <- IO Word64
getCycles
IO ()
act
Double
endTime <- IO Double
getTime
Double
endCpuTime <- IO Double
getCPUTime
Word64
endCycles <- IO Word64
getCycles
Maybe GCStatistics
endStatsPreGC <- IO (Maybe GCStatistics)
getGCStatistics
IO ()
performMinorGC
Maybe GCStatistics
endStatsPostGC <- IO (Maybe GCStatistics)
getGCStatistics
let !m :: Measured
m = Maybe GCStatistics
-> Maybe GCStatistics -> Maybe GCStatistics -> Measured -> Measured
applyGCStatistics Maybe GCStatistics
endStatsPostGC Maybe GCStatistics
endStatsPreGC Maybe GCStatistics
startStats (Measured -> Measured) -> Measured -> Measured
forall a b. (a -> b) -> a -> b
$ Measured
measured {
measTime :: Double
measTime = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
endTime Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
startTime)
, measCpuTime :: Double
measCpuTime = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Double
endCpuTime Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
startCpuTime)
, measCycles :: Int64
measCycles = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 (Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
endCycles Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startCycles))
, measIters :: Int64
measIters = Int64
n
}
(Measured, Double) -> IO (Measured, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Measured
m, Double
endTime)
where
addResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)
addResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)
addResults (!Measured
m1, Double
_) (!Measured
m2, !Double
d2) = (Measured
m3, Double
d2)
where
add :: (Measured -> a) -> a
add Measured -> a
f = Measured -> a
f Measured
m1 a -> a -> a
forall a. Num a => a -> a -> a
+ Measured -> a
f Measured
m2
m3 :: Measured
m3 = Measured :: Double
-> Double
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Double
-> Double
-> Double
-> Double
-> Measured
Measured
{ measTime :: Double
measTime = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measTime
, measCpuTime :: Double
measCpuTime = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measCpuTime
, measCycles :: Int64
measCycles = (Measured -> Int64) -> Int64
forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measCycles
, measIters :: Int64
measIters = (Measured -> Int64) -> Int64
forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measIters
, measAllocated :: Int64
measAllocated = (Measured -> Int64) -> Int64
forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measAllocated
, measNumGcs :: Int64
measNumGcs = (Measured -> Int64) -> Int64
forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measNumGcs
, measBytesCopied :: Int64
measBytesCopied = (Measured -> Int64) -> Int64
forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measBytesCopied
, measMutatorWallSeconds :: Double
measMutatorWallSeconds = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measMutatorWallSeconds
, measMutatorCpuSeconds :: Double
measMutatorCpuSeconds = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measMutatorCpuSeconds
, measGcWallSeconds :: Double
measGcWallSeconds = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measGcWallSeconds
, measGcCpuSeconds :: Double
measGcCpuSeconds = (Measured -> Double) -> Double
forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measGcCpuSeconds
}
{-# INLINE measure #-}
threshold :: Double
threshold :: Double
threshold = Double
0.03
{-# INLINE threshold #-}
runBenchmarkable :: Benchmarkable -> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable :: Benchmarkable
-> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable Benchmarkable{Bool
a -> Int64 -> IO ()
Int64 -> IO a
Int64 -> a -> IO ()
perRun :: Benchmarkable -> Bool
runRepeatedly :: ()
cleanEnv :: ()
allocEnv :: ()
perRun :: Bool
runRepeatedly :: a -> Int64 -> IO ()
cleanEnv :: Int64 -> a -> IO ()
allocEnv :: Int64 -> IO a
..} Int64
i a -> a -> a
comb Int64 -> IO () -> IO a
f
| Bool
perRun = IO a
work IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int64 -> a -> IO a
forall t. (Eq t, Num t) => t -> a -> IO a
go (Int64
i Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1)
| Bool
otherwise = IO a
work
where
go :: t -> a -> IO a
go t
0 a
result = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
go !t
n !a
result = IO a
work IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> a -> IO a
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1) (a -> IO a) -> (a -> a) -> a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
comb a
result
count :: Int64
count | Bool
perRun = Int64
1
| Bool
otherwise = Int64
i
work :: IO a
work = do
a
env <- Int64 -> IO a
allocEnv Int64
count
let clean :: IO ()
clean = Int64 -> a -> IO ()
cleanEnv Int64
count a
env
run :: IO ()
run = a -> Int64 -> IO ()
runRepeatedly a
env Int64
count
IO ()
clean IO () -> IO () -> IO ()
`seq` IO ()
run IO () -> IO () -> IO ()
`seq` () -> IO ()
forall a. a -> IO a
evaluate (() -> IO ()) -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> ()
forall a. NFData a => a -> ()
rnf a
env
Int64 -> IO () -> IO a
f Int64
count IO ()
run IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` IO ()
clean
{-# INLINE work #-}
{-# INLINE runBenchmarkable #-}
runBenchmarkable_ :: Benchmarkable -> Int64 -> IO ()
runBenchmarkable_ :: Benchmarkable -> Int64 -> IO ()
runBenchmarkable_ Benchmarkable
bm Int64
i = Benchmarkable
-> Int64 -> (() -> () -> ()) -> (Int64 -> IO () -> IO ()) -> IO ()
forall a.
Benchmarkable
-> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable Benchmarkable
bm Int64
i (\() () -> ()) ((IO () -> IO ()) -> Int64 -> IO () -> IO ()
forall a b. a -> b -> a
const IO () -> IO ()
forall a. a -> a
id)
{-# INLINE runBenchmarkable_ #-}
runBenchmark :: Benchmarkable
-> Double
-> IO (V.Vector Measured, Double)
runBenchmark :: Benchmarkable -> Double -> IO (Vector Measured, Double)
runBenchmark Benchmarkable
bm Double
timeLimit = do
IO ()
initializeTime
Benchmarkable -> Int64 -> IO ()
runBenchmarkable_ Benchmarkable
bm Int64
1
Double
start <- IO ()
performGC IO () -> IO Double -> IO Double
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO Double
getTime
let loop :: [Int64]
-> Double -> Int -> [Measured] -> IO (Vector Measured, Double)
loop [] !Double
_ !Int
_ [Measured]
_ = String -> IO (Vector Measured, Double)
forall a. HasCallStack => String -> a
error String
"unpossible!"
loop (Int64
iters:[Int64]
niters) Double
prev Int
count [Measured]
acc = do
(Measured
m, Double
endTime) <- Benchmarkable -> Int64 -> IO (Measured, Double)
measure Benchmarkable
bm Int64
iters
let overThresh :: Double
overThresh = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 (Measured -> Double
measTime Measured
m Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
threshold) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
prev
if Double
endTime Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
timeLimit Bool -> Bool -> Bool
&&
Double
overThresh Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
threshold Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
10 Bool -> Bool -> Bool
&&
Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
4 :: Int)
then do
let !v :: Vector Measured
v = Vector Measured -> Vector Measured
forall a. Vector a -> Vector a
V.reverse ([Measured] -> Vector Measured
forall a. [a] -> Vector a
V.fromList [Measured]
acc)
(Vector Measured, Double) -> IO (Vector Measured, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Measured
v, Double
endTime Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
start)
else [Int64]
-> Double -> Int -> [Measured] -> IO (Vector Measured, Double)
loop [Int64]
niters Double
overThresh (Int
countInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Measured
mMeasured -> [Measured] -> [Measured]
forall a. a -> [a] -> [a]
:[Measured]
acc)
[Int64]
-> Double -> Int -> [Measured] -> IO (Vector Measured, Double)
loop ([Int64] -> [Int64]
forall a. Eq a => [a] -> [a]
squish ((Double -> Maybe (Int64, Double)) -> Double -> [Int64]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Double -> Maybe (Int64, Double)
series Double
1)) Double
0 Int
0 []
squish :: (Eq a) => [a] -> [a]
squish :: [a] -> [a]
squish [a]
ys = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [a] -> [a]
forall a. Eq a => a -> [a] -> [a]
go [] [a]
ys
where go :: a -> [a] -> [a]
go a
x [a]
xs = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs
series :: Double -> Maybe (Int64, Double)
series :: Double -> Maybe (Int64, Double)
series Double
k = (Int64, Double) -> Maybe (Int64, Double)
forall a. a -> Maybe a
Just (Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
l, Double
l)
where l :: Double
l = Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1.05
measured :: Measured
measured :: Measured
measured = Measured :: Double
-> Double
-> Int64
-> Int64
-> Int64
-> Int64
-> Int64
-> Double
-> Double
-> Double
-> Double
-> Measured
Measured {
measTime :: Double
measTime = Double
0
, measCpuTime :: Double
measCpuTime = Double
0
, measCycles :: Int64
measCycles = Int64
0
, measIters :: Int64
measIters = Int64
0
, measAllocated :: Int64
measAllocated = Int64
forall a. Bounded a => a
minBound
, measNumGcs :: Int64
measNumGcs = Int64
forall a. Bounded a => a
minBound
, measBytesCopied :: Int64
measBytesCopied = Int64
forall a. Bounded a => a
minBound
, measMutatorWallSeconds :: Double
measMutatorWallSeconds = Double
bad
, measMutatorCpuSeconds :: Double
measMutatorCpuSeconds = Double
bad
, measGcWallSeconds :: Double
measGcWallSeconds = Double
bad
, measGcCpuSeconds :: Double
measGcCpuSeconds = Double
bad
} where bad :: Double
bad = -Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0
applyGCStatistics :: Maybe GCStatistics
-> Maybe GCStatistics
-> Maybe GCStatistics
-> Measured
-> Measured
applyGCStatistics :: Maybe GCStatistics
-> Maybe GCStatistics -> Maybe GCStatistics -> Measured -> Measured
applyGCStatistics (Just GCStatistics
endPostGC) (Just GCStatistics
endPreGC) (Just GCStatistics
start) Measured
m = Measured
m {
measAllocated :: Int64
measAllocated = GCStatistics -> (GCStatistics -> Int64) -> Int64
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Int64
gcStatsBytesAllocated
, measNumGcs :: Int64
measNumGcs = GCStatistics -> (GCStatistics -> Int64) -> Int64
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPreGC GCStatistics -> Int64
gcStatsNumGcs
, measBytesCopied :: Int64
measBytesCopied = GCStatistics -> (GCStatistics -> Int64) -> Int64
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Int64
gcStatsBytesCopied
, measMutatorWallSeconds :: Double
measMutatorWallSeconds = GCStatistics -> (GCStatistics -> Double) -> Double
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Double
gcStatsMutatorWallSeconds
, measMutatorCpuSeconds :: Double
measMutatorCpuSeconds = GCStatistics -> (GCStatistics -> Double) -> Double
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Double
gcStatsMutatorCpuSeconds
, measGcWallSeconds :: Double
measGcWallSeconds = GCStatistics -> (GCStatistics -> Double) -> Double
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPreGC GCStatistics -> Double
gcStatsGcWallSeconds
, measGcCpuSeconds :: Double
measGcCpuSeconds = GCStatistics -> (GCStatistics -> Double) -> Double
forall a. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPreGC GCStatistics -> Double
gcStatsGcCpuSeconds
} where diff :: GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
a GCStatistics -> a
f = GCStatistics -> a
f GCStatistics
a a -> a -> a
forall a. Num a => a -> a -> a
- GCStatistics -> a
f GCStatistics
start
applyGCStatistics Maybe GCStatistics
_ Maybe GCStatistics
_ Maybe GCStatistics
_ Measured
m = Measured
m
secs :: Double -> String
secs :: Double -> String
secs Double
k
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
: Double -> String
secs (-Double
k)
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Double
k Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"s"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-3 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e3) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"ms"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-6 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e6) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"μs"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-9 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e9) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"ns"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-12 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e12) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"ps"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-15 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e15) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"fs"
| Double
k Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e-18 = (Double
kDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
1e18) Double -> ShowS
forall p. PrintfType p => Double -> String -> p
`with` String
"as"
| Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%g s" Double
k
where with :: Double -> String -> p
with (Double
t :: Double) (String
u :: String)
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e9 = String -> Double -> String -> p
forall r. PrintfType r => String -> r
printf String
"%.4g %s" Double
t String
u
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e3 = String -> Double -> String -> p
forall r. PrintfType r => String -> r
printf String
"%.0f %s" Double
t String
u
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e2 = String -> Double -> String -> p
forall r. PrintfType r => String -> r
printf String
"%.1f %s" Double
t String
u
| Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1e1 = String -> Double -> String -> p
forall r. PrintfType r => String -> r
printf String
"%.2f %s" Double
t String
u
| Bool
otherwise = String -> Double -> String -> p
forall r. PrintfType r => String -> r
printf String
"%.3f %s" Double
t String
u
foreign import ccall unsafe "criterion_inittime" initializeTime :: IO ()
foreign import ccall unsafe "criterion_rdtsc" getCycles :: IO Word64
foreign import ccall unsafe "criterion_gettime" getTime :: IO Double
foreign import ccall unsafe "criterion_getcputime" getCPUTime :: IO Double