Commits

Bryan O'Sullivan  committed c7fcc34

Update docs.

  • Participants
  • Parent commits d85899d

Comments (0)

Files changed (6)

File Criterion.hs

+-- |
+-- Module      : Criterion
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Core benchmarking code.
+
 module Criterion
     (
       Benchmarkable(..)
 import Criterion.Plot (plotWith, plotKDE, plotTiming)
 import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, bgroup)
 import Data.Array.Vector ((:*:)(..), lengthU, mapU)
-import Prelude hiding (catch)
 import Statistics.Function (createIO)
 import Statistics.KernelDensity (epanechnikovPDF)
 import Statistics.RandomVariate (withSystemRandom)
 import Statistics.Types (Sample)
 import System.Mem (performGC)
 
+-- | Run a single benchmark and return timings for executing it.
 runBenchmark :: Benchmarkable b => Config -> Environment -> b -> IO Sample
 runBenchmark cfg env b = do
   runForAtLeast 0.1 10000 (`replicateM_` getTime)
     timeLoop k | k <= 0    = return ()
                | 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

File Criterion/Config.hs

     mempty  = Nada
     mappend = max
 
-data PlotOutput = CSV
-                | PDF Int Int
-                | PNG Int Int
-                | SVG Int Int
-                | Window Int Int
+-- | Supported plot outputs.  Some outputs support width and height in
+-- varying units.
+data PlotOutput = CSV           -- ^ Textual CSV file.
+                | PDF Int Int   -- ^ PDF file, dimensions in points.
+                | PNG Int Int   -- ^ PNG file, dimensions in pixels.
+                | SVG Int Int   -- ^ SVG file, dimensions in points.
+                | Window Int Int-- ^ Display in a window, dimensions in pixels.
                   deriving (Eq, Ord, Read, Show)
 
+-- | What to plot.
 data Plot = KernelDensity
           | Timing
             deriving (Eq, Ord, Read, Show)
 
 data Config = Config {
-      cfgBanner       :: Last String
-    , cfgConfInterval :: Last Double
-    , cfgPerformGC    :: Last Bool
-    , cfgPlot         :: MultiMap Plot PlotOutput
-    , cfgPrintExit    :: PrintExit
-    , cfgResamples    :: Last Int
-    , cfgSamples      :: Last Int
-    , cfgVerbosity    :: Last Verbosity
+      cfgBanner       :: Last String -- ^ The \"version\" banner to print.
+    , 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.
+    , cfgPrintExit    :: PrintExit   -- ^ Whether to print information and exit.
+    , cfgResamples    :: Last Int    -- ^ Number of resamples to perform.
+    , cfgSamples      :: Last Int    -- ^ Number of samples to collect.
+    , cfgVerbosity    :: Last Verbosity -- ^ Whether to run verbosely.
     } deriving (Eq, Read, Show, Typeable)
 
 emptyConfig :: Config
               , cfgVerbosity    = mempty
               }
 
+-- | A configuration with sensible defaults.
 defaultConfig :: Config
 defaultConfig = Config {
                   cfgBanner       = ljust "I don't know what version I am."
                 , cfgVerbosity    = ljust Normal
                 }
 
+-- | Constructor for 'Last' values.
 ljust :: a -> Last a
 ljust = Last . Just
 
-fromLJ :: (Config -> Last a) -> Config -> a
+-- | Deconstructor for 'Last' values.
+fromLJ :: (Config -> Last a)    -- ^ Field to access.
+       -> Config                -- ^ Default to use.
+       -> a
 fromLJ f cfg = case f cfg of
                  Last Nothing  -> fromLJ f defaultConfig
                  Last (Just a) -> a

File Criterion/Main.hs

     ) where
 
 import Control.Monad (MonadPlus(..))
-import Criterion (Benchmarkable(..), Benchmark, bench, bgroup, runAndAnalyse)
+import Criterion (runAndAnalyse)
 import Criterion.Config
 import Criterion.Environment (measureEnvironment)
 import Criterion.IO (note, printError)
 import Criterion.MultiMap (singleton)
-import Data.List (isPrefixOf)
+import Criterion.Types (Benchmarkable(..), Benchmark, bench, benchNames, bgroup)
+import Data.List (isPrefixOf, sort)
 import Data.Monoid (Monoid(..), Last(..))
 import System.Console.GetOpt
 import System.Environment (getArgs, getProgName)
 import System.Exit (ExitCode(..), exitWith)
 import Text.ParserCombinators.Parsec
 
+-- | Parse a plot output.
 parsePlot :: Parser PlotOutput
 parsePlot = try (dim "window" Window 800 600)
     `mplus` try (dim "win" Window 800 600)
               _                   -> mzero
            <?> "dimensions"
 
+-- | Parse a plot type.
 plot :: Plot -> String -> IO Config
 plot p s = case parse parsePlot "" s of
              Left _err -> parseError "unknown plot type\n"
              Right t   -> return mempty { cfgPlot = singleton p t }
 
+-- | Parse a confidence interval.
 ci :: String -> IO Config
 ci s = case reads s' of
          [(d,"%")] -> check (d/100)
                 | d >= 1 = parseError "confidence interval is greater than 1"
                 | otherwise = return mempty { cfgConfInterval = ljust d }
 
+-- | Parse a positive number.
 pos :: (Num a, Ord a, Read a) =>
        String -> (Last a -> Config) -> String -> IO Config
 pos q f s =
           "collect garbage between iterations"
  , Option ['I'] ["ci"] (ReqArg ci "CI")
           "bootstrap confidence interval"
+ , Option ['l'] ["--list"] (noArg mempty { cfgPrintExit = List })
+          "print a list of benchmarks"
  , Option ['k'] ["plot-kde"] (ReqArg (plot KernelDensity) "TYPE")
           "plot kernel density estimate of probabilities"
  , Option ['q'] ["quiet"] (noArg mempty { cfgVerbosity = ljust Quiet })
     ]
   exitWith exitCode
 
-parseCommandLine :: Config -> [OptDescr (IO Config)] -> [String]
-                 -> IO (Config, [String])
-parseCommandLine defCfg options args =
+-- | Parse command line options.
+parseArgs :: Config -> [OptDescr (IO Config)] -> [String]
+          -> IO (Config, [String])
+parseArgs defCfg options args =
   case getOpt Permute options args of
     (_, _, (err:_)) -> parseError err
     (opts, rest, _) -> do
         Version -> printBanner cfg >> exitWith ExitSuccess
         _ ->       return (cfg, rest)
 
+-- | An entry point that can be used as a @main@ function.
 defaultMain :: [Benchmark] -> IO ()
 defaultMain = defaultMainWith defaultConfig
 
+-- | An entry point that can be used as a @main@ function, with
+-- configurable defaults.
 defaultMainWith :: Config -> [Benchmark] -> IO ()
 defaultMainWith defCfg bs = do
   (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs

File Criterion/Plot.hs

                | t >= 1e3  = printf "%.0f %s" t u
                | t >= 1e2  = printf "%.0f %s" t u
                | t >= 1e1  = printf "%.1f %s" t u
-               | otherwise = printf "%.1f %s" t u
+               | otherwise = printf "%.2f %s" t u

File Criterion/Types.hs

+-- |
+-- Module      : Criterion.Types
+-- Copyright   : (c) Bryan O'Sullivan 2009
+--
+-- License     : BSD-style
+-- Maintainer  : bos@serpentine.com
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- Types for benchmarking.
+--
+-- The core class is 'Benchmarkable', which admits both pure functions
+-- and 'IO' actions.
+--
+-- For a pure function of type @Int -> a@, the benchmarking harness
+-- calls this function repeatedly, each time with a different 'Int'
+-- argument, and reduces the result the function returns to WHNF.
+
 {-# LANGUAGE FlexibleInstances, GADTs #-}
 module Criterion.Types
     (
     , benchNames
     ) where
 
-import Control.Parallel.Strategies
 import Control.Exception (evaluate)
 
+-- | A benchmarkable function or action.
 class Benchmarkable b where
     run :: b -> Int -> IO ()
 
-instance (NFData a) => Benchmarkable (Int -> a) where
+instance Benchmarkable (Int -> a) where
     run f u = evaluate (f u) >> return ()
 
 instance Benchmarkable (IO a) where
     run a _ = a >> return ()
 
+-- | A benchmark may be composed of either a single 'Benchmarkable'
+-- item with a name, or a (possibly nested) group of 'Benchmark's.
 data Benchmark where
     Benchmark  :: Benchmarkable b => String -> b -> Benchmark
     BenchGroup :: String -> [Benchmark] -> Benchmark
 
+-- | Create a single benchmark.
 bench :: Benchmarkable b => String -> b -> Benchmark
 bench = Benchmark
 
+-- | Group several benchmarks together under a common name.
 bgroup :: String -> [Benchmark] -> Benchmark
 bgroup = BenchGroup
 
+-- | Retrieve the names of all benchmarks.
 benchNames :: Benchmark -> [String]
 benchNames (Benchmark d _)   = [d]
-benchNames (BenchGroup d bs) = d : concatMap benchNames bs
+benchNames (BenchGroup d bs) = map ((d ++ "/") ++) . concatMap benchNames $ bs
 
 instance Show Benchmark where
     show (Benchmark d _)  = ("Benchmark " ++ show d)

File examples/Judy.hs

 {-# LANGUAGE FlexibleInstances, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-full-laziness #-}
 
 -- cabal install judy
 
 import Control.Monad (forM_)
 import Criterion.Config
 import Criterion.Main
+import Criterion.Types
 import qualified Data.IntMap as I
 import qualified Data.Judy as J
+import qualified Data.Map as M
+import qualified Data.IntMap as I
+import Data.List (foldl')
 
 -- Work around the fact that the GC won't run finalizers aggressively
 -- enough for us.
 myConfig = defaultConfig { cfgPerformGC = ljust True }
 
 main = defaultMainWith myConfig [
-        bench "insert 1M"   (testit 1000000)
-       ,bench "insert 10M"  (testit 10000000)
-       ,bench "insert 100M" (testit 100000000)
+        bgroup "judy" [
+                     bench "insert 1M"   (testit 1000000)
+                   , bench "insert 10M"  (testit 10000000)
+                   , bench "insert 100M" (testit 100000000)
+                   ],
+        bgroup "map" [
+                      bench "insert 100k" (testmap 100000)
+                   , bench "insert 1M"    (testmap 1000000)
+                   ],
+        bgroup "intmap" [
+                     bench "insert 100k" (testintmap 100000)
+                   , bench "insert 1M"   (testintmap 1000000)
+                   ]
     ]
 
 testit n = do
    forM_ [1..n] $ \n -> J.insert n (fromIntegral n :: Int) j
    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)]
+
+testintmap :: Int -> Int -> I.IntMap Int
+testintmap n i =
+    foldl' (\m k -> I.insert k 1 m) I.empty [0..(n+i-i)]