Commits

Bryan O'Sullivan committed 7936d82

Fix up the definition of the Benchmarkable type.

  • Participants
  • Parent commits 6ce02fd

Comments (0)

Files changed (2)

File Criterion.hs

 runBenchmark env b = do
   doIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)
   let minTime = envClockResolution env * 1000
-  (testTime :*: testIters :*: _) <- doIO $ runForAtLeast (min minTime 0.1) 1 timeLoop
+  (testTime :*: testIters :*: _) <- doIO $ 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
   times <- doIO $ 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

File Criterion/Types.hs

 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