{-# LANGUAGE ViewPatterns #-}
module Perf.Time
( tick_,
warmup,
tick,
tickWHNF,
tickLazy,
tickForce,
tickForceArgs,
tickIO,
ticks,
ticksIO,
Cycles (..),
cputime,
clocktime,
time,
times,
stepTime,
)
where
import Control.DeepSeq
import Control.Monad (replicateM_)
import Data.Fixed
import Data.Time
import GHC.Word (Word64)
import Perf.Types
import System.CPUTime
import System.CPUTime.Rdtsc
import Prelude
newtype Cycles = Cycles {Cycles -> Word64
word :: Word64}
deriving (Int -> Cycles -> ShowS
[Cycles] -> ShowS
Cycles -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cycles] -> ShowS
$cshowList :: [Cycles] -> ShowS
show :: Cycles -> String
$cshow :: Cycles -> String
showsPrec :: Int -> Cycles -> ShowS
$cshowsPrec :: Int -> Cycles -> ShowS
Show, ReadPrec [Cycles]
ReadPrec Cycles
Int -> ReadS Cycles
ReadS [Cycles]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cycles]
$creadListPrec :: ReadPrec [Cycles]
readPrec :: ReadPrec Cycles
$creadPrec :: ReadPrec Cycles
readList :: ReadS [Cycles]
$creadList :: ReadS [Cycles]
readsPrec :: Int -> ReadS Cycles
$creadsPrec :: Int -> ReadS Cycles
Read, Cycles -> Cycles -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cycles -> Cycles -> Bool
$c/= :: Cycles -> Cycles -> Bool
== :: Cycles -> Cycles -> Bool
$c== :: Cycles -> Cycles -> Bool
Eq, Eq Cycles
Cycles -> Cycles -> Bool
Cycles -> Cycles -> Ordering
Cycles -> Cycles -> Cycles
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Cycles -> Cycles -> Cycles
$cmin :: Cycles -> Cycles -> Cycles
max :: Cycles -> Cycles -> Cycles
$cmax :: Cycles -> Cycles -> Cycles
>= :: Cycles -> Cycles -> Bool
$c>= :: Cycles -> Cycles -> Bool
> :: Cycles -> Cycles -> Bool
$c> :: Cycles -> Cycles -> Bool
<= :: Cycles -> Cycles -> Bool
$c<= :: Cycles -> Cycles -> Bool
< :: Cycles -> Cycles -> Bool
$c< :: Cycles -> Cycles -> Bool
compare :: Cycles -> Cycles -> Ordering
$ccompare :: Cycles -> Cycles -> Ordering
Ord, Integer -> Cycles
Cycles -> Cycles
Cycles -> Cycles -> Cycles
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Cycles
$cfromInteger :: Integer -> Cycles
signum :: Cycles -> Cycles
$csignum :: Cycles -> Cycles
abs :: Cycles -> Cycles
$cabs :: Cycles -> Cycles
negate :: Cycles -> Cycles
$cnegate :: Cycles -> Cycles
* :: Cycles -> Cycles -> Cycles
$c* :: Cycles -> Cycles -> Cycles
- :: Cycles -> Cycles -> Cycles
$c- :: Cycles -> Cycles -> Cycles
+ :: Cycles -> Cycles -> Cycles
$c+ :: Cycles -> Cycles -> Cycles
Num, Num Cycles
Ord Cycles
Cycles -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Cycles -> Rational
$ctoRational :: Cycles -> Rational
Real, Int -> Cycles
Cycles -> Int
Cycles -> [Cycles]
Cycles -> Cycles
Cycles -> Cycles -> [Cycles]
Cycles -> Cycles -> Cycles -> [Cycles]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Cycles -> Cycles -> Cycles -> [Cycles]
$cenumFromThenTo :: Cycles -> Cycles -> Cycles -> [Cycles]
enumFromTo :: Cycles -> Cycles -> [Cycles]
$cenumFromTo :: Cycles -> Cycles -> [Cycles]
enumFromThen :: Cycles -> Cycles -> [Cycles]
$cenumFromThen :: Cycles -> Cycles -> [Cycles]
enumFrom :: Cycles -> [Cycles]
$cenumFrom :: Cycles -> [Cycles]
fromEnum :: Cycles -> Int
$cfromEnum :: Cycles -> Int
toEnum :: Int -> Cycles
$ctoEnum :: Int -> Cycles
pred :: Cycles -> Cycles
$cpred :: Cycles -> Cycles
succ :: Cycles -> Cycles
$csucc :: Cycles -> Cycles
Enum, Enum Cycles
Real Cycles
Cycles -> Integer
Cycles -> Cycles -> (Cycles, Cycles)
Cycles -> Cycles -> Cycles
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Cycles -> Integer
$ctoInteger :: Cycles -> Integer
divMod :: Cycles -> Cycles -> (Cycles, Cycles)
$cdivMod :: Cycles -> Cycles -> (Cycles, Cycles)
quotRem :: Cycles -> Cycles -> (Cycles, Cycles)
$cquotRem :: Cycles -> Cycles -> (Cycles, Cycles)
mod :: Cycles -> Cycles -> Cycles
$cmod :: Cycles -> Cycles -> Cycles
div :: Cycles -> Cycles -> Cycles
$cdiv :: Cycles -> Cycles -> Cycles
rem :: Cycles -> Cycles -> Cycles
$crem :: Cycles -> Cycles -> Cycles
quot :: Cycles -> Cycles -> Cycles
$cquot :: Cycles -> Cycles -> Cycles
Integral)
instance Semigroup Cycles where
<> :: Cycles -> Cycles -> Cycles
(<>) = forall a. Num a => a -> a -> a
(+)
instance Monoid Cycles where
mempty :: Cycles
mempty = Cycles
0
tick_ :: IO Cycles
tick_ :: IO Cycles
tick_ = do
Word64
t <- IO Word64
rdtsc
Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t))
warmup :: Int -> IO ()
warmup :: Int -> IO ()
warmup Int
n = forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n IO Cycles
tick_
tick :: (a -> b) -> a -> IO (Cycles, b)
tick :: forall a b. (a -> b) -> a -> IO (Cycles, b)
tick !a -> b
f !a
a = do
!Word64
t <- IO Word64
rdtsc
!b
a' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
!Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), b
a')
{-# INLINEABLE tick #-}
tickWHNF :: (a -> b) -> a -> IO (Cycles, b)
tickWHNF :: forall a b. (a -> b) -> a -> IO (Cycles, b)
tickWHNF a -> b
f a
a = do
!Word64
t <- IO Word64
rdtsc
!b
a' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
!Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), b
a')
{-# INLINEABLE tickWHNF #-}
tickLazy :: (a -> b) -> a -> IO (Cycles, b)
tickLazy :: forall a b. (a -> b) -> a -> IO (Cycles, b)
tickLazy a -> b
f a
a = do
Word64
t <- IO Word64
rdtsc
let a' :: b
a' = a -> b
f a
a
Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), b
a')
{-# INLINEABLE tickLazy #-}
tickForce :: (NFData a, NFData b) => (a -> b) -> a -> IO (Cycles, b)
tickForce :: forall a b. (NFData a, NFData b) => (a -> b) -> a -> IO (Cycles, b)
tickForce (forall a. NFData a => a -> a
force -> !a -> b
f) (forall a. NFData a => a -> a
force -> !a
a) = do
!Word64
t <- IO Word64
rdtsc
!b
a' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. NFData a => a -> a
force (a -> b
f a
a))
!Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), b
a')
{-# INLINEABLE tickForce #-}
tickForceArgs :: (NFData a) => (a -> b) -> a -> IO (Cycles, b)
tickForceArgs :: forall a b. NFData a => (a -> b) -> a -> IO (Cycles, b)
tickForceArgs (forall a. NFData a => a -> a
force -> !a -> b
f) (forall a. NFData a => a -> a
force -> !a
a) = do
!Word64
t <- IO Word64
rdtsc
!b
a' <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$! a -> b
f a
a
!Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), b
a')
{-# INLINEABLE tickForceArgs #-}
tickIO :: IO a -> IO (Cycles, a)
tickIO :: forall a. IO a -> IO (Cycles, a)
tickIO IO a
a = do
!Word64
t <- IO Word64
rdtsc
!a
a' <- IO a
a
!Word64
t' <- IO Word64
rdtsc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> Cycles
Cycles (Word64
t' forall a. Num a => a -> a -> a
- Word64
t), a
a')
{-# INLINEABLE tickIO #-}
ticks :: Int -> (a -> b) -> a -> IO ([Cycles], b)
ticks :: forall a b. Int -> (a -> b) -> a -> IO ([Cycles], b)
ticks = forall (m :: * -> *) a b t.
Monad m =>
((a -> b) -> a -> m (t, b)) -> Int -> (a -> b) -> a -> m ([t], b)
multi forall a b. (a -> b) -> a -> IO (Cycles, b)
tick
{-# INLINEABLE ticks #-}
ticksIO :: Int -> IO a -> IO ([Cycles], a)
ticksIO :: forall a. Int -> IO a -> IO ([Cycles], a)
ticksIO = forall (m :: * -> *) a t.
Monad m =>
(m a -> m (t, a)) -> Int -> m a -> m ([t], a)
multiM forall a. IO a -> IO (Cycles, a)
tickIO
{-# INLINEABLE ticksIO #-}
stepTime :: StepMeasure IO Cycles
stepTime :: StepMeasure IO Cycles
stepTime = forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure IO Cycles
start Cycles -> IO Cycles
stop
where
start :: IO Cycles
start = Word64 -> Cycles
Cycles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word64
rdtsc
stop :: Cycles -> IO Cycles
stop Cycles
r = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Cycles
x -> Cycles
x forall a. Num a => a -> a -> a
- Cycles
r) (Word64 -> Cycles
Cycles forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word64
rdtsc)
{-# INLINEABLE stepTime #-}
cputime :: StepMeasure IO Integer
cputime :: StepMeasure IO Integer
cputime = forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure IO Integer
start Integer -> IO Integer
stop
where
start :: IO Integer
start = IO Integer
getCPUTime
stop :: Integer -> IO Integer
stop Integer
a = do
Integer
t <- IO Integer
getCPUTime
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Integer
t forall a. Num a => a -> a -> a
- Integer
a
clocktime :: StepMeasure IO Double
clocktime :: StepMeasure IO Double
clocktime = forall (m :: * -> *) t i. m i -> (i -> m t) -> StepMeasure m t
StepMeasure IO UTCTime
start UTCTime -> IO Double
stop
where
start :: IO UTCTime
start = IO UTCTime
getCurrentTime
stop :: UTCTime -> IO Double
stop UTCTime
a = do
UTCTime
t <- IO UTCTime
getCurrentTime
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Double
fromNominalDiffTime forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t UTCTime
a
fromNominalDiffTime :: NominalDiffTime -> Double
fromNominalDiffTime :: NominalDiffTime -> Double
fromNominalDiffTime NominalDiffTime
t = forall a. Num a => Integer -> a
fromInteger Integer
i forall a. Num a => a -> a -> a
* Double
1e-12
where
(MkFixed Integer
i) = NominalDiffTime -> Fixed E12
nominalDiffTimeToSeconds NominalDiffTime
t
time :: Measure IO Cycles
time :: Measure IO Cycles
time = forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure forall a b. (a -> b) -> a -> IO (Cycles, b)
tick forall a. IO a -> IO (Cycles, a)
tickIO
{-# INLINEABLE time #-}
times :: Int -> Measure IO [Cycles]
times :: Int -> Measure IO [Cycles]
times Int
n = forall (m :: * -> *) t.
(forall a b. (a -> b) -> a -> m (t, b))
-> (forall a. m a -> m (t, a)) -> Measure m t
Measure (forall a b. Int -> (a -> b) -> a -> IO ([Cycles], b)
ticks Int
n) (forall a. Int -> IO a -> IO ([Cycles], a)
ticksIO Int
n)
{-# INLINEABLE times #-}