{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}

-- | Use of 'System.Clock' from the [clock](https://hackage.haskell.org/package/clock) library to measure time performance of a computation.
module Perf.Time
  ( Nanos,
    defaultClock,
    toSecs,
    nanosWith,
    nanos,
    tick_,
    warmup,
    tickWith,
    tick,
    tickWHNF,
    tickLazy,
    tickForce,
    tickForceArgs,
    tickIO,
    tickIOWith,
    ticks,
    ticksIO,
    time,
    times,
    timesWith,
    timesN,
    timesNWith,
    stepTime,
  )
where

import Control.DeepSeq
import Control.Monad (replicateM_)
import Perf.Types
import System.Clock
import Prelude

-- | A performance measure of number of nanoseconds.
type Nanos = Integer

-- | Convert 'Nanos' to seconds.
toSecs :: Nanos -> Double
toSecs :: Nanos -> Double
toSecs Nanos
ns = Nanos -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Nanos
ns Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9

-- | 'MonotonicRaw' is the default for macOS & linux, at around 42 nano time resolution, and a 'tick_' measurement of around 170 nanos. For Windows, 'ThreadCPUTime' has a similar time resolution at 42 nanos and a 'tick_' of around 500 nanos.
defaultClock :: Clock

#ifdef mingw32_HOST_OS
defaultClock = ThreadCPUTime
#else
defaultClock :: Clock
defaultClock = Clock
MonotonicRaw
#endif

-- | A single 'defaultClock' reading (note that the absolute value is not meaningful).
nanos :: IO Nanos
nanos :: IO Nanos
nanos = Clock -> IO Nanos
nanosWith Clock
defaultClock

-- | A single reading of a specific 'Clock'.
nanosWith :: Clock -> IO Nanos
nanosWith :: Clock -> IO Nanos
nanosWith Clock
c = TimeSpec -> Nanos
toNanoSecs (TimeSpec -> Nanos) -> IO TimeSpec -> IO Nanos
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Clock -> IO TimeSpec
getTime Clock
c

-- | tick_ measures the number of nanos it takes to read the clock.
tick_ :: IO Nanos
tick_ :: IO Nanos
tick_ = do
  Nanos
t <- IO Nanos
nanos
  Nanos
t' <- IO Nanos
nanos
  Nanos -> IO Nanos
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t)

-- | Warm up the clock, to avoid a high first measurement. Without a warmup, one or more larger values can occur at the start of a measurement spree, and often are in the zone of an L2 miss.
warmup :: Int -> IO ()
warmup :: Int -> IO ()
warmup Int
n = Int -> IO Nanos -> IO ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n IO Nanos
tick_

-- | tick from a specific 'Clock'
tickWith :: Clock -> (a -> b) -> a -> IO (Nanos, b)
tickWith :: forall a b. Clock -> (a -> b) -> a -> IO (Nanos, b)
tickWith Clock
c !a -> b
f !a
a = do
  !Nanos
t <- Clock -> IO Nanos
nanosWith Clock
c
  !b
a' <- b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
  !Nanos
t' <- Clock -> IO Nanos
nanosWith Clock
c
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tickWith #-}

-- | /tick f a/
--
-- - strictly evaluates f and a to WHNF
-- - reads the clock
-- - strictly evaluates f a to WHNF
-- - reads the clock
-- - returns (nanos, f a)
tick :: (a -> b) -> a -> IO (Nanos, b)
tick :: forall a b. (a -> b) -> a -> IO (Nanos, b)
tick !a -> b
f !a
a = do
  !Nanos
t <- IO Nanos
nanos
  !b
a' <- b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
  !Nanos
t' <- IO Nanos
nanos
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tick #-}

-- | /tickWHNF f a/
--
-- - reads the clock
-- - strictly evaluates f a to WHNF (this may also kick off thunk evaluation in f or a which will also be captured in the cycle count)
-- - reads the clock
-- - returns (nanos, f a)
tickWHNF :: (a -> b) -> a -> IO (Nanos, b)
tickWHNF :: forall a b. (a -> b) -> a -> IO (Nanos, b)
tickWHNF a -> b
f a
a = do
  !Nanos
t <- IO Nanos
nanos
  !b
a' <- b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
  !Nanos
t' <- IO Nanos
nanos
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tickWHNF #-}

-- | /tickLazy f a/
--
-- - reads the clock
-- - lazily evaluates f a
-- - reads the clock
-- - returns (nanos, f a)
tickLazy :: (a -> b) -> a -> IO (Nanos, b)
tickLazy :: forall a b. (a -> b) -> a -> IO (Nanos, b)
tickLazy a -> b
f a
a = do
  Nanos
t <- IO Nanos
nanos
  let a' :: b
a' = a -> b
f a
a
  Nanos
t' <- IO Nanos
nanos
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tickLazy #-}

-- | /tickForce f a/
--
-- - deeply evaluates f and a,
-- - reads the clock
-- - deeply evaluates f a
-- - reads the clock
-- - returns (nanos, f a)
tickForce :: (NFData a, NFData b) => (a -> b) -> a -> IO (Nanos, b)
tickForce :: forall a b. (NFData a, NFData b) => (a -> b) -> a -> IO (Nanos, b)
tickForce ((a -> b) -> a -> b
forall a. NFData a => a -> a
force -> !a -> b
f) (a -> a
forall a. NFData a => a -> a
force -> !a
a) = do
  !Nanos
t <- IO Nanos
nanos
  !b
a' <- b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> b
forall a. NFData a => a -> a
force (a -> b
f a
a))
  !Nanos
t' <- IO Nanos
nanos
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tickForce #-}

-- | /tickForceArgs f a/
--
-- - deeply evaluates f and a,
-- - reads the clock
-- - strictly evaluates f a to WHNF
-- - reads the clock
-- - returns (nanos, f a)
tickForceArgs :: (NFData a) => (a -> b) -> a -> IO (Nanos, b)
tickForceArgs :: forall a b. NFData a => (a -> b) -> a -> IO (Nanos, b)
tickForceArgs ((a -> b) -> a -> b
forall a. NFData a => a -> a
force -> !a -> b
f) (a -> a
forall a. NFData a => a -> a
force -> !a
a) = do
  !Nanos
t <- IO Nanos
nanos
  !b
a' <- b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (b -> IO b) -> b -> IO b
forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
  !Nanos
t' <- IO Nanos
nanos
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, b
a')
{-# INLINEABLE tickForceArgs #-}

-- | measures an /IO a/
tickIO :: IO a -> IO (Nanos, a)
tickIO :: forall a. IO a -> IO (Nanos, a)
tickIO IO a
a = do
  !Nanos
t <- IO Nanos
nanos
  !a
a' <- IO a
a
  !Nanos
t' <- IO Nanos
nanos
  (Nanos, a) -> IO (Nanos, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, a
a')
{-# INLINEABLE tickIO #-}

-- | measures an /IO a/
tickIOWith :: Clock -> IO a -> IO (Nanos, a)
tickIOWith :: forall a. Clock -> IO a -> IO (Nanos, a)
tickIOWith Clock
c IO a
a = do
  !Nanos
t <- Clock -> IO Nanos
nanosWith Clock
c
  !a
a' <- IO a
a
  !Nanos
t' <- Clock -> IO Nanos
nanosWith Clock
c
  (Nanos, a) -> IO (Nanos, a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t, a
a')
{-# INLINEABLE tickIOWith #-}

-- | n measurements of a tick
--
-- returns a list of Nanos and the last evaluated f a
ticks :: Int -> (a -> b) -> a -> IO ([Nanos], b)
ticks :: forall a b. Int -> (a -> b) -> a -> IO ([Nanos], b)
ticks = ((a -> b) -> a -> IO (Nanos, b))
-> Int -> (a -> b) -> a -> IO ([Nanos], b)
forall (m :: * -> *) a b t.
Monad m =>
((a -> b) -> a -> m (t, b)) -> Int -> (a -> b) -> a -> m ([t], b)
multi (a -> b) -> a -> IO (Nanos, b)
forall a b. (a -> b) -> a -> IO (Nanos, b)
tick
{-# INLINEABLE ticks #-}

-- | n measurements of a tickIO
--
-- returns an IO tuple; list of Nanos and the last evaluated f a
ticksIO :: Int -> IO a -> IO ([Nanos], a)
ticksIO :: forall a. Int -> IO a -> IO ([Nanos], a)
ticksIO = (IO a -> IO (Nanos, a)) -> Int -> IO a -> IO ([Nanos], a)
forall (m :: * -> *) a t.
Monad m =>
(m a -> m (t, a)) -> Int -> m a -> m ([t], a)
multiM IO a -> IO (Nanos, a)
forall a. IO a -> IO (Nanos, a)
tickIO
{-# INLINEABLE ticksIO #-}

-- | tick as a 'StepMeasure'
stepTime :: StepMeasure IO Nanos
stepTime :: StepMeasure IO Nanos
stepTime = IO Nanos -> (Nanos -> IO Nanos) -> StepMeasure IO Nanos
forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure IO Nanos
start Nanos -> IO Nanos
stop
  where
    start :: IO Nanos
start = IO Nanos
nanos
    stop :: Nanos -> IO Nanos
stop Nanos
r = (Nanos -> Nanos) -> IO Nanos -> IO Nanos
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Nanos
x -> Nanos
x Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
r) IO Nanos
nanos
{-# INLINEABLE stepTime #-}

-- | tick as a 'Measure'
time :: Measure IO Nanos
time :: Measure IO Nanos
time = (forall a b. (a -> b) -> a -> IO (Nanos, b)) -> Measure IO Nanos
forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b)) -> Measure m t
Measure (a -> b) -> a -> IO (Nanos, b)
forall a b. (a -> b) -> a -> IO (Nanos, b)
tick
{-# INLINEABLE time #-}

-- | tick as a multi-Measure
times :: Int -> Measure IO [Nanos]
times :: Int -> Measure IO [Nanos]
times Int
n = (forall a b. (a -> b) -> a -> IO ([Nanos], b))
-> Measure IO [Nanos]
forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b)) -> Measure m t
Measure (Int -> (a -> b) -> a -> IO ([Nanos], b)
forall a b. Int -> (a -> b) -> a -> IO ([Nanos], b)
ticks Int
n)
{-# INLINEABLE times #-}

-- | tickWith as a multi-Measure
timesWith :: Clock -> Int -> Measure IO [Nanos]
timesWith :: Clock -> Int -> Measure IO [Nanos]
timesWith Clock
c Int
n = Int -> Measure IO Nanos -> Measure IO [Nanos]
forall (m :: * -> *) t.
Applicative m =>
Int -> Measure m t -> Measure m [t]
repeated Int
n ((forall a b. (a -> b) -> a -> IO (Nanos, b)) -> Measure IO Nanos
forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b)) -> Measure m t
Measure (Clock -> (a -> b) -> a -> IO (Nanos, b)
forall a b. Clock -> (a -> b) -> a -> IO (Nanos, b)
tickWith Clock
c))
{-# INLINEABLE timesWith #-}

-- | tickWith for n repeated applications
timesN :: Int -> Measure IO Nanos
timesN :: Int -> Measure IO Nanos
timesN Int
n = (forall a b. (a -> b) -> a -> IO (Nanos, b)) -> Measure IO Nanos
forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b)) -> Measure m t
Measure (Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
forall a b. Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
tickNWith Clock
defaultClock Int
n)
{-# INLINEABLE timesN #-}

-- | tickWith for n repeated applications
timesNWith :: Clock -> Int -> Measure IO Nanos
timesNWith :: Clock -> Int -> Measure IO Nanos
timesNWith Clock
c Int
n = (forall a b. (a -> b) -> a -> IO (Nanos, b)) -> Measure IO Nanos
forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b)) -> Measure m t
Measure (Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
forall a b. Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
tickNWith Clock
c Int
n)
{-# INLINEABLE timesNWith #-}

tickNWith :: Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
tickNWith :: forall a b. Clock -> Int -> (a -> b) -> a -> IO (Nanos, b)
tickNWith Clock
c Int
n !a -> b
f !a
a = do
  !Nanos
t <- Clock -> IO Nanos
nanosWith Clock
c
  !b
a' <- (b -> b) -> (a -> b) -> a -> Int -> IO b
forall b t a. (b -> t) -> (a -> b) -> a -> Int -> IO t
multiN b -> b
forall a. a -> a
id a -> b
f a
a Int
n
  !Nanos
t' <- Clock -> IO Nanos
nanosWith Clock
c
  (Nanos, b) -> IO (Nanos, b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a b. (RealFrac a, Integral b) => a -> b
floor @Double (Nanos -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Nanos
t' Nanos -> Nanos -> Nanos
forall a. Num a => a -> a -> a
- Nanos
t) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), b
a')
{-# INLINEABLE tickNWith #-}