time decoding time too
[packages/utf8-string.git] / tests / Bench.hs
1 {-# OPTIONS -cpp -fglasgow-exts #-}
2
3 {-
4 $ ghc --make -O2 Bench.hs -o bench
5
6 $ ./bench
7 Size of test data: 2428k
8 Char Optimal byteString decode
9 1 0.102 0.109 0.102 0.109 0.102
10 0.063 0.063 0.070 0.055 0.070 # "decode"
11 -}
12
13 --
14 -- Benchmark tool.
15 -- Compare a function against equivalent code from other libraries for
16 -- space and time.
17 --
18
19 import Data.ByteString (ByteString)
20 import qualified Data.ByteString as P
21 -- import qualified Data.ByteString as L
22
23 import Data.List
24 import Data.Char
25 import Data.Word
26 import Data.Int
27
28 import System.Mem
29 import Control.Concurrent
30
31 import System.IO
32 import System.CPUTime
33 import System.IO.Unsafe
34 import Control.Monad
35 import Control.Exception
36 import Text.Printf
37
38 ------------------------------------------------------------------------
39 -- a reference (incorrect, but fast) implementation:
40
41 import GHC.Ptr
42 import qualified GHC.Base as GHC
43 import qualified Data.ByteString as B
44 import qualified Data.ByteString.Base as B
45
46 import Data.ByteString (ByteString)
47 import qualified Data.ByteString as B
48 import qualified Data.ByteString.Char8 as C
49 import qualified Data.ByteString.Lazy as L
50
51 import Data.List
52 import Data.Char
53 import Data.Word
54 import Data.Int
55
56 import System.IO
57 import Control.Monad
58 import Text.Printf
59
60 import qualified Codec.Binary.UTF8.String as UTF8
61
62 ------------------------------------------------------------------------
63
64 main :: IO ()
65 main = do
66 force (fps,chars,strs)
67 printf "# Size of test data: %dk\n" ((floor $ (fromIntegral (B.length fps)) / 1024) :: Int)
68 printf "#Char\t Optimal byteString decode\n"
69 run 5 (fps,chars,strs) tests
70
71 --
72 -- Measure the difference building an decoded String from
73 -- bytestring+GHC's inbuilt decoder, and ours.
74 --
75 -- Most cost is in building the String.
76 --
77 tests =
78 [ ("decode",
79 [F ( app UTF8.decode)
80 ,F ( app unpackCStringUTF8) ])
81
82 , ("encode",
83 [F ( app UTF8.encode) ])
84 ]
85
86
87 -- unpackCStringUtf8# wants \0 termianted strings. rewrite it to take a
88 -- length instead, and we avoid the copy in useAsCString.
89 unpackCStringUTF8 :: B.ByteString -> [Char]
90 unpackCStringUTF8 b = unsafePerformIO $ B.unsafeUseAsCString b $ \(Ptr a) ->
91 return (GHC.unpackCStringUtf8# a)
92
93
94 ------------------------------------------------------------------------
95
96 run c x tests = sequence_ $ zipWith (doit c x) [1..] tests
97
98 doit :: Int -> a -> Int -> (String, [F a]) -> IO ()
99 doit count x n (s,ls) = do
100 printf "%2d " n
101 fn ls
102 printf "\t# %-16s\n" (show s)
103 hFlush stdout
104 where fn xs = case xs of
105 [f,g] -> runN count f x >> putStr "\n "
106 >> runN count g x >> putStr "\t"
107 [f] -> runN count f x >> putStr "\t"
108 _ -> return ()
109 run f x = dirtyCache fps >> performGC >> threadDelay 100 >> time f x
110 runN 0 f x = return ()
111 runN c f x = run f x >> runN (c-1) f x
112
113 dirtyCache x = evaluate (P.foldl1' (+) x)
114 {-# NOINLINE dirtyCache #-}
115
116 time :: F a -> a -> IO ()
117 time (F f) a = do
118 start <- getCPUTime
119 v <- force (f a)
120 case v of
121 B -> printf "--\t"
122 _ -> do
123 end <- getCPUTime
124 let diff = (fromIntegral (end - start)) / (10^12)
125 printf "%0.3f " (diff :: Double)
126 hFlush stdout
127
128 ------------------------------------------------------------------------
129 --
130 -- an existential list
131 --
132 data F a = forall b . Forceable b => F (a -> b)
133
134 data Result = T | B
135
136 --
137 -- a bit deepSeqish
138 --
139 class Forceable a where
140 force :: a -> IO Result
141 force v = v `seq` return T
142
143 #if !defined(HEAD)
144 instance Forceable P.ByteString where
145 force v = P.length v `seq` return T
146 #endif
147
148 instance Forceable L.ByteString where
149 force v = L.length v `seq` return T
150
151 -- instance Forceable SPS.PackedString where
152 -- force v = SPS.length v `seq` return T
153
154 -- instance Forceable PS.PackedString where
155 -- force v = PS.lengthPS v `seq` return T
156
157 instance Forceable a => Forceable (Maybe a) where
158 force Nothing = return T
159 force (Just v) = force v `seq` return T
160
161 instance Forceable [a] where
162 force v = length v `seq` return T
163
164 instance (Forceable a, Forceable b) => Forceable (a,b) where
165 force (a,b) = force a >> force b
166
167 instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where
168 force (a,b,c) = force a >> force b >> force c
169
170 instance Forceable Int
171 instance Forceable Int64
172 instance Forceable Bool
173 instance Forceable Char
174 instance Forceable Word8
175 instance Forceable Ordering
176
177 -- used to signal undefinedness
178 instance Forceable () where force () = return B
179
180 ------------------------------------------------------------------------
181 --
182 -- some large strings to play with
183 --
184
185 fps :: P.ByteString
186 fps = unsafePerformIO $ P.readFile dict
187 {-# NOINLINE fps #-}
188
189 chars :: [Word8]
190 chars = B.unpack fps
191 {-# NOINLINE chars #-}
192
193 strs :: String
194 strs = C.unpack fps
195 {-# NOINLINE strs #-}
196
197 dict = "/usr/share/dict/words"
198
199 ------------------------------------------------------------------------
200
201 type Input = (B.ByteString,[Word8],String)
202
203 class (Eq a, Ord a) => Ap a where app :: (a -> b) -> Input -> b
204
205 instance Ap B.ByteString where app f x = f (fst3 x)
206 instance Ap [Word8] where app f x = f (snd3 x)
207 instance Ap String where app f x = f (thd3 x)
208
209 fst3 (a,_,_) = a
210 snd3 (_,a,_) = a
211 thd3 (_,_,a) = a