-- | Tools for benchmarking and accumulating results.
--   Nothing Agda-specific in here.

module Agda.Utils.Benchmark where

import Prelude hiding (null)

import Control.DeepSeq
import qualified Control.Exception as E (evaluate)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Writer
import Control.Monad.State
import Control.Monad.IO.Class ( MonadIO(..) )


import Data.Function
import qualified Data.List as List
import Data.Monoid
import Data.Maybe

import GHC.Generics (Generic)

import qualified Text.PrettyPrint.Boxes as Boxes

import Agda.Utils.ListT
import Agda.Utils.Null
import Agda.Utils.Monad hiding (finally)
import qualified Agda.Utils.Maybe.Strict as Strict
import Agda.Utils.Pretty
import Agda.Utils.Time
import Agda.Utils.Trie (Trie)
import qualified Agda.Utils.Trie as Trie


-- * Benchmark trie

-- | Account we can bill computation time to.
type Account a = [a]

-- | Record when we started billing the current account.
type CurrentAccount a = Strict.Maybe (Account a, CPUTime)

type Timings        a = Trie a CPUTime

data BenchmarkOn a = BenchmarkOff | BenchmarkOn | BenchmarkSome (Account a -> Bool)
  deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BenchmarkOn a) x -> BenchmarkOn a
forall a x. BenchmarkOn a -> Rep (BenchmarkOn a) x
$cto :: forall a x. Rep (BenchmarkOn a) x -> BenchmarkOn a
$cfrom :: forall a x. BenchmarkOn a -> Rep (BenchmarkOn a) x
Generic

isBenchmarkOn :: Account a -> BenchmarkOn a -> Bool
isBenchmarkOn :: forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account a
_ BenchmarkOn a
BenchmarkOff      = Bool
False
isBenchmarkOn Account a
_ BenchmarkOn a
BenchmarkOn       = Bool
True
isBenchmarkOn Account a
a (BenchmarkSome Account a -> Bool
p) = Account a -> Bool
p Account a
a

-- | Benchmark structure is a trie, mapping accounts (phases and subphases)
--   to CPU time spent on their performance.
data Benchmark a = Benchmark
  { forall a. Benchmark a -> BenchmarkOn a
benchmarkOn    :: !(BenchmarkOn a)
    -- ^ Are we benchmarking at all?
  , forall a. Benchmark a -> CurrentAccount a
currentAccount :: !(CurrentAccount a)
    -- ^ What are we billing to currently?
  , forall a. Benchmark a -> Timings a
timings        :: !(Timings a)
    -- ^ The accounts and their accumulated timing bill.
  }
  deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Benchmark a) x -> Benchmark a
forall a x. Benchmark a -> Rep (Benchmark a) x
$cto :: forall a x. Rep (Benchmark a) x -> Benchmark a
$cfrom :: forall a x. Benchmark a -> Rep (Benchmark a) x
Generic

-- | Initial benchmark structure (empty).
instance Null (Benchmark a) where
  empty :: Benchmark a
empty = Benchmark
    { benchmarkOn :: BenchmarkOn a
benchmarkOn = forall a. BenchmarkOn a
BenchmarkOff
    , currentAccount :: CurrentAccount a
currentAccount = forall a. Maybe a
Strict.Nothing
    , timings :: Timings a
timings = forall a. Null a => a
empty
    }
  null :: Benchmark a -> Bool
null = forall a. Null a => a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Benchmark a -> Timings a
timings

-- | Semantic editor combinator.
mapBenchmarkOn :: (BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn :: forall a.
(BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn BenchmarkOn a -> BenchmarkOn a
f Benchmark a
b = Benchmark a
b { benchmarkOn :: BenchmarkOn a
benchmarkOn = BenchmarkOn a -> BenchmarkOn a
f forall a b. (a -> b) -> a -> b
$ forall a. Benchmark a -> BenchmarkOn a
benchmarkOn Benchmark a
b }

-- | Semantic editor combinator.
mapCurrentAccount ::
  (CurrentAccount a -> CurrentAccount a) -> Benchmark a -> Benchmark a
mapCurrentAccount :: forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount CurrentAccount a -> CurrentAccount a
f Benchmark a
b = Benchmark a
b { currentAccount :: CurrentAccount a
currentAccount = CurrentAccount a -> CurrentAccount a
f (forall a. Benchmark a -> CurrentAccount a
currentAccount Benchmark a
b) }

-- | Semantic editor combinator.
mapTimings :: (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings :: forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings Timings a -> Timings a
f Benchmark a
b = Benchmark a
b { timings :: Timings a
timings = Timings a -> Timings a
f (forall a. Benchmark a -> Timings a
timings Benchmark a
b) }

-- | Add to specified CPU time account.
addCPUTime :: Ord a => Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime :: forall a.
Ord a =>
Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime Account a
acc CPUTime
t = forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings (forall k v.
Ord k =>
(v -> v -> v) -> [k] -> v -> Trie k v -> Trie k v
Trie.insertWith forall a. Num a => a -> a -> a
(+) Account a
acc CPUTime
t)

-- | Print benchmark as three-column table with totals.
instance (Ord a, Pretty a) => Pretty (Benchmark a) where
  pretty :: Benchmark a -> Doc
pretty Benchmark a
b = [Char] -> Doc
text forall a b. (a -> b) -> a -> b
$ Box -> [Char]
Boxes.render Box
table
    where
    trie :: Timings a
trie = forall a. Benchmark a -> Timings a
timings Benchmark a
b
    ([[a]]
accounts, [(CPUTime, CPUTime)]
times0) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => (v -> v -> Ordering) -> Trie k v -> [([k], v)]
Trie.toListOrderedBy (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)
                               forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => (v -> Bool) -> Trie k v -> Trie k v
Trie.filter ((forall a. Ord a => a -> a -> Bool
> Integer -> CPUTime
fromMilliseconds Integer
10) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
                               forall a b. (a -> b) -> a -> b
$ forall k u v.
Ord k =>
(Trie k u -> Maybe v) -> Trie k u -> Trie k v
Trie.mapSubTries (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b} {k}. (Num b, Ord k) => Trie k b -> (b, b)
aggr) Timings a
trie
    times :: [CPUTime]
times = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(CPUTime, CPUTime)]
times0
    aggr :: Trie k b -> (b, b)
aggr Trie k b
t = (forall a. a -> Maybe a -> a
fromMaybe b
0 forall a b. (a -> b) -> a -> b
$ forall k v. Ord k => [k] -> Trie k v -> Maybe v
Trie.lookup [] Trie k b
t, forall a. Sum a -> a
getSum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. a -> Sum a
Sum Trie k b
t)
    aggrTimes :: [Box]
aggrTimes = do
      ([a]
a, (CPUTime
t, CPUTime
aggrT)) <- forall a b. [a] -> [b] -> [(a, b)]
zip [[a]]
accounts [(CPUTime, CPUTime)]
times0
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if CPUTime
t forall a. Eq a => a -> a -> Bool
== CPUTime
aggrT Bool -> Bool -> Bool
|| forall a. Null a => a -> Bool
null [a]
a
               then Box
""
               else [Char] -> Box
Boxes.text forall a b. (a -> b) -> a -> b
$ [Char]
"(" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
prettyShow CPUTime
aggrT forall a. [a] -> [a] -> [a]
++ [Char]
")"

    -- Generate a table.
    table :: Box
table = forall (f :: * -> *).
Foldable f =>
Int -> Alignment -> f Box -> Box
Boxes.hsep Int
1 Alignment
Boxes.left [Box
col1, Box
col2, Box
col3]

    -- First column: Accounts.
    col1 :: Box
col1 = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.left forall a b. (a -> b) -> a -> b
$
           forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Box
Boxes.text forall a b. (a -> b) -> a -> b
$
           [Char]
"Total" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Pretty a => [a] -> [Char]
showAccount [[a]]
accounts
    -- Second column: Times.
    col2 :: Box
col2 = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.right forall a b. (a -> b) -> a -> b
$
           forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Box
Boxes.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> [Char]
prettyShow) forall a b. (a -> b) -> a -> b
$
           forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [CPUTime]
times forall a. a -> [a] -> [a]
: [CPUTime]
times
    -- Thid column: Aggregate times.
    col3 :: Box
col3 = forall (f :: * -> *). Foldable f => Alignment -> f Box -> Box
Boxes.vcat Alignment
Boxes.right forall a b. (a -> b) -> a -> b
$
           Box
"" forall a. a -> [a] -> [a]
: [Box]
aggrTimes

    showAccount :: [a] -> [Char]
showAccount [] = [Char]
"Miscellaneous"
    showAccount [a]
ks = forall a. [a] -> [[a]] -> [a]
List.intercalate [Char]
"." forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> [Char]
prettyShow [a]
ks


-- * Benchmarking monad.

-- | Monad with access to benchmarking data.

class (Ord (BenchPhase m), Functor m, MonadIO m) => MonadBench m where
  type BenchPhase m
  getBenchmark :: m (Benchmark (BenchPhase m))

  putBenchmark :: Benchmark (BenchPhase m) -> m ()
  putBenchmark Benchmark (BenchPhase m)
b = forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const Benchmark (BenchPhase m)
b

  modifyBenchmark :: (Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
  modifyBenchmark Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
f = do
    Benchmark (BenchPhase m)
b <- forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
    forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark forall a b. (a -> b) -> a -> b
$! Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)
f Benchmark (BenchPhase m)
b

  -- | We need to be able to terminate benchmarking in case of an exception.
  finally :: m b -> m c -> m b

getsBenchmark :: MonadBench m => (Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark :: forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark Benchmark (BenchPhase m) -> c
f = Benchmark (BenchPhase m) -> c
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark

instance MonadBench m => MonadBench (ReaderT r m) where
  type BenchPhase (ReaderT r m) = BenchPhase m
  getBenchmark :: ReaderT r m (Benchmark (BenchPhase (ReaderT r m)))
getBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ReaderT r m)) -> ReaderT r m ()
putBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ReaderT r m))
 -> Benchmark (BenchPhase (ReaderT r m)))
-> ReaderT r m ()
modifyBenchmark = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ReaderT r m b -> ReaderT r m c -> ReaderT r m b
finally ReaderT r m b
m ReaderT r m c
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \ r
r ->
    forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (ReaderT r m b
m forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r) (ReaderT r m c
f forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` r
r)

instance (MonadBench m, Monoid w) => MonadBench (WriterT w m) where
  type BenchPhase (WriterT w m) = BenchPhase m
  getBenchmark :: WriterT w m (Benchmark (BenchPhase (WriterT w m)))
getBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (WriterT w m)) -> WriterT w m ()
putBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (WriterT w m))
 -> Benchmark (BenchPhase (WriterT w m)))
-> WriterT w m ()
modifyBenchmark = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. WriterT w m b -> WriterT w m c -> WriterT w m b
finally WriterT w m b
m WriterT w m c
f = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
WriterT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m b
m) (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT w m c
f)

instance MonadBench m => MonadBench (StateT r m) where
  type BenchPhase (StateT r m) = BenchPhase m

  getBenchmark :: StateT r m (Benchmark (BenchPhase (StateT r m)))
getBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (StateT r m)) -> StateT r m ()
putBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (StateT r m))
 -> Benchmark (BenchPhase (StateT r m)))
-> StateT r m ()
modifyBenchmark = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. StateT r m b -> StateT r m c -> StateT r m b
finally StateT r m b
m StateT r m c
f = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \r
s ->
    forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (StateT r m b
m forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` r
s) (StateT r m c
f forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` r
s)

instance MonadBench m => MonadBench (ExceptT e m) where
  type BenchPhase (ExceptT e m) = BenchPhase m

  getBenchmark :: ExceptT e m (Benchmark (BenchPhase (ExceptT e m)))
getBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ExceptT e m)) -> ExceptT e m ()
putBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ExceptT e m))
 -> Benchmark (BenchPhase (ExceptT e m)))
-> ExceptT e m ()
modifyBenchmark = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ExceptT e m b -> ExceptT e m c -> ExceptT e m b
finally ExceptT e m b
m ExceptT e m c
f = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m b
m) (forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m c
f)

instance MonadBench m => MonadBench (ListT m) where
  type BenchPhase (ListT m) = BenchPhase m

  getBenchmark :: ListT m (Benchmark (BenchPhase (ListT m)))
getBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadBench m => m (Benchmark (BenchPhase m))
getBenchmark
  putBenchmark :: Benchmark (BenchPhase (ListT m)) -> ListT m ()
putBenchmark    = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
Benchmark (BenchPhase m) -> m ()
putBenchmark
  modifyBenchmark :: (Benchmark (BenchPhase (ListT m))
 -> Benchmark (BenchPhase (ListT m)))
-> ListT m ()
modifyBenchmark = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark
  finally :: forall b c. ListT m b -> ListT m c -> ListT m b
finally ListT m b
m ListT m c
f = forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
finally (forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
runListT ListT m b
m) (forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
runListT ListT m c
f)

-- | Turn benchmarking on/off.

setBenchmarking :: MonadBench m => BenchmarkOn (BenchPhase m) -> m ()
setBenchmarking :: forall (m :: * -> *).
MonadBench m =>
BenchmarkOn (BenchPhase m) -> m ()
setBenchmarking BenchmarkOn (BenchPhase m)
b = forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark forall a b. (a -> b) -> a -> b
$ forall a.
(BenchmarkOn a -> BenchmarkOn a) -> Benchmark a -> Benchmark a
mapBenchmarkOn forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const BenchmarkOn (BenchPhase m)
b

-- | Bill current account with time up to now.
--   Switch to new account.
--   Return old account (if any).

switchBenchmarking :: MonadBench m
  => Strict.Maybe (Account (BenchPhase m))      -- ^ Maybe new account.
  -> m (Strict.Maybe (Account (BenchPhase m)))  -- ^ Maybe old account.
switchBenchmarking :: forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
newAccount = do
  CPUTime
now <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => m CPUTime
getCPUTime
  -- Stop and bill current benchmarking.
  CurrentAccount (BenchPhase m)
oldAccount <- forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark forall a. Benchmark a -> CurrentAccount a
currentAccount
  forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
Strict.whenJust CurrentAccount (BenchPhase m)
oldAccount forall a b. (a -> b) -> a -> b
$ \ (Account (BenchPhase m)
acc, CPUTime
start) ->
    forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark forall a b. (a -> b) -> a -> b
$ forall a.
Ord a =>
Account a -> CPUTime -> Benchmark a -> Benchmark a
addCPUTime Account (BenchPhase m)
acc forall a b. (a -> b) -> a -> b
$ CPUTime
now forall a. Num a => a -> a -> a
- CPUTime
start
  -- Switch to new account.
  forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark forall a b. (a -> b) -> a -> b
$ forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ (, CPUTime
now) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Account (BenchPhase m))
newAccount
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CurrentAccount (BenchPhase m)
oldAccount

-- | Resets the account and the timing information.

reset :: MonadBench m => m ()
reset :: forall (m :: * -> *). MonadBench m => m ()
reset = forall (m :: * -> *).
MonadBench m =>
(Benchmark (BenchPhase m) -> Benchmark (BenchPhase m)) -> m ()
modifyBenchmark forall a b. (a -> b) -> a -> b
$
  forall a.
(CurrentAccount a -> CurrentAccount a)
-> Benchmark a -> Benchmark a
mapCurrentAccount (forall a b. a -> b -> a
const forall a. Maybe a
Strict.Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  forall a. (Timings a -> Timings a) -> Benchmark a -> Benchmark a
mapTimings (forall a b. a -> b -> a
const forall a. Null a => a
Trie.empty)

-- | Bill a computation to a specific account.
--   Works even if the computation is aborted by an exception.

billTo :: MonadBench m => Account (BenchPhase m) -> m c -> m c
billTo :: forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> m c -> m c
billTo Account (BenchPhase m)
account m c
m = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account (BenchPhase m)
account forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark forall a. Benchmark a -> BenchmarkOn a
benchmarkOn) m c
m forall a b. (a -> b) -> a -> b
$ do
  -- Switch to new account.
  Maybe (Account (BenchPhase m))
old <- forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Strict.Just Account (BenchPhase m)
account
  -- Compute and switch back to old account.
  (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> IO a
E.evaluate forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m c
m) forall (m :: * -> *) b c. MonadBench m => m b -> m c -> m b
`finally` forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
old

-- | Bill a CPS function to an account. Can't handle exceptions.
billToCPS :: MonadBench m => Account (BenchPhase m) -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS :: forall (m :: * -> *) b c.
MonadBench m =>
Account (BenchPhase m) -> ((b -> m c) -> m c) -> (b -> m c) -> m c
billToCPS Account (BenchPhase m)
account (b -> m c) -> m c
f b -> m c
k = forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifNotM (forall a. Account a -> BenchmarkOn a -> Bool
isBenchmarkOn Account (BenchPhase m)
account forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) c.
MonadBench m =>
(Benchmark (BenchPhase m) -> c) -> m c
getsBenchmark forall a. Benchmark a -> BenchmarkOn a
benchmarkOn) ((b -> m c) -> m c
f b -> m c
k) forall a b. (a -> b) -> a -> b
$ do
  -- Switch to new account.
  Maybe (Account (BenchPhase m))
old <- forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Strict.Just Account (BenchPhase m)
account
  (b -> m c) -> m c
f forall a b. (a -> b) -> a -> b
$ \ b
x -> b
x seq :: forall a b. a -> b -> b
`seq` do
    Maybe (Account (BenchPhase m))
_ <- forall (m :: * -> *).
MonadBench m =>
Maybe (Account (BenchPhase m))
-> m (Maybe (Account (BenchPhase m)))
switchBenchmarking Maybe (Account (BenchPhase m))
old
    b -> m c
k b
x

-- | Bill a pure computation to a specific account.
billPureTo :: MonadBench m  => Account (BenchPhase m) -> c -> m c
billPureTo :: forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> c -> m c
billPureTo Account (BenchPhase m)
account = forall (m :: * -> *) c.
MonadBench m =>
Account (BenchPhase m) -> m c -> m c
billTo Account (BenchPhase m)
account forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return

-- NFData instances.

instance NFData a => NFData (BenchmarkOn a)
instance NFData a => NFData (Benchmark a)