{-# LANGUAGE RecordWildCards #-}

module Benchmark.Types
       ( RaazBench
       , toBenchmarkable
       , nBytes
       , nRuns
       , runRaazBench
       , header
       ) where

import Criterion.Measurement
import Criterion.Measurement.Types hiding (measure)

import Data.Int
import Text.PrettyPrint

import Raaz.Core

-- | The total data processed in each benchmark.
nBytes :: BYTES Int
nBytes :: BYTES Int
nBytes = BYTES Int
32 BYTES Int -> BYTES Int -> BYTES Int
forall a. Num a => a -> a -> a
* BYTES Int
1024

-- | How many times to run each benchmark
nRuns :: Int64
nRuns :: Int64
nRuns = Int64
10000

type RaazBench         = (String, Benchmarkable)

header :: Doc
header :: Doc
header = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text
         [ String
"Implementation"
         , String
"time"
         , String
"cycles"
         , String
"rate (bits/sec)"
         , String
"time/byte"
         , String
"cycles/byte"
         ]

-- | Execute a benchmark and writeout the results.
runRaazBench :: RaazBench -> IO Doc
runRaazBench :: RaazBench -> IO Doc
runRaazBench (String
nm, Benchmarkable
bm) = do
  (Measured
memt,Double
_) <- Benchmarkable -> Int64 -> IO (Measured, Double)
measure Benchmarkable
bm Int64
nRuns
  Doc -> IO Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> IO Doc) -> Doc -> IO Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
nm Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: Measured -> [Doc]
pprMeasured Measured
memt


------------------------ Helper functions ------------------------


pprMeasured :: Measured -> [Doc]
pprMeasured :: Measured -> [Doc]
pprMeasured Measured{Double
Int64
measTime :: Measured -> Double
measCpuTime :: Measured -> Double
measCycles :: Measured -> Int64
measIters :: Measured -> Int64
measAllocated :: Measured -> Int64
measNumGcs :: Measured -> Int64
measBytesCopied :: Measured -> Int64
measMutatorWallSeconds :: Measured -> Double
measMutatorCpuSeconds :: Measured -> Double
measGcWallSeconds :: Measured -> Double
measGcCpuSeconds :: Measured -> Double
measGcCpuSeconds :: Double
measGcWallSeconds :: Double
measMutatorCpuSeconds :: Double
measMutatorWallSeconds :: Double
measBytesCopied :: Int64
measNumGcs :: Int64
measAllocated :: Int64
measIters :: Int64
measCycles :: Int64
measCpuTime :: Double
measTime :: Double
..} =
  [ String -> Doc
text (Double -> String
secs Double
tm)          -- time
  , String -> Doc
text (Double -> String
humanise Double
cy)      -- cycles
  , String -> Doc
text String
rt                 -- rate
  , String -> Doc
text String
secB               -- secs/byte
  , String -> Doc
text (Double -> String
humanise Double
cycB)    -- cycles/byte
  ]
  where tm :: Double
tm    = Double
measTime   Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nRuns
        cy :: Double
cy    = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
measCycles Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
nRuns
        bytes :: Double
bytes = BYTES Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral BYTES Int
nBytes
        secB :: String
secB  = Double -> String
humanise (Double
tm Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
bytes) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s"
        cycB :: Double
cycB  = Double
cy    Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
bytes
        rt :: String
rt    = Double -> String
humanise (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double
8 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
bytes Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tm


-- | Humanise the output units.
humanise :: Double -> String
humanise :: Double -> String
humanise Double
u | Double
u Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1     = Int -> Double -> String
goL Int
0 Double
u
           | Bool
otherwise = Int -> Double -> String
goU Int
0 Double
u
  where goL :: Int -> Double -> String
goL Int
e Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
1 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
3  = Int -> Double -> String
restrictDecimals Int
2  Double
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
unitPrefix Int
e
                | Bool
otherwise         = Int -> Double -> String
goL (Int
e  Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1000)

        goU :: Int -> Double -> String
goU Int
e Double
x | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
100 Bool -> Bool -> Bool
|| Int
e Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5 = Int -> Double -> String
restrictDecimals Int
2 Double
x  String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
unitPrefix Int
e
                | Bool
otherwise         = Int -> Double -> String
goU (Int
e  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000)


restrictDecimals :: Int -> Double -> String
restrictDecimals :: Int -> Double -> String
restrictDecimals Int
n Double
x = String
u String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
v
  where (String
u,String
v) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (String -> (String, String)) -> String -> (String, String)
forall a b. (a -> b) -> a -> b
$ Double -> String
forall a. Show a => a -> String
show Double
x


-- | @Unit prefix n@ gives proper prefix every 10^{3n} exponent
unitPrefix :: Int -> String
unitPrefix :: Int -> String
unitPrefix Int
ex
  | Int
ex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<  -Int
3   = String -> String
forall a. HasCallStack => String -> a
error String
"exponent too small name"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
3   = String
"n"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
2   = String
"µ"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1   = String
"m"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = String
""
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1    = String
"K"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2    = String
"M"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3    = String
"G"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4    = String
"T"
  | Int
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
5    = String
"P"
  | Bool
otherwise  = String -> String
forall a. HasCallStack => String -> a
error String
"exponent to large to name"