Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Rework Benchmarkable from a typeclass to a newtype

The typeclass gave us no expressivity, but complicated the code
somewhat. The new arrangement is quite a bit simpler.
  • Loading branch information...
commit 4536da4a3e21113165899f1c8195f6f7516de2b8 1 parent 6caa8f9
@bos authored
View
1  Criterion.hs
@@ -14,7 +14,6 @@ module Criterion
(
Benchmarkable(..)
, Benchmark
- , Pure
, nf
, whnf
, nfIO
View
14 Criterion/Internal.hs
@@ -46,11 +46,11 @@ 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
+runBenchmark :: Environment -> Benchmarkable -> Criterion Sample
+runBenchmark env (Benchmarkable run) = do
_ <- liftIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime)
let minTime = envClockResolution env * 1000
- (testTime, testIters, _) <- liftIO $ runForAtLeast (min minTime 0.1) 1 (run b)
+ (testTime, testIters, _) <- liftIO $ runForAtLeast (min minTime 0.1) 1 run
_ <- prolix "ran %d iterations in %s\n" testIters (secs testTime)
cfg <- getConfig
let newIters = ceiling $ minTime * testItersD / testTime
@@ -68,11 +68,11 @@ runBenchmark env b = do
times <- liftIO . fmap (U.map ((/ newItersD) . subtract (envClockCost env))) .
U.replicateM sampleCount $ do
when (fromLJ cfgPerformGC cfg) $ performGC
- time_ (run b newIters)
+ time_ (run newIters)
return times
-- | Run a single benchmark and analyse its performance.
-runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b
+runAndAnalyseOne :: Environment -> String -> Benchmarkable
-> Criterion (Sample,SampleAnalysis,Outliers)
runAndAnalyseOne env _desc b = do
times <- runBenchmark env b
@@ -183,9 +183,9 @@ runNotAnalyse p bs' = goQuickly "" bs'
mapM_ (goQuickly (prefix pfx desc)) bs
goQuickly pfx (BenchCompare bs) = mapM_ (goQuickly pfx) bs
- runOne b = do
+ runOne (Benchmarkable run) = do
samples <- getConfigItem $ fromLJ cfgSamples
- liftIO $ run b samples
+ liftIO $ run samples
prefix :: String -> String -> String
prefix "" desc = desc
View
3  Criterion/Main.hs
@@ -27,7 +27,6 @@ module Criterion.Main
-- * Types
Benchmarkable(..)
, Benchmark
- , Pure
-- * Constructing benchmarks
, bench
, bgroup
@@ -52,7 +51,7 @@ import Criterion.Config
import Criterion.Environment (measureEnvironment)
import Criterion.IO.Printf (note, printError)
import Criterion.Monad (Criterion, withConfig)
-import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench,
+import Criterion.Types (Benchmarkable(..), Benchmark(..), bench,
benchNames, bgroup, bcompare, nf, nfIO, whnf, whnfIO)
import Data.Char (toLower)
import Data.List (isPrefixOf, sort, stripPrefix)
View
71 Criterion/Types.hs
@@ -30,7 +30,6 @@ module Criterion.Types
-- * Benchmark descriptions
Benchmarkable(..)
, Benchmark(..)
- , Pure
, whnf
, nf
, nfIO
@@ -53,76 +52,62 @@ import Data.Data (Data, Typeable)
import GHC.Generics (Generic)
import Statistics.Types (Sample)
--- | A benchmarkable function or action.
-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 ()
-
--- | A container for a pure function to benchmark, and an argument to
--- supply to it each time it is evaluated.
-data Pure where
- WHNF :: (a -> b) -> a -> Pure
- NF :: NFData b => (a -> b) -> a -> Pure
+-- | A pure function or impure action that can be benchmarked. The
+-- 'Int' parameter indicates the number of times to run the given
+-- function or action.
+newtype Benchmarkable = Benchmarkable (Int -> IO ())
-- | Apply an argument to a function, and evaluate the result to weak
-- head normal form (WHNF).
-whnf :: (a -> b) -> a -> Pure
-whnf = WHNF
+whnf :: (a -> b) -> a -> Benchmarkable
+whnf = pure id
{-# INLINE whnf #-}
-- | Apply an argument to a function, and evaluate the result to head
-- normal form (NF).
-nf :: NFData b => (a -> b) -> a -> Pure
-nf = NF
+nf :: NFData b => (a -> b) -> a -> Benchmarkable
+nf = pure rnf
{-# INLINE nf #-}
+pure :: (b -> c) -> (a -> b) -> a -> Benchmarkable
+pure reduce f0 x0 = Benchmarkable $ go f0 x0
+ where go f x n
+ | n <= 0 = return ()
+ | otherwise = evaluate (reduce (f x)) >> go f x (n-1)
+{-# INLINE pure #-}
+
-- | Perform an action, then evaluate its result to head normal form.
-- This is particularly useful for forcing a lazy IO action to be
-- completely performed.
-nfIO :: NFData a => IO a -> IO ()
-nfIO a = evaluate . rnf =<< a
+nfIO :: NFData a => IO a -> Benchmarkable
+nfIO = impure rnf
{-# INLINE nfIO #-}
-- | Perform an action, then evaluate its result to weak head normal
-- form (WHNF). This is useful for forcing an IO action whose result
-- is an expression to be evaluated down to a more useful value.
-whnfIO :: IO a -> IO ()
-whnfIO a = a >>= evaluate >> return ()
+whnfIO :: IO a -> Benchmarkable
+whnfIO = impure id
{-# INLINE whnfIO #-}
-instance Benchmarkable Pure where
- run p@(WHNF _ _) = go p
- where
- go fx@(WHNF f x) n
- | n <= 0 = return ()
- | otherwise = evaluate (f x) >> go fx (n-1)
- run p@(NF _ _) = go p
- where
- go fx@(NF f x) n
- | n <= 0 = return ()
- | otherwise = evaluate (rnf (f x)) >> go fx (n-1)
- {-# INLINE run #-}
-
-instance Benchmarkable (IO a) where
- run a n
- | n <= 0 = return ()
- | otherwise = a >> run a (n-1)
- {-# INLINE run #-}
+impure :: (a -> b) -> IO a -> Benchmarkable
+impure strategy a = Benchmarkable go
+ where go n
+ | n <= 0 = return ()
+ | otherwise = a >>= (evaluate . strategy) >> go (n-1)
+{-# INLINE impure #-}
-- | A benchmark may consist of either a single 'Benchmarkable' item
-- with a name, created with 'bench', or a (possibly nested) group of
-- 'Benchmark's, created with 'bgroup'.
data Benchmark where
- Benchmark :: Benchmarkable b => String -> b -> Benchmark
+ Benchmark :: String -> Benchmarkable -> Benchmark
BenchGroup :: String -> [Benchmark] -> Benchmark
BenchCompare :: [Benchmark] -> Benchmark
-- | Create a single benchmark.
-bench :: Benchmarkable b =>
- String -- ^ A name to identify the benchmark.
- -> b
+bench :: String -- ^ A name to identify the benchmark.
+ -> Benchmarkable
-> Benchmark
bench = Benchmark
Please sign in to comment.
Something went wrong with that request. Please try again.