Commits

Bryan O'Sullivan committed 40d584a

Allow a settable config.

Comments (0)

Files changed (3)

Criterion/Main.hs

     , bench
     , bgroup
     , defaultMain
+    , defaultMainWith
     , defaultOptions
     , parseCommandLine
     ) where
   putStr (usageInfo ("Usage: " ++ p ++ " [OPTIONS]") options)
   exitWith exitCode
 
-parseCommandLine :: [OptDescr (IO Config)] -> [String] -> IO (Config, [String])
-parseCommandLine options args =
+parseCommandLine :: Config -> [OptDescr (IO Config)] -> [String]
+                 -> IO (Config, [String])
+parseCommandLine defCfg options args =
   case getOpt Permute options args of
     (_, _, (err:_)) -> parseError err
     (opts, rest, _) -> do
-      cfg <- (mappend defaultConfig . mconcat) `fmap` sequence opts
+      cfg <- (mappend defCfg . mconcat) `fmap` sequence opts
       case cfgPrintExit cfg of
         Help ->    printBanner cfg >> printUsage options ExitSuccess
         Version -> printBanner cfg >> exitWith ExitSuccess
         _ ->       return (cfg, rest)
 
 defaultMain :: [Benchmark] -> IO ()
-defaultMain bs = do
-  (cfg, args) <- parseCommandLine defaultOptions =<< getArgs
+defaultMain = defaultMainWith defaultConfig
+
+defaultMainWith :: Config -> [Benchmark] -> IO ()
+defaultMainWith defCfg bs = do
+  (cfg, args) <- parseCommandLine defCfg defaultOptions =<< getArgs
   env <- measureEnvironment cfg
   let shouldRun b = null args || any (`isPrefixOf` b) args
   mapM_ (runAndAnalyse shouldRun cfg env) bs
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+-- cabal install judy.
+
+import Criterion.Main
+import Criterion.Config
+
+import Control.Monad
+import qualified Data.Judy as J
+import qualified Data.IntMap as I
+import Data.List
+
+myConfig = defaultConfig { cfgPerformGC = ljust True }
+
+main = defaultMainWith myConfig [
+        bench "insert 1M"   (testit 1000000)
+       ,bench "insert 10M"  (testit 10000000)
+       ,bench "insert 100M" (testit 100000000)
+    ]
+
+testit n = do
+   j <- J.new :: IO (J.JudyL Int)
+   forM_ [1..n] $ \n -> J.insert n (fromIntegral n :: Int) j
+   v <- J.lookup 100 j
+   v `seq` return ()
     where go i | i == 0    = 1
                | otherwise = i * fact (i-1)
 
+fio :: Integer -> IO Integer
+fio n | n < 0     = error "negative!"
+      | otherwise = go n
+    where go i | i == 0    = return 1
+               | otherwise = do
+            j <- fio (i-1)
+            return $! i * j
+
 main = defaultMain [
         bgroup "fib" [ bench "fib 10" (\(_::Int) -> fib 10)
                      , bench "fib 35" (\(_::Int) -> fib 35)
         bgroup "fact" [ bench "fact 100" (\(_::Int) -> fact 100)
                       , bench "fact 350" (\(_::Int) -> fact 350)
                       , bench "fact 700" (\(_::Int) -> fact 700)
-                      ]
+                      ],
+        bgroup "fio" [ bench "fio 100" (fio 100)
+                     , bench "fio 350" (fio 350)
+                     , bench "fio 700" (fio 700)
+                     ]
        ]