criterion 0.1.4 → 0.2.0

raw patch · 12 files changed

+132/−59 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Criterion.hs +10/−10
• Criterion/Environment.hs +5/−4
• Criterion/IO.hs +2/−2
• Criterion/Main.hs +6/−3
• Criterion/Monad.hs +16/−8
• Criterion/Plot.hs +3/−2
• Criterion/Types.hs +25/−5
• criterion.cabal +6/−2
• examples/Fibber.hs +10/−10
• examples/Judy.hs +13/−13
• examples/Makefile +9/−0
• examples/Tiny.hs +27/−0

@@ -13,6 +13,7 @@     (       Benchmarkable(..)     , Benchmark+    , B(..)     , bench     , bgroup     , runBenchmark@@ -20,15 +21,16 @@     ) where  import Control.Monad ((<=<), forM_, replicateM_, when)+import Control.Monad.Trans (liftIO) import Criterion.Analysis (OutlierVariance(..), classifyOutliers,                            outlierVariance, noteOutliers) import Criterion.Config (Config(..), Plot(..), fromLJ) import Criterion.Environment (Environment(..)) import Criterion.IO (note, prolix, summary) import Criterion.Measurement (getTime, runForAtLeast, secs, time_)-import Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO)+import Criterion.Monad (ConfigM, getConfig, getConfigItem) import Criterion.Plot (plotWith, plotKDE, plotTiming)-import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, bgroup)+import Criterion.Types (Benchmarkable(..), Benchmark(..), B(..), bench, bgroup) import Data.Array.Vector ((:*:)(..), concatU, lengthU, mapU) import Statistics.Function (createIO, minMax) import Statistics.KernelDensity (epanechnikovPDF)@@ -44,9 +46,10 @@ -- executing it. runBenchmark :: Benchmarkable b => Environment -> b -> ConfigM Sample runBenchmark env b = do-  doIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)+  liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)   let minTime = envClockResolution env * 1000-  (testTime :*: testIters :*: _) <- doIO $ runForAtLeast (min minTime 0.1) 1 timeLoop+  (testTime :*: testIters :*: _) <-+      liftIO $ runForAtLeast (min minTime 0.1) 1 (run b)   prolix "ran %d iterations in %s\n" testIters (secs testTime)   cfg <- getConfig   let newIters    = ceiling $ minTime * testItersD / testTime@@ -56,14 +59,11 @@   note "collecting %d samples, %d iterations each, in estimated %s\n"        sampleCount newIters (secs (fromIntegral sampleCount * newItersD *                                    testTime / testItersD))-  times <- doIO $ fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .+  times <- liftIO . fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .            createIO sampleCount . const $ do              when (fromLJ cfgPerformGC cfg) $ performGC-             time_ (timeLoop newIters)+             time_ (run b newIters)   return times-  where-    timeLoop k | k <= 0    = return ()-               | otherwise = run b k >> timeLoop (k-1)  -- | Run a single benchmark and analyse its performance. runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b@@ -74,7 +74,7 @@   let ests = [mean,stdDev]   numResamples <- getConfigItem $ fromLJ cfgResamples   note "bootstrapping with %d resamples\n" numResamples-  res <- doIO $ withSystemRandom (\gen -> resample gen ests numResamples times)+  res <- liftIO $ 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)

@@ -18,10 +18,11 @@     ) where  import Control.Monad (replicateM_)+import Control.Monad.Trans (liftIO) import Criterion.Analysis (analyseMean) import Criterion.IO (note) import Criterion.Measurement (getTime, runForAtLeast, time_)-import Criterion.Monad (ConfigM, doIO)+import Criterion.Monad (ConfigM) import Data.Array.Vector import Data.Typeable (Typeable) import Statistics.Function (createIO)@@ -38,9 +39,9 @@ measureEnvironment :: ConfigM Environment measureEnvironment = do   note "warming up\n"-  (_ :*: seed :*: _) <- doIO $ runForAtLeast 0.1 10000 resolution+  (_ :*: seed :*: _) <- liftIO $ runForAtLeast 0.1 10000 resolution   note "estimating clock resolution...\n"-  clockRes <- thd3 `fmap` doIO (runForAtLeast 0.5 seed resolution) >>=+  clockRes <- thd3 `fmap` liftIO (runForAtLeast 0.5 seed resolution) >>=               uncurry analyseMean   note "estimating cost of a clock call...\n"   clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry analyseMean@@ -53,7 +54,7 @@       times <- createIO (k+1) (const getTime)       return (tailU . filterU (>=0) . zipWithU (-) (tailU times) $ times,               lengthU times)-    cost timeLimit = doIO $ do+    cost timeLimit = liftIO $ do       let timeClock k = time_ (replicateM_ k getTime)       timeClock 1       (_ :*: iters :*: elapsed) <- runForAtLeast 0.01 10000 timeClock

@@ -21,7 +21,7 @@ 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 Criterion.Monad (ConfigM, getConfig, getConfigItem) import Data.Monoid (getLast) import System.IO (Handle, stderr, stdout) import qualified Text.Printf (HPrintfType, hPrintf)@@ -89,6 +89,6 @@ summary msg   = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)        case sumOpt of-         Just fn -> doIO $ appendFile fn msg+         Just fn -> liftIO $ appendFile fn msg          Nothing -> return () 

@@ -24,6 +24,7 @@     -- * Types       Benchmarkable(..)     , Benchmark+    , B(..)     -- * Constructing benchmarks     , bench     , bgroup@@ -36,13 +37,15 @@     ) where  import Control.Monad (MonadPlus(..))+import Control.Monad.Trans (liftIO) import Criterion (runAndAnalyse) import Criterion.Config import Criterion.Environment (measureEnvironment) import Criterion.IO (note, printError) import Criterion.MultiMap (singleton)-import Criterion.Monad (doIO, withConfig)-import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, benchNames, bgroup)+import Criterion.Monad (withConfig)+import Criterion.Types (Benchmarkable(..), Benchmark(..), B(..), bench,+                        benchNames, bgroup) import Data.List (isPrefixOf, sort) import Data.Monoid (Monoid(..), Last(..)) import System.Console.GetOpt@@ -230,7 +233,7 @@       mapM_ (note "  %s\n") (sort $ concatMap benchNames bs)     else do       case getLast $ cfgSummaryFile cfg of-        Just fn -> doIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"+        Just fn -> liftIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"         Nothing -> return ()       env <- measureEnvironment       let shouldRun b = null args || any (`isPrefixOf` b) args

@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | -- Module      : Criterion.Monad -- Copyright   : (c) Neil Brown 2009@@ -7,13 +8,23 @@ -- Stability   : experimental -- Portability : GHC ---module Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO, withConfig) where+-- The environment in which most criterion code executes.+module Criterion.Monad+    (+      ConfigM+    , getConfig+    , getConfigItem+    , withConfig+    ) where -import Control.Monad.Reader (ReaderT, ask, runReaderT)-import Control.Monad.Trans (lift)+import Control.Monad.Reader (MonadReader, ReaderT, ask, runReaderT)+import Control.Monad.Trans (MonadIO) import Criterion.Config (Config) -type ConfigM = ReaderT Config IO+-- | The monad in which most criterion code executes.+newtype ConfigM a = ConfigM {+      runConfigM :: ReaderT Config IO a+    } deriving (Functor, Monad, MonadReader Config, MonadIO)  getConfig :: ConfigM Config getConfig = ask@@ -21,8 +32,5 @@ 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+withConfig = flip (runReaderT . runConfigM)

@@ -18,8 +18,9 @@     , plotWith     ) where +import Control.Monad.Trans (liftIO) import Criterion.Config-import Criterion.Monad (ConfigM, doIO, getConfigItem)+import Criterion.Monad (ConfigM, getConfigItem) import Data.Array.Vector import Data.Char (isSpace, toLower) import Data.Foldable (forM_)@@ -41,7 +42,7 @@  plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM () plotWith p plot = getConfigItem (M.lookup p . cfgPlot)-                    >>= maybe (return ()) (flip forM_ (doIO . plot))+                    >>= maybe (return ()) (liftIO . flip forM_ plot)  -- | Plot timing data. plotTiming :: PlotOutput        -- ^ The kind of output desired.

@@ -26,6 +26,7 @@     (       Benchmarkable(..)     , Benchmark(..)+    , B(..)     , bench     , bgroup     , benchNames@@ -34,14 +35,33 @@ import Control.Exception (evaluate)  -- | A benchmarkable function or action.-class Benchmarkable b where-    run :: b -> Int -> IO ()+class Benchmarkable a where+    -- | Run a function or action the specified number of times.+    run :: a                    -- ^ The function or action to benchmark.+        -> Int                  -- ^ The number of times to run or evaluate it.+        -> IO () -instance Benchmarkable (Int -> a) where-    run f u = evaluate (f u) >> return ()+-- | A container for a pure function to benchmark, and an argument to+-- supply to it each time it is evaluated.+data B a b = B (a -> b) a +instance Benchmarkable (a -> b, a) where+    run fx@(f,x) n+        | n <= 0    = return ()+        | otherwise = evaluate (f x) >> run fx (n-1)+    {-# INLINE run #-}++instance Benchmarkable (B a b) where+    run fx@(B f x) n+        | n <= 0    = return ()+        | otherwise = evaluate (f x) >> run fx (n-1)+    {-# INLINE run #-}+ instance Benchmarkable (IO a) where-    run a _ = a >> return ()+    run a n+        | n <= 0    = return ()+        | otherwise = a >> run a (n-1)+    {-# INLINE run #-}  -- | A benchmark may consist of either a single 'Benchmarkable' item -- with a name, created with 'bench', or a (possibly nested) group of

@@ -1,5 +1,5 @@ name:           criterion-version:        0.1.4+version:        0.2.0 synopsis:       Robust, reliable performance measurement and analysis license:        BSD3 license-file:   LICENSE@@ -10,7 +10,11 @@ build-type:     Simple cabal-version:  >= 1.2 extra-source-files:-  README examples/Fibber.hs examples/Judy.hs+  README+  examples/Fibber.hs+  examples/Judy.hs+  examples/Makefile+  examples/Tiny.hs description:   This library provides a powerful but simple way to measure the   performance of Haskell code.  It provides both a framework for

@@ -25,18 +25,18 @@             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 "tiny" [ bench "fib 10" $ B fib 10+                      , bench "fib 15" $ B fib 15+                      , bench "fib 20" $ B fib 20+                      , bench "fib 25" $ B fib 25                       ],-        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)+        bgroup "fib" [ bench "fib 10" $ B fib 10+                     , bench "fib 35" $ B fib 35+                     , bench "fib 37" $ B fib 37                      ],-        bgroup "fact" [ bench "fact 100"  $ \n -> fact (100+n-n)-                      , bench "fact 1000" $ \n -> fact (1000+n-n)-                      , bench "fact 3000" $ \n -> fact (3000+n-n)+        bgroup "fact" [ bench "fact 100"  $ B fact 100+                      , bench "fact 1000" $ B fact 1000+                      , bench "fact 3000" $ B fact 3000                       ],         bgroup "fio" [ bench "fio 100"  (fio 100)                      , bench "fio 1000" (fio 1000)

@@ -19,17 +19,17 @@  main = defaultMainWith myConfig [         bgroup "judy" [-                     bench "insert 1M"   (testit 1000000)-                   , bench "insert 10M"  (testit 10000000)-                   , bench "insert 100M" (testit 100000000)+                     bench "insert 1M"   $ B testit 1000000+                   , bench "insert 10M"  $ B testit 10000000+                   , bench "insert 100M" $ B testit 100000000                    ],         bgroup "map" [-                      bench "insert 100k" (testmap 100000)-                   , bench "insert 1M"    (testmap 1000000)+                     bench "insert 100k" $ B testmap 100000+                   , bench "insert 1M"   $ B testmap 1000000                    ],         bgroup "intmap" [-                     bench "insert 100k" (testintmap 100000)-                   , bench "insert 1M"   (testintmap 1000000)+                     bench "insert 100k" $ B testintmap 100000+                   , bench "insert 1M"   $ B testintmap 1000000                    ]     ] @@ -39,10 +39,10 @@    v <- J.lookup 100 j    v `seq` return () -testmap :: Int -> Int -> M.Map Int Int-testmap n i =-    foldl' (\m k -> M.insert k 1 m) M.empty [0..(n+i-i)]+testmap :: Int -> M.Map Int Int+testmap n =+    foldl' (\m k -> M.insert k 1 m) M.empty [0..n] -testintmap :: Int -> Int -> I.IntMap Int-testintmap n i =-    foldl' (\m k -> I.insert k 1 m) I.empty [0..(n+i-i)]+testintmap :: Int -> I.IntMap Int+testintmap n =+    foldl' (\m k -> I.insert k 1 m) I.empty [0..n]

@@ -0,0 +1,9 @@+all := Fibber Judy Tiny++all: $(all)++%: %.hs+	ghc -O --make $<++clean:+	-rm -f *.hi *.o $(all)

@@ -0,0 +1,27 @@+{-# LANGUAGE ScopedTypeVariables #-}++import Criterion.Main+import Control.Parallel+import qualified Data.IntMap as I+import Data.List (foldl')+import Criterion.Config+import qualified Criterion.MultiMap as M++myConfig = defaultConfig {+             -- Always display an 800x600 window.+             cfgPlot = M.singleton KernelDensity (Window 800 600)+           }++main = defaultMainWith myConfig [+         bench "fib 30" $ B fib 30+       , bench "intmap 50k" $ B intmap 50000+       , bench "intmap 75k" $ B intmap 75000+       ]+        +fib :: Int -> Int+fib 0 = 0+fib 1 = 1+fib n = fib (n-1) + fib (n-2)++intmap :: Int -> I.IntMap Int+intmap n = foldl' (\m k -> I.insert k 33 m) I.empty [0..n]