Commits

Bryan O'Sullivan committed 791b82c

Replace the B type with Pure, and nf and whnf ctors.

Comments (0)

Files changed (7)

     (
       Benchmarkable(..)
     , Benchmark
-    , B(..)
+    , Pure
+    , nf
+    , whnf
     , bench
     , bgroup
     , runBenchmark
 import Criterion.Measurement (getTime, runForAtLeast, secs, time_)
 import Criterion.Monad (ConfigM, getConfig, getConfigItem)
 import Criterion.Plot (plotWith, plotKDE, plotTiming)
-import Criterion.Types (Benchmarkable(..), Benchmark(..), B(..), bench, bgroup)
+import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure,
+                        bench, bgroup, nf, whnf)
 import Data.Array.Vector ((:*:)(..), concatU, lengthU, mapU)
 import Statistics.Function (createIO, minMax)
 import Statistics.KernelDensity (epanechnikovPDF)

Criterion/Main.hs

     -- * Types
       Benchmarkable(..)
     , Benchmark
-    , B(..)
+    , Pure
     -- * Constructing benchmarks
     , bench
     , bgroup
+    , nf
+    , whnf
     -- * Running benchmarks
     , defaultMain
     , defaultMainWith
 import Criterion.IO (note, printError)
 import Criterion.MultiMap (singleton)
 import Criterion.Monad (withConfig)
-import Criterion.Types (Benchmarkable(..), Benchmark(..), B(..), bench,
-                        benchNames, bgroup)
+import Criterion.Types (Benchmarkable(..), Benchmark(..), Pure, bench,
+                        benchNames, bgroup, nf, whnf)
 import Data.List (isPrefixOf, sort)
 import Data.Monoid (Monoid(..), Last(..))
 import System.Console.GetOpt
 -- only be evaluated once, for which all but the first iteration of
 -- the timing loop will be timing the cost of doing nothing.
 --
--- To work around this, we provide two types for benchmarking pure
--- code.  The first is a specialised tuple:
+-- To work around this, we provide a special type, 'Pure', for
+-- benchmarking pure code.  Values of this type are constructed using
+-- one of two functions.
+--
+-- The first is a function which will cause results to be evaluated to
+-- head normal form (NF):
 --
 -- @
--- data 'B' a = forall b. 'B' (a -> b) a
+-- 'nf' :: 'NFData' b => (a -> b) -> a -> 'Pure'
 -- @
 --
--- The second is a specialised tuple named 'B':
+-- The second will cause results to be evaluated to weak head normal
+-- form (the Haskell default):
 --
 -- @
--- (a -> b, a)
+-- 'whnf' :: (a -> b) -> a -> 'Pure'
 -- @
 --
 -- As both of these types suggest, when you want to benchmark a
 -- * The first element is the function, saturated with all but its
 --   last argument.
 --
--- * The second is the last argument to the function.
+-- * The second element is the last argument to the function.
 --
--- In practice, it is much easier to use the 'B' tuple than a normal
--- tuple.  Using 'B', the type checker can see when the function type
--- @a -> b@ and its argument type @a@ are the same, whereas code may
--- require an explicit type annotation to make this connection
--- explicit for a regular tuple.  Here is an example that makes the
--- distinction clearer.  Suppose we want to benchmark the following
--- function:
+-- Here is an example that makes the use of these functions clearer.
+-- Suppose we want to benchmark the following function:
 --
 -- @
 -- firstN :: Int -> [Int]
 -- So in the easy case, we construct a benchmark as follows:
 --
 -- @
--- 'B' firstN 1000
+-- 'nf' firstN 1000
 -- @
 --
 -- The compiler will correctly infer that the number 1000 must have
--- the type 'Int', and the type of the expression is
---
--- @
--- 'B' ['Int'] 'Int'
--- @
---
--- However, say we try to construct a benchmark using a tuple, as
--- follows:
---
--- @
--- (firstN, 1000)
--- @
---
--- Since we have written a numeric literal with no explicit type, the
--- compiler will correctly infer a rather general type for this
--- expression:
---
--- @
--- ('Num' a) => ('Int' -> ['Int'], a)
--- @
---
--- This does not match the type @(a -> b, a)@, so we would have to
--- explicitly annotate the number @1000@ as having the type @'Int'@
--- for the typechecker to accept this as a valid benchmarkable
--- expression.
+-- the type 'Int', and the type of the expression is 'Pure'.
 
 -- $rnf
 --
--- The harness for evaluating a pure function only evaluates the
--- result to weak head normal form (WHNF).  If you need the result
--- evaluated all the way to normal form, use the @rnf@ function from
--- the Control.Parallel.Strategies module to force its complete
--- evaluation.
+-- The 'whnf' harness for evaluating a pure function only evaluates
+-- the result to weak head normal form (WHNF).  If you need the result
+-- evaluated all the way to normal form, use the 'nf' function to
+-- force its complete evaluation.
 --
--- Using the @firstN@ example from earlier, to naive eyes it /appears/
--- that the following code ought to benchmark the production of the
--- first 1000 list elements:
+-- Using the @firstN@ example from earlier, to naive eyes it might
+-- /appear/ that the following code ought to benchmark the production
+-- of the first 1000 list elements:
 --
 -- @
--- B firstN 1000
+-- 'whnf' firstN 1000
 -- @
 --
--- Because the result is only forced until WHNF is reached, what this
--- /actually/ benchmarks is merely the production of the first list
--- element!  Here is a corrected version:
---
--- @
--- B (rnf . firstN) 1000
--- @
-
-
+-- Because in this case the result will only be forced until it
+-- reaches WHNF, what this would /actually/ benchmark is merely the
+-- production of the first list element!

Criterion/Types.hs

 {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GADTs #-}
+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
 
 -- |
 -- Module      : Criterion.Types
 -- The core class is 'Benchmarkable', which admits both pure functions
 -- and 'IO' actions.
 --
--- For a pure function of type @Int -> a@, the benchmarking harness
+-- For a pure function of type @a -> b@, the benchmarking harness
 -- calls this function repeatedly, each time with a different 'Int'
 -- argument, and reduces the result the function returns to weak head
 -- normal form.  If you need the result reduced to normal form, that
     (
       Benchmarkable(..)
     , Benchmark(..)
-    , B(..)
+    , Pure
+    , whnf
+    , nf
     , bench
     , bgroup
     , benchNames
     ) where
 
+import Control.DeepSeq (NFData, rnf)
 import Control.Exception (evaluate)
 
 -- | A benchmarkable function or action.
 
 -- | A container for a pure function to benchmark, and an argument to
 -- supply to it each time it is evaluated.
-data B a = forall b. B (a -> b) a
+data Pure where
+    WHNF :: (a -> b) -> a -> Pure
+    NF :: NFData b => (a -> b) -> a -> Pure
 
-instance Benchmarkable (a -> b, a) where
-    run fx@(f,x) n
-        | n <= 0    = return ()
-        | otherwise = evaluate (f x) >> run fx (n-1)
-    {-# INLINE run #-}
+whnf :: (a -> b) -> a -> Pure
+whnf = WHNF
+{-# INLINE whnf #-}
 
-instance Benchmarkable (B a) where
-    run fx@(B f x) n
-        | n <= 0    = return ()
-        | otherwise = evaluate (f x) >> run fx (n-1)
+nf :: NFData b => (a -> b) -> a -> Pure
+nf = NF
+{-# INLINE nf #-}
+
+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
     base < 5,
     bytestring >= 0.9 && < 1.0,
     containers,
+    deepseq >= 1.1.0.0,
     filepath,
     mtl,
     parallel,

examples/Fibber.hs

             return $! i * j
 
 main = defaultMain [
-        bgroup "tiny" [ bench "fib 10" $ B fib 10
-                      , bench "fib 15" $ B fib 15
-                      , bench "fib 20" $ B fib 20
-                      , bench "fib 25" $ B fib 25
+        bgroup "tiny" [ bench "fib 10" $ whnf fib 10
+                      , bench "fib 15" $ whnf fib 15
+                      , bench "fib 20" $ whnf fib 20
+                      , bench "fib 25" $ whnf fib 25
                       ],
-        bgroup "fib" [ bench "fib 10" $ B fib 10
-                     , bench "fib 35" $ B fib 35
-                     , bench "fib 37" $ B fib 37
+        bgroup "fib" [ bench "fib 10" $ whnf fib 10
+                     , bench "fib 35" $ whnf fib 35
+                     , bench "fib 37" $ whnf fib 37
                      ],
-        bgroup "fact" [ bench "fact 100"  $ B fact 100
-                      , bench "fact 1000" $ B fact 1000
-                      , bench "fact 3000" $ B fact 3000
+        bgroup "fact" [ bench "fact 100"  $ whnf fact 100
+                      , bench "fact 1000" $ whnf fact 1000
+                      , bench "fact 3000" $ whnf fact 3000
                       ],
         bgroup "fio" [ bench "fio 100"  (fio 100)
                      , bench "fio 1000" (fio 1000)
 
 main = defaultMainWith myConfig [
         bgroup "judy" [
-                     bench "insert 1M"   $ B testit 1000000
-                   , bench "insert 10M"  $ B testit 10000000
-                   , bench "insert 100M" $ B testit 100000000
+                     bench "insert 1M"   $ whnf testit 1000000
+                   , bench "insert 10M"  $ whnf testit 10000000
+                   , bench "insert 100M" $ whnf testit 100000000
                    ],
         bgroup "map" [
-                     bench "insert 100k" $ B testmap 100000
-                   , bench "insert 1M"   $ B testmap 1000000
+                     bench "insert 100k" $ whnf testmap 100000
+                   , bench "insert 1M"   $ whnf testmap 1000000
                    ],
         bgroup "intmap" [
-                     bench "insert 100k" $ B testintmap 100000
-                   , bench "insert 1M"   $ B testintmap 1000000
+                     bench "insert 100k" $ whnf testintmap 100000
+                   , bench "insert 1M"   $ whnf testintmap 1000000
                    ]
     ]
 
            }
 
 main = defaultMainWith myConfig [
-         bench "fib 10" $ B fib 10
-       , bench "fib 30" $ B fib 30
-       , bench "intmap 50k" $ B intmap 50000
-       , bench "intmap 75k" $ B intmap 75000
+         bench "fib 10" $ whnf fib 10
+       , bench "fib 30" $ whnf fib 30
+       , bench "intmap 50k" $ whnf intmap 50000
+       , bench "intmap 75k" $ whnf intmap 75000
        ]
         
 fib :: Int -> Int