{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface,
    ScopedTypeVariables #-}

-- |
-- Module      : Criterion.Measurement
-- Copyright   : (c) 2009-2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Benchmark measurement code.

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

-- | Statistics about memory usage and the garbage collector. Apart from
-- 'gcStatsCurrentBytesUsed' and 'gcStatsCurrentBytesSlop' all are cumulative values since
-- the program started.
--
-- 'GCStatistics' is cargo-culted from the @GCStats@ data type that "GHC.Stats"
-- used to export. Since @GCStats@ was removed in GHC 8.4, @criterion@ uses
-- 'GCStatistics' to provide a backwards-compatible view of GC statistics.
data GCStatistics = GCStatistics
    { -- | Total number of bytes allocated
    GCStatistics -> Int64
gcStatsBytesAllocated :: !Int64
    -- | Number of garbage collections performed (any generation, major and
    -- minor)
    , GCStatistics -> Int64
gcStatsNumGcs :: !Int64
    -- | Maximum number of live bytes seen so far
    , GCStatistics -> Int64
gcStatsMaxBytesUsed :: !Int64
    -- | Number of byte usage samples taken, or equivalently
    -- the number of major GCs performed.
    , GCStatistics -> Int64
gcStatsNumByteUsageSamples :: !Int64
    -- | Sum of all byte usage samples, can be used with
    -- 'gcStatsNumByteUsageSamples' to calculate averages with
    -- arbitrary weighting (if you are sampling this record multiple
    -- times).
    , GCStatistics -> Int64
gcStatsCumulativeBytesUsed :: !Int64
    -- | Number of bytes copied during GC
    , GCStatistics -> Int64
gcStatsBytesCopied :: !Int64
    -- | Number of live bytes at the end of the last major GC
    , GCStatistics -> Int64
gcStatsCurrentBytesUsed :: !Int64
    -- | Current number of bytes lost to slop
    , GCStatistics -> Int64
gcStatsCurrentBytesSlop :: !Int64
    -- | Maximum number of bytes lost to slop at any one time so far
    , GCStatistics -> Int64
gcStatsMaxBytesSlop :: !Int64
    -- | Maximum number of megabytes allocated
    , GCStatistics -> Int64
gcStatsPeakMegabytesAllocated :: !Int64
    -- | CPU time spent running mutator threads.  This does not include
    -- any profiling overhead or initialization.
    , GCStatistics -> Double
gcStatsMutatorCpuSeconds :: !Double

    -- | Wall clock time spent running mutator threads.  This does not
    -- include initialization.
    , GCStatistics -> Double
gcStatsMutatorWallSeconds :: !Double
    -- | CPU time spent running GC
    , GCStatistics -> Double
gcStatsGcCpuSeconds :: !Double
    -- | Wall clock time spent running GC
    , GCStatistics -> Double
gcStatsGcWallSeconds :: !Double
    -- | Total CPU time elapsed since program start
    , GCStatistics -> Double
gcStatsCpuSeconds :: !Double
    -- | Total wall clock time elapsed since start
    , GCStatistics -> Double
gcStatsWallSeconds :: !Double
    } deriving (GCStatistics -> GCStatistics -> Bool
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]
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
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
GCStatistics -> DataType
GCStatistics -> Constr
(forall b. Data b => b -> b) -> GCStatistics -> 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)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
MonadPlus m =>
(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 (m :: * -> *).
Monad m =>
(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 :: forall u. Int -> (forall d. Data d => d -> u) -> GCStatistics -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> GCStatistics -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> GCStatistics -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GCStatistics -> [u]
gmapQr :: forall r r'.
(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 :: forall r r'.
(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 (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(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 (t :: * -> *) (c :: * -> *).
Typeable t =>
(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 (c :: * -> *).
(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 (c :: * -> *).
(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
Data, 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)

-- | Try to get GC statistics, bearing in mind that the GHC runtime
-- will throw an exception if statistics collection was not enabled
-- using \"@+RTS -T@\".
--
-- If you need guaranteed up-to-date stats, call 'performGC' first.
getGCStatistics :: IO (Maybe GCStatistics)
#if MIN_VERSION_base(4,10,0)
-- Use RTSStats/GCDetails to gather GC stats
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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
ns forall a. Num a => a -> a -> a
* Double
1.0E-9

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just GCStatistics {
      gcStatsBytesAllocated :: Int64
gcStatsBytesAllocated         = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
allocated_bytes RTSStats
stats
    , gcStatsNumGcs :: Int64
gcStatsNumGcs                 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
gcs RTSStats
stats
    , gcStatsMaxBytesUsed :: Int64
gcStatsMaxBytesUsed           = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
max_live_bytes RTSStats
stats
    , gcStatsNumByteUsageSamples :: Int64
gcStatsNumByteUsageSamples    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word32
major_gcs RTSStats
stats
    , gcStatsCumulativeBytesUsed :: Int64
gcStatsCumulativeBytesUsed    = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
cumulative_live_bytes RTSStats
stats
    , gcStatsBytesCopied :: Int64
gcStatsBytesCopied            = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
copied_bytes RTSStats
stats
    , gcStatsCurrentBytesUsed :: Int64
gcStatsCurrentBytesUsed       = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ GCDetails -> Word64
gcdetails_live_bytes GCDetails
gcdetails
    , gcStatsCurrentBytesSlop :: Int64
gcStatsCurrentBytesSlop       = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ GCDetails -> Word64
gcdetails_slop_bytes GCDetails
gcdetails
    , gcStatsMaxBytesSlop :: Int64
gcStatsMaxBytesSlop           = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
max_slop_bytes RTSStats
stats
    , gcStatsPeakMegabytesAllocated :: Int64
gcStatsPeakMegabytesAllocated = forall a b. (Integral a, Num b) => a -> b
fromIntegral (RTSStats -> Word64
max_mem_in_use_bytes RTSStats
stats) forall a. Integral a => a -> a -> a
`quot` (Int64
1024forall a. Num a => a -> a -> a
*Int64
1024)
    , gcStatsMutatorCpuSeconds :: Double
gcStatsMutatorCpuSeconds      = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
mutator_cpu_ns RTSStats
stats
    , gcStatsMutatorWallSeconds :: Double
gcStatsMutatorWallSeconds     = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
mutator_elapsed_ns RTSStats
stats
    , gcStatsGcCpuSeconds :: Double
gcStatsGcCpuSeconds           = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
gc_cpu_ns RTSStats
stats
    , gcStatsGcWallSeconds :: Double
gcStatsGcWallSeconds          = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
gc_elapsed_ns RTSStats
stats
    , gcStatsCpuSeconds :: Double
gcStatsCpuSeconds             = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
cpu_ns RTSStats
stats
    , gcStatsWallSeconds :: Double
gcStatsWallSeconds            = Int64 -> Double
nsToSecs forall a b. (a -> b) -> a -> b
$ RTSStats -> Int64
elapsed_ns RTSStats
stats
    }
 forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Exc.catch`
  \(SomeException
_::Exc.SomeException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
#else
-- Use the old GCStats type to gather GC stats
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 the execution of a benchmark a given number of times.
--
-- This function initializes the timer before measuring time (refer to the
-- documentation for 'initializeTime' for more details).
measure :: Benchmarkable        -- ^ Operation to benchmark.
        -> Int64                -- ^ Number of iterations.
        -> IO (Measured, Double)
measure :: Benchmarkable -> Int64 -> IO (Measured, Double)
measure Benchmarkable
bm Int64
iters = forall a.
Benchmarkable
-> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable Benchmarkable
bm Int64
iters (Measured, Double) -> (Measured, Double) -> (Measured, Double)
combineResults forall a b. (a -> b) -> a -> b
$ \ !Int64
n IO ()
act -> do
  -- Ensure the stats from getGCStatistics are up-to-date
  -- by garbage collecting. performMinorGC does /not/ update all stats, but
  -- it does update the ones we need (see applyGCStatistics for details.
  --
  -- We use performMinorGC instead of performGC to avoid the cost of copying
  -- the live data in the heap potentially hundreds of times in a
  -- single benchmark.
  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
  -- From these we can derive GC-related deltas.
  Maybe GCStatistics
endStatsPreGC <- IO (Maybe GCStatistics)
getGCStatistics
  IO ()
performMinorGC
  -- From these we can derive all other deltas, and performGC guarantees they
  -- are up-to-date.
  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 forall a b. (a -> b) -> a -> b
$ Measured
measured {
             measTime :: Double
measTime    = forall a. Ord a => a -> a -> a
max Double
0 (Double
endTime forall a. Num a => a -> a -> a
- Double
startTime)
           , measCpuTime :: Double
measCpuTime = forall a. Ord a => a -> a -> a
max Double
0 (Double
endCpuTime forall a. Num a => a -> a -> a
- Double
startCpuTime)
           , measCycles :: Int64
measCycles  = forall a. Ord a => a -> a -> a
max Int64
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
endCycles forall a. Num a => a -> a -> a
- Word64
startCycles))
           , measIters :: Int64
measIters   = Int64
n
           }
  forall (m :: * -> *) a. Monad m => a -> m a
return (Measured
m, Double
endTime)
  where
    -- When combining runs, the Measured value is accumulated over many runs,
    -- but the Double value is the most recent absolute measurement of time.
    combineResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)
    combineResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)
combineResults (!Measured
m1, Double
_) (!Measured
m2, !Double
d2) = (Measured
m3, Double
d2)
      where
        combine :: (a -> a -> a) -> (Measured -> a) -> a
        combine :: forall a. (a -> a -> a) -> (Measured -> a) -> a
combine a -> a -> a
g Measured -> a
sel = Measured -> a
sel Measured
m1 a -> a -> a
`g` Measured -> a
sel Measured
m2

        add :: Num a => (Measured -> a) -> a
        add :: forall a. Num a => (Measured -> a) -> a
add = forall a. (a -> a -> a) -> (Measured -> a) -> a
combine forall a. Num a => a -> a -> a
(+)

        m3 :: Measured
m3 = Measured
            { measTime :: Double
measTime               = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measTime
            , measCpuTime :: Double
measCpuTime            = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measCpuTime
            , measCycles :: Int64
measCycles             = forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measCycles
            , measIters :: Int64
measIters              = forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measIters

            , measAllocated :: Int64
measAllocated          = forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measAllocated
            , measPeakMbAllocated :: Int64
measPeakMbAllocated    = forall a. (a -> a -> a) -> (Measured -> a) -> a
combine forall a. Ord a => a -> a -> a
max Measured -> Int64
measPeakMbAllocated
            , measNumGcs :: Int64
measNumGcs             = forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measNumGcs
            , measBytesCopied :: Int64
measBytesCopied        = forall a. Num a => (Measured -> a) -> a
add Measured -> Int64
measBytesCopied
            , measMutatorWallSeconds :: Double
measMutatorWallSeconds = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measMutatorWallSeconds
            , measMutatorCpuSeconds :: Double
measMutatorCpuSeconds  = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measMutatorCpuSeconds
            , measGcWallSeconds :: Double
measGcWallSeconds      = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measGcWallSeconds
            , measGcCpuSeconds :: Double
measGcCpuSeconds       = forall a. Num a => (Measured -> a) -> a
add Measured -> Double
measGcCpuSeconds
            }
{-# INLINE measure #-}

-- | The amount of time a benchmark must run for in order for us to
-- have some trust in the raw measurement.
--
-- We set this threshold so that we can generate enough data to later
-- perform meaningful statistical analyses.
--
-- The threshold is 30 milliseconds. One use of 'runBenchmark' must
-- accumulate more than 300 milliseconds of total measurements above
-- this threshold before it will finish.
threshold :: Double
threshold :: Double
threshold = Double
0.03
{-# INLINE threshold #-}

runBenchmarkable :: Benchmarkable -> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable :: forall a.
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {t}. (Eq t, Num t) => t -> a -> IO a
go (Int64
i 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 = forall (m :: * -> *) a. Monad m => a -> m a
return a
result
    go !t
n !a
result = IO a
work forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= t -> a -> IO a
go (t
n forall a. Num a => a -> a -> a
- t
1) 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 seq :: forall a b. a -> b -> b
`seq` IO ()
run seq :: forall a b. a -> b -> b
`seq` forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> ()
rnf a
env

        Int64 -> IO () -> IO a
f Int64
count IO ()
run 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 = forall a.
Benchmarkable
-> Int64 -> (a -> a -> a) -> (Int64 -> IO () -> IO a) -> IO a
runBenchmarkable Benchmarkable
bm Int64
i (\() () -> ()) (forall a b. a -> b -> a
const forall a. a -> a
id)
{-# INLINE runBenchmarkable_ #-}

-- | Run a single benchmark, and return measurements collected while
-- executing it, along with the amount of time the measurement process
-- took.
--
-- This function initializes the timer before measuring time (refer to the
-- documentation for 'initializeTime' for more details).
runBenchmark :: Benchmarkable
             -> Double
             -- ^ Lower bound on how long the benchmarking process
             -- should take.  In practice, this time limit may be
             -- exceeded in order to generate enough data to perform
             -- meaningful statistical analyses.
             -> 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 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]
_ = 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 = forall a. Ord a => a -> a -> a
max Double
0 (Measured -> Double
measTime Measured
m forall a. Num a => a -> a -> a
- Double
threshold) forall a. Num a => a -> a -> a
+ Double
prev
        -- We try to honour the time limit, but we also have more
        -- important constraints:
        --
        -- We must generate enough data that bootstrapping won't
        -- simply crash.
        --
        -- We need to generate enough measurements that have long
        -- spans of execution to outweigh the (rather high) cost of
        -- measurement.
        if Double
endTime forall a. Num a => a -> a -> a
- Double
start forall a. Ord a => a -> a -> Bool
>= Double
timeLimit Bool -> Bool -> Bool
&&
           Double
overThresh forall a. Ord a => a -> a -> Bool
> Double
threshold forall a. Num a => a -> a -> a
* Double
10 Bool -> Bool -> Bool
&&
           Int
count forall a. Ord a => a -> a -> Bool
>= (Int
4 :: Int)
          then do
            let !v :: Vector Measured
v = forall a. Vector a -> Vector a
V.reverse (forall a. [a] -> Vector a
V.fromList [Measured]
acc)
            forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Measured
v, Double
endTime forall a. Num a => a -> a -> a
- Double
start)
          else [Int64]
-> Double -> Int -> [Measured] -> IO (Vector Measured, Double)
loop [Int64]
niters Double
overThresh (Int
countforall a. Num a => a -> a -> a
+Int
1) (Measured
mforall a. a -> [a] -> [a]
:[Measured]
acc)
  [Int64]
-> Double -> Int -> [Measured] -> IO (Vector Measured, Double)
loop (forall a. Eq a => [a] -> [a]
squish (forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Double -> Maybe (Int64, Double)
series Double
1)) Double
0 Int
0 []

-- Our series starts its growth very slowly when we begin at 1, so we
-- eliminate repeated values.
squish :: (Eq a) => [a] -> [a]
squish :: forall a. Eq a => [a] -> [a]
squish [a]
ys = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. Eq a => a -> [a] -> [a]
go [] [a]
ys
  where go :: a -> [a] -> [a]
go a
x [a]
xs = a
x forall a. a -> [a] -> [a]
: forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs

series :: Double -> Maybe (Int64, Double)
series :: Double -> Maybe (Int64, Double)
series Double
k = forall a. a -> Maybe a
Just (forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
l, Double
l)
  where l :: Double
l = Double
k forall a. Num a => a -> a -> a
* Double
1.05

-- | An empty structure.
measured :: Measured
measured :: Measured
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          = forall a. Bounded a => a
minBound
    , measPeakMbAllocated :: Int64
measPeakMbAllocated    = forall a. Bounded a => a
minBound
    , measNumGcs :: Int64
measNumGcs             = forall a. Bounded a => a
minBound
    , measBytesCopied :: Int64
measBytesCopied        = 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
1forall a. Fractional a => a -> a -> a
/Double
0

-- | Apply the difference between two sets of GC statistics to a
-- measurement.
applyGCStatistics :: Maybe GCStatistics
                  -- ^ Statistics gathered at the __end__ of a run, post-GC.
                  -> Maybe GCStatistics
                  -- ^ Statistics gathered at the __end__ of a run, pre-GC.
                  -> Maybe GCStatistics
                  -- ^ Statistics gathered at the __beginning__ of a run.
                  -> Measured
                  -- ^ Value to \"modify\".
                  -> Measured
applyGCStatistics :: Maybe GCStatistics
-> Maybe GCStatistics -> Maybe GCStatistics -> Measured -> Measured
applyGCStatistics (Just GCStatistics
endPostGC) (Just GCStatistics
endPreGC) (Just GCStatistics
start) Measured
m = Measured
m {
    -- The choice of endPostGC or endPreGC is important.
    -- For bytes allocated/copied, and mutator statistics, we use
    -- endPostGC, because the intermediate performGC ensures they're up-to-date.
    -- The others (num GCs and GC cpu/wall seconds) must be diffed against
    -- endPreGC so that the extra performGC does not taint them.
    measAllocated :: Int64
measAllocated          = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Int64
gcStatsBytesAllocated
  , measPeakMbAllocated :: Int64
measPeakMbAllocated    = GCStatistics -> Int64
gcStatsPeakMegabytesAllocated GCStatistics
endPostGC
  , measNumGcs :: Int64
measNumGcs             = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPreGC  GCStatistics -> Int64
gcStatsNumGcs
  , measBytesCopied :: Int64
measBytesCopied        = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Int64
gcStatsBytesCopied
  , measMutatorWallSeconds :: Double
measMutatorWallSeconds = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Double
gcStatsMutatorWallSeconds
  , measMutatorCpuSeconds :: Double
measMutatorCpuSeconds  = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPostGC GCStatistics -> Double
gcStatsMutatorCpuSeconds
  , measGcWallSeconds :: Double
measGcWallSeconds      = forall {a}. Num a => GCStatistics -> (GCStatistics -> a) -> a
diff GCStatistics
endPreGC  GCStatistics -> Double
gcStatsGcWallSeconds
  , measGcCpuSeconds :: Double
measGcCpuSeconds       = 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 forall a. Num a => a -> a -> a
- GCStatistics -> a
f GCStatistics
start
applyGCStatistics Maybe GCStatistics
_ Maybe GCStatistics
_ Maybe GCStatistics
_ Measured
m = Measured
m

-- | Convert a number of seconds to a string.  The string will consist
-- of four decimal places, followed by a short description of the time
-- units.
secs :: Double -> String
secs :: Double -> String
secs Double
k
    | Double
k forall a. Ord a => a -> a -> Bool
< Double
0      = Char
'-' forall a. a -> [a] -> [a]
: Double -> String
secs (-Double
k)
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1     = Double
k        forall {t}. PrintfType t => Double -> String -> t
`with` String
"s"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-3  = (Double
kforall a. Num a => a -> a -> a
*Double
1e3)  forall {t}. PrintfType t => Double -> String -> t
`with` String
"ms"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-6  = (Double
kforall a. Num a => a -> a -> a
*Double
1e6)  forall {t}. PrintfType t => Double -> String -> t
`with` String
"μs"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-9  = (Double
kforall a. Num a => a -> a -> a
*Double
1e9)  forall {t}. PrintfType t => Double -> String -> t
`with` String
"ns"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-12 = (Double
kforall a. Num a => a -> a -> a
*Double
1e12) forall {t}. PrintfType t => Double -> String -> t
`with` String
"ps"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-15 = (Double
kforall a. Num a => a -> a -> a
*Double
1e15) forall {t}. PrintfType t => Double -> String -> t
`with` String
"fs"
    | Double
k forall a. Ord a => a -> a -> Bool
>= Double
1e-18 = (Double
kforall a. Num a => a -> a -> a
*Double
1e18) forall {t}. PrintfType t => Double -> String -> t
`with` String
"as"
    | Bool
otherwise  = forall r. PrintfType r => String -> r
printf String
"%g s" Double
k
     where with :: Double -> String -> t
with (Double
t :: Double) (String
u :: String)
               | Double
t forall a. Ord a => a -> a -> Bool
>= Double
1e9  = forall r. PrintfType r => String -> r
printf String
"%.4g %s" Double
t String
u
               | Double
t forall a. Ord a => a -> a -> Bool
>= Double
1e3  = forall r. PrintfType r => String -> r
printf String
"%.0f %s" Double
t String
u
               | Double
t forall a. Ord a => a -> a -> Bool
>= Double
1e2  = forall r. PrintfType r => String -> r
printf String
"%.1f %s" Double
t String
u
               | Double
t forall a. Ord a => a -> a -> Bool
>= Double
1e1  = forall r. PrintfType r => String -> r
printf String
"%.2f %s" Double
t String
u
               | Bool
otherwise = forall r. PrintfType r => String -> r
printf String
"%.3f %s" Double
t String
u

-- | Set up time measurement.
--
-- @criterion@ measures time using OS-specific APIs whenever possible for
-- efficiency. On certain operating systems, such as macOS and Windows, one
-- must explicitly initialize a timer (which 'initializeTime' accomplishes)
-- before one can actually measure the current time (which 'getTime'
-- accomplishes).
--
-- It is imperative that you call 'initializeTime' before calling 'getTime'.
-- (See [this bug report](https://github.com/haskell/criterion/issues/195) for an
-- example of what can happen if you do not do so.) All of the 'IO'-returning
-- functions in "Criterion.Main" make sure that this is done, but other
-- functions (such as those in "Criterion.Measurement") do not guarantee this
-- unless otherwise stated.
foreign import ccall unsafe "criterion_inittime" initializeTime :: IO ()

-- | Read the CPU cycle counter.
foreign import ccall unsafe "criterion_rdtsc" getCycles :: IO Word64

-- | Return the current wallclock time, in seconds since some
-- arbitrary time.
--
-- You /must/ call 'initializeTime' once before calling this function!
-- Refer to the documentation for 'initializeTime' for more details.
foreign import ccall unsafe "criterion_gettime" getTime :: IO Double

-- | Return the amount of elapsed CPU time, combining user and kernel
-- (system) time into a single measure.
foreign import ccall unsafe "criterion_getcputime" getCPUTime :: IO Double