criterion 1.3.0.0 → 1.4.0.0

raw patch · 11 files changed

+188/−86 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Criterion/Analysis.hs +2/−6
• Criterion/Measurement.hs +47/−16
• Criterion/Monad.hs +1/−20
• Criterion/Monad/Internal.hs +0/−1
• Criterion/Types.hs +45/−36
• Criterion/Types/Internal.hs +40/−1
• changelog.md +47/−0
• criterion.cabal +2/−2
• examples/ConduitVsPipes.hs +2/−2
• examples/criterion-examples.cabal +1/−1
• tests/Tests.hs +1/−1

@@ -37,7 +37,7 @@ import Control.Monad.Trans.Except import Criterion.IO.Printf (note, prolix) import Criterion.Measurement (secs, threshold)-import Criterion.Monad (Criterion, getGen, getOverhead)+import Criterion.Monad (Criterion, getGen) import Criterion.Types import Data.Int (Int64) import Data.Maybe (fromJust)@@ -142,16 +142,13 @@               -> ExceptT String Criterion Report analyseSample i name meas = do   Config{..} <- ask-  overhead <- lift getOverhead   let ests      = [Mean,StdDev]       -- The use of filter here throws away very-low-quality       -- measurements when bootstrapping the mean and standard       -- deviations.  Without this, the numbers look nonsensical when       -- very brief actions are measured.       stime     = measure (measTime . rescale) .-                  G.filter ((>= threshold) . measTime) . G.map fixTime .-                  G.tail $ meas-      fixTime m = m { measTime = measTime m - overhead / 2 }+                  G.filter ((>= threshold) . measTime) $ meas       n         = G.length meas       s         = G.length stime   _ <- lift $ prolix "bootstrapping with %d of %d samples (%d%%)\n"@@ -164,7 +161,6 @@       ov = outlierVariance estMean estStdDev (fromIntegral n)       an = SampleAnalysis {                anRegress    = rs-             , anOverhead   = overhead              , anMean       = estMean              , anStdDev     = estStdDev              , anOutlierVar = ov

@@ -49,12 +49,20 @@ #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.@@ -108,6 +116,8 @@ -- | 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@@ -170,16 +180,29 @@         -> Int64                -- ^ Number of iterations.         -> IO (Measured, Double) measure bm iters = runBenchmarkable bm iters addResults $ \ !n 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.+  performMinorGC   startStats <- getGCStatistics   startTime <- getTime   startCpuTime <- getCPUTime   startCycles <- getCycles   act-  endStats <- getGCStatistics   endTime <- getTime   endCpuTime <- getCPUTime   endCycles <- getCycles-  let !m = applyGCStatistics endStats startStats $ measured {+  -- From these we can derive GC-related deltas.+  endStatsPreGC <- getGCStatistics+  performMinorGC+  -- From these we can derive all other deltas, and performGC guarantees they+  -- are up-to-date.+  endStatsPostGC <- getGCStatistics+  let !m = applyGCStatistics endStatsPostGC endStatsPreGC startStats $ measured {              measTime    = max 0 (endTime - startTime)            , measCpuTime = max 0 (endCpuTime - startCpuTime)            , measCycles  = max 0 (fromIntegral (endCycles - startCycles))@@ -187,8 +210,10 @@            }   return (m, 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.     addResults :: (Measured, Double) -> (Measured, Double) -> (Measured, Double)-    addResults (!m1, !d1) (!m2, !d2) = (m3, d1 + d2)+    addResults (!m1, _) (!m2, !d2) = (m3, d2)       where         add f = f m1 + f m2 @@ -239,8 +264,7 @@          clean `seq` run `seq` evaluate $ rnf env -        performGC-        f count run `finally` clean <* performGC+        f count run `finally` clean     {-# INLINE work #-} {-# INLINE runBenchmarkable #-} @@ -313,22 +337,29 @@ -- | Apply the difference between two sets of GC statistics to a -- measurement. applyGCStatistics :: Maybe GCStatistics-                  -- ^ Statistics gathered at the __end__ of a run.+                  -- ^ 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 (Just end) (Just start) m = m {-    measAllocated          = diff gcStatsBytesAllocated-  , measNumGcs             = diff gcStatsNumGcs-  , measBytesCopied        = diff gcStatsBytesCopied-  , measMutatorWallSeconds = diff gcStatsMutatorWallSeconds-  , measMutatorCpuSeconds  = diff gcStatsMutatorCpuSeconds-  , measGcWallSeconds      = diff gcStatsGcWallSeconds-  , measGcCpuSeconds       = diff gcStatsGcCpuSeconds-  } where diff f = f end - f start-applyGCStatistics _ _ m = m+applyGCStatistics (Just endPostGC) (Just endPreGC) (Just start) m = 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          = diff endPostGC gcStatsBytesAllocated+  , measNumGcs             = diff endPreGC  gcStatsNumGcs+  , measBytesCopied        = diff endPostGC gcStatsBytesCopied+  , measMutatorWallSeconds = diff endPostGC gcStatsMutatorWallSeconds+  , measMutatorCpuSeconds  = diff endPostGC gcStatsMutatorCpuSeconds+  , measGcWallSeconds      = diff endPreGC  gcStatsGcWallSeconds+  , measGcCpuSeconds       = diff endPreGC  gcStatsGcCpuSeconds+  } where diff a f = f a - f start+applyGCStatistics _ _ _ m = 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

@@ -14,26 +14,20 @@       Criterion     , withConfig     , getGen-    , getOverhead     ) where  import Control.Monad.Reader (asks, runReaderT) import Control.Monad.Trans (liftIO)-import Control.Monad (when)-import Criterion.Measurement (measure, runBenchmark, secs) import Criterion.Monad.Internal (Criterion(..), Crit(..)) import Criterion.Types hiding (measure) import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Statistics.Regression (olsRegress) import System.Random.MWC (GenIO, createSystemRandom)-import qualified Data.Vector.Generic as G  -- | Run a 'Criterion' action with the given 'Config'. withConfig :: Config -> Criterion a -> IO a withConfig cfg (Criterion act) = do   g <- newIORef Nothing-  o <- newIORef Nothing-  runReaderT act (Crit cfg g o)+  runReaderT act (Crit cfg g)  -- | Return a random number generator, creating one if necessary. --@@ -41,19 +35,6 @@ -- call 'createSystemRandom' more than once if multiple threads race). getGen :: Criterion GenIO getGen = memoise gen createSystemRandom---- | Return an estimate of the measurement overhead.-getOverhead :: Criterion Double-getOverhead = do-  verbose <- asks ((== Verbose) . verbosity)-  memoise overhead $ do-    (meas,_) <- runBenchmark (whnfIO $ measure (whnfIO $ return ()) 1) 1-    let metric get = G.convert . G.map get $ meas-    let o = G.head . fst $-            olsRegress [metric (fromIntegral . measIters)] (metric measTime)-    when verbose . liftIO $-      putStrLn $ "measurement overhead " ++ secs o-    return o  -- | Memoise the result of an 'IO' action. --

@@ -29,7 +29,6 @@ data Crit = Crit {     config   :: !Config   , gen      :: !(IORef (Maybe GenIO))-  , overhead :: !(IORef (Maybe Double))   }  -- | The monad in which most criterion code executes.

@@ -57,8 +57,8 @@     , addPrefix     , benchNames     -- ** Evaluation control-    , whnf     , nf+    , whnf     , nfIO     , whnfIO     -- * Result types@@ -76,8 +76,7 @@ import Data.Semigroup  import Control.DeepSeq (NFData(rnf))-import Control.Exception (evaluate)-import Criterion.Types.Internal (fakeEnvironment)+import Criterion.Types.Internal (fakeEnvironment, nf', whnf') import Data.Aeson (FromJSON(..), ToJSON(..)) import Data.Binary (Binary(..), putWord8, getWord8) import Data.Data (Data, Typeable)@@ -212,7 +211,7 @@       (measTime, measCpuTime, measCycles, measIters,        i measAllocated, i measNumGcs, i measBytesCopied,        d measMutatorWallSeconds, d measMutatorCpuSeconds,-       d measGcWallSeconds, d measMutatorCpuSeconds)+       d measGcWallSeconds, d measGcCpuSeconds)       where i = fromInt; d = fromDouble  instance NFData Measured where@@ -313,46 +312,61 @@     get = Measured <$> get <*> get <*> get <*> get                    <*> get <*> get <*> get <*> get <*> get <*> get <*> get --- | Apply an argument to a function, and evaluate the result to weak--- head normal form (WHNF).-whnf :: (a -> b) -> a -> Benchmarkable-whnf = pureFunc id-{-# INLINE whnf #-}- -- | Apply an argument to a function, and evaluate the result to -- normal form (NF). nf :: NFData b => (a -> b) -> a -> Benchmarkable-nf = pureFunc rnf-{-# INLINE nf #-}+nf f x = toBenchmarkable (nf' rnf f x) -pureFunc :: (b -> c) -> (a -> b) -> a -> Benchmarkable-pureFunc reduce f0 x0 = toBenchmarkable (go f0 x0)-  where go f x n-          | n <= 0    = return ()-          | otherwise = evaluate (reduce (f x)) >> go f x (n-1)-{-# INLINE pureFunc #-}+-- | Apply an argument to a function, and evaluate the result to weak+-- head normal form (WHNF).+whnf :: (a -> b) -> a -> Benchmarkable+whnf f x = toBenchmarkable (whnf' f x)  -- | Perform an action, then evaluate its result to normal form. -- This is particularly useful for forcing a lazy 'IO' action to be -- completely performed. nfIO :: NFData a => IO a -> Benchmarkable-nfIO = toBenchmarkable . impure rnf-{-# INLINE nfIO #-}+nfIO a = toBenchmarkable (nfIO' rnf a)  -- | Perform an action, then evaluate its result to weak head normal -- form (WHNF).  This is useful for forcing an 'IO' action whose result -- is an expression to be evaluated down to a more useful value. whnfIO :: IO a -> Benchmarkable-whnfIO = toBenchmarkable . impure id-{-# INLINE whnfIO #-}+whnfIO a = toBenchmarkable (whnfIO' a) -impure :: (a -> b) -> IO a -> Int64 -> IO ()-impure strategy a = go+-- Along with nf' and whnf', the following two functions are the core+-- benchmarking loops. They have been carefully constructed to avoid+-- allocation while also evaluating @a@.+--+-- These functions must not be inlined. There are two possible issues that+-- can arise if they are inlined. First, the work is often floated out of+-- the loop, which creates a nonsense benchmark. Second, the benchmark code+-- itself could be changed by the user's optimization level. By marking them+-- @NOINLINE@, the core benchmark code is always the same.+--+-- See #183 and #184 for discussion.++-- | Generate a function that will run an action a given number of times,+-- reducing it to normal form each time.+nfIO' :: (a -> b) -> IO a -> (Int64 -> IO ())+nfIO' reduce a = go   where go n           | n <= 0    = return ()-          | otherwise = a >>= (evaluate . strategy) >> go (n-1)-{-# INLINE impure #-}+          | otherwise = do+              x <- a+              reduce x `seq` go (n-1)+{-# NOINLINE nfIO' #-} +-- | Generate a function that will run an action a given number of times.+whnfIO' :: IO a -> (Int64 -> IO ())+whnfIO' a = go+  where+    go n | n <= 0    = return ()+         | otherwise = do+             x <- a+             x `seq` go (n-1)+{-# NOINLINE whnfIO' #-}+ -- | Specification of a collection of benchmarks and environments. A -- benchmark may consist of: --@@ -523,7 +537,7 @@     -- newly generated environment.     -> Benchmarkable perBatchEnvWithCleanup alloc clean work-    = Benchmarkable alloc clean (impure rnf . work) False+    = Benchmarkable alloc clean (nfIO' rnf . work) False  -- | Create a Benchmarkable where a fresh environment is allocated for every -- run of the operation to benchmark. This is useful for benchmarking mutable@@ -709,9 +723,6 @@ data SampleAnalysis = SampleAnalysis {       anRegress    :: [Regression]       -- ^ Estimates calculated via linear regression.-    , anOverhead   :: Double-      -- ^ Estimated measurement overhead, in seconds.  Estimation is-      -- performed via linear regression.     , anMean       :: St.Estimate St.ConfInt Double       -- ^ Estimated mean.     , anStdDev     :: St.Estimate St.ConfInt Double@@ -726,12 +737,12 @@  instance Binary SampleAnalysis where     put SampleAnalysis{..} = do-      put anRegress; put anOverhead; put anMean; put anStdDev; put anOutlierVar-    get = SampleAnalysis <$> get <*> get <*> get <*> get <*> get+      put anRegress; put anMean; put anStdDev; put anOutlierVar+    get = SampleAnalysis <$> get <*> get <*> get <*> get  instance NFData SampleAnalysis where     rnf SampleAnalysis{..} =-        rnf anRegress `seq` rnf anOverhead `seq` rnf anMean `seq`+        rnf anRegress `seq` rnf anMean `seq`         rnf anStdDev `seq` rnf anOutlierVar  -- | Data for a KDE chart of performance.@@ -760,9 +771,7 @@     , reportKeys     :: [String]       -- ^ See 'measureKeys'.     , reportMeasured :: V.Vector Measured-      -- ^ Raw measurements. These are /not/ corrected for the-      -- estimated measurement overhead that can be found via the-      -- 'anOverhead' field of 'reportAnalysis'.+      -- ^ Raw measurements.     , reportAnalysis :: SampleAnalysis       -- ^ Report analysis.     , reportOutliers :: Outliers

@@ -1,3 +1,5 @@+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_GHC -fno-full-laziness #-} -- | -- Module      : Criterion.Types.Internal -- Copyright   : (c) 2017 Ryan Scott@@ -8,8 +10,10 @@ -- Portability : GHC -- -- Exports 'fakeEnvironment'.-module Criterion.Types.Internal (fakeEnvironment) where+module Criterion.Types.Internal (fakeEnvironment, nf', whnf') where +import Data.Int (Int64)+ -- | A dummy environment that is passed to functions that create benchmarks -- from environments when no concrete environment is available. fakeEnvironment :: env@@ -19,3 +23,38 @@   , "\tconstructs benchmarks from an environment?"   , "\t(see the documentation for `env` for details)"   ]++-- Along with Criterion.Types.nfIO' and Criterion.Types.whnfIO', the following+-- two functions are the core benchmarking loops. They have been carefully+-- constructed to avoid allocation while also evaluating @f x@.+--+-- Because these functions are pure, GHC is particularly smart about optimizing+-- them. We must turn off @-ffull-laziness@ to prevent the computation from+-- being floated out of the loop.+--+-- For a similar reason, these functions must not be inlined. There are two+-- possible issues that can arise if they are inlined. First, the work is often+-- floated out of the loop, which creates a nonsense benchmark. Second, the+-- benchmark code itself could be changed by the user's optimization level. By+-- marking them @NOINLINE@, the core benchmark code is always the same.+--+-- See #183 and #184 for discussion.++-- | Generate a function which applies an argument to a function a+-- given number of times, reducing the result to normal form.+nf' :: (b -> ()) -> (a -> b) -> a -> (Int64 -> IO ())+nf' reduce f x = go+  where+    go n | n <= 0    = return ()+         | otherwise = let !y = f x+                       in reduce y `seq` go (n-1)+{-# NOINLINE nf' #-}++-- | Generate a function which applies an argument to a function a+-- given number of times.+whnf' :: (a -> b) -> a -> (Int64 -> IO ())+whnf' f x = go+  where+    go n | n <= 0    = return ()+         | otherwise = f x `seq` go (n-1)+{-# NOINLINE whnf' #-}

@@ -1,3 +1,50 @@+1.4.0.0++* We now do three samples for statistics:++  * `performMinorGC` before the first sample, to ensure it's up to date.+  * Take another sample after the action, without a garbage collection, so we+    can gather legitimate readings on GC-related statistics.+  * Then `performMinorGC` and sample once more, so we can get up-to-date+    readings on other metrics.++  The type of `applyGCStatistics` has changed accordingly. Before, it was:++  ```haskell+     Maybe GCStatistics -- ^ Statistics gathered at the end of a run.+  -> Maybe GCStatistics -- ^ Statistics gathered at the beginning of a run.+  -> Measured -> Measured+  ```++  Now, it is:++  ```haskell+     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 -> Measured+  ```++  When diffing `GCStatistics` in `applyGCStatistics`, we carefully choose+  whether to diff against the end stats pre- or post-GC.++* Use `performMinorGC` rather than `performGC` to update garbage collection+  statistics. This improves the benchmark performance of fast functions on large+  objects.++* Fix a bug in the `ToJSON Measured` instance which duplicated the+  mutator CPU seconds where GC CPU seconds should go.++* Fix a bug in sample analysis which incorrectly accounted for overhead+  causing runtime errors and invalid results. Accordingly, the buggy+  `getOverhead` function has been removed.++* Fix a bug in `Measurement.measure` which inflated the reported time taken+  for `perRun` benchmarks.++* Reduce overhead of `nf`, `whnf`, `nfIO`, and `whnfIO` by removing allocation+  from the central loops.+ 1.3.0.0  * `criterion` was previously reporting the following statistics incorrectly

@@ -1,5 +1,5 @@ name:           criterion-version:        1.3.0.0+version:        1.4.0.0 synopsis:       Robust, reliable performance measurement and analysis license:        BSD3 license-file:   LICENSE@@ -99,7 +99,7 @@     containers,     deepseq >= 1.1.0.0,     directory,-    exceptions >= 0.8.2 && < 0.9,+    exceptions >= 0.8.2 && < 0.10,     filepath,     Glob >= 0.7.2,     microstache >= 1.0.1 && < 1.1,

@@ -5,7 +5,7 @@ -- by compiling with the -fno-full-laziness option.  import Criterion.Main (bench, bgroup, defaultMain, nfIO, whnf)-import Data.Conduit (($=), ($$))+import Data.Conduit (runConduit, (.|)) import Data.Functor.Identity (Identity(..)) import Pipes ((>->), discard, each, for, runEffect) import qualified Data.Conduit.List as C@@ -28,7 +28,7 @@  pipes, conduit :: (Monad m) => Int -> m () pipes n = runEffect $ for (each [1..n] >-> P.map (+1) >-> P.filter even) discard-conduit n = C.sourceList [1..n] $= C.map (+1) $= C.filter even $$ C.sinkNull+conduit n = runConduit $ C.sourceList [1..n] .| C.map (+1) .| C.filter even .| C.sinkNull  main :: IO () main = criterion 10000

@@ -33,7 +33,7 @@   ghc-options: -Wall -rtsopts   build-depends:     base == 4.*,-    conduit >= 1.1,+    conduit >= 1.2.13.1,     criterion,     pipes >= 4.1,     transformers

@@ -15,7 +15,7 @@   m1 = Measured 4.613000783137977e-05 3.500000000000378e-05 31432 1 0 0 0 0.0 0.0 0.0 0.0   v1 = V.fromList [m1]   est1 = estimateFromErr 0.0 (0.0, 0.0) (mkCL 0.0)-  s1 = SampleAnalysis [] 0.0 est1 est1 (OutlierVariance Unaffected "" 0.0)+  s1 = SampleAnalysis [] est1 est1 (OutlierVariance Unaffected "" 0.0)  m2 :: Measured m2 = Measured {measTime = 1.1438998626545072e-5