{-# 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
(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)

-- | 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 = 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
-- 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 = 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)
combineResults ((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
  -- 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 (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
    -- 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 :: (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 :: (Measured -> a) -> a
add = (a -> a -> a) -> (Measured -> a) -> a
forall a. (a -> a -> a) -> (Measured -> a) -> a
combine a -> a -> a
forall a. Num a => a -> a -> a
(+)

        m3 :: Measured
m3 = Measured :: Double
-> Double
-> Int64
-> 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
            , measPeakMbAllocated :: Int64
measPeakMbAllocated    = (Int64 -> Int64 -> Int64) -> (Measured -> Int64) -> Int64
forall a. (a -> a -> a) -> (Measured -> a) -> a
combine Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Measured -> Int64
measPeakMbAllocated
            , 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 #-}

-- | 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 :: 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_ #-}

-- | 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 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
        -- 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 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 []

-- Our series starts its growth very slowly when we begin at 1, so we
-- eliminate repeated values.
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

-- | An empty structure.
measured :: Measured
measured :: Measured
measured = Measured :: Double
-> Double
-> Int64
-> 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
    , measPeakMbAllocated :: Int64
measPeakMbAllocated    = 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

-- | 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          = GCStatistics -> (GCStatistics -> Int64) -> Int64
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             = 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

-- | 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 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

-- | 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