Skip to content

Commit f04a55b

Browse files
sjakobisjakobi
committed
WIP
1 parent 3567a98 commit f04a55b

File tree

1 file changed

+116
-115
lines changed

1 file changed

+116
-115
lines changed

‎benchmarks/FineGrained.hs‎

Lines changed: 116 additions & 115 deletions
Original file line numberDiff line numberDiff line change
@@ -48,46 +48,20 @@ bytesLength = 32
4848
defaultGen :: StdGen
4949
defaultGen = mkStdGen 42
5050

51-
env' ::
52-
(NFData a) =>
53-
Int ->
54-
(Int -> IOGenM StdGen -> IO a) ->
55-
(a -> Benchmarkable) ->
56-
Benchmark
57-
env' size setup run =
58-
env
59-
( do
60-
gen <- newIOGenM defaultGen
61-
setup size gen
62-
)
63-
(\x -> bench (show size) (run x))
64-
65-
env'' ::
66-
(NFData env) =>
67-
(Int -> IOGenM StdGen -> IO env) ->
68-
(Int -> env -> Benchmark) ->
69-
Int ->
70-
Benchmark
71-
env'' setup b size =
72-
env
73-
( do
74-
gen <- newIOGenM defaultGen
75-
setup size gen
76-
)
77-
(b size)
78-
7951
bFromList :: Benchmark
8052
bFromList =
8153
bgroup
8254
"fromList"
83-
[ bgroup "Bytes" [env' s setupBytes run | s <- defaultSizes],
84-
bgroup "Int" [env' s genInts run | s <- defaultSizes]
55+
[ bgroup' "Bytes" setupBytes b,
56+
bgroup' "Int" genInts b
8557
]
8658
where
87-
setupBytes s = genNBytes s bytesLength
88-
run :: (Hashable a) => [a] -> Benchmarkable
89-
run = whnf (HM.fromList . map (,()))
59+
setupBytes s gen = genNBytes s bytesLength gen
60+
b s = bench (show s) . whnf (HM.fromList . map (,()))
9061

62+
-- TODO: For the "overlap" and "equal" cases, it would be interesting to
63+
-- have separate benchmarks both with and without shared subtrees,
64+
-- so we can make use of pointer equality.
9165
bUnion :: Benchmark
9266
bUnion =
9367
bgroup
@@ -99,67 +73,19 @@ bUnion =
9973

10074
bUnionDisjoint :: [Benchmark]
10175
bUnionDisjoint =
102-
[ bgroup "Bytes" [env' s setupBytes run | s <- defaultSizes],
103-
bgroup "Int" [env' s setupInts run | s <- defaultSizes]
76+
[ bgroup' "Bytes" genBytesMapsDisjoint b,
77+
bgroup' "Int" genIntMapsDisjoint b
10478
]
10579
where
106-
run :: (Hashable a) => (HashMap a Int, HashMap a Int) -> Benchmarkable
107-
run = whnf (\(as, bs) -> HM.union as bs)
108-
setupBytes = genBytesMapsDisjoint
109-
setupInts = genIntMapsDisjoint
110-
111-
genIntMapsDisjoint ::
112-
(StatefulGen g m) =>
113-
Int -> g -> m (HashMap Int Int, HashMap Int Int)
114-
genIntMapsDisjoint s gen = do
115-
ints <- genInts s gen
116-
let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints
117-
return (keysToMap trues, keysToMap falses)
80+
b s = bench (show s) . whnf (\(as, bs) -> HM.union as bs)
11881

119-
genBytesMapsDisjoint ::
120-
(StatefulGen g m) =>
121-
Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
122-
genBytesMapsDisjoint s gen = do
123-
(trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
124-
return (keysToMap trues, keysToMap falses)
125-
126-
-- TODO: Separate benchmarks for overlap with pointer eq?!
12782
bUnionOverlap :: [Benchmark]
12883
bUnionOverlap =
129-
[ bgroup "Bytes" [env' s setupBytes run | s <- defaultSizes],
130-
bgroup "Int" [env' s setupInts run | s <- defaultSizes]
84+
[ bgroup' "Bytes" genBytesMapsOverlap b,
85+
bgroup' "Int" genIntMapsOverlap b
13186
]
13287
where
133-
run :: (Hashable a) => (HashMap a Int, HashMap a Int) -> Benchmarkable
134-
run = whnf (\(as, bs) -> HM.union as bs)
135-
setupBytes = genBytesMapsOverlap
136-
setupInts = genIntMapsOverlap
137-
138-
genBytesMapsOverlap ::
139-
(StatefulGen g m) =>
140-
Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
141-
genBytesMapsOverlap s gen = do
142-
(trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
143-
let (a_sep, b_sep) = splitAt (s `div` 4) trues
144-
return
145-
( keysToMap falses `HM.union` keysToMap a_sep,
146-
keysToMap falses `HM.union` keysToMap b_sep
147-
)
148-
149-
genIntMapsOverlap ::
150-
(StatefulGen g m) =>
151-
Int -> g -> m (HashMap Int Int, HashMap Int Int)
152-
genIntMapsOverlap s gen = do
153-
let s_overlap = s `div` 2
154-
let s_a_sep = (s - s_overlap) `div` 2
155-
let s_b_sep = s - s_overlap - s_a_sep
156-
overlap <- genInts s_overlap gen
157-
a_sep <- genInts s_a_sep gen
158-
b_sep <- genInts s_b_sep gen
159-
return
160-
( keysToMap overlap `HM.union` keysToMap a_sep,
161-
keysToMap overlap `HM.union` keysToMap b_sep
162-
)
88+
b s = bench (show s) . whnf (\(as, bs) -> HM.union as bs)
16389

16490
bUnionEqual :: [Benchmark]
16591
bUnionEqual =
@@ -170,16 +96,6 @@ bUnionEqual =
17096
run :: (Hashable a) => HashMap a Int -> Benchmarkable
17197
run = whnf (\m -> HM.union m m)
17298

173-
genBytesMap :: (StatefulGen g m) => Int -> g -> m (HashMap Bytes Int)
174-
genBytesMap s gen = do
175-
ks <- Key.Bytes.genNBytes s bytesLength gen
176-
return (keysToMap ks)
177-
178-
genIntMap :: (StatefulGen g m) => Int -> g -> m (HashMap Int Int)
179-
genIntMap s gen = do
180-
ks <- genInts s gen
181-
return (keysToMap ks)
182-
18399
bDifference :: Benchmark
184100
bDifference =
185101
bgroup
@@ -197,14 +113,6 @@ bDifferenceDisjoint =
197113
where
198114
b size = bench (show size) . whnf (\(xs, ys) -> HM.difference xs ys)
199115

200-
bgroup' ::
201-
(NFData env) =>
202-
String ->
203-
(Int -> IOGenM StdGen -> IO env) ->
204-
(Int -> env -> Benchmark) ->
205-
Benchmark
206-
bgroup' name setup b = bgroup name [env'' setup b s | s <- defaultSizes]
207-
208116
bDifferenceOverlap :: [Benchmark]
209117
bDifferenceOverlap =
210118
[ bgroup' "Bytes" genBytesMapsOverlap b,
@@ -231,16 +139,6 @@ bSetFromList =
231139
where
232140
b size = bench (show size) . whnf Data.HashSet.fromList
233141

234-
keysToMap :: (Hashable k) => [k] -> HashMap k Int
235-
keysToMap = HM.fromList . map (,1)
236-
237-
genInts ::
238-
(StatefulGen g m) =>
239-
Int ->
240-
g ->
241-
m [Int]
242-
genInts n = replicateM n . uniformM
243-
244142
{-
245143
bInsert = [ env m $ \d -> bench (show s) $ whnf (\(k, v, m) -> HM.insert k v m) d ]
246144
where m s = do
@@ -251,3 +149,106 @@ bInsert = [ env m $ \d -> bench (show s) $ whnf (\(k, v, m) -> HM.insert k v m)
251149
HMI.unsafeInsert b v hm
252150
return (m, newKeys) -- separate existing, new
253151
-}
152+
153+
-------------------------------------------------------------------------------
154+
-- Boilerplate
155+
156+
bgroup' ::
157+
(NFData env) =>
158+
String ->
159+
(Int -> IOGenM StdGen -> IO env) ->
160+
(Int -> env -> Benchmark) ->
161+
Benchmark
162+
bgroup' name setup b = bgroup name [env'' setup b s | s <- defaultSizes]
163+
164+
env' ::
165+
(NFData a) =>
166+
Int ->
167+
(Int -> IOGenM StdGen -> IO a) ->
168+
(a -> Benchmarkable) ->
169+
Benchmark
170+
env' size setup run =
171+
env
172+
( do
173+
gen <- newIOGenM defaultGen
174+
setup size gen
175+
)
176+
(\x -> bench (show size) (run x))
177+
178+
env'' ::
179+
(NFData env) =>
180+
(Int -> IOGenM StdGen -> IO env) ->
181+
(Int -> env -> Benchmark) ->
182+
Int ->
183+
Benchmark
184+
env'' setup b size =
185+
env
186+
( do
187+
gen <- newIOGenM defaultGen
188+
setup size gen
189+
)
190+
(b size)
191+
192+
-------------------------------------------------------------------------------
193+
-- Generators
194+
195+
keysToMap :: (Hashable k) => [k] -> HashMap k Int
196+
keysToMap = HM.fromList . map (,1)
197+
198+
genInts ::
199+
(StatefulGen g m) =>
200+
Int ->
201+
g ->
202+
m [Int]
203+
genInts n = replicateM n . uniformM
204+
205+
genBytesMap :: (StatefulGen g m) => Int -> g -> m (HashMap Bytes Int)
206+
genBytesMap s gen = do
207+
ks <- Key.Bytes.genNBytes s bytesLength gen
208+
return (keysToMap ks)
209+
210+
genIntMap :: (StatefulGen g m) => Int -> g -> m (HashMap Int Int)
211+
genIntMap s gen = do
212+
ks <- genInts s gen
213+
return (keysToMap ks)
214+
215+
genBytesMapsOverlap ::
216+
(StatefulGen g m) =>
217+
Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
218+
genBytesMapsOverlap s gen = do
219+
(trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
220+
let (a_sep, b_sep) = splitAt (s `div` 4) trues
221+
return
222+
( keysToMap falses `HM.union` keysToMap a_sep,
223+
keysToMap falses `HM.union` keysToMap b_sep
224+
)
225+
226+
genIntMapsOverlap ::
227+
(StatefulGen g m) =>
228+
Int -> g -> m (HashMap Int Int, HashMap Int Int)
229+
genIntMapsOverlap s gen = do
230+
let s_overlap = s `div` 2
231+
let s_a_sep = (s - s_overlap) `div` 2
232+
let s_b_sep = s - s_overlap - s_a_sep
233+
overlap <- genInts s_overlap gen
234+
a_sep <- genInts s_a_sep gen
235+
b_sep <- genInts s_b_sep gen
236+
return
237+
( keysToMap overlap `HM.union` keysToMap a_sep,
238+
keysToMap overlap `HM.union` keysToMap b_sep
239+
)
240+
241+
genIntMapsDisjoint ::
242+
(StatefulGen g m) =>
243+
Int -> g -> m (HashMap Int Int, HashMap Int Int)
244+
genIntMapsDisjoint s gen = do
245+
ints <- genInts s gen
246+
let (trues, falses) = Data.List.partition (flip testBit (31 :: Int)) ints
247+
return (keysToMap trues, keysToMap falses)
248+
249+
genBytesMapsDisjoint ::
250+
(StatefulGen g m) =>
251+
Int -> g -> m (HashMap Bytes Int, HashMap Bytes Int)
252+
genBytesMapsDisjoint s gen = do
253+
(trues, falses) <- Key.Bytes.genDisjoint s bytesLength gen
254+
return (keysToMap trues, keysToMap falses)

0 commit comments

Comments
 (0)