{-# LANGUAGE NumericUnderscores #-}
-- | The measurement harness every benchmark slice shares. Deliberately not
-- @tasty-bench@: allocated bytes and the work counters the library reports
-- about itself are the figures a slice is here to expose, and a harness built
-- around a timing distribution cannot express either.
module BenchSupport
( timedValue
, requireRight
, randomPoints
) where
import Control.DeepSeq (NFData, force)
import Control.Exception (evaluate)
import Data.Word (Word64)
import GHC.Clock (getMonotonicTimeNSec)
import GHC.Stats (RTSStats (allocated_bytes), getRTSStats, getRTSStatsEnabled)
import Moonlight.Triangulation (Point (Point))
import System.CPUTime (getCPUTime)
-- | Both clocks, because they answer different questions and neither
-- substitutes for the other. Elapsed is what anything is compared against —
-- the board against spade is wall clock, and a parallel construction that used
-- more cores gets no allowance for having used them. CPU is the work receipt:
-- on one capability the two agree, and where they diverge the ratio is the
-- parallelism actually obtained. Reporting CPU alone, as this did, would let a
-- change that halves elapsed time and doubles total work read as a regression.
timedValue :: NFData value => String -> IO value -> IO value
timedValue label action = do
statsEnabled <- getRTSStatsEnabled
before <- if statsEnabled then Just <$> getRTSStats else pure Nothing
wallStart <- getMonotonicTimeNSec
cpuStart <- getCPUTime
value <- action >>= evaluate . force
cpuEnd <- getCPUTime
wallEnd <- getMonotonicTimeNSec
after <- if statsEnabled then Just <$> getRTSStats else pure Nothing
putStrLn (label <> "-elapsed: " <> show (fromIntegral (wallEnd - wallStart) / 1.0e9 :: Double) <> "s")
putStrLn (label <> "-cpu: " <> show (fromIntegral (cpuEnd - cpuStart) / 1.0e12 :: Double) <> "s")
case (before, after) of
(Just left, Just right) ->
putStrLn (label <> "-allocated-bytes: " <> show (allocated_bytes right - allocated_bytes left))
_ -> pure ()
pure value
requireRight :: Show error => Either error value -> IO value
requireRight value = case value of
Left failure -> fail (show failure)
Right result -> pure result
randomPoints :: Word64 -> Int -> [Point]
randomPoints seed count = take count (go seed)
where
go :: Word64 -> [Point]
go state =
let state1 = state * 6364136223846793005 + 1442695040888963407
state2 = state1 * 6364136223846793005 + 1442695040888963407
unit :: Word64 -> Double
unit value = fromIntegral (value `div` 2048) / 9_007_199_254_740_992
in Point (2 * unit state1 - 1) (2 * unit state2 - 1) : go state2