How can one force evaluation of the same value multiple times in Haskell?

Question

I have a function bench which can be used to calculate the time taken to evaluate an action :

data Benchmark
  = Benchmark POSIXTime POSIXTime
  | BenchmarkN [Benchmark]

bench :: a -> IO Benchmark
bench action
  = do
    start  <- getPOSIXTime
    let !_ = action
    end    <- getPOSIXTime
    return $ Benchmark start end

I'm trying to take a mean of multiple benchmarks of said action , however subsequent evaluations of action happen almost instantly as it has already been evaluated once:

benchN :: Int -> a -> IO Benchmark
benchN count action
  = BenchmarkN <$> (mapM bench $ replicate count action)

Is there anyway to force action to be evaluated multiple times, such that it will take the full time to evaluate?

Link to repo: https://github.com/wdhg/benchy

Answer 1

The technique that criterion uses is to compile a function whnf' in its own module with no inlining and a special -fno-full-laziness optimization flag, something like:

-- WHNF.hs
{-# OPTIONS_GHC -fno-full-laziness #-}

module WHNF (whnf') where

whnf' :: (a -> b) -> a -> (Int -> IO ())
whnf' f x = go
  where
    go n | n <= 0 = return ()
         | otherwise = f x `seq` go (n-1)
{-# NOINLINE whnf' #-}

Here, the computation is represented in two parts -- as a function and an argument to call it on. The function whnf' turns it into a benchmarking function Int -> IO () that takes a replication count and will safely re-run the computation (specifically, by forcing it to weak head normal form) the given number of times.

Note that the replication count here is not for generating a bunch of separate timings. Rather, it's used to scale up the time when benchmarking really fast computations so that timing overhead doesn't swamp the benchmark. For slow computations, you can use a count of 1.

In your main benchmarking module, you'll generally also need to represent the expression to be benchmarked using the same two parts, a function and an argument to call it on. Though not necessary, it may be convenient to introduce a data type for this, including the replication count scale:

data Benchmarkable a b = Benchmarkable (a -> b) a Int

and then you can bench it a single time with:

data Benchmark
  = Benchmark POSIXTime POSIXTime
  | BenchmarkN [Benchmark]
  deriving (Show)

bench :: Benchmarkable a b -> IO Benchmark
bench (Benchmarkable f a n) = do
  start  <- getPOSIXTime
  () <- whnf' f a n
  end    <- getPOSIXTime
  return $ Benchmark start end

or multiple times with:

benchN :: Int -> Benchmarkable a b -> IO Benchmark
benchN count b = BenchmarkN <$> replicateM count (bench b)

If you have a slow Fibonacci implemenation:

slowFib :: Integer -> Integer
slowFib 0 = 0
slowFib 1 = 1
slowFib n = slowFib (n-1) + slowFib (n-2)

where slowFib 35 takes an appreciable fraction of a second to run, you can can try:

main = print =<< benchN 10 (Benchmarkable slowFib 35 1)

and it seems to work okay, outputting:

BenchmarkN [Benchmark 1586018307.738716168s 1586018308.179642319s,
Benchmark 1586018308.179642466s 1586018308.618854568s,
Benchmark 1586018308.618854653s 1586018309.057612242s,
Benchmark 1586018309.057612287s 1586018309.496228626s,
Benchmark 1586018309.496228714s 1586018309.934910649s,
Benchmark 1586018309.934910697s 1586018310.373258208s,
Benchmark 1586018310.373258295s 1586018310.811727495s,
Benchmark 1586018310.811727542s 1586018311.250130875s,
Benchmark 1586018311.250131005s 1586018311.689046116s,
Benchmark 1586018311.689046207s 1586018312.127901112s]

The full code for the WHNF module:

-- WHNF.hs
{-# OPTIONS_GHC -fno-full-laziness #-}

module WHNF (whnf') where

whnf' :: (a -> b) -> a -> (Int -> IO ())
whnf' f x = go
  where
    go n | n <= 0 = return ()
         | otherwise = f x `seq` go (n-1)
{-# NOINLINE whnf' #-}

and the benchmark itself in a separate module:

-- Benchmark.hs
{-# OPTIONS_GHC -O2 #-}

import WHNF
import Data.Time.Clock.POSIX
import Control.Monad

data Benchmarkable a b = Benchmarkable (a -> b) a Int

data Benchmark
  = Benchmark POSIXTime POSIXTime
  | BenchmarkN [Benchmark]
  deriving (Show)

bench :: Benchmarkable a b -> IO Benchmark
bench (Benchmarkable f a n) = do
  start  <- getPOSIXTime
  () <- whnf' f a n
  end    <- getPOSIXTime
  return $ Benchmark start end

benchN :: Int -> Benchmarkable a b -> IO Benchmark
benchN count b = BenchmarkN <$> replicateM count (bench b)

slowFib :: Integer -> Integer
slowFib 0 = 0
slowFib 1 = 1
slowFib n = slowFib (n-1) + slowFib (n-2)

main :: IO ()
main = print =<< benchN 10 (Benchmarkable slowFib 35 1)