@@ -184,8 +184,9 @@ instance Eq Product25 where
184184 && a25 == b25
185185
186186-------------------------------------------------------------------------------
187−
188187-- Simple non-recursive ADT
188+-------------------------------------------------------------------------------
189+
189190data CustomDT1
190191 = CDT1C1
191192 | CDT1C2 Int
@@ -199,30 +200,15 @@ $(DERIVE_CLASS ''CustomDT1)
199200#endif
200201
201202-------------------------------------------------------------------------------
202−
203−{-# INLINE getSize #-}
204−getSize :: forall a. SERIALIZE_CLASS a => a -> Int
205−#ifdef USE_UNBOX
206−getSize _ = sizeOf (Proxy :: Proxy a)
207−#else
208−getSize val =
209− case size :: Size a of
210− Size f -> f 0 val
211−#endif
203+-- Recursive ADT
204+-------------------------------------------------------------------------------
212205
213206#ifndef USE_UNBOX
214−{-# INLINE sizeOfOnce #-}
215−sizeOfOnce :: forall a. Serialize a => a -> Int
216−sizeOfOnce val = getSize val
217−
218−-- Recursive ADT
219207data BinTree a
220208 = Tree (BinTree a) (BinTree a)
221209 | Leaf a
222210 deriving (Show, Read, Eq, Generic)
223211
224−-- XXX If a is ConstSize we can use an array to represent the binary tree. If
225−-- the tree is balanced space wastage would be minimum.
226212#ifndef USE_TH
227213instance Serialize (BinTree a)
228214#else
@@ -244,30 +230,24 @@ mkBinTree = go (generate $ arbitrary)
244230 go r 0 = Leaf <$> r
245231 go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
246232
247−{-
248−prop :: Property
249−prop = forAll arbitrary (ioProperty . test)
233+#endif
250234
251− where
235+-------------------------------------------------------------------------------
236+-- Size helpers
237+-------------------------------------------------------------------------------
252238
253− test :: BinTree Int -> IO Bool
254− test t = do
255− let n =
256− case size :: Size (BinTree Int) of
257− ConstSize x -> x
258− VarSize f -> f t
259− arr <- newBytes n
260− _ <- serialize 0 arr t
261− (_, t1) <- deserialize 0 arr
262− return $ t1 == t
263−
264−runQC :: IO ()
265−runQC = quickCheckWith stdArgs {maxSuccess = 100} prop
266−-}
239+{-# INLINE getSize #-}
240+getSize :: forall a. SERIALIZE_CLASS a => a -> Int
241+#ifdef USE_UNBOX
242+getSize _ = sizeOf (Proxy :: Proxy a)
243+#else
244+getSize val =
245+ case size :: Size a of
246+ Size f -> f 0 val
267247#endif
268248
269249-------------------------------------------------------------------------------
270−-- Helpers
250+-- Common helpers
271251-------------------------------------------------------------------------------
272252
273253-- Parts of "f" that are dependent on val will not be optimized out.
@@ -293,6 +273,13 @@ loopWith count f e val = go count val
293273 then f e x >> go (n-1) x
294274 else return ()
295275
276+benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
277+benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
278+
279+-------------------------------------------------------------------------------
280+-- Serialization Helpers
281+-------------------------------------------------------------------------------
282+
296283{-# INLINE pokeWithSize #-}
297284pokeWithSize :: SERIALIZE_CLASS a => MutableByteArray -> a -> IO ()
298285pokeWithSize arr val = do
@@ -321,11 +308,12 @@ pokeTimes val times = do
321308peek :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> MutableByteArray -> IO ()
322309peek val arr = do
323310#ifdef USE_UNBOX
324− val1
311+ (val1 :: a)
325312#else
326313 (_, val1 :: a)
327314#endif
328315 <- DESERIALIZE_OP 0 arr
316+ assert (val == val1) (pure ())
329317 -- Ensure that we are actually constructing the type and using it.
330318 -- Otherwise we may just read the values and discard them.
331319 -- The comparison adds to the cost though.
@@ -369,37 +357,54 @@ trip val = do
369357roundtrip :: (Eq a, SERIALIZE_CLASS a) => a -> Int -> IO ()
370358roundtrip val times = loop times trip val
371359
372−benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
373−benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
374−
375360-------------------------------------------------------------------------------
376361-- Benchmarks
377362-------------------------------------------------------------------------------
378363
379−{-# INLINE benchPoke #-}
380−benchPoke :: String -> (forall a. SERIALIZE_CLASS a =>
381− a -> Int -> IO ()) -> BinTree Int -> [Int] -> Int -> Benchmark
382−benchPoke gname f tInt lInt times =
364+{-# INLINE benchConst #-}
365+benchConst ::
366+ String
367+ -> (forall a. (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ())
368+ -> Int
369+ -> Benchmark
370+benchConst gname f times =
383371 bgroup gname
384− [ benchSink "C1" times
385− (f CDT1C1)
386− , benchSink "C2" (times `div` 2)
387− (f (CDT1C2 5))
388− , benchSink "C3" (times `div` 3)
389− (f (CDT1C3 5 2))
390− , benchSink "Sum2" times
391− (f Sum21)
392− , benchSink "Sum25" times
393− (f Sum2525)
394− , benchSink "Product25" (times `div` 26)
395− (f (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25))
372+ [ let !n = getSize Unit
373+ in benchSink "Unit" times (f n Unit)
374+ , let !n = getSize CDT1C1
375+ in benchSink "C1" times (f n CDT1C1)
376+ , let val = CDT1C2 5
377+ !n = getSize val
378+ in benchSink "C2" (times `div` 2) (f n val)
379+ , let val = CDT1C3 5 2
380+ !n = getSize val
381+ in benchSink "C3" (times `div` 3) (f n val)
382+ , let !n = getSize Sum21
383+ in benchSink "Sum2" times (f n Sum21)
384+ , let !n = getSize Sum2525
385+ in benchSink "Sum25" times (f n Sum2525)
386+ , let val = Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
387+ !n = getSize val
388+ in benchSink "Product25" (times `div` 26) (f n val)
389+ ]
390+
396391#ifndef USE_UNBOX
397− , benchSink "bintree-int" 1
398− (f tInt)
399− , benchSink "list-int" 1
400− (f lInt)
401−#endif
392+{-# INLINE benchVar #-}
393+benchVar ::
394+ String
395+ -> (forall a. (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ())
396+ -> BinTree Int
397+ -> [Int]
398+ -> Int
399+ -> Benchmark
400+benchVar gname f tInt lInt times =
401+ bgroup gname
402+ [ let !n = getSize tInt
403+ in benchSink "bintree-int" times (f n tInt)
404+ , let !n = getSize lInt
405+ in benchSink "list-int" times (f n lInt)
402406 ]
407+#endif
403408
404409-- Times is scaled by the number of constructors to normalize
405410#ifdef USE_UNBOX
@@ -412,57 +417,20 @@ allBenchmarks tInt lInt times =
412417 [ bgroup "sizeOf"
413418 [
414419#ifndef USE_UNBOX
415− bench "bintree-int" $ nf sizeOfOnce tInt
416− , bench "list-int" $ nf sizeOfOnce lInt
417−#endif
418− ]
419− , benchPoke "poke" pokeTimes tInt lInt times
420− , benchPoke "pokeWithSize" pokeTimesWithSize tInt lInt times
421− , bgroup "peek"
422− [ let !n = getSize Unit
423− in benchSink "Unit" times (peekTimes n Unit)
424− , let !n = getSize CDT1C1
425− in benchSink "C1" times (peekTimes n CDT1C1)
426− , let val = CDT1C2 5
427− !n = getSize val
428− in benchSink "C2" (times `div` 2) (peekTimes n val)
429− , let val = CDT1C3 5 2
430− !n = getSize val
431− in benchSink "C3" (times `div` 3) (peekTimes n val)
432− , let !n = getSize Sum21
433− in benchSink "Sum2" times (peekTimes n Sum21)
434− , let !n = getSize Sum2525
435− in benchSink "Sum25" times (peekTimes n Sum2525)
436− , let val = Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
437− !n = getSize val
438− in benchSink "Product25" (times `div` 26) (peekTimes n val)
439−#ifndef USE_UNBOX
440− , let !n = getSize tInt
441− in benchSink "bintree-int" 1 (peekTimes n tInt)
442− , let !n = getSize lInt
443− in benchSink "list-int" 1 (peekTimes n lInt)
420+ bench "bintree-int" $ nf getSize tInt
421+ , bench "list-int" $ nf getSize lInt
444422#endif
445423 ]
446− , bgroup "roundtrip"
447− [ benchSink "C1" times
448− (roundtrip CDT1C1)
449− , benchSink "C2" (times `div` 2)
450− (roundtrip (CDT1C2 5))
451− , benchSink "C3" (times `div` 3)
452− (roundtrip (CDT1C3 5 2))
453− , benchSink "Sum2" times
454− (roundtrip Sum21)
455− , benchSink "Sum25" times
456− (roundtrip Sum2525)
457− , benchSink "Product25" (times `div` 26)
458− (roundtrip (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25))
424+ , benchConst "poke" (const pokeTimes) times
425+ , benchConst "pokeWithSize" (const pokeTimesWithSize) times
426+ , benchConst "peek" peekTimes times
427+ , benchConst "roundtrip" (const roundtrip) times
459428#ifndef USE_UNBOX
460− , benchSink "bintree-int" 1
461− (roundtrip tInt)
462− , benchSink "list-int" 1
463− (roundtrip lInt)
429+ , benchVar "poke" (const pokeTimes) tInt lInt 1
430+ , benchVar "pokeWithSize" (const pokeTimesWithSize) tInt lInt 1
431+ , benchVar "peek" peekTimes tInt lInt 1
432+ , benchVar "roundtrip" (const roundtrip) tInt lInt 1
464433#endif
465− ]
466434 ]
467435
468436-------------------------------------------------------------------------------
@@ -496,8 +464,8 @@ main = do
496464 -- Check the .dump-simpl output
497465 let value = 100000
498466 -- print $ getSize (CDT1C3 4 2)
499− -- print $ sizeOfOnce tInt
500− -- print $ sizeOfOnce lInt
467+ -- print $ getSize tInt
468+ -- print $ getSize lInt
501469
502470 -- pokeTimes tInt 1
503471