diff --git a/Criterion.hs b/Criterion.hs --- a/Criterion.hs +++ b/Criterion.hs @@ -22,6 +22,7 @@ , perBatchEnvWithCleanup , perRunEnv , perRunEnvWithCleanup + , toBenchmarkable , bench , bgroup -- ** Running a benchmark diff --git a/Criterion/Main.hs b/Criterion/Main.hs --- a/Criterion/Main.hs +++ b/Criterion/Main.hs @@ -36,6 +36,7 @@ , perBatchEnvWithCleanup , perRunEnv , perRunEnvWithCleanup + , toBenchmarkable , bench , bgroup -- ** Running a benchmark @@ -61,7 +62,8 @@ import Criterion.Measurement (initializeTime) import Criterion.Monad (withConfig) import Criterion.Types -import Data.List (isPrefixOf, sort, stripPrefix) +import Data.Char (toLower) +import Data.List (isInfixOf, isPrefixOf, sort, stripPrefix) import Data.Maybe (fromMaybe) import Options.Applicative (execParser) import System.Environment (getProgName) @@ -102,6 +104,8 @@ Left errMsg -> Left . fromMaybe errMsg . stripPrefix "compile :: " $ errMsg Right ps -> Right $ \b -> null ps || any (`match` b) ps + Pattern -> Right $ \b -> null args || any (`isInfixOf` b) args + IPattern -> Right $ \b -> null args || any (`isInfixOf` map toLower b) (map (map toLower) args) selectBenches :: MatchType -> [String] -> Benchmark -> IO (String -> Bool) selectBenches matchType benches bsgroup = do diff --git a/Criterion/Main/Options.hs b/Criterion/Main/Options.hs --- a/Criterion/Main/Options.hs +++ b/Criterion/Main/Options.hs @@ -17,6 +17,7 @@ , MatchType(..) , defaultConfig , parseWith + , config , describe , versionInfo ) where @@ -50,6 +51,11 @@ -- @\"foo\"@ will match @\"foobar\"@. | Glob -- ^ Match by Unix-style glob pattern. + | Pattern + -- ^ Match by searching given substring in benchmark + -- paths. + | IPattern + -- ^ Same as 'Pattern', but case insensitive. deriving (Eq, Ord, Bounded, Enum, Read, Show, Typeable, Data, Generic) @@ -100,9 +106,10 @@ matchNames wat = wat <*> option match (long "match" <> short 'm' <> metavar "MATCH" <> value Prefix <> - help "How to match benchmark names (\"prefix\" or \"glob\")") + help "How to match benchmark names (\"prefix\", \"glob\", \"pattern\", or \"ipattern\")") <*> many (argument str (metavar "NAME...")) +-- | Parse a configuration. config :: Config -> Parser Config config Config{..} = Config <$> option (mkCL <$> range 0.001 0.999) @@ -155,12 +162,14 @@ match = do m <- readerAsk case map toLower m of - mm | mm `isPrefixOf` "pfx" -> return Prefix - | mm `isPrefixOf` "prefix" -> return Prefix - | mm `isPrefixOf` "glob" -> return Glob - | otherwise -> - readerError $ show m ++ " is not a known match type. " - ++ "Try \"prefix\" or \"glob\"." + mm | mm `isPrefixOf` "pfx" -> return Prefix + | mm `isPrefixOf` "prefix" -> return Prefix + | mm `isPrefixOf` "glob" -> return Glob + | mm `isPrefixOf` "pattern" -> return Pattern + | mm `isPrefixOf` "ipattern" -> return IPattern + | otherwise -> readerError $ + show m ++ " is not a known match type" + ++ "Try \"prefix\", \"pattern\", \"ipattern\" or \"glob\"." regressParams :: ReadM ([String], String) regressParams = do diff --git a/Criterion/Measurement.hs b/Criterion/Measurement.hs --- a/Criterion/Measurement.hs +++ b/Criterion/Measurement.hs @@ -1,8 +1,16 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, ScopedTypeVariables #-} +#if MIN_VERSION_base(4,10,0) +-- Disable deprecation warnings for now until we remove the use of getGCStats +-- and applyGCStats for good +{-# OPTIONS_GHC -Wno-deprecations #-} +#endif + -- | -- Module : Criterion.Measurement -- Copyright : (c) 2009-2014 Bryan O'Sullivan @@ -20,45 +28,168 @@ , getTime , getCPUTime , getCycles - , getGCStats + , getGCStatistics + , GCStatistics(..) , secs , measure , runBenchmark , runBenchmarkable , runBenchmarkable_ , measured - , applyGCStats + , applyGCStatistics , threshold + -- * Deprecated + , getGCStats + , applyGCStats ) where import Criterion.Types (Benchmarkable(..), Measured(..)) import Control.Applicative ((<*)) import Control.DeepSeq (NFData(rnf)) import Control.Exception (finally,evaluate) +import Data.Data (Data, Typeable) import Data.Int (Int64) import Data.List (unfoldr) import Data.Word (Word64) +import GHC.Generics (Generic) import GHC.Stats (GCStats(..)) +#if MIN_VERSION_base(4,10,0) +import GHC.Stats (RTSStats(..), GCDetails(..)) +#endif import System.Mem (performGC) import Text.Printf (printf) import qualified Control.Exception as Exc import qualified Data.Vector as V import qualified GHC.Stats as Stats +-- | Statistics about memory usage and the garbage collector. Apart from +-- 'gcStatsCurrentBytesUsed' and 'gcStatsCurrentBytesSlop' all are cumulative values since +-- the program started. +-- +-- 'GCStatistics' is cargo-culted from the 'GCStats' data type that "GHC.Stats" +-- has. Since 'GCStats' was marked as deprecated and will be removed in GHC 8.4, +-- we use 'GCStatistics' to provide a backwards-compatible view of GC statistics. +data GCStatistics = GCStatistics + { -- | Total number of bytes allocated + gcStatsBytesAllocated :: !Int64 + -- | Number of garbage collections performed (any generation, major and + -- minor) + , gcStatsNumGcs :: !Int64 + -- | Maximum number of live bytes seen so far + , gcStatsMaxBytesUsed :: !Int64 + -- | Number of byte usage samples taken, or equivalently + -- the number of major GCs performed. + , gcStatsNumByteUsageSamples :: !Int64 + -- | Sum of all byte usage samples, can be used with + -- 'gcStatsNumByteUsageSamples' to calculate averages with + -- arbitrary weighting (if you are sampling this record multiple + -- times). + , gcStatsCumulativeBytesUsed :: !Int64 + -- | Number of bytes copied during GC + , gcStatsBytesCopied :: !Int64 + -- | Number of live bytes at the end of the last major GC + , gcStatsCurrentBytesUsed :: !Int64 + -- | Current number of bytes lost to slop + , gcStatsCurrentBytesSlop :: !Int64 + -- | Maximum number of bytes lost to slop at any one time so far + , gcStatsMaxBytesSlop :: !Int64 + -- | Maximum number of megabytes allocated + , gcStatsPeakMegabytesAllocated :: !Int64 + -- | CPU time spent running mutator threads. This does not include + -- any profiling overhead or initialization. + , gcStatsMutatorCpuSeconds :: !Double + + -- | Wall clock time spent running mutator threads. This does not + -- include initialization. + , gcStatsMutatorWallSeconds :: !Double + -- | CPU time spent running GC + , gcStatsGcCpuSeconds :: !Double + -- | Wall clock time spent running GC + , gcStatsGcWallSeconds :: !Double + -- | Total CPU time elapsed since program start + , gcStatsCpuSeconds :: !Double + -- | Total wall clock time elapsed since start + , gcStatsWallSeconds :: !Double + } deriving (Eq, Read, Show, Typeable, Data, Generic) + -- | Try to get GC statistics, bearing in mind that the GHC runtime -- will throw an exception if statistics collection was not enabled -- using \"@+RTS -T@\". +{-# DEPRECATED getGCStats + ["GCStats has been deprecated in GHC 8.2. As a consequence,", + "getGCStats has also been deprecated in favor of getGCStatistics.", + "getGCStats will be removed in the next major criterion release."] #-} getGCStats :: IO (Maybe GCStats) getGCStats = (Just `fmap` Stats.getGCStats) `Exc.catch` \(_::Exc.SomeException) -> return Nothing +-- | Try to get GC statistics, bearing in mind that the GHC runtime +-- will throw an exception if statistics collection was not enabled +-- using \"@+RTS -T@\". +getGCStatistics :: IO (Maybe GCStatistics) +#if MIN_VERSION_base(4,10,0) +-- Use RTSStats/GCDetails to gather GC stats +getGCStatistics = do + stats <- Stats.getRTSStats + let gcdetails :: Stats.GCDetails + gcdetails = gc stats + + nsToSecs :: Int64 -> Double + nsToSecs ns = fromIntegral ns * 1.0E-9 + + return $ Just GCStatistics { + gcStatsBytesAllocated = fromIntegral $ gcdetails_allocated_bytes gcdetails + , gcStatsNumGcs = fromIntegral $ gcs stats + , gcStatsMaxBytesUsed = fromIntegral $ max_live_bytes stats + , gcStatsNumByteUsageSamples = fromIntegral $ major_gcs stats + , gcStatsCumulativeBytesUsed = fromIntegral $ cumulative_live_bytes stats + , gcStatsBytesCopied = fromIntegral $ gcdetails_copied_bytes gcdetails + , gcStatsCurrentBytesUsed = fromIntegral $ gcdetails_live_bytes gcdetails + , gcStatsCurrentBytesSlop = fromIntegral $ gcdetails_slop_bytes gcdetails + , gcStatsMaxBytesSlop = fromIntegral $ max_slop_bytes stats + , gcStatsPeakMegabytesAllocated = fromIntegral (max_mem_in_use_bytes stats) `quot` (1024*1024) + , gcStatsMutatorCpuSeconds = nsToSecs $ mutator_cpu_ns stats + , gcStatsMutatorWallSeconds = nsToSecs $ mutator_elapsed_ns stats + , gcStatsGcCpuSeconds = nsToSecs $ gcdetails_cpu_ns gcdetails + , gcStatsGcWallSeconds = nsToSecs $ gcdetails_elapsed_ns gcdetails + , gcStatsCpuSeconds = nsToSecs $ cpu_ns stats + , gcStatsWallSeconds = nsToSecs $ elapsed_ns stats + } + `Exc.catch` + \(_::Exc.SomeException) -> return Nothing +#else +-- Use the old GCStats type to gather GC stats +getGCStatistics = do + stats <- Stats.getGCStats + return $ Just GCStatistics { + gcStatsBytesAllocated = bytesAllocated stats + , gcStatsNumGcs = numGcs stats + , gcStatsMaxBytesUsed = maxBytesUsed stats + , gcStatsNumByteUsageSamples = numByteUsageSamples stats + , gcStatsCumulativeBytesUsed = cumulativeBytesUsed stats + , gcStatsBytesCopied = bytesCopied stats + , gcStatsCurrentBytesUsed = currentBytesUsed stats + , gcStatsCurrentBytesSlop = currentBytesSlop stats + , gcStatsMaxBytesSlop = maxBytesSlop stats + , gcStatsPeakMegabytesAllocated = peakMegabytesAllocated stats + , gcStatsMutatorCpuSeconds = mutatorCpuSeconds stats + , gcStatsMutatorWallSeconds = mutatorWallSeconds stats + , gcStatsGcCpuSeconds = gcCpuSeconds stats + , gcStatsGcWallSeconds = gcWallSeconds stats + , gcStatsCpuSeconds = cpuSeconds stats + , gcStatsWallSeconds = wallSeconds stats + } + `Exc.catch` + \(_::Exc.SomeException) -> return Nothing +#endif + -- | Measure the execution of a benchmark a given number of times. measure :: Benchmarkable -- ^ Operation to benchmark. -> Int64 -- ^ Number of iterations. -> IO (Measured, Double) measure bm iters = runBenchmarkable bm iters addResults $ \act -> do - startStats <- getGCStats + startStats <- getGCStatistics startTime <- getTime startCpuTime <- getCPUTime startCycles <- getCycles @@ -66,8 +197,8 @@ endTime <- getTime endCpuTime <- getCPUTime endCycles <- getCycles - endStats <- getGCStats - let !m = applyGCStats endStats startStats $ measured { + endStats <- getGCStatistics + let !m = applyGCStatistics endStats startStats $ measured { measTime = max 0 (endTime - startTime) , measCpuTime = max 0 (endCpuTime - startCpuTime) , measCycles = max 0 (fromIntegral (endCycles - startCycles)) @@ -200,6 +331,10 @@ -- | Apply the difference between two sets of GC statistics to a -- measurement. +{-# DEPRECATED applyGCStats + ["GCStats has been deprecated in GHC 8.2. As a consequence,", + "applyGCStats has also been deprecated in favor of applyGCStatistics.", + "applyGCStats will be removed in the next major criterion release."] #-} applyGCStats :: Maybe GCStats -- ^ Statistics gathered at the __end__ of a run. -> Maybe GCStats @@ -217,6 +352,26 @@ , measGcCpuSeconds = diff gcCpuSeconds } where diff f = f end - f start applyGCStats _ _ m = m + +-- | Apply the difference between two sets of GC statistics to a +-- measurement. +applyGCStatistics :: Maybe GCStatistics + -- ^ Statistics gathered at the __end__ of a run. + -> Maybe GCStatistics + -- ^ Statistics gathered at the __beginning__ of a run. + -> Measured + -- ^ Value to \"modify\". + -> Measured +applyGCStatistics (Just end) (Just start) m = m { + measAllocated = diff gcStatsBytesAllocated + , measNumGcs = diff gcStatsNumGcs + , measBytesCopied = diff gcStatsBytesCopied + , measMutatorWallSeconds = diff gcStatsMutatorWallSeconds + , measMutatorCpuSeconds = diff gcStatsMutatorCpuSeconds + , measGcWallSeconds = diff gcStatsGcWallSeconds + , measGcCpuSeconds = diff gcStatsGcCpuSeconds + } where diff f = f end - f start +applyGCStatistics _ _ m = m -- | Convert a number of seconds to a string. The string will consist -- of four decimal places, followed by a short description of the time diff --git a/Criterion/Types.hs b/Criterion/Types.hs --- a/Criterion/Types.hs +++ b/Criterion/Types.hs @@ -50,6 +50,7 @@ , perBatchEnvWithCleanup , perRunEnv , perRunEnvWithCleanup + , toBenchmarkable , bench , bgroup , addPrefix @@ -146,6 +147,8 @@ noop = const $ return () {-# INLINE noop #-} +-- | Construct a 'Benchmarkable' value from an impure action, where the 'Int64' +-- parameter indicates the number of times to run the action. toBenchmarkable :: (Int64 -> IO ()) -> Benchmarkable toBenchmarkable f = Benchmarkable noop (const noop) (const f) False {-# INLINE toBenchmarkable #-} diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,21 @@ +1.2.1.0 + +* Add `GCStatistics`, `getGCStatistics`, and `applyGCStatistics` to + `Criterion.Measurement`. These are inteded to replace `GCStats` (which has + been deprecated in `base` and will be removed in GHC 8.4), as well as + `getGCStats` and `applyGCStats`, which have also been deprecated and will be + removed in the next major `criterion` release. + +* Add new matchers for the `--match` flag: + * `--match pattern`, which matches by searching for a given substring in + benchmark paths. + * `--match ipattern`, which is like `--match pattern` but case-insensitive. + +* Export `Criterion.Main.Options.config`. + +* Export `Criterion.toBenchmarkable`, which behaves like the `Benchmarkable` + constructor did prior to `criterion-1.2.0.0`. + 1.2.0.0 * Use `statistics-0.14`. diff --git a/criterion.cabal b/criterion.cabal --- a/criterion.cabal +++ b/criterion.cabal @@ -1,5 +1,5 @@ name: criterion -version: 1.2.0.0 +version: 1.2.1.0 synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE @@ -10,7 +10,7 @@ homepage: http://www.serpentine.com/criterion bug-reports: https://github.com/bos/criterion/issues build-type: Simple -cabal-version: >= 1.8 +cabal-version: >= 1.10 extra-source-files: README.markdown changelog.md @@ -112,6 +112,7 @@ build-depends: ghc-prim + default-language: Haskell2010 ghc-options: -Wall -funbox-strict-fields if impl(ghc >= 6.8) ghc-options: -fwarn-tabs @@ -121,6 +122,7 @@ ghc-options: -O2 Executable criterion-report + Default-Language: Haskell2010 GHC-Options: -Wall -rtsopts Main-Is: Report.hs Other-Modules: Options @@ -136,14 +138,15 @@ ghc-prim test-suite sanity - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: Sanity.hs - ghc-options: -Wall -rtsopts + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Sanity.hs + default-language: Haskell2010 + ghc-options: -Wall -rtsopts if flag(fast) - ghc-options: -O0 + ghc-options: -O0 else - ghc-options: -O2 + ghc-options: -O2 build-depends: HUnit, @@ -155,13 +158,14 @@ tasty-hunit test-suite tests - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: Tests.hs - other-modules: Properties + type: exitcode-stdio-1.0 + hs-source-dirs: tests + main-is: Tests.hs + default-language: Haskell2010 + other-modules: Properties ghc-options: - -Wall -threaded -O0 -rtsopts + -Wall -threaded -O0 -rtsopts build-depends: QuickCheck >= 2.4, @@ -176,12 +180,13 @@ aeson >= 0.8 test-suite cleanup - type: exitcode-stdio-1.0 - hs-source-dirs: tests - main-is: Cleanup.hs + type: exitcode-stdio-1.0 + hs-source-dirs: tests + default-language: Haskell2010 + main-is: Cleanup.hs ghc-options: - -Wall -threaded -O0 -rtsopts + -Wall -threaded -O0 -rtsopts build-depends: HUnit, diff --git a/examples/Overhead.hs b/examples/Overhead.hs --- a/examples/Overhead.hs +++ b/examples/Overhead.hs @@ -11,18 +11,27 @@ main :: IO () main = do - statsEnabled <- getGCStatsEnabled + statsEnabled <- getRTSStatsEnabled defaultMain $ [ - bench "measure" $ whnfIO (M.measure (whnfIO $ return ()) 1) - , bench "getTime" $ whnfIO M.getTime - , bench "getCPUTime" $ whnfIO M.getCPUTime - , bench "getCycles" $ whnfIO M.getCycles - , bench "M.getGCStats" $ whnfIO M.getGCStats + bench "measure" $ whnfIO (M.measure (whnfIO $ return ()) 1) + , bench "getTime" $ whnfIO M.getTime + , bench "getCPUTime" $ whnfIO M.getCPUTime + , bench "getCycles" $ whnfIO M.getCycles + , bench "M.getGCStatisticss" $ whnfIO M.getGCStatistics ] ++ if statsEnabled - then [bench "GHC.getGCStats" $ whnfIO GHC.getGCStats] + then [bench +#if MIN_VERSION_base(4,10,0) + "GHC.getRTSStats" $ whnfIO GHC.getRTSStats +#else + "GHC.getGCStats" $ whnfIO GHC.getGCStats +#endif + ] else [] #if !MIN_VERSION_base(4,6,0) -getGCStatsEnabled :: IO Bool -getGCStatsEnabled = return False +getRTSStatsEnabled :: IO Bool +getRTSStatsEnabled = return False +#elif !MIN_VERSION_base(4,10,0) +getRTSStatsEnabled :: IO Bool +getRTSStatsEnabled = getGCStatsEnabled #endif diff --git a/tests/Cleanup.hs b/tests/Cleanup.hs --- a/tests/Cleanup.hs +++ b/tests/Cleanup.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} import Criterion.Main (Benchmark, bench, nfIO) import Criterion.Types (Config(..), Verbosity(Quiet))