git.iko.soy/streamly
on master help sign in
Add benchmarks for the recordSyntaxWithHeader option in Serialize.TH
c6fa580Adithya Kumar
benchmark/Streamly/Benchmark/Data/Serialize.hs+55−3
compare with master
unifiedsplit
@@ -45,6 +45,11 @@ import Streamly.Internal.Data.Serialize.TH
45import Gauge
45import Gauge
46import Streamly.Benchmark.Common
46import Streamly.Benchmark.Common
47
47
48+#ifndef USE_UNBOX
49+import Streamly.Benchmark.Data.Serialize.RecCompatible
50+import Streamly.Benchmark.Data.Serialize.RecNonCompatible
51+#endif
52+
48#ifdef USE_UNBOX
53#ifdef USE_UNBOX
49#define SERIALIZE_CLASS Unbox
54#define SERIALIZE_CLASS Unbox
50#define DERIVE_CLASS deriveUnbox
55#define DERIVE_CLASS deriveUnbox
@@ -474,6 +479,41 @@ benchVar gname f tInt lInt times =
474 , let !n = getSize lInt
479 , let !n = getSize lInt
475 in benchSink "list-int" times (f n lInt)
480 in benchSink "list-int" times (f n lInt)
476 ]
481 ]
482+
483+{-
484+{-# INLINE benchGeneric #-}
485+benchGeneric
486+ :: (NFData b, Serialize b)
487+ => String
488+ -> String
489+ -> (forall a. (NFData a, Serialize a) =>
490+ Int -> a -> Int -> IO ())
491+ -> b
492+ -> Int
493+ -> Benchmark
494+benchGeneric gname valId f val times =
495+ bgroup gname
496+ [ let !n = getSize val
497+ in benchSink valId times (f n val)
498+ ]
499+-}
500+
501+{-# INLINE benchLargeRec #-}
502+benchLargeRec ::
503+ String
504+ -> (forall a. (NFData a, Serialize a) =>
505+ Int -> a -> Int -> IO ())
506+ -> RecNonCompatible
507+ -> RecCompatible
508+ -> Int
509+ -> Benchmark
510+benchLargeRec gname f recL recR times =
511+ bgroup gname
512+ [ let !n = getSize recL
513+ in benchSink "RecNonCompatible" times (f n recL)
514+ , let !n = getSize recR
515+ in benchSink "RecCompatible" times (f n recR)
516+ ]
477#endif
517#endif
478
518
479-- Times is scaled by the number of constructors to normalize
519-- Times is scaled by the number of constructors to normalize
@@ -481,8 +521,9 @@ benchVar gname f tInt lInt times =
481allBenchmarks :: Int -> [Benchmark]
521allBenchmarks :: Int -> [Benchmark]
482allBenchmarks times =
522allBenchmarks times =
483#else
523#else
524+allBenchmarks ::
484−allBenchmarks :: BinTree Int -> [Int] -> Int -> [Benchmark]
525+ BinTree Int -> [Int] -> RecNonCompatible -> RecCompatible -> Int -> [Benchmark]
485−allBenchmarks tInt lInt times =
526+allBenchmarks tInt lInt recL recR times =
486#endif
527#endif
487 [ bgroup "sizeOf"
528 [ bgroup "sizeOf"
488 [
529 [
@@ -502,6 +543,10 @@ allBenchmarks tInt lInt times =
502 , benchVar "encode" (const encodeTimes) tInt lInt 1
543 , benchVar "encode" (const encodeTimes) tInt lInt 1
503 , benchVar "peek" peekTimes tInt lInt 1
544 , benchVar "peek" peekTimes tInt lInt 1
504 , benchVar "roundtrip" (const roundtrip) tInt lInt 1
545 , benchVar "roundtrip" (const roundtrip) tInt lInt 1
546+ , benchLargeRec "poke" (const pokeTimes) recL recR times
547+ , benchLargeRec "encode" (const encodeTimes) recL recR times
548+ , benchLargeRec "peek" peekTimes recL recR times
549+ , benchLargeRec "roundtrip" (const roundtrip) recL recR times
505#endif
550#endif
506 ]
551 ]
507
552
@@ -517,6 +562,9 @@ main = do
517 -- nodes 1 level = log_2 (100001/3) + 1 = 16
562 -- nodes 1 level = log_2 (100001/3) + 1 = 16
518 !(tInt :: BinTree Int) <- force <$> mkBinTree 16
563 !(tInt :: BinTree Int) <- force <$> mkBinTree 16
519
564
565+ let !recL = valRecNonCompatible
566+ let !recR = valRecCompatible
567+
520 -- Approximately 100000 constructors, assuming two constructors (Cons, Int)
568 -- Approximately 100000 constructors, assuming two constructors (Cons, Int)
521 -- per element.
569 -- per element.
522 let lInt = [1..50000 :: Int]
570 let lInt = [1..50000 :: Int]
@@ -528,7 +576,11 @@ main = do
528#ifdef USE_UNBOX
576#ifdef USE_UNBOX
529 runWithCLIOpts defaultStreamSize allBenchmarks
577 runWithCLIOpts defaultStreamSize allBenchmarks
530#else
578#else
579+ len
580+ `seq` runWithCLIOpts
581+ defaultStreamSize
531− len `seq` runWithCLIOpts defaultStreamSize (allBenchmarks tInt lInt)
582+ (allBenchmarks tInt lInt recL recR)
583+
532#endif
584#endif
533#else
585#else
534 -- Enable FUSION_CHECK macro at the beginning of the file
586 -- Enable FUSION_CHECK macro at the beginning of the file
benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Streamly.Benchmark.Data.Serialize.RecCompatible
4+ ( RecCompatible(..)
5+ , valRecCompatible
6+ ) where
7+
8+--------------------------------------------------------------------------------
9+-- Imports
10+--------------------------------------------------------------------------------
11+
12+import Streamly.Internal.Data.Serialize (Serialize)
13+import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
14+
15+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
16+
17+--------------------------------------------------------------------------------
18+-- Code
19+--------------------------------------------------------------------------------
20+
21+$(genLargeRecord "RecCompatible" 50)
22+$(Serialize.deriveSerializeWith
23+ (Serialize.defaultConfig {Serialize.recordSyntaxWithHeader = True})
24+ [d|instance Serialize RecCompatible|])
benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Streamly.Benchmark.Data.Serialize.RecNonCompatible
4+ ( RecNonCompatible(..)
5+ , valRecNonCompatible
6+ ) where
7+
8+--------------------------------------------------------------------------------
9+-- Imports
10+--------------------------------------------------------------------------------
11+
12+import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
13+
14+import qualified Streamly.Internal.Data.Serialize.TH as Serialize
15+
16+--------------------------------------------------------------------------------
17+-- Code
18+--------------------------------------------------------------------------------
19+
20+$(genLargeRecord "RecNonCompatible" 50)
21+$(Serialize.deriveSerialize ''RecNonCompatible)
benchmark/Streamly/Benchmark/Data/Serialize/TH.hsnew file+76
@@ -0,0 +1,76 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+
3+module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where
4+
5+--------------------------------------------------------------------------------
6+-- Imports
7+--------------------------------------------------------------------------------
8+
9+import Language.Haskell.TH
10+
11+import Streamly.Internal.Data.Serialize.TH.Bottom (makeI)
12+import Control.DeepSeq (NFData(..))
13+
14+--------------------------------------------------------------------------------
15+-- Large Record
16+--------------------------------------------------------------------------------
17+
18+genLargeRecord :: String -> Int -> Q [Dec]
19+genLargeRecord tyName numFields =
20+ sequence
21+ ([ dataD
22+ (pure [])
23+ (mkName tyName)
24+ []
25+ Nothing
26+ [mkCon tyName]
27+ [derivClause Nothing [conT ''Eq, conT ''Show]]
28+ , mkValueSigDec
29+ , mkValueDec
30+ , nfDataInstance tyName
31+ ])
32+
33+ where
34+
35+ fieldTypeChoices = [conT ''()]
36+ chooseCycle i xs = xs !! (i `mod` length xs)
37+ nfDataInstance nm =
38+ instanceD
39+ (pure [])
40+ (appT (conT ''NFData) (conT (mkName nm)))
41+ [ funD
42+ 'rnf
43+ [ clause
44+ [ conP
45+ (mkName nm)
46+ (varP . makeI <$> [0 .. (numFields - 1)])
47+ ]
48+ (normalB
49+ (foldl
50+ (\b a -> [|rnf $(b) `seq` rnf $(a)|])
51+ [|()|]
52+ (varE . makeI <$> [0 .. (numFields - 1)])))
53+ []
54+ ]
55+ ]
56+ valueName = mkName $ "val" ++ tyName
57+ mkValueSigDec = sigD valueName [t|$(conT (mkName tyName))|]
58+ mkValueDec =
59+ funD
60+ valueName
61+ [ clause
62+ []
63+ (normalB
64+ (foldl
65+ (\b a -> [|$(b) $(a)|])
66+ (conE (mkName tyName))
67+ (const (conE '()) <$> [0 .. (numFields - 1)])))
68+ []
69+ ]
70+ mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])
71+ mkField i =
72+ varBangType
73+ (mkName ("field" ++ show i))
74+ (bangType
75+ (bang noSourceUnpackedness noSourceStrictness)
76+ (chooseCycle i fieldTypeChoices))
benchmark/streamly-benchmarks.cabal+7−1
@@ -379,7 +379,13 @@ benchmark Data.Serialize
379 hs-source-dirs: .
379 hs-source-dirs: .
380 cpp-options: -DUSE_TH
380 cpp-options: -DUSE_TH
381 main-is: Streamly/Benchmark/Data/Serialize.hs
381 main-is: Streamly/Benchmark/Data/Serialize.hs
382− build-depends: QuickCheck
382+ build-depends: QuickCheck, template-haskell
383+ other-modules:
384+ Streamly.Benchmark.Data.Serialize.TH
385+ Streamly.Benchmark.Data.Serialize.RecCompatible
386+ Streamly.Benchmark.Data.Serialize.RecNonCompatible
387+ if flag(limit-build-mem)
388+ ghc-options: +RTS -M1000M -RTS
383
389
384benchmark Data.Unfold
390benchmark Data.Unfold
385 import: bench-options
391 import: bench-options
streamly.cabal+1
@@ -63,6 +63,7 @@ extra-source-files:
63 benchmark/bench-runner/Main.hs
63 benchmark/bench-runner/Main.hs
64 benchmark/bench-runner/bench-runner.cabal
64 benchmark/bench-runner/bench-runner.cabal
65 benchmark/Streamly/Benchmark/Data/*.hs
65 benchmark/Streamly/Benchmark/Data/*.hs
66+ benchmark/Streamly/Benchmark/Data/Serialize/*.hs
66 benchmark/Streamly/Benchmark/Data/Array/Common.hs
67 benchmark/Streamly/Benchmark/Data/Array/Common.hs
67 benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs
68 benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs
68 benchmark/Streamly/Benchmark/Data/Array/Generic.hs
69 benchmark/Streamly/Benchmark/Data/Array/Generic.hs