on 0.2 help sign in
text/tests/BenchUtils.hs
79 lines 2.3 kB history raw
1{-# LANGUAGE ExistentialQuantification #-}
2module BenchUtils where
4import qualified Data.List as L
5import Data.ByteString (ByteString(..))
6import Data.Word
7import Text.Printf
8import System.IO
9import Data.Text.Internal (Text(..))
10import System.Mem
11import System.CPUTime
12import Control.Exception
13import Control.Concurrent
15data Result = T | B
17data F a = forall b. F (a -> b) | forall b. Flist (a -> [b])
19class Forceable a where
20 force :: a -> IO Result
21 force v = v `seq` return T
23instance Forceable Text
25seqList = L.foldl' (flip seq) (return ())
26instance Forceable [a] where
27 force = L.foldl' (flip seq) (return T)
29instance Forceable ByteString
30instance Forceable Char
31instance Forceable Bool
32instance Forceable Int
33instance Forceable Word8
35instance (Forceable a, Forceable b) => Forceable (a,b) where
36 force (a,b) = force a >> force b
38instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where
39 force (a,b,c) = force a >> force b >> force c
41run c x tests = sequence_ $ zipWith (runTest c x) [1..] tests
43runTest :: Int -> a -> Int -> (String,[F a]) -> IO ()
44runTest count x n (name,tests) = do
45 printf "%2d " n
46 fn tests
47 printf "\t# %-16s\n" (show name)
48 hFlush stdout
49 where fn xs = case xs of
50 [f,g,h] -> runN count f x >> putStr "\t"
51 >> runN count g x >> putStr "\t"
52 >> runN count h x >> putStr "\t"
53 [f,g] -> runN count f x >> putStr "\t"
54 >> runN count g x >> putStr "\t\t"
55 [f] -> runN count f x >> putStr "\t\t\t"
56 _ -> return ()
57 run f x = performGC >> threadDelay 100 >> time f x
58 runN 0 f x = return ()
59 runN c f x = run f x >> runN (c-1) f x
61time (Flist f) a = do
62 start <- getCPUTime
63 v <- seqList (f a)
64 end <- getCPUTime
65 let diff = (fromIntegral (end - start)) / 10^12
66 printf "%0.3f" (diff :: Double)
67 hFlush stdout
69time (F f) a = do
70 start <- getCPUTime
71 v <- evaluate (f a)
72 end <- getCPUTime
73 let diff = (fromIntegral (end - start)) / 10^12
74 printf "%0.3f" (diff :: Double)
75 hFlush stdout
77app1 f (x,y,z) = f x
78app2 f (x,y,z) = f y
79app3 f (x,y,z) = f z