{-# OPTIONS -cpp -fglasgow-exts #-}
module Bench.Utils where
--
-- Benchmark tool.
-- Compare a function against equivalent code from other libraries for
-- space and time.
--
import Data.List
import Data.Char
import Data.Word
import Data.Int
import System.Mem
import Control.Concurrent
import System.IO
import System.CPUTime
import System.IO.Unsafe
import Control.Monad
import Control.Exception
import Text.Printf
import qualified Data.ByteString.Char8 as P
import qualified Data.ByteString as S
run :: Int -> a -> [(String, [F a])] -> IO ()
run c x tests = sequence_ $ zipWith (doit c x) [1..] tests
doit :: Int -> a -> Int -> (String, [F a]) -> IO ()
doit count x n (s,ls) = do
printf "%2d %s\n " n (show s)
fn ls
hFlush stdout
where fn xs = case xs of
[f,g] -> runN count f x >> putStr "\n "
>> runN count g x >> putStr "\n\n"
[f] -> runN count f x >> putStr "\n\n"
_ -> return ()
run f x = dirtyCache fps >> performGC >> threadDelay 100 >> time f x
runN 0 f x = return ()
runN c f x = run f x >> runN (c-1) f x
dirtyCache x = evaluate (S.foldl1' (+) x)
{-# NOINLINE dirtyCache #-}
time :: F a -> a -> IO ()
time (F f) a = do
start <- getCPUTime
v <- force (f a)
case v of
B -> printf "--\t"
_ -> do
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
printf "%0.3f " (diff :: Double)
hFlush stdout
------------------------------------------------------------------------
--
-- an existential list of testables
--
data F a = forall b . Forceable b => F (a -> b)
data Result = T | B
--
-- a bit deepSeqish
--
class Forceable a where
force :: a -> IO Result
force v = v `seq` return T
#if !defined(HEAD)
instance Forceable P.ByteString where
force v = P.length v `seq` return T
#endif
instance Forceable a => Forceable (Maybe a) where
force Nothing = return T
force (Just v) = force v `seq` return T
instance Forceable a => Forceable [a] where
force xs = mapM_ force xs >> return T
instance (Forceable a, Forceable b) => Forceable (a,b) where
force (a,b) = force a >> force b
instance Forceable Int
instance Forceable Int64
instance Forceable Bool
instance Forceable Char
instance Forceable Word8
instance Forceable Ordering
-- used to signal undefinedness
instance Forceable () where force () = return B
------------------------------------------------------------------------
--
-- some large strings to play with
--
string :: String
string = P.unpack (unsafePerformIO (P.readFile dict))
{-# NOINLINE string #-}
string2 :: String
string2 = P.unpack (unsafePerformIO (P.readFile dict2))
{-# NOINLINE string2 #-}
-- just for dirtying the cache
fps :: P.ByteString
fps = (unsafePerformIO (P.readFile dict2))
{-# NOINLINE fps #-}
dict = "Bench/bigdata"
dict2 = "Bench/data"
-- Some short hand.
type X = Int
type W = Word8
type S = String