criterion 0.6.2.1 → 0.8.0.0
raw patch · 14 files changed
+552/−339 lines, 14 filesdep +Globdep +binarydep +ghc-primdep ~deepseqdep ~statisticsPVP ok
version bump matches the API change (PVP)
Dependencies added: Glob, binary, ghc-prim
Dependency ranges changed: deepseq, statistics
API changes (from Hackage documentation)
- Criterion.IO: class CritHPrintfType a
- Criterion.IO: instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r)
- Criterion.IO: instance CritHPrintfType (Criterion a)
- Criterion.IO: instance CritHPrintfType (IO a)
- Criterion.IO: note :: CritHPrintfType r => String -> r
- Criterion.IO: printError :: CritHPrintfType r => String -> r
- Criterion.IO: prolix :: CritHPrintfType r => String -> r
- Criterion.IO: summary :: String -> Criterion ()
+ Criterion: bcompare :: [Benchmark] -> Benchmark
+ Criterion.Analysis.Types: instance Binary OutlierEffect
+ Criterion.Analysis.Types: instance Binary OutlierVariance
+ Criterion.Analysis.Types: instance Binary Outliers
+ Criterion.Analysis.Types: instance Binary SampleAnalysis
+ Criterion.Analysis.Types: instance Constructor C1_0OutlierEffect
+ Criterion.Analysis.Types: instance Constructor C1_0OutlierVariance
+ Criterion.Analysis.Types: instance Constructor C1_0Outliers
+ Criterion.Analysis.Types: instance Constructor C1_0SampleAnalysis
+ Criterion.Analysis.Types: instance Constructor C1_1OutlierEffect
+ Criterion.Analysis.Types: instance Constructor C1_2OutlierEffect
+ Criterion.Analysis.Types: instance Constructor C1_3OutlierEffect
+ Criterion.Analysis.Types: instance Datatype D1OutlierEffect
+ Criterion.Analysis.Types: instance Datatype D1OutlierVariance
+ Criterion.Analysis.Types: instance Datatype D1Outliers
+ Criterion.Analysis.Types: instance Datatype D1SampleAnalysis
+ Criterion.Analysis.Types: instance Generic OutlierEffect
+ Criterion.Analysis.Types: instance Generic OutlierVariance
+ Criterion.Analysis.Types: instance Generic Outliers
+ Criterion.Analysis.Types: instance Generic SampleAnalysis
+ Criterion.Analysis.Types: instance Read SampleAnalysis
+ Criterion.Analysis.Types: instance Selector S1_0_0OutlierVariance
+ Criterion.Analysis.Types: instance Selector S1_0_0Outliers
+ Criterion.Analysis.Types: instance Selector S1_0_0SampleAnalysis
+ Criterion.Analysis.Types: instance Selector S1_0_1OutlierVariance
+ Criterion.Analysis.Types: instance Selector S1_0_1Outliers
+ Criterion.Analysis.Types: instance Selector S1_0_1SampleAnalysis
+ Criterion.Analysis.Types: instance Selector S1_0_2OutlierVariance
+ Criterion.Analysis.Types: instance Selector S1_0_2Outliers
+ Criterion.Analysis.Types: instance Selector S1_0_2SampleAnalysis
+ Criterion.Analysis.Types: instance Selector S1_0_3Outliers
+ Criterion.Analysis.Types: instance Selector S1_0_4Outliers
+ Criterion.Config: Glob :: MatchType
+ Criterion.Config: Prefix :: MatchType
+ Criterion.Config: cfgMatchType :: Config -> Last MatchType
+ Criterion.Config: cfgResults :: Config -> Last FilePath
+ Criterion.Config: data MatchType
+ Criterion.Config: instance Bounded MatchType
+ Criterion.Config: instance Constructor C1_0Config
+ Criterion.Config: instance Constructor C1_0MatchType
+ Criterion.Config: instance Constructor C1_0PrintExit
+ Criterion.Config: instance Constructor C1_0Verbosity
+ Criterion.Config: instance Constructor C1_1MatchType
+ Criterion.Config: instance Constructor C1_1PrintExit
+ Criterion.Config: instance Constructor C1_1Verbosity
+ Criterion.Config: instance Constructor C1_2PrintExit
+ Criterion.Config: instance Constructor C1_2Verbosity
+ Criterion.Config: instance Constructor C1_3PrintExit
+ Criterion.Config: instance Data MatchType
+ Criterion.Config: instance Data Verbosity
+ Criterion.Config: instance Datatype D1Config
+ Criterion.Config: instance Datatype D1MatchType
+ Criterion.Config: instance Datatype D1PrintExit
+ Criterion.Config: instance Datatype D1Verbosity
+ Criterion.Config: instance Enum MatchType
+ Criterion.Config: instance Eq MatchType
+ Criterion.Config: instance Generic Config
+ Criterion.Config: instance Generic MatchType
+ Criterion.Config: instance Generic PrintExit
+ Criterion.Config: instance Generic Verbosity
+ Criterion.Config: instance Ord MatchType
+ Criterion.Config: instance Read MatchType
+ Criterion.Config: instance Selector S1_0_0Config
+ Criterion.Config: instance Selector S1_0_10Config
+ Criterion.Config: instance Selector S1_0_11Config
+ Criterion.Config: instance Selector S1_0_12Config
+ Criterion.Config: instance Selector S1_0_13Config
+ Criterion.Config: instance Selector S1_0_14Config
+ Criterion.Config: instance Selector S1_0_1Config
+ Criterion.Config: instance Selector S1_0_2Config
+ Criterion.Config: instance Selector S1_0_3Config
+ Criterion.Config: instance Selector S1_0_4Config
+ Criterion.Config: instance Selector S1_0_5Config
+ Criterion.Config: instance Selector S1_0_6Config
+ Criterion.Config: instance Selector S1_0_7Config
+ Criterion.Config: instance Selector S1_0_8Config
+ Criterion.Config: instance Selector S1_0_9Config
+ Criterion.Config: instance Show MatchType
+ Criterion.Config: instance Typeable MatchType
+ Criterion.Environment: instance Constructor C1_0Environment
+ Criterion.Environment: instance Data Environment
+ Criterion.Environment: instance Datatype D1Environment
+ Criterion.Environment: instance Generic Environment
+ Criterion.Environment: instance Selector S1_0_0Environment
+ Criterion.Environment: instance Selector S1_0_1Environment
+ Criterion.IO: hGetResults :: Handle -> IO (Either String ResultForest)
+ Criterion.IO: hPutResults :: Handle -> ResultForest -> IO ()
+ Criterion.IO: header :: ByteString
+ Criterion.IO: readResults :: FilePath -> IO (Either String ResultForest)
+ Criterion.IO: writeResults :: FilePath -> ResultForest -> IO ()
+ Criterion.IO.Printf: class CritHPrintfType a
+ Criterion.IO.Printf: instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r)
+ Criterion.IO.Printf: instance CritHPrintfType (Criterion a)
+ Criterion.IO.Printf: instance CritHPrintfType (IO a)
+ Criterion.IO.Printf: note :: CritHPrintfType r => String -> r
+ Criterion.IO.Printf: printError :: CritHPrintfType r => String -> r
+ Criterion.IO.Printf: prolix :: CritHPrintfType r => String -> r
+ Criterion.IO.Printf: summary :: String -> Criterion ()
+ Criterion.Main: makeMatcher :: MatchType -> [String] -> Either String (String -> Bool)
+ Criterion.Report: instance Constructor C1_0Report
+ Criterion.Report: instance Constructor C1_0TemplateException
+ Criterion.Report: instance Datatype D1Report
+ Criterion.Report: instance Datatype D1TemplateException
+ Criterion.Report: instance Generic Report
+ Criterion.Report: instance Generic TemplateException
+ Criterion.Report: instance Read Report
+ Criterion.Report: instance Read TemplateException
+ Criterion.Report: instance Selector S1_0_0Report
+ Criterion.Report: instance Selector S1_0_1Report
+ Criterion.Report: instance Selector S1_0_2Report
+ Criterion.Report: instance Selector S1_0_3Report
+ Criterion.Report: instance Selector S1_0_4Report
+ Criterion.Types: Compare :: !Int -> ResultForest -> ResultTree
+ Criterion.Types: Result :: String -> Sample -> SampleAnalysis -> Outliers -> Result
+ Criterion.Types: Single :: Result -> ResultTree
+ Criterion.Types: data Result
+ Criterion.Types: data ResultTree
+ Criterion.Types: description :: Result -> String
+ Criterion.Types: instance Binary Result
+ Criterion.Types: instance Binary ResultTree
+ Criterion.Types: instance Constructor C1_0Result
+ Criterion.Types: instance Constructor C1_0ResultTree
+ Criterion.Types: instance Constructor C1_1ResultTree
+ Criterion.Types: instance Data Result
+ Criterion.Types: instance Data ResultTree
+ Criterion.Types: instance Datatype D1Result
+ Criterion.Types: instance Datatype D1ResultTree
+ Criterion.Types: instance Eq Result
+ Criterion.Types: instance Eq ResultTree
+ Criterion.Types: instance Generic Result
+ Criterion.Types: instance Generic ResultTree
+ Criterion.Types: instance Read Result
+ Criterion.Types: instance Read ResultTree
+ Criterion.Types: instance Selector S1_0_0Result
+ Criterion.Types: instance Selector S1_0_1Result
+ Criterion.Types: instance Selector S1_0_2Result
+ Criterion.Types: instance Selector S1_0_3Result
+ Criterion.Types: instance Show Result
+ Criterion.Types: instance Show ResultTree
+ Criterion.Types: instance Typeable Result
+ Criterion.Types: instance Typeable ResultTree
+ Criterion.Types: outliers :: Result -> Outliers
+ Criterion.Types: sample :: Result -> Sample
+ Criterion.Types: sampleAnalysis :: Result -> SampleAnalysis
+ Criterion.Types: type ResultForest = [ResultTree]
- Criterion.Config: Config :: Last String -> Last Double -> Last Bool -> PrintExit -> Last Int -> Last FilePath -> Last Int -> Last FilePath -> Last FilePath -> Last FilePath -> Last Verbosity -> Last FilePath -> Last Bool -> Config
+ Criterion.Config: Config :: Last String -> Last Double -> Last MatchType -> Last Bool -> PrintExit -> Last Int -> Last FilePath -> Last FilePath -> Last Int -> Last FilePath -> Last FilePath -> Last FilePath -> Last Verbosity -> Last FilePath -> Last Bool -> Config
Files
- Criterion.hs +3/−223
- Criterion/Analysis.hs +1/−1
- Criterion/Analysis/Types.hs +15/−7
- Criterion/Config.hs +22/−7
- Criterion/Environment.hs +5/−4
- Criterion/IO.hs +45/−79
- Criterion/IO/Printf.hs +99/−0
- Criterion/Internal.hs +262/−0
- Criterion/Main.hs +47/−9
- Criterion/Measurement.hs +2/−2
- Criterion/Report.hs +5/−4
- Criterion/Types.hs +28/−1
- criterion.cabal +9/−2
- examples/Comparison.hs +9/−0
Criterion.hs view
@@ -20,232 +20,12 @@ , nfIO , whnfIO , bench+ , bcompare , bgroup , runBenchmark , runAndAnalyse , runNotAnalyse ) where -import Control.Monad (replicateM_, when, mplus)-import Control.Monad.Trans (liftIO)-import Criterion.Analysis (Outliers(..), OutlierEffect(..), OutlierVariance(..),- SampleAnalysis(..), analyseSample,- classifyOutliers, noteOutliers)-import Criterion.Config (Config(..), Verbosity(..), fromLJ)-import Criterion.Environment (Environment(..))-import Criterion.IO (note, prolix, summary)-import Criterion.Measurement (getTime, runForAtLeast, secs, time_)-import Criterion.Monad (Criterion, getConfig, getConfigItem)-import Criterion.Report (Report(..), report)-import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure,- bench, bgroup, nf, nfIO, whnf, whnfIO)-import qualified Data.Vector.Unboxed as U-import Data.Monoid (getLast)-import Statistics.Resampling.Bootstrap (Estimate(..))-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 => Environment -> b -> Criterion Sample-runBenchmark env b = do- _ <- liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)- let minTime = envClockResolution env * 1000- (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- sampleCount = fromLJ cfgSamples cfg- newItersD = fromIntegral newIters- testItersD = fromIntegral testIters- estTime = (fromIntegral sampleCount * newItersD *- testTime / testItersD)- when (fromLJ cfgVerbosity cfg > Normal || estTime > 5) $- note "collecting %d samples, %d iterations each, in estimated %s\n"- sampleCount newIters (secs estTime)- -- Run the GC to make sure garabage created by previous benchmarks- -- don't affect this benchmark.- liftIO performGC- times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .- U.replicateM sampleCount $ do- when (fromLJ cfgPerformGC cfg) $ performGC- time_ (run b newIters)- return times---- | Run a single benchmark and analyse its performance.-runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b- -> Criterion (Sample,SampleAnalysis,Outliers)-runAndAnalyseOne env _desc b = do- times <- runBenchmark env b- ci <- getConfigItem $ fromLJ cfgConfInterval- numResamples <- getConfigItem $ fromLJ cfgResamples- _ <- prolix "analysing with %d resamples\n" numResamples- an@SampleAnalysis{..} <- liftIO $ analyseSample ci times numResamples- let OutlierVariance{..} = anOutlierVar- let wibble = case ovEffect of- Unaffected -> "unaffected" :: String- Slight -> "slightly inflated"- Moderate -> "moderately inflated"- Severe -> "severely inflated"- bs "mean" anMean- summary ","- bs "std dev" anStdDev- summary "\n"- vrb <- getConfigItem $ fromLJ cfgVerbosity- let out = classifyOutliers times- when (vrb == Verbose || (ovEffect > Unaffected && vrb > Quiet)) $ do- noteOutliers out- _ <- note "variance introduced by outliers: %.3f%%\n" (ovFraction * 100)- _ <- note "variance is %s by outliers\n" wibble- return ()- return (times,an,out)- where bs :: String -> Estimate -> Criterion ()- 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 :: [Result] -> Criterion ()-plotAll descTimes = do- report (zipWith (\n (Result d t a o) -> Report n d t a o) [0..] descTimes)--data Result = Result { description :: String- , _sample :: Sample- , sampleAnalysis :: SampleAnalysis- , _outliers :: Outliers- }--type ResultForest = [ResultTree]-data ResultTree = Single Result | Compare ResultForest---- | Run, and analyse, one or more benchmarks.-runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses- -- whether to run a benchmark by its- -- name.- -> Environment- -> Benchmark- -> Criterion ()-runAndAnalyse p env bs' = do- rts <- go "" bs'-- mbCompareFile <- getConfigItem $ getLast . cfgCompareFile- case mbCompareFile of- Nothing -> return ()- Just compareFile -> do- liftIO $ writeFile compareFile $ resultForestToCSV rts-- let rs = flatten rts- plotAll rs- junit rs-- where go :: String -> Benchmark -> Criterion ResultForest- go pfx (Benchmark desc b)- | p desc' = do _ <- note "\nbenchmarking %s\n" desc'- summary (show desc' ++ ",") -- String will be quoted- (x,an,out) <- runAndAnalyseOne env desc' b- let result = Result desc' x an out- return [Single result]- | otherwise = return []- where desc' = prefix pfx desc- go pfx (BenchGroup desc bs) =- concat `fmap` mapM (go (prefix pfx desc)) bs- go pfx (BenchCompare bs) = ((:[]) . Compare . concat) `fmap` mapM (go pfx) bs--runNotAnalyse :: (String -> Bool) -- ^ A predicate that chooses- -- whether to run a benchmark by its- -- name.- -> Benchmark- -> Criterion ()-runNotAnalyse p bs' = goQuickly "" bs'- where goQuickly :: String -> Benchmark -> Criterion ()- goQuickly pfx (Benchmark desc b)- | p desc' = do _ <- note "benchmarking %s\n" desc'- runOne b- | otherwise = return ()- where desc' = prefix pfx desc- goQuickly pfx (BenchGroup desc bs) =- mapM_ (goQuickly (prefix pfx desc)) bs- goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs-- runOne b = do- samples <- getConfigItem $ fromLJ cfgSamples- liftIO $ run b samples--prefix :: String -> String -> String-prefix "" desc = desc-prefix pfx desc = pfx ++ '/' : desc--flatten :: ResultForest -> [Result]-flatten [] = []-flatten (Single r : rs) = r : flatten rs-flatten (Compare crs : rs) = flatten crs ++ flatten rs--resultForestToCSV :: ResultForest -> String-resultForestToCSV = unlines- . ("Reference,Name,% faster than reference" :)- . map (\(ref, n, p) -> printf "%s,%s,%.0f" ref n p)- . top- where- top :: ResultForest -> [(String, String, Double)]- top [] = []- top (Single _ : rts) = top rts- top (Compare rts' : rts) = cmpRT rts' ++ top rts-- cmpRT :: ResultForest -> [(String, String, Double)]- cmpRT [] = []- cmpRT (Single r : rts) = cmpWith r rts- cmpRT (Compare rts' : rts) = case getReference rts' of- Nothing -> cmpRT rts- Just r -> cmpRT rts' ++ cmpWith r rts-- cmpWith :: Result -> ResultForest -> [(String, String, Double)]- cmpWith _ [] = []- cmpWith ref (Single r : rts) = cmp ref r : cmpWith ref rts- cmpWith ref (Compare rts' : rts) = cmpRT rts' ++- cmpWith ref rts' ++- cmpWith ref rts-- getReference :: ResultForest -> Maybe Result- getReference [] = Nothing- getReference (Single r : _) = Just r- getReference (Compare rts' : rts) = getReference rts' `mplus`- getReference rts--cmp :: Result -> Result -> (String, String, Double)-cmp ref r = (description ref, description r, percentFaster)- where- percentFaster = (meanRef - meanR) / meanRef * 100-- meanRef = mean ref- meanR = mean r-- mean = estPoint . anMean . sampleAnalysis---- | Write summary JUnit file (if applicable)-junit :: [Result] -> Criterion ()-junit rs- = do junitOpt <- getConfigItem (getLast . cfgJUnitFile)- case junitOpt of- Just fn -> liftIO $ writeFile fn msg- Nothing -> return ()- where- msg = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" ++- printf "<testsuite name=\"Criterion benchmarks\" tests=\"%d\">\n"- (length rs) ++- concatMap single rs ++- "</testsuite>\n"- single r = printf " <testcase name=\"%s\" time=\"%f\" />\n"- (attrEsc $ description r) (estPoint $ anMean $ sampleAnalysis r)- attrEsc = concatMap esc- where- esc '\'' = "'"- esc '"' = """- esc '<' = "<"- esc '>' = ">"- esc '&' = "&"- esc c = [c]+import Criterion.Internal+import Criterion.Types
Criterion/Analysis.hs view
@@ -27,7 +27,7 @@ import Control.Monad (when) import Criterion.Analysis.Types-import Criterion.IO (note)+import Criterion.IO.Printf (note) import Criterion.Measurement (secs) import Criterion.Monad (Criterion) import Data.Int (Int64)
Criterion/Analysis/Types.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,+ RecordWildCards #-} -- | -- Module : Criterion.Analysis.Types -- Copyright : (c) 2011 Bryan O'Sullivan@@ -19,10 +20,11 @@ ) where import Control.DeepSeq (NFData(rnf))-import Data.Data (Data)+import Data.Binary (Binary)+import Data.Data (Data, Typeable) import Data.Int (Int64) import Data.Monoid (Monoid(..))-import Data.Typeable (Typeable)+import GHC.Generics (Generic) import qualified Statistics.Resampling.Bootstrap as B -- | Outliers from sample data, calculated using the boxplot@@ -38,8 +40,9 @@ -- ^ Between 1.5 and 3 times the IQR above the third quartile. , highSevere :: {-# UNPACK #-} !Int64 -- ^ More than 3 times the IQR above the third quartile.- } deriving (Eq, Read, Show, Typeable, Data)+ } deriving (Eq, Read, Show, Typeable, Data, Generic) +instance Binary Outliers instance NFData Outliers -- | A description of the extent to which outliers in the sample data@@ -49,8 +52,9 @@ | Moderate -- ^ Between 10% and 50%. | Severe -- ^ Above 50% (i.e. measurements -- are useless).- deriving (Eq, Ord, Read, Show, Typeable, Data)+ deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +instance Binary OutlierEffect instance NFData OutlierEffect instance Monoid Outliers where@@ -71,8 +75,10 @@ -- ^ Brief textual description of effect. , ovFraction :: Double -- ^ Quantitative description of effect (a fraction between 0 and 1).- } deriving (Eq, Read, Show, Typeable, Data)+ } deriving (Eq, Read, Show, Typeable, Data, Generic) +instance Binary OutlierVariance+ instance NFData OutlierVariance where rnf OutlierVariance{..} = rnf ovEffect `seq` rnf ovDesc `seq` rnf ovFraction @@ -81,7 +87,9 @@ anMean :: B.Estimate , anStdDev :: B.Estimate , anOutlierVar :: OutlierVariance- } deriving (Eq, Show, Typeable, Data)+ } deriving (Eq, Read, Show, Typeable, Data, Generic)++instance Binary SampleAnalysis instance NFData SampleAnalysis where rnf SampleAnalysis{..} =
Criterion/Config.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} -- | -- Module : Criterion.Config@@ -15,29 +15,36 @@ ( Config(..) , PrintExit(..)+ , MatchType(..) , Verbosity(..) , defaultConfig , fromLJ , ljust ) where -import Data.Data (Data)+import Data.Data (Data, Typeable) import Data.Function (on) import Data.Monoid (Monoid(..), Last(..))-import Data.Typeable (Typeable)+import GHC.Generics (Generic) +data MatchType = Prefix | Glob+ deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data,+ Generic)+ -- | Control the amount of information displayed. data Verbosity = Quiet | Normal | Verbose- deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable)+ deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data,+ Generic) -- | Print some information and exit, without running any benchmarks. data PrintExit = Nada -- ^ Do not actually print-and-exit. (Default.) | List -- ^ Print a list of known benchmarks. | Version -- ^ Print version information (if known). | Help -- ^ Print a help\/usaage message.- deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data)+ deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data,+ Generic) instance Monoid PrintExit where mempty = Nada@@ -47,9 +54,11 @@ data Config = Config { cfgBanner :: Last String -- ^ The \"version\" banner to print. , cfgConfInterval :: Last Double -- ^ Confidence interval to use.+ , cfgMatchType :: Last MatchType -- ^ Kind of matching to use for benchmark names. , cfgPerformGC :: Last Bool -- ^ Whether to run the GC between passes. , cfgPrintExit :: PrintExit -- ^ Whether to print information and exit. , cfgResamples :: Last Int -- ^ Number of resamples to perform.+ , cfgResults :: Last FilePath -- ^ File to write raw results to. , cfgReport :: Last FilePath -- ^ Filename of report. , cfgSamples :: Last Int -- ^ Number of samples to collect. , cfgSummaryFile :: Last FilePath -- ^ Filename of summary CSV.@@ -58,7 +67,7 @@ , cfgVerbosity :: Last Verbosity -- ^ Whether to run verbosely. , cfgJUnitFile :: Last FilePath -- ^ Filename of JUnit report. , cfgMeasure :: Last Bool -- ^ Whether to do any measurement.- } deriving (Eq, Read, Show, Typeable)+ } deriving (Eq, Read, Show, Typeable, Generic) instance Monoid Config where mempty = emptyConfig@@ -69,9 +78,11 @@ defaultConfig = Config { cfgBanner = ljust "I don't know what version I am." , cfgConfInterval = ljust 0.95- , cfgPerformGC = ljust False+ , cfgMatchType = ljust Prefix+ , cfgPerformGC = ljust True , cfgPrintExit = Nada , cfgResamples = ljust (100 * 1000)+ , cfgResults = mempty , cfgReport = mempty , cfgSamples = ljust 100 , cfgSummaryFile = mempty@@ -98,10 +109,12 @@ emptyConfig = Config { cfgBanner = mempty , cfgConfInterval = mempty+ , cfgMatchType = mempty , cfgPerformGC = mempty , cfgPrintExit = mempty , cfgReport = mempty , cfgResamples = mempty+ , cfgResults = mempty , cfgSamples = mempty , cfgSummaryFile = mempty , cfgCompareFile = mempty@@ -116,10 +129,12 @@ Config { cfgBanner = app cfgBanner a b , cfgConfInterval = app cfgConfInterval a b+ , cfgMatchType = app cfgMatchType a b , cfgPerformGC = app cfgPerformGC a b , cfgPrintExit = app cfgPrintExit a b , cfgReport = app cfgReport a b , cfgResamples = app cfgResamples a b+ , cfgResults = app cfgResults a b , cfgSamples = app cfgSamples a b , cfgSummaryFile = app cfgSummaryFile a b , cfgCompareFile = app cfgCompareFile a b
Criterion/Environment.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TypeOperators #-} -- | -- Module : Criterion.Environment@@ -20,11 +20,12 @@ import Control.Monad (replicateM_) import Control.Monad.Trans (liftIO) import Criterion.Analysis (analyseMean)-import Criterion.IO (note)+import Criterion.IO.Printf (note) import Criterion.Measurement (getTime, runForAtLeast, time_) import Criterion.Monad (Criterion) import qualified Data.Vector.Unboxed as U-import Data.Typeable (Typeable)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic) -- | Measured aspects of the execution environment. data Environment = Environment {@@ -32,7 +33,7 @@ -- ^ Clock resolution (in seconds). , envClockCost :: {-# UNPACK #-} !Double -- ^ The cost of a single clock call (in seconds).- } deriving (Eq, Read, Show, Typeable)+ } deriving (Eq, Read, Show, Typeable, Data, Generic) -- | Measure the execution environment. measureEnvironment :: Criterion Environment
Criterion/IO.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} -- | -- Module : Criterion.IO -- Copyright : (c) 2009, 2010 Bryan O'Sullivan@@ -9,92 +10,57 @@ -- -- Input and output actions. -{-# LANGUAGE FlexibleInstances, Rank2Types, TypeSynonymInstances #-} module Criterion.IO (- CritHPrintfType- , note- , printError- , prolix- , summary+ header+ , hGetResults+ , hPutResults+ , readResults+ , writeResults ) where -import Control.Monad (when)-import Control.Monad.Trans (liftIO)-import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity, fromLJ)-import Criterion.Monad (Criterion, getConfig, getConfigItem)-import Data.Monoid (getLast)-import System.IO (Handle, stderr, stdout)-import qualified Text.Printf (HPrintfType, hPrintf)-import Text.Printf (PrintfArg)---- 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)---- | An internal class that acts like Printf/HPrintf.------ The implementation is visible to the rest of the program, but the--- details of the class are not.-class CritHPrintfType a where- chPrintfImpl :: (Config -> Bool) -> PrintfCont -> a---instance CritHPrintfType (Criterion 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:+import Criterion.Types (ResultForest, ResultTree(..))+import Data.Binary (Binary(..), encode)+import Data.Binary.Get (runGetOrFail)+import Data.Binary.Put (putByteString, putWord16be, runPut)+import Data.Version (Version(..))+import Paths_criterion (version)+import System.IO (Handle, IOMode(..), withFile)+import qualified Data.ByteString.Lazy as L -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))--}+header :: L.ByteString+header = runPut $ do+ putByteString "criterio"+ mapM_ (putWord16be . fromIntegral) (versionBranch version) --- | Print a \"normal\" note.-note :: (CritHPrintfType r) => String -> r-note = chPrintf ((> Quiet) . fromLJ cfgVerbosity) stdout+hGetResults :: Handle -> IO (Either String ResultForest)+hGetResults handle = do+ let fixup = reverse . nukem . reverse+ nukem (Compare k _ : rs) = let (cs, rs') = splitAt k rs+ in Compare k (fixup (reverse cs)) : nukem rs'+ nukem (r : rs) = r : nukem rs+ nukem _ = []+ bs <- L.hGet handle (fromIntegral (L.length header))+ if bs == header+ then (Right . fixup) `fmap` readAll handle+ else return $ Left "unexpected header" --- | Print verbose output.-prolix :: (CritHPrintfType r) => String -> r-prolix = chPrintf ((== Verbose) . fromLJ cfgVerbosity) stdout+hPutResults :: Handle -> ResultForest -> IO ()+hPutResults handle rs = do+ L.hPut handle header+ mapM_ (L.hPut handle . encode) rs --- | Print an error message.-printError :: (CritHPrintfType r) => String -> r-printError = chPrintf (const True) stderr+readResults :: FilePath -> IO (Either String ResultForest)+readResults path = withFile path ReadMode hGetResults --- | Add to summary CSV (if applicable)-summary :: String -> Criterion ()-summary msg- = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)- case sumOpt of- Just fn -> liftIO $ appendFile fn msg- Nothing -> return ()+writeResults :: FilePath -> ResultForest -> IO ()+writeResults path rs = withFile path WriteMode (flip hPutResults rs) +readAll :: Binary a => Handle -> IO [a]+readAll handle = do+ let go bs+ | L.null bs = return []+ | otherwise = case runGetOrFail get bs of+ Left (_, _, err) -> fail err+ Right (bs', _, a) -> (a:) `fmap` go bs'+ go =<< L.hGetContents handle
+ Criterion/IO/Printf.hs view
@@ -0,0 +1,99 @@+-- |+-- Module : Criterion.IO.Printf+-- Copyright : (c) 2009, 2010 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Input and output actions.++{-# LANGUAGE FlexibleInstances, Rank2Types, TypeSynonymInstances #-}+module Criterion.IO.Printf+ (+ CritHPrintfType+ , note+ , printError+ , prolix+ , summary+ ) where++import Control.Monad (when)+import Control.Monad.Trans (liftIO)+import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity, fromLJ)+import Criterion.Monad (Criterion, getConfig, getConfigItem)+import Data.Monoid (getLast)+import System.IO (Handle, stderr, stdout)+import qualified Text.Printf (HPrintfType, hPrintf)+import Text.Printf (PrintfArg)++-- 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)++-- | An internal class that acts like Printf/HPrintf.+--+-- The implementation is visible to the rest of the program, but the+-- details of the class are not.+class CritHPrintfType a where+ chPrintfImpl :: (Config -> Bool) -> PrintfCont -> a+++instance CritHPrintfType (Criterion 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 :: (CritHPrintfType r) => String -> r+note = chPrintf ((> Quiet) . fromLJ cfgVerbosity) stdout++-- | Print verbose output.+prolix :: (CritHPrintfType r) => String -> r+prolix = chPrintf ((== Verbose) . fromLJ cfgVerbosity) stdout++-- | Print an error message.+printError :: (CritHPrintfType r) => String -> r+printError = chPrintf (const True) stderr++-- | Add to summary CSV (if applicable)+summary :: String -> Criterion ()+summary msg+ = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)+ case sumOpt of+ Just fn -> liftIO $ appendFile fn msg+ Nothing -> return ()
+ Criterion/Internal.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE BangPatterns, RecordWildCards #-}+-- |+-- Module : Criterion+-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+-- Core benchmarking code.++module Criterion.Internal+ (+ runBenchmark+ , runAndAnalyse+ , runNotAnalyse+ , prefix+ ) where++import Control.Monad (foldM, replicateM_, when, mplus)+import Control.Monad.Trans (liftIO)+import Data.Binary (encode)+import qualified Data.ByteString.Lazy as L+import Criterion.Analysis (Outliers(..), OutlierEffect(..), OutlierVariance(..),+ SampleAnalysis(..), analyseSample,+ classifyOutliers, noteOutliers)+import Criterion.Config (Config(..), Verbosity(..), fromLJ)+import Criterion.Environment (Environment(..))+import Criterion.IO (header, hGetResults)+import Criterion.IO.Printf (note, prolix, summary)+import Criterion.Measurement (getTime, runForAtLeast, secs, time_)+import Criterion.Monad (Criterion, getConfig, getConfigItem)+import Criterion.Report (Report(..), report)+import Criterion.Types (Benchmark(..), Benchmarkable(..),+ Result(..), ResultForest, ResultTree(..))+import qualified Data.Vector.Unboxed as U+import Data.Monoid (getLast)+import Statistics.Resampling.Bootstrap (Estimate(..))+import Statistics.Types (Sample)+import System.Directory (getTemporaryDirectory, removeFile)+import System.IO (IOMode(..), SeekMode(..), hClose, hSeek, openBinaryFile,+ openBinaryTempFile)+import System.Mem (performGC)+import Text.Printf (printf)++-- | Run a single benchmark, and return timings measured when+-- executing it.+runBenchmark :: Benchmarkable b => Environment -> b -> Criterion Sample+runBenchmark env b = do+ _ <- liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)+ let minTime = envClockResolution env * 1000+ (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+ sampleCount = fromLJ cfgSamples cfg+ newItersD = fromIntegral newIters+ testItersD = fromIntegral testIters+ estTime = (fromIntegral sampleCount * newItersD *+ testTime / testItersD)+ when (fromLJ cfgVerbosity cfg > Normal || estTime > 5) $+ note "collecting %d samples, %d iterations each, in estimated %s\n"+ sampleCount newIters (secs estTime)+ -- Run the GC to make sure garabage created by previous benchmarks+ -- don't affect this benchmark.+ liftIO performGC+ times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .+ U.replicateM sampleCount $ do+ when (fromLJ cfgPerformGC cfg) $ performGC+ time_ (run b newIters)+ return times++-- | Run a single benchmark and analyse its performance.+runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b+ -> Criterion (Sample,SampleAnalysis,Outliers)+runAndAnalyseOne env _desc b = do+ times <- runBenchmark env b+ ci <- getConfigItem $ fromLJ cfgConfInterval+ numResamples <- getConfigItem $ fromLJ cfgResamples+ _ <- prolix "analysing with %d resamples\n" numResamples+ an@SampleAnalysis{..} <- liftIO $ analyseSample ci times numResamples+ let OutlierVariance{..} = anOutlierVar+ let wibble = case ovEffect of+ Unaffected -> "unaffected" :: String+ Slight -> "slightly inflated"+ Moderate -> "moderately inflated"+ Severe -> "severely inflated"+ bs "mean" anMean+ summary ","+ bs "std dev" anStdDev+ summary "\n"+ vrb <- getConfigItem $ fromLJ cfgVerbosity+ let out = classifyOutliers times+ when (vrb == Verbose || (ovEffect > Unaffected && vrb > Quiet)) $ do+ noteOutliers out+ _ <- note "variance introduced by outliers: %.3f%%\n" (ovFraction * 100)+ _ <- note "variance is %s by outliers\n" wibble+ return ()+ return (times,an,out)+ where bs :: String -> Estimate -> Criterion ()+ 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 :: [Result] -> Criterion ()+plotAll descTimes = do+ report (zipWith (\n (Result d t a o) -> Report n d t a o) [0..] descTimes)++-- | Run, and analyse, one or more benchmarks.+runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses+ -- whether to run a benchmark by its+ -- name.+ -> Environment+ -> Benchmark+ -> Criterion ()+runAndAnalyse p env bs' = do+ mbResultFile <- getConfigItem $ getLast . cfgResults+ (resultFile, handle) <- liftIO $+ case mbResultFile of+ Nothing -> do+ tmpDir <- getTemporaryDirectory+ openBinaryTempFile tmpDir "criterion.dat"+ Just file -> do+ handle <- openBinaryFile file ReadWriteMode+ return (file, handle)+ liftIO $ L.hPut handle header++ let go !k (pfx, Benchmark desc b)+ | p desc' = do _ <- note "\nbenchmarking %s\n" desc'+ summary (show desc' ++ ",") -- String will be quoted+ (x,an,out) <- runAndAnalyseOne env desc' b+ let result = Single $ Result desc' x an out+ liftIO $ L.hPut handle (encode result)+ return $! k + 1+ | otherwise = return (k :: Int)+ where desc' = prefix pfx desc+ go !k (pfx, BenchGroup desc bs) =+ foldM go k [(prefix pfx desc, b) | b <- bs]+ go !k (pfx, BenchCompare bs) = do+ l <- foldM go 0 [(pfx, b) | b <- bs]+ let result = Compare l []+ liftIO $ L.hPut handle (encode result)+ return $! l + k+ _ <- go 0 ("", bs')++ rts <- (either fail return =<<) . liftIO $ do+ hSeek handle AbsoluteSeek 0+ rs <- hGetResults handle+ hClose handle+ case mbResultFile of+ Just _ -> return rs+ _ -> removeFile resultFile >> return rs++ mbCompareFile <- getConfigItem $ getLast . cfgCompareFile+ case mbCompareFile of+ Nothing -> return ()+ Just compareFile -> do+ liftIO $ writeFile compareFile $ resultForestToCSV rts++ let rs = flatten rts+ plotAll rs+ junit rs++runNotAnalyse :: (String -> Bool) -- ^ A predicate that chooses+ -- whether to run a benchmark by its+ -- name.+ -> Benchmark+ -> Criterion ()+runNotAnalyse p bs' = goQuickly "" bs'+ where goQuickly :: String -> Benchmark -> Criterion ()+ goQuickly pfx (Benchmark desc b)+ | p desc' = do _ <- note "benchmarking %s\n" desc'+ runOne b+ | otherwise = return ()+ where desc' = prefix pfx desc+ goQuickly pfx (BenchGroup desc bs) =+ mapM_ (goQuickly (prefix pfx desc)) bs+ goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs++ runOne b = do+ samples <- getConfigItem $ fromLJ cfgSamples+ liftIO $ run b samples++prefix :: String -> String -> String+prefix "" desc = desc+prefix pfx desc = pfx ++ '/' : desc++flatten :: ResultForest -> [Result]+flatten [] = []+flatten (Single r : rs) = r : flatten rs+flatten (Compare _ crs : rs) = flatten crs ++ flatten rs++resultForestToCSV :: ResultForest -> String+resultForestToCSV = unlines+ . ("Reference,Name,% faster than reference" :)+ . map (\(ref, n, p) -> printf "%s,%s,%.0f" ref n p)+ . top+ where+ top :: ResultForest -> [(String, String, Double)]+ top [] = []+ top (Single _ : rts) = top rts+ top (Compare _ rts' : rts) = cmpRT rts' ++ top rts++ cmpRT :: ResultForest -> [(String, String, Double)]+ cmpRT [] = []+ cmpRT (Single r : rts) = cmpWith r rts+ cmpRT (Compare _ rts' : rts) = case getReference rts' of+ Nothing -> cmpRT rts+ Just r -> cmpRT rts' ++ cmpWith r rts++ cmpWith :: Result -> ResultForest -> [(String, String, Double)]+ cmpWith _ [] = []+ cmpWith ref (Single r : rts) = cmp ref r : cmpWith ref rts+ cmpWith ref (Compare _ rts' : rts) = cmpRT rts' +++ cmpWith ref rts' +++ cmpWith ref rts++ getReference :: ResultForest -> Maybe Result+ getReference [] = Nothing+ getReference (Single r : _) = Just r+ getReference (Compare _ rts' : rts) = getReference rts' `mplus`+ getReference rts++cmp :: Result -> Result -> (String, String, Double)+cmp ref r = (description ref, description r, percentFaster)+ where+ percentFaster = (meanRef - meanR) / meanRef * 100++ meanRef = mean ref+ meanR = mean r++ mean = estPoint . anMean . sampleAnalysis++-- | Write summary JUnit file (if applicable)+junit :: [Result] -> Criterion ()+junit rs+ = do junitOpt <- getConfigItem (getLast . cfgJUnitFile)+ case junitOpt of+ Just fn -> liftIO $ writeFile fn msg+ Nothing -> return ()+ where+ msg = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" +++ printf "<testsuite name=\"Criterion benchmarks\" tests=\"%d\">\n"+ (length rs) +++ concatMap single rs +++ "</testsuite>\n"+ single r = printf " <testcase name=\"%s\" time=\"%f\" />\n"+ (attrEsc $ description r) (estPoint $ anMean $ sampleAnalysis r)+ attrEsc = concatMap esc+ where+ esc '\'' = "'"+ esc '"' = """+ esc '<' = "<"+ esc '>' = ">"+ esc '&' = "&"+ esc c = [c]
Criterion/Main.hs view
@@ -40,23 +40,28 @@ , defaultMain , defaultMainWith -- * Other useful code+ , makeMatcher , defaultOptions , parseArgs ) where +import Control.Monad (unless) import Control.Monad.Trans (liftIO)-import Criterion (runAndAnalyse, runNotAnalyse)+import Criterion.Internal (runAndAnalyse, runNotAnalyse, prefix) import Criterion.Config import Criterion.Environment (measureEnvironment)-import Criterion.IO (note, printError)+import Criterion.IO.Printf (note, printError) import Criterion.Monad (Criterion, withConfig) import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench, benchNames, bgroup, bcompare, nf, nfIO, whnf, whnfIO)-import Data.List (isPrefixOf, sort)+import Data.Char (toLower)+import Data.List (isPrefixOf, sort, stripPrefix)+import Data.Maybe (fromMaybe) import Data.Monoid (Monoid(..), Last(..)) import System.Console.GetOpt import System.Environment (getArgs, getProgName) import System.Exit (ExitCode(..), exitWith)+import System.FilePath.Glob -- | Parse a confidence interval. ci :: String -> IO Config@@ -71,6 +76,12 @@ | d >= 1 = parseError "confidence interval is greater than 1" | otherwise = return mempty { cfgConfInterval = ljust d } +matchType :: String -> IO Config+matchType s = case map toLower s of+ "prefix" -> return mempty { cfgMatchType = ljust Prefix }+ "glob" -> return mempty { cfgMatchType = ljust Glob }+ _ -> parseError "match type is not 'glob' or 'prefix'"+ -- | Parse a positive number. pos :: (Num a, Ord a, Read a) => String -> (Last a -> Config) -> String -> IO Config@@ -91,11 +102,13 @@ , Option ['G'] ["no-gc"] (noArg mempty { cfgPerformGC = ljust False }) "do not collect garbage between iterations" , Option ['g'] ["gc"] (noArg mempty { cfgPerformGC = ljust True })- "collect garbage between iterations"+ "collect garbage between iterations (default)" , Option ['I'] ["ci"] (ReqArg ci "CI") "bootstrap confidence interval" , Option ['l'] ["list"] (noArg mempty { cfgPrintExit = List }) "print only a list of benchmark names"+ , Option ['m'] ["match"] (ReqArg matchType "MATCH")+ "how to match benchmark names (prefix|glob)" , Option ['o'] ["output"] (ReqArg (\t -> return $ mempty { cfgReport = ljust t }) "FILENAME") "report file to write to"@@ -104,6 +117,9 @@ , Option [] ["resamples"] (ReqArg (pos "resample count"$ \n -> mempty { cfgResamples = n }) "N") "number of bootstrap resamples to perform"+ , Option [] ["results"]+ (ReqArg (\n -> return $ mempty { cfgResults = ljust n }) "FILENAME")+ "file to write raw results to" , Option ['s'] ["samples"] (ReqArg (pos "sample count" $ \n -> mempty { cfgSamples = n }) "N") "number of samples to collect"@@ -113,9 +129,10 @@ , Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME") "produce a summary CSV file of all results" , Option ['r'] ["compare"] (ReqArg (\s -> return $ mempty { cfgCompareFile = ljust s }) "FILENAME")- "produce a CSV file of comparisons\nagainst reference benchmarks.\nSee the bcompare combinator"+ "produce a CSV file of comparisons\nagainst reference benchmarks\n\+ \(see the bcompare combinator)" , Option ['n'] ["no-measurements"] (noArg mempty { cfgMeasure = ljust False })- "Don't do any measurements"+ "don't do any measurements" , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version }) "display version, then exit" , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })@@ -135,7 +152,9 @@ p <- getProgName putStr (usageInfo ("Usage: " ++ p ++ " [OPTIONS] [BENCHMARKS]") options) putStrLn "If no benchmark names are given, all are run\n\- \Otherwise, benchmarks are run by prefix match"+ \Otherwise, benchmarks are chosen by prefix or zsh-style pattern \+ \match\n\+ \(use --match to specify how to match the benchmarks to run)" exitWith exitCode -- | Parse command line options.@@ -169,6 +188,17 @@ defaultMain :: [Benchmark] -> IO () defaultMain = defaultMainWith defaultConfig (return ()) +makeMatcher :: MatchType -> [String] -> Either String (String -> Bool)+makeMatcher matchKind args =+ case matchKind of+ Prefix -> Right $ \b -> null args || any (`isPrefixOf` b) args+ Glob ->+ let compOptions = compDefault { errorRecovery = False }+ in case mapM (tryCompileWith compOptions) args of+ Left errMsg -> Left . fromMaybe errMsg . stripPrefix "compile :: " $+ errMsg+ Right ps -> Right $ \b -> null ps || any (`match` b) ps+ -- | An entry point that can be used as a @main@ function, with -- configurable defaults. --@@ -199,7 +229,11 @@ -> IO () defaultMainWith defCfg prep bs = do (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs- let shouldRun b = null args || any (`isPrefixOf` b) args+ shouldRun <- either parseError return .+ makeMatcher (fromMaybe Prefix . getLast . cfgMatchType $ cfg) $+ args+ unless (null args || any shouldRun (names bsgroup)) $+ parseError "none of the specified names matches a benchmark" withConfig cfg $ if not $ fromLJ cfgMeasure cfg then runNotAnalyse shouldRun bsgroup@@ -217,12 +251,16 @@ runAndAnalyse shouldRun env bsgroup where bsgroup = BenchGroup "" bs+ names = go ""+ where go pfx (BenchGroup pfx' bms) = concatMap (go (prefix pfx pfx')) bms+ go pfx (Benchmark desc _) = [prefix pfx desc]+ go _ (BenchCompare _) = [] -- | Display an error message from a command line parsing failure, and -- exit. parseError :: String -> IO a parseError msg = do- _ <- printError "Error: %s" msg+ _ <- printError "Error: %s\n" msg _ <- printError "Run \"%s --help\" for usage information\n" =<< getProgName exitWith (ExitFailure 64)
Criterion/Measurement.hs view
@@ -19,11 +19,11 @@ , time , time_ ) where- + import Control.Monad (when) import Data.Time.Clock.POSIX (getPOSIXTime) import Text.Printf (printf)- + time :: IO a -> IO (Double, a) time act = do start <- getTime
Criterion/Report.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,- ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, OverloadedStrings,+ RecordWildCards, ScopedTypeVariables #-} -- | -- Module : Criterion.Report@@ -34,6 +34,7 @@ import Criterion.Monad (Criterion, getConfig) import Data.Data (Data, Typeable) import Data.Monoid (Last(..))+import GHC.Generics (Generic) import Paths_criterion (getDataFileName) import Statistics.Sample.KernelDensity (kde) import Statistics.Types (Sample)@@ -55,7 +56,7 @@ , reportTimes :: Sample , reportAnalysis :: SampleAnalysis , reportOutliers :: Outliers- } deriving (Eq, Show, Typeable, Data)+ } deriving (Eq, Read, Show, Typeable, Data, Generic) -- | The path to the template and other files used for generating -- reports.@@ -163,7 +164,7 @@ -- | A problem arose with a template. data TemplateException = TemplateNotFound FilePath -- ^ The template could not be found.- deriving (Eq, Show, Typeable, Data)+ deriving (Eq, Read, Show, Typeable, Data, Generic) instance Exception TemplateException
Criterion/Types.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GADTs #-}+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, ExistentialQuantification,+ FlexibleInstances, GADTs #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- |@@ -26,6 +27,7 @@ module Criterion.Types (+ -- * Benchmark descriptions Benchmarkable(..) , Benchmark(..) , Pure@@ -37,10 +39,19 @@ , bgroup , bcompare , benchNames+ -- * Result types+ , Result(..)+ , ResultForest+ , ResultTree(..) ) where import Control.DeepSeq (NFData, rnf) import Control.Exception (evaluate)+import Criterion.Analysis.Types (Outliers(..), SampleAnalysis(..))+import Data.Binary (Binary)+import Data.Data (Data, Typeable)+import GHC.Generics (Generic)+import Statistics.Types (Sample) -- | A benchmarkable function or action. class Benchmarkable a where@@ -142,3 +153,19 @@ show (Benchmark d _) = ("Benchmark " ++ show d) show (BenchGroup d _) = ("BenchGroup " ++ show d) show (BenchCompare _) = ("BenchCompare")++data Result = Result {+ description :: String+ , sample :: Sample+ , sampleAnalysis :: SampleAnalysis+ , outliers :: Outliers+ } deriving (Eq, Read, Show, Typeable, Data, Generic)++instance Binary Result++type ResultForest = [ResultTree]+data ResultTree = Single Result+ | Compare !Int ResultForest+ deriving (Eq, Read, Show, Typeable, Data, Generic)++instance Binary ResultTree
criterion.cabal view
@@ -1,5 +1,5 @@ name: criterion-version: 0.6.2.1+version: 0.8.0.0 synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE@@ -44,6 +44,7 @@ Criterion.Config Criterion.Environment Criterion.IO+ Criterion.IO.Printf Criterion.Main Criterion.Measurement Criterion.Monad@@ -51,25 +52,31 @@ Criterion.Types other-modules:+ Criterion.Internal Paths_criterion build-depends: aeson >= 0.3.2.12, base < 5,+ binary >= 0.6.3.0, bytestring >= 0.9 && < 1.0, containers, deepseq >= 1.1.0.0, directory, filepath,+ Glob >= 0.7.2, hastache >= 0.5.0, mtl >= 2, mwc-random >= 0.8.0.3, parsec >= 3.1.0,- statistics >= 0.10.0.0,+ statistics >= 0.10.4.0, time, transformers, vector >= 0.7.1, vector-algorithms >= 0.4+ if impl(ghc < 7.6)+ build-depends:+ ghc-prim ghc-options: -O2 -Wall -funbox-strict-fields if impl(ghc >= 6.8)
+ examples/Comparison.hs view
@@ -0,0 +1,9 @@+import Criterion.Main++main = defaultMain [+ bcompare [+ bench "exp" $ whnf exp (2 :: Double)+ , bench "log" $ whnf log (2 :: Double)+ , bench "sqrt" $ whnf sqrt (2 :: Double)+ ]+ ]