packages feed

criterion 0.1.2 → 0.1.3

raw patch · 10 files changed

+253/−123 lines, 10 filesdep +mtldep ~Chartdep ~statisticsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: mtl

Dependency ranges changed: Chart, statistics

API changes (from Hackage documentation)

- Criterion.IO: class NoOp a
- Criterion.IO: instance (NoOp r) => NoOp (a -> r)
- Criterion.IO: instance NoOp (IO a)
+ Criterion.Config: cfgPlotSameAxis :: Config -> Last Bool
+ Criterion.Config: cfgSummaryFile :: Config -> Last String
+ Criterion.IO: instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r)
+ Criterion.IO: instance CritHPrintfType (ConfigM a)
+ Criterion.IO: instance CritHPrintfType (IO a)
+ Criterion.IO: summary :: String -> ConfigM ()
+ Criterion.Monad: doIO :: IO a -> ConfigM a
+ Criterion.Monad: getConfig :: ConfigM Config
+ Criterion.Monad: getConfigItem :: (Config -> a) -> ConfigM a
+ Criterion.Monad: type ConfigM = ReaderT Config IO
+ Criterion.Monad: withConfig :: Config -> ConfigM a -> IO a
- Criterion: runAndAnalyse :: (String -> Bool) -> Config -> Environment -> Benchmark -> IO ()
+ Criterion: runAndAnalyse :: (String -> Bool) -> Environment -> Benchmark -> ConfigM ()
- Criterion: runBenchmark :: (Benchmarkable b) => Config -> Environment -> b -> IO Sample
+ Criterion: runBenchmark :: (Benchmarkable b) => Environment -> b -> ConfigM Sample
- Criterion.Analysis: analyseMean :: Config -> Sample -> Int -> IO Double
+ Criterion.Analysis: analyseMean :: Sample -> Int -> ConfigM Double
- Criterion.Analysis: noteOutliers :: Config -> Outliers -> IO ()
+ Criterion.Analysis: noteOutliers :: Outliers -> ConfigM ()
- Criterion.Config: Config :: Last String -> Last Double -> Last Bool -> MultiMap Plot PlotOutput -> PrintExit -> Last Int -> Last Int -> Last Verbosity -> Config
+ Criterion.Config: Config :: Last String -> Last Double -> Last Bool -> MultiMap Plot PlotOutput -> Last Bool -> PrintExit -> Last Int -> Last Int -> Last String -> Last Verbosity -> Config
- Criterion.Environment: measureEnvironment :: Config -> IO Environment
+ Criterion.Environment: measureEnvironment :: ConfigM Environment
- Criterion.IO: note :: (HPrintfType r, NoOp r) => Config -> String -> r
+ Criterion.IO: note :: (CritHPrintfType r) => String -> r
- Criterion.IO: printError :: (HPrintfType r) => String -> r
+ Criterion.IO: printError :: (CritHPrintfType r) => String -> r
- Criterion.IO: prolix :: (HPrintfType r, NoOp r) => Config -> String -> r
+ Criterion.IO: prolix :: (CritHPrintfType r) => String -> r
- Criterion.Plot: plotKDE :: PlotOutput -> String -> Points -> UArr Double -> IO ()
+ Criterion.Plot: plotKDE :: PlotOutput -> String -> Maybe (Double :*: Double) -> Points -> UArr Double -> IO ()
- Criterion.Plot: plotWith :: Plot -> Config -> (PlotOutput -> IO ()) -> IO ()
+ Criterion.Plot: plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM ()

Files

Criterion.hs view
@@ -19,17 +19,18 @@     , runAndAnalyse     ) where -import Control.Monad (replicateM_, when)+import Control.Monad ((<=<), forM_, replicateM_, when) import Criterion.Analysis (OutlierVariance(..), classifyOutliers,                            outlierVariance, noteOutliers) import Criterion.Config (Config(..), Plot(..), fromLJ) import Criterion.Environment (Environment(..))-import Criterion.IO (note, prolix)+import Criterion.IO (note, prolix, summary) import Criterion.Measurement (getTime, runForAtLeast, secs, time_)+import Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO) import Criterion.Plot (plotWith, plotKDE, plotTiming) import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, bgroup)-import Data.Array.Vector ((:*:)(..), lengthU, mapU)-import Statistics.Function (createIO)+import Data.Array.Vector ((:*:)(..), concatU, lengthU, mapU)+import Statistics.Function (createIO, minMax) import Statistics.KernelDensity (epanechnikovPDF) import Statistics.RandomVariate (withSystemRandom) import Statistics.Resampling (resample)@@ -37,23 +38,25 @@ import Statistics.Sample (mean, stdDev) import Statistics.Types (Sample) import System.Mem (performGC)+import Text.Printf (printf)  -- | Run a single benchmark, and return timings measured when -- executing it.-runBenchmark :: Benchmarkable b => Config -> Environment -> b -> IO Sample-runBenchmark cfg env b = do-  runForAtLeast 0.1 10000 (`replicateM_` getTime)+runBenchmark :: Benchmarkable b => Environment -> b -> ConfigM Sample+runBenchmark env b = do+  doIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)   let minTime = envClockResolution env * 1000-  (testTime :*: testIters :*: _) <- runForAtLeast (min minTime 0.1) 1 timeLoop-  prolix cfg "ran %d iterations in %s\n" testIters (secs testTime)+  (testTime :*: testIters :*: _) <- doIO $ runForAtLeast (min minTime 0.1) 1 timeLoop+  prolix "ran %d iterations in %s\n" testIters (secs testTime)+  cfg <- getConfig   let newIters    = ceiling $ minTime * testItersD / testTime       sampleCount = fromLJ cfgSamples cfg       newItersD   = fromIntegral newIters       testItersD  = fromIntegral testIters-  note cfg "collecting %d samples, %d iterations each, in estimated %s\n"+  note "collecting %d samples, %d iterations each, in estimated %s\n"        sampleCount newIters (secs (fromIntegral sampleCount * newItersD *                                    testTime / testItersD))-  times <- fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .+  times <- doIO $ fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .            createIO sampleCount . const $ do              when (fromLJ cfgPerformGC cfg) $ performGC              time_ (timeLoop newIters)@@ -63,19 +66,17 @@                | otherwise = run b k >> timeLoop (k-1)  -- | Run a single benchmark and analyse its performance.-runAndAnalyseOne :: Benchmarkable b => Config -> Environment -> String -> b-                 -> IO ()-runAndAnalyseOne cfg env desc b = do-  times <- runBenchmark cfg env b+runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b+                 -> ConfigM Sample+runAndAnalyseOne env _desc b = do+  times <- runBenchmark env b   let numSamples = lengthU times-  plotWith Timing cfg $ \o -> plotTiming o desc times-  plotWith KernelDensity cfg $ \o -> uncurry (plotKDE o desc)-                                     (epanechnikovPDF 100 times)   let ests = [mean,stdDev]-      numResamples = fromLJ cfgResamples cfg-  note cfg "bootstrapping with %d resamples\n" numResamples-  res <- withSystemRandom (\gen -> resample gen ests numResamples times)-  let [em,es] = bootstrapBCA (fromLJ cfgConfInterval cfg) times ests res+  numResamples <- getConfigItem $ fromLJ cfgResamples+  note "bootstrapping with %d resamples\n" numResamples+  res <- doIO $ withSystemRandom (\gen -> resample gen ests numResamples times)+  ci <- getConfigItem $ fromLJ cfgConfInterval+  let [em,es] = bootstrapBCA ci times ests res       (effect, v) = outlierVariance em es (fromIntegral $ numSamples)       wibble = case effect of                  Unaffected -> "unaffected" :: String@@ -83,30 +84,55 @@                  Moderate -> "moderately inflated"                  Severe -> "severely inflated"   bs "mean" em+  summary ","   bs "std dev" es-  noteOutliers cfg (classifyOutliers times)-  note cfg "variance introduced by outliers: %.3f%%\n" (v * 100)-  note cfg "variance is %s by outliers\n" wibble-  where bs :: String -> Estimate -> IO ()-        bs d e = note cfg "%s: %s, lb %s, ub %s, ci %.3f\n" d-                   (secs $ estPoint e)-                   (secs $ estLowerBound e) (secs $ estUpperBound e)-                   (estConfidenceLevel e)+  summary "\n"+  noteOutliers (classifyOutliers times)+  note "variance introduced by outliers: %.3f%%\n" (v * 100)+  note "variance is %s by outliers\n" wibble+  return times+  where bs :: String -> Estimate -> ConfigM ()+        bs d e = do note "%s: %s, lb %s, ub %s, ci %.3f\n" d+                      (secs $ estPoint e)+                      (secs $ estLowerBound e) (secs $ estUpperBound e)+                      (estConfidenceLevel e)+                    summary $ printf "%g,%g,%g" +                      (estPoint e)+                      (estLowerBound e) (estUpperBound e) +plotAll :: [(String, Sample)] -> ConfigM ()+plotAll descTimes = forM_ descTimes $ \(desc,times) -> do+  plotWith Timing $ \o -> plotTiming o desc times+  plotWith KernelDensity $ \o -> uncurry (plotKDE o desc extremes)+                                     (epanechnikovPDF 100 times)+  where+    extremes = case descTimes of+                 (_:_:_) -> toJust . minMax . concatU . map snd $ descTimes+                 _       -> Nothing+    toJust r@(lo :*: hi)+        | lo == infinity || hi == -infinity = Nothing+        | otherwise                         = Just r+        where infinity                      = 1/0+ -- | Run, and analyse, one or more benchmarks. runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses                                   -- whether to run a benchmark by its                                   -- name.-              -> Config               -> Environment               -> Benchmark-              -> IO ()-runAndAnalyse p cfg env = go ""+              -> ConfigM ()+runAndAnalyse p env = plotAll <=< go ""   where go pfx (Benchmark desc b)-            | p desc'   = do note cfg "\nbenchmarking %s\n" desc'-                             runAndAnalyseOne cfg env desc' b-            | otherwise = return ()+            | p desc'   = do note "\nbenchmarking %s\n" desc'+                             summary (show desc' ++ ",") -- String will be quoted+                             x <- runAndAnalyseOne env desc' b+                             sameAxis <- getConfigItem $ fromLJ cfgPlotSameAxis+                             if sameAxis+                               then return  [(desc',x)]+                               else plotAll [(desc',x)] >> return []+            | otherwise = return []             where desc' = prefix pfx desc-        go pfx (BenchGroup desc bs) = mapM_ (go (prefix pfx desc)) bs+        go pfx (BenchGroup desc bs) =+            concat `fmap` mapM (go (prefix pfx desc)) bs         prefix ""  desc = desc         prefix pfx desc = pfx ++ '/' : desc
Criterion/Analysis.hs view
@@ -21,9 +21,9 @@     ) where  import Control.Monad (when)-import Criterion.Config (Config) import Criterion.IO (note) import Criterion.Measurement (secs)+import Criterion.Monad (ConfigM) import Data.Array.Vector (foldlU) import Data.Int (Int64) import Data.Monoid (Monoid(..))@@ -122,28 +122,27 @@  -- | Display the mean of a 'Sample', and characterise the outliers -- present in the sample.-analyseMean :: Config-            -> Sample+analyseMean :: Sample             -> Int              -- ^ Number of iterations used to                                 -- compute the sample.-            -> IO Double-analyseMean cfg a iters = do+            -> ConfigM Double+analyseMean a iters = do   let µ = mean a-  note cfg "mean is %s (%d iterations)\n" (secs µ) iters-  noteOutliers cfg . classifyOutliers $ a+  note "mean is %s (%d iterations)\n" (secs µ) iters+  noteOutliers . classifyOutliers $ a   return µ  -- | Display a report of the 'Outliers' present in a 'Sample'.-noteOutliers :: Config -> Outliers -> IO ()-noteOutliers cfg o = do+noteOutliers :: Outliers -> ConfigM ()+noteOutliers o = do   let frac n = (100::Double) * fromIntegral n / fromIntegral (samplesSeen o)-      check :: Int64 -> Double -> String -> IO ()+      check :: Int64 -> Double -> String -> ConfigM ()       check k t d = when (frac k > t) $-                    note cfg "  %d (%.1g%%) %s\n" k (frac k) d+                    note "  %d (%.1g%%) %s\n" k (frac k) d       outCount = countOutliers o   when (outCount > 0) $ do-    note cfg "found %d outliers among %d samples (%.1g%%)\n"-             outCount (samplesSeen o) (frac outCount)+    note "found %d outliers among %d samples (%.1g%%)\n"+         outCount (samplesSeen o) (frac outCount)     check (lowSevere o) 0 "low severe"     check (lowMild o) 1 "low mild"     check (highMild o) 1 "high mild"
Criterion/Config.hs view
@@ -65,9 +65,11 @@     , cfgConfInterval :: Last Double -- ^ Confidence interval to use.     , cfgPerformGC    :: Last Bool   -- ^ Whether to run the GC between passes.     , cfgPlot         :: MultiMap Plot PlotOutput -- ^ What to plot, and where.+    , cfgPlotSameAxis :: Last Bool     , cfgPrintExit    :: PrintExit   -- ^ Whether to print information and exit.     , cfgResamples    :: Last Int    -- ^ Number of resamples to perform.     , cfgSamples      :: Last Int    -- ^ Number of samples to collect.+    , cfgSummaryFile  :: Last String -- ^ Filename of summary CSV     , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.     } deriving (Eq, Read, Show, Typeable) @@ -82,9 +84,11 @@                 , cfgConfInterval = ljust 0.95                 , cfgPerformGC    = ljust False                 , cfgPlot         = mempty+                , cfgPlotSameAxis = ljust False                 , cfgPrintExit    = Nada                 , cfgResamples    = ljust (100 * 1000)                 , cfgSamples      = ljust 100+                , cfgSummaryFile  = mempty                 , cfgVerbosity    = ljust Normal                 } @@ -106,9 +110,11 @@               , cfgConfInterval = mempty               , cfgPerformGC    = mempty               , cfgPlot         = mempty+              , cfgPlotSameAxis = mempty               , cfgPrintExit    = mempty               , cfgResamples    = mempty               , cfgSamples      = mempty+              , cfgSummaryFile  = mempty               , cfgVerbosity    = mempty               } @@ -119,8 +125,10 @@     , cfgConfInterval = app cfgConfInterval a b     , cfgPerformGC    = app cfgPerformGC a b     , cfgPlot         = app cfgPlot a b+    , cfgPlotSameAxis = app cfgPlotSameAxis a b     , cfgPrintExit    = app cfgPrintExit a b     , cfgSamples      = app cfgSamples a b+    , cfgSummaryFile  = app cfgSummaryFile a b     , cfgResamples    = app cfgResamples a b     , cfgVerbosity    = app cfgVerbosity a b     }
Criterion/Environment.hs view
@@ -19,9 +19,9 @@  import Control.Monad (replicateM_) import Criterion.Analysis (analyseMean)-import Criterion.Config (Config) import Criterion.IO (note) import Criterion.Measurement (getTime, runForAtLeast, time_)+import Criterion.Monad (ConfigM, doIO) import Data.Array.Vector import Data.Typeable (Typeable) import Statistics.Function (createIO)@@ -35,15 +35,15 @@     } deriving (Eq, Read, Show, Typeable)  -- | Measure the execution environment.-measureEnvironment :: Config -> IO Environment-measureEnvironment cfg = do-  note cfg "warming up\n"-  (_ :*: seed :*: _) <- runForAtLeast 0.1 10000 resolution-  note cfg "estimating clock resolution...\n"-  clockRes <- thd3 `fmap` runForAtLeast 0.5 seed resolution >>=-              uncurry (analyseMean cfg)-  note cfg "estimating cost of a clock call...\n"-  clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry (analyseMean cfg)+measureEnvironment :: ConfigM Environment+measureEnvironment = do+  note "warming up\n"+  (_ :*: seed :*: _) <- doIO $ runForAtLeast 0.1 10000 resolution+  note "estimating clock resolution...\n"+  clockRes <- thd3 `fmap` doIO (runForAtLeast 0.5 seed resolution) >>=+              uncurry analyseMean+  note "estimating cost of a clock call...\n"+  clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry analyseMean   return $ Environment {                envClockResolution = clockRes              , envClockCost = clockCost@@ -53,7 +53,7 @@       times <- createIO (k+1) (const getTime)       return (tailU . filterU (>=0) . zipWithU (-) (tailU times) $ times,               lengthU times)-    cost timeLimit = do+    cost timeLimit = doIO $ do       let timeClock k = time_ (replicateM_ k getTime)       timeClock 1       (_ :*: iters :*: elapsed) <- runForAtLeast 0.01 10000 timeClock
Criterion/IO.hs view
@@ -9,40 +9,86 @@ -- -- Input and output actions. +{-# LANGUAGE FlexibleInstances, Rank2Types, TypeSynonymInstances #-} module Criterion.IO     (-      NoOp-    , note+      note     , printError     , prolix+    , summary     ) where -import Criterion.Config (Config, Verbosity(..), cfgVerbosity, fromLJ)-import System.IO (stderr, stdout)-import Text.Printf (HPrintfType, hPrintf)+import Control.Monad (when)+import Control.Monad.Trans (liftIO)+import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity, fromLJ)+import Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO)+import Data.Monoid (getLast)+import System.IO (Handle, stderr, stdout)+import qualified Text.Printf (HPrintfType, hPrintf)+import Text.Printf (PrintfArg) --- | A typeclass hack to match that of the 'HPrintfType' class.-class NoOp a where-    noop :: a+-- First item is the action to print now, given all the arguments gathered+-- together so far.  The second item is the function that will take a further argument+-- and give back a new PrintfCont.+data PrintfCont = PrintfCont (IO ()) (PrintfArg a => a -> PrintfCont) -instance NoOp (IO a) where-    noop = return undefined+-- An internal class that acts like Printf/HPrintf.+--+-- The implementation is visible to the rest of the program, but the class is+class CritHPrintfType a where+  chPrintfImpl :: (Config -> Bool) -> PrintfCont -> a -instance (NoOp r) => NoOp (a -> r) where-    noop _ = noop +instance CritHPrintfType (ConfigM a) where+  chPrintfImpl check (PrintfCont final _)+    = do x <- getConfig+         when (check x) (liftIO final)+         return undefined++instance CritHPrintfType (IO a) where+  chPrintfImpl _ (PrintfCont final _)+    = final >> return undefined++instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r) where+  chPrintfImpl check (PrintfCont _ anotherArg) x+    = chPrintfImpl check (anotherArg x)++chPrintf :: CritHPrintfType r => (Config -> Bool) -> Handle -> String -> r+chPrintf shouldPrint h s+  = chPrintfImpl shouldPrint (make (Text.Printf.hPrintf h s) (Text.Printf.hPrintf h s))+  where+    make :: IO () -> (forall a r. (PrintfArg a, Text.Printf.HPrintfType r) => a -> r) -> PrintfCont+    make curCall curCall' = PrintfCont curCall (\x -> make (curCall' x) (curCall' x))++{- A demonstration of how to write printf in this style, in case it is ever needed+  in fututre:++cPrintf :: CritHPrintfType r => (Config -> Bool) -> String -> r+cPrintf shouldPrint s+  = chPrintfImpl shouldPrint (make (Text.Printf.printf s)+  (Text.Printf.printf s))+  where+    make :: IO () -> (forall a r. (PrintfArg a, Text.Printf.PrintfType r) => a -> r) -> PrintfCont+    make curCall curCall' = PrintfCont curCall (\x -> make (curCall' x) (curCall' x))+-}+ -- | Print a \"normal\" note.-note :: (HPrintfType r, NoOp r) => Config -> String -> r-note cfg msg = if fromLJ cfgVerbosity cfg > Quiet-               then hPrintf stdout msg-               else noop+note :: (CritHPrintfType r) => String -> r+note = chPrintf ((> Quiet) . fromLJ cfgVerbosity) stdout  -- | Print verbose output.-prolix :: (HPrintfType r, NoOp r) => Config -> String -> r-prolix cfg msg = if fromLJ cfgVerbosity cfg == Verbose-                 then hPrintf stdout msg-                 else noop+prolix :: (CritHPrintfType r) => String -> r+prolix = chPrintf ((== Verbose) . fromLJ cfgVerbosity) stdout  -- | Print an error message.-printError :: (HPrintfType r) => String -> r-printError msg = hPrintf stderr msg+printError :: (CritHPrintfType r) => String -> r+printError = chPrintf (const True) stderr++-- | Add to summary CSV (if applicable)+summary :: String -> ConfigM ()+summary msg+  = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)+       case sumOpt of+         Just fn -> doIO $ appendFile fn msg+         Nothing -> return ()+
Criterion/Main.hs view
@@ -41,7 +41,8 @@ import Criterion.Environment (measureEnvironment) import Criterion.IO (note, printError) import Criterion.MultiMap (singleton)-import Criterion.Types (Benchmarkable(..), Benchmark, bench, benchNames, bgroup)+import Criterion.Monad (doIO, withConfig)+import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, benchNames, bgroup) import Data.List (isPrefixOf, sort) import Data.Monoid (Monoid(..), Last(..)) import System.Console.GetOpt@@ -113,10 +114,12 @@           "collect garbage between iterations"  , Option ['I'] ["ci"] (ReqArg ci "CI")           "bootstrap confidence interval"- , Option ['l'] ["--list"] (noArg mempty { cfgPrintExit = List })+ , Option ['l'] ["list"] (noArg mempty { cfgPrintExit = List })           "print a list of all benchmark names, then exit"  , Option ['k'] ["plot-kde"] (ReqArg (plot KernelDensity) "TYPE")           "plot kernel density estimate of probabilities"+ , Option [] ["kde-same-axis"] (noArg mempty {cfgPlotSameAxis = ljust True })+          "plot all KDE graphs with the same X axis range (useful for comparison)"  , Option ['q'] ["quiet"] (noArg mempty { cfgVerbosity = ljust Quiet })           "print less output"  , Option [] ["resamples"]@@ -127,6 +130,8 @@           "number of samples to collect"  , Option ['t'] ["plot-timing"] (ReqArg (plot Timing) "TYPE")           "plot timings"+ , Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME")+          "produce a summary CSV file of all the benchmark means and standard deviations"  , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version })           "display version, then exit"  , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })@@ -134,10 +139,10 @@  ]  printBanner :: Config -> IO ()-printBanner cfg =+printBanner cfg = withConfig cfg $      case cfgBanner cfg of-      Last (Just b) -> note cfg "%s\n" b-      _             -> note cfg "Hey, nobody told me what version I am!\n"+      Last (Just b) -> note "%s\n" b+      _             -> note "Hey, nobody told me what version I am!\n"  printUsage :: [OptDescr (IO Config)] -> ExitCode -> IO a printUsage options exitCode = do@@ -218,14 +223,18 @@ defaultMainWith :: Config -> [Benchmark] -> IO () defaultMainWith defCfg bs = do   (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs-  if cfgPrintExit cfg == List+  withConfig cfg $+   if cfgPrintExit cfg == List     then do-      note cfg "Benchmarks:\n"-      mapM_ (note cfg "  %s\n") (sort $ concatMap benchNames bs)+      note "Benchmarks:\n"+      mapM_ (note "  %s\n") (sort $ concatMap benchNames bs)     else do-      env <- measureEnvironment cfg+      case getLast $ cfgSummaryFile cfg of+        Just fn -> doIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"+        Nothing -> return ()+      env <- measureEnvironment       let shouldRun b = null args || any (`isPrefixOf` b) args-      mapM_ (runAndAnalyse shouldRun cfg env) bs+      runAndAnalyse shouldRun env $ BenchGroup "" bs  -- | Display an error message from a command line parsing failure, and -- exit.
+ Criterion/Monad.hs view
@@ -0,0 +1,28 @@+-- |+-- Module      : Criterion.Monad+-- Copyright   : (c) Neil Brown 2009+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+module Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO, withConfig) where++import Control.Monad.Reader (ReaderT, ask, runReaderT)+import Control.Monad.Trans (lift)+import Criterion.Config (Config)++type ConfigM = ReaderT Config IO++getConfig :: ConfigM Config+getConfig = ask++getConfigItem :: (Config -> a) -> ConfigM a+getConfigItem f = f `fmap` getConfig++doIO :: IO a -> ConfigM a+doIO = lift++withConfig :: Config -> ConfigM a -> IO a+withConfig = flip runReaderT
Criterion/Plot.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, TypeOperators #-}  -- | -- Module      : Criterion.Plot@@ -19,6 +19,7 @@     ) where  import Criterion.Config+import Criterion.Monad (ConfigM, doIO, getConfigItem) import Data.Array.Vector import Data.Char (isSpace, toLower) import Data.Foldable (forM_)@@ -38,11 +39,9 @@ import Criterion.IO (printError) #endif -plotWith :: Plot -> Config -> (PlotOutput -> IO ()) -> IO ()-plotWith p cfg plot =-  case M.lookup p (cfgPlot cfg) of-    Nothing -> return ()-    Just s -> forM_ s $ plot+plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM ()+plotWith p plot = getConfigItem (M.lookup p . cfgPlot)+                    >>= maybe (return ()) (flip forM_ (doIO . plot))  -- | Plot timing data. plotTiming :: PlotOutput        -- ^ The kind of output desired.@@ -80,33 +79,34 @@ -- | Plot kernel density estimate. plotKDE :: PlotOutput           -- ^ The kind of output desired.         -> String               -- ^ Benchmark name.+        -> Maybe (Double :*: Double) -- ^ Range of x-axis         -> Points               -- ^ Points at which KDE was computed.         -> UArr Double          -- ^ Kernel density estimates.         -> IO () -plotKDE CSV desc points pdf = do+plotKDE CSV desc _exs points pdf = do   writeTo (mangle $ printf "%s densities.csv" desc) $ \h -> do     putRow h ["execution time", "probability"]     forM_ (zip (fromU pdf) (fromU (fromPoints points))) $ \(x, y) ->       putRow h [show x, show y]  #ifdef HAVE_CHART-plotKDE (PDF x y) desc points pdf =-  renderableToPDFFile (renderKDE desc points pdf) x y+plotKDE (PDF x y) desc exs points pdf =+  renderableToPDFFile (renderKDE desc exs points pdf) x y                       (mangle $ printf "%s densities %dx%d.pdf" desc x y) -plotKDE (PNG x y) desc points pdf =-  renderableToPNGFile (renderKDE desc points pdf) x y+plotKDE (PNG x y) desc exs points pdf =+  renderableToPNGFile (renderKDE desc exs points pdf) x y                       (mangle $ printf "%s densities %dx%d.png" desc x y) -plotKDE (SVG x y) desc points pdf =-  renderableToSVGFile (renderKDE desc points pdf) x y+plotKDE (SVG x y) desc exs points pdf =+  renderableToSVGFile (renderKDE desc exs points pdf) x y                       (mangle $ printf "%s densities %dx%d.svg" desc x y) -plotKDE (Window x y) desc points pdf =-    renderableToWindow (renderKDE desc points pdf) x y+plotKDE (Window x y) desc exs points pdf =+    renderableToWindow (renderKDE desc exs points pdf) x y #else-plotKDE output _desc _points _pdf =+plotKDE output _desc _exs _points _pdf =   printError "ERROR: output type %s not supported on this platform\n"              (show output) #endif@@ -133,8 +133,9 @@          $ plot_bars_spacing ^= BarsFixGap 0          $ defaultPlotBars -renderKDE :: String -> Points -> UArr Double -> Renderable ()-renderKDE desc points pdf = toRenderable layout+renderKDE :: String -> Maybe (Double :*: Double) -> Points -> UArr Double+          -> Renderable ()+renderKDE desc exs points pdf = toRenderable layout   where     layout = layout1_title ^= "Densities of execution times for \"" ++                               desc ++ "\""@@ -146,10 +147,13 @@     leftAxis = laxis_title ^= "estimate of probability density"              $ defaultLayoutAxis -    bottomAxis = laxis_generate ^= autoScaledAxis secAxis+    bottomAxis = laxis_generate ^= semiAutoScaledAxis secAxis                $ laxis_title ^= "execution time"                $ defaultLayoutAxis +    semiAutoScaledAxis opts ps = autoScaledAxis opts (extremities ++ ps)+    extremities = maybe [] (\(lo :*: hi) -> [lo, hi]) exs+     info = plot_lines_values ^= [zip (fromU (fromPoints points)) (fromU spdf)]          $ defaultPlotLines @@ -157,7 +161,7 @@     spdf = mapU (/ sumU pdf) pdf  -- | An axis whose labels display as seconds (or fractions thereof).-secAxis :: LinearAxisParams+secAxis :: LinearAxisParams Double secAxis = la_labelf ^= secs         $ defaultLinearAxis 
criterion.cabal view
@@ -1,12 +1,12 @@ name:           criterion-version:        0.1.2-synopsis:       Benchmarking, Performance, Testing+version:        0.1.3+synopsis:       Robust, reliable performance measurement and analysis license:        BSD3 license-file:   LICENSE author:         Bryan O'Sullivan <bos@serpentine.com> maintainer:     Bryan O'Sullivan <bos@serpentine.com> copyright:      2009 Bryan O'Sullivan-category:       Development, Performance+category:       Development, Performance, Testing build-type:     Simple cabal-version:  >= 1.2 extra-source-files:@@ -33,6 +33,7 @@     Criterion.IO     Criterion.Main     Criterion.Measurement+    Criterion.Monad     Criterion.MultiMap     Criterion.Plot     Criterion.Types@@ -42,16 +43,17 @@     bytestring >= 0.9 && < 1.0,     containers,     filepath,+    mtl,     parallel,     parsec,-    statistics >= 0.3.4,+    statistics >= 0.3.5,     time,     uvector,     uvector-algorithms >= 0.2    if flag(chart)     build-depends:-      Chart,+      Chart>=0.12,       data-accessor     cpp-options: -DHAVE_CHART 
examples/Fibber.hs view
@@ -3,15 +3,18 @@ import Criterion.Main  fib :: Int -> Int-fib 0 = 0-fib 1 = 1-fib n = fib (n-1) + fib (n-2)+fib n | n < 0     = error "negative!"+      | otherwise = go (fromIntegral n)+  where+    go 0 = 0+    go 1 = 1+    go n = go (n-1) + go (n-2)  fact :: Int -> Integer fact n | n < 0     = error "negative!"        | otherwise = go (fromIntegral n)-    where go i | i == 0    = 1-               | otherwise = i * go (i-1)+    where go 0 = 1+          go i = i * go (i-1)  fio :: Int -> IO Integer fio n | n < 0     = error "negative!"@@ -22,6 +25,11 @@             return $! i * j  main = defaultMain [+        bgroup "tiny" [ bench "fib 10" $ \n -> fib (10+n-n)+                      , bench "fib 15" $ \n -> fib (15+n-n)+                      , bench "fib 20" $ \n -> fib (20+n-n)+                      , bench "fib 25" $ \n -> fib (25+n-n)+                      ],         bgroup "fib" [ bench "fib 10" $ \n -> fib (10+n-n)                      , bench "fib 35" $ \n -> fib (35+n-n)                      , bench "fib 37" $ \n -> fib (37+n-n)