1
- {-# LANGUAGE CPP, GADTs, PackageImports #-}
1
+ {-# LANGUAGE CPP, DeriveGeneric, GADTs, PackageImports, RecordWildCards #-}
2
2
3
3
module Main where
4
4
5
5
import Control.DeepSeq
6
- import Control.Exception (evaluate )
7
- import Control.Monad.Trans (liftIO )
8
- import Criterion.Config
9
- import Criterion.Main
6
+ import Control.DeepSeq.Generics (genericRnf )
7
+ import Criterion.Main (bench , bgroup , defaultMain , env , nf , whnf )
10
8
import Data.Bits ((.&.) )
11
9
import Data.Hashable (Hashable )
12
10
import qualified Data.ByteString as BS
@@ -16,6 +14,7 @@ import qualified Data.IntMap as IM
16
14
import qualified Data.Map as M
17
15
import Data.List (foldl' )
18
16
import Data.Maybe (fromMaybe )
17
+ import GHC.Generics (Generic )
19
18
import Prelude hiding (lookup )
20
19
21
20
import qualified Util.ByteString as UBS
@@ -32,20 +31,82 @@ data B where
32
31
instance NFData B where
33
32
rnf (B b) = rnf b
34
33
34
+ -- TODO: This a stopgap measure to keep the benchmark work with
35
+ -- Criterion 1.0.
36
+ data Env = Env {
37
+ n :: ! Int ,
38
+
39
+ elems :: ! [(String , Int )],
40
+ keys :: ! [String ],
41
+ elemsBS :: ! [(BS. ByteString , Int )],
42
+ keysBS :: ! [BS. ByteString ],
43
+ elemsI :: ! [(Int , Int )],
44
+ keysI :: ! [Int ],
45
+ elemsI2 :: ! [(Int , Int )], -- for union
46
+
47
+ keys' :: ! [String ],
48
+ keysBS' :: ! [BS. ByteString ],
49
+ keysI' :: ! [Int ],
50
+
51
+ keysDup :: ! [String ],
52
+ keysDupBS :: ! [BS. ByteString ],
53
+ keysDupI :: ! [Int ],
54
+ elemsDup :: ! [(String , Int )],
55
+ elemsDupBS :: ! [(BS. ByteString , Int )],
56
+ elemsDupI :: ! [(Int , Int )],
57
+
58
+ hm :: ! (HM. HashMap String Int ),
59
+ hmbs :: ! (HM. HashMap BS. ByteString Int ),
60
+ hmi :: ! (HM. HashMap Int Int ),
61
+ hmi2 :: ! (HM. HashMap Int Int ),
62
+ m :: ! (M. Map String Int ),
63
+ mbs :: ! (M. Map BS. ByteString Int ),
64
+ im :: ! (IM. IntMap Int ),
65
+ ihm :: ! (IHM. Map String Int ),
66
+ ihmbs :: ! (IHM. Map BS. ByteString Int )
67
+ } deriving Generic
68
+
69
+ instance NFData Env where rnf = genericRnf
70
+
71
+ setupEnv :: IO Env
72
+ setupEnv = do
73
+ let n = 2 ^ (12 :: Int )
74
+
75
+ elems = zip keys [1 .. n]
76
+ keys = US. rnd 8 n
77
+ elemsBS = zip keysBS [1 .. n]
78
+ keysBS = UBS. rnd 8 n
79
+ elemsI = zip keysI [1 .. n]
80
+ keysI = UI. rnd (n+ n) n
81
+ elemsI2 = zip [n `div` 2 .. n + (n `div` 2 )] [1 .. n] -- for union
82
+
83
+ keys' = US. rnd' 8 n
84
+ keysBS' = UBS. rnd' 8 n
85
+ keysI' = UI. rnd' (n+ n) n
86
+
87
+ keysDup = US. rnd 2 n
88
+ keysDupBS = UBS. rnd 2 n
89
+ keysDupI = UI. rnd (n`div` 4 ) n
90
+ elemsDup = zip keysDup [1 .. n]
91
+ elemsDupBS = zip keysDupBS [1 .. n]
92
+ elemsDupI = zip keysDupI [1 .. n]
93
+
94
+ hm = HM. fromList elems
95
+ hmbs = HM. fromList elemsBS
96
+ hmi = HM. fromList elemsI
97
+ hmi2 = HM. fromList elemsI2
98
+ m = M. fromList elems
99
+ mbs = M. fromList elemsBS
100
+ im = IM. fromList elemsI
101
+ ihm = IHM. fromList elems
102
+ ihmbs = IHM. fromList elemsBS
103
+ return Env {.. }
104
+
35
105
main :: IO ()
36
106
main = do
37
- let hm = HM. fromList elems :: HM. HashMap String Int
38
- hmbs = HM. fromList elemsBS :: HM. HashMap BS. ByteString Int
39
- hmi = HM. fromList elemsI :: HM. HashMap Int Int
40
- hmi2 = HM. fromList elemsI2 :: HM. HashMap Int Int
41
- m = M. fromList elems :: M. Map String Int
42
- mbs = M. fromList elemsBS :: M. Map BS. ByteString Int
43
- im = IM. fromList elemsI :: IM. IntMap Int
44
- ihm = IHM. fromList elems :: IHM. Map String Int
45
- ihmbs = IHM. fromList elemsBS :: IHM. Map BS. ByteString Int
46
- defaultMainWith defaultConfig
47
- (liftIO . evaluate $ rnf [B m, B mbs, B hm, B hmbs, B hmi, B im])
107
+ defaultMain
48
108
[
109
+ env setupEnv $ \ ~ (Env {.. }) ->
49
110
-- * Comparison to other data structures
50
111
-- ** Map
51
112
bgroup " Map"
@@ -84,7 +145,8 @@ main = do
84
145
]
85
146
86
147
-- ** Map from the hashmap package
87
- , bgroup " hashmap/Map"
148
+ , env setupEnv $ \ ~ (Env {.. }) ->
149
+ bgroup " hashmap/Map"
88
150
[ bgroup " lookup"
89
151
[ bench " String" $ whnf (lookupIHM keys) ihm
90
152
, bench " ByteString" $ whnf (lookupIHM keysBS) ihmbs
@@ -120,7 +182,8 @@ main = do
120
182
]
121
183
122
184
-- ** IntMap
123
- , bgroup " IntMap"
185
+ , env setupEnv $ \ ~ (Env {.. }) ->
186
+ bgroup " IntMap"
124
187
[ bench " lookup" $ whnf (lookupIM keysI) im
125
188
, bench " lookup-miss" $ whnf (lookupIM keysI') im
126
189
, bench " insert" $ whnf (insertIM elemsI) IM. empty
@@ -131,7 +194,8 @@ main = do
131
194
, bench " fromList" $ whnf IM. fromList elemsI
132
195
]
133
196
134
- , bgroup " HashMap"
197
+ , env setupEnv $ \ ~ (Env {.. }) ->
198
+ bgroup " HashMap"
135
199
[ -- * Basic interface
136
200
bgroup " lookup"
137
201
[ bench " String" $ whnf (lookup keys) hm
@@ -217,28 +281,6 @@ main = do
217
281
]
218
282
]
219
283
]
220
- where
221
- n :: Int
222
- n = 2 ^ (12 :: Int )
223
-
224
- elems = zip keys [1 .. n]
225
- keys = US. rnd 8 n
226
- elemsBS = zip keysBS [1 .. n]
227
- keysBS = UBS. rnd 8 n
228
- elemsI = zip keysI [1 .. n]
229
- keysI = UI. rnd (n+ n) n
230
- elemsI2 = zip [n `div` 2 .. n + (n `div` 2 )] [1 .. n] -- for union
231
-
232
- keys' = US. rnd' 8 n
233
- keysBS' = UBS. rnd' 8 n
234
- keysI' = UI. rnd' (n+ n) n
235
-
236
- keysDup = US. rnd 2 n
237
- keysDupBS = UBS. rnd 2 n
238
- keysDupI = UI. rnd (n`div` 4 ) n
239
- elemsDup = zip keysDup [1 .. n]
240
- elemsDupBS = zip keysDupBS [1 .. n]
241
- elemsDupI = zip keysDupI [1 .. n]
242
284
243
285
------------------------------------------------------------------------
244
286
-- * HashMap
0 commit comments