@@ -17,46 +17,214 @@ module Main (main) where
1717-- Imports
1818-------------------------------------------------------------------------------
1919
20−import Control.DeepSeq (NFData(..), force)
20+import Control.DeepSeq (NFData(..))
2121import Control.Exception (assert)
2222import Control.Monad (replicateM_)
2323import GHC.Generics (Generic)
2424import System.Random (randomRIO)
25−import Test.QuickCheck
25+#ifndef USE_UNBOX
26+import Test.QuickCheck (Arbitrary, arbitrary)
27+#endif
2628
29+#ifdef USE_UNBOX
30+import Data.Proxy (Proxy(..))
31+import Streamly.Internal.Data.Unbox
32+#else
33+import Control.DeepSeq (force)
34+import Test.QuickCheck (oneof, generate)
2735import Streamly.Internal.Data.Unbox (newBytes)
2836import Streamly.Internal.Data.Serialize
29−#define USE_TH
37+#endif
38+
3039#ifdef USE_TH
40+#ifdef USE_UNBOX
41+import Streamly.Internal.Data.Unbox.TH
42+#else
3143import Streamly.Internal.Data.Serialize.TH
3244#endif
45+#endif
3346
3447import Gauge
3548import Streamly.Benchmark.Common
3649
50+#ifdef USE_UNBOX
51+#define SERIALIZE_CLASS Unbox
52+#define DERIVE_CLASS deriveUnbox
53+#define SERIALIZE_OP pokeByteIndex
54+#define DESERIALIZE_OP peekByteIndex
55+#else
56+#define SERIALIZE_CLASS Serialize
57+#define DERIVE_CLASS deriveSerialize
58+#define SERIALIZE_OP serialize
59+#define DESERIALIZE_OP deserialize
60+#endif
61+
3762-------------------------------------------------------------------------------
3863-- Types
3964-------------------------------------------------------------------------------
4065
66+data Unit = Unit
67+ deriving (Generic, Show, Eq)
68+
69+#ifndef USE_TH
70+instance SERIALIZE_CLASS Unit
71+#else
72+$(DERIVE_CLASS ''Unit)
73+#endif
74+
75+data Sum2
76+ = Sum21
77+ | Sum22
78+ deriving (Generic, Show, Eq)
79+
80+#ifndef USE_TH
81+instance SERIALIZE_CLASS Sum2
82+#else
83+$(DERIVE_CLASS ''Sum2)
84+#endif
85+
86+data Sum25
87+ = Sum251
88+ | Sum252
89+ | Sum253
90+ | Sum254
91+ | Sum255
92+ | Sum256
93+ | Sum257
94+ | Sum258
95+ | Sum259
96+ | Sum2510
97+ | Sum2511
98+ | Sum2512
99+ | Sum2513
100+ | Sum2514
101+ | Sum2515
102+ | Sum2516
103+ | Sum2517
104+ | Sum2518
105+ | Sum2519
106+ | Sum2520
107+ | Sum2521
108+ | Sum2522
109+ | Sum2523
110+ | Sum2524
111+ | Sum2525
112+ deriving (Generic, Show, Eq)
113+
114+#ifndef USE_TH
115+instance SERIALIZE_CLASS Sum25
116+#else
117+$(DERIVE_CLASS ''Sum25)
118+#endif
119+
120+data Product25
121+ = Product25
122+ Int
123+ Int
124+ Int
125+ Int
126+ Int
127+ Int
128+ Int
129+ Int
130+ Int
131+ Int
132+ Int
133+ Int
134+ Int
135+ Int
136+ Int
137+ Int
138+ Int
139+ Int
140+ Int
141+ Int
142+ Int
143+ Int
144+ Int
145+ Int
146+ Int
147+ deriving (Generic, Show)
148+
149+#ifndef USE_TH
150+instance SERIALIZE_CLASS Product25
151+#else
152+$(DERIVE_CLASS ''Product25)
153+#endif
154+
155+-- XXX derived Eq instance is not inlined
156+instance Eq Product25 where
157+ {-# INLINE (==) #-}
158+ (==)
159+ (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)
160+ (Product25 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25)
161+ = a1 == b1
162+ && a2 == b2
163+ && a3 == b3
164+ && a4 == b4
165+ && a5 == b5
166+ && a6 == b6
167+ && a7 == b7
168+ && a8 == b8
169+ && a9 == b9
170+ && a10 == b10
171+ && a11 == b11
172+ && a12 == b12
173+ && a13 == b13
174+ && a14 == b14
175+ && a15 == b15
176+ && a16 == b16
177+ && a17 == b17
178+ && a18 == b18
179+ && a19 == b19
180+ && a20 == b20
181+ && a21 == b21
182+ && a22 == b22
183+ && a23 == b23
184+ && a24 == b24
185+ && a25 == b25
186+
187+-------------------------------------------------------------------------------
188+
41189-- Simple non-recursive ADT
42190data CustomDT1
43191 = CDT1C1
44192 | CDT1C2 Int
45− | CDT1C3 Int Bool
193+ | CDT1C3 Int Int
46194 deriving (Generic, Show, Eq)
47195
48196#ifndef USE_TH
49−instance Serialize CustomDT1
197+instance SERIALIZE_CLASS CustomDT1
50198#else
51−$(deriveSerialize ''CustomDT1)
199+$(DERIVE_CLASS ''CustomDT1)
52200#endif
53201
202+-------------------------------------------------------------------------------
203+
204+{-# INLINE getSize #-}
205+getSize :: forall a. SERIALIZE_CLASS a => a -> Int
206+#ifdef USE_UNBOX
207+getSize _ = sizeOf (Proxy :: Proxy a)
208+#else
209+getSize val =
210+ case size :: Size a of
211+ ConstSize x -> x
212+ VarSize f -> f val
213+#endif
214+
215+#ifndef USE_UNBOX
216+{-# INLINE sizeOfOnce #-}
217+sizeOfOnce :: forall a. Serialize a => a -> Int
218+sizeOfOnce val = getSize val
219+
54220-- Recursive ADT
55221data BinTree a
56222 = Tree (BinTree a) (BinTree a)
57223 | Leaf a
58224 deriving (Show, Read, Eq, Generic)
59225
226+-- XXX If a is ConstSize we can use an array to represent the binary tree. If
227+-- the tree is balanced space wastage would be minimum.
60228#ifndef USE_TH
61229instance Serialize (BinTree a)
62230#else
@@ -78,6 +246,7 @@ mkBinTree = go (generate $ arbitrary)
78246 go r 0 = Leaf <$> r
79247 go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
80248
249+{-
81250prop :: Property
82251prop = forAll arbitrary (ioProperty . test)
83252
@@ -96,20 +265,7 @@ prop = forAll arbitrary (ioProperty . test)
96265
97266runQC :: IO ()
98267runQC = quickCheckWith stdArgs {maxSuccess = 100} prop
99−
100−data Enumeration = Enum1 | Enum2 | Enum3 | Enum4 | Enum5
101− deriving (Show, Read, Eq, Generic)
102−
103−instance NFData Enumeration where
104− rnf a = rnf a `seq` ()
105−
106−instance Arbitrary Enumeration where
107− arbitrary = elements [Enum1, Enum2, Enum3, Enum4, Enum5]
108−
109−#ifndef USE_TH
110−instance Serialize Enumeration
111−#else
112−$(deriveSerialize ''Enumeration)
268+-}
113269#endif
114270
115271-------------------------------------------------------------------------------
@@ -117,41 +273,55 @@ $(deriveSerialize ''Enumeration)
117273-------------------------------------------------------------------------------
118274
119275{-# INLINE pokeTimes #-}
120−pokeTimes :: forall a. Serialize a => a -> Int -> IO ()
276+pokeTimes :: forall a. SERIALIZE_CLASS a => a -> Int -> IO ()
121277pokeTimes val times = do
122− let n =
123− case size :: Size a of
124− ConstSize x -> x
125− VarSize f -> f val
278+ -- XXX Size computation should also be part of the loop measuring
279+ -- serialization cost.
280+ let n = getSize val
126281 arr <- newBytes n
127282 replicateM_ times $ do
128− serialize 0 arr val
283+ SERIALIZE_OP 0 arr val
129284
130285{-# INLINE peekTimes #-}
131−peekTimes :: forall a. Serialize a => a -> Int -> IO ()
132−peekTimes val times = do
133− let n =
134− case size :: Size a of
135− ConstSize x -> x
136− VarSize f -> f val
286+peekTimes :: forall a. (Eq a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()
287+peekTimes n val times = do
137288 arr <- newBytes n
138− _ <- serialize 0 arr val
289+ _ <- SERIALIZE_OP 0 arr val
139290 replicateM_ times $ do
140− (_, _ :: a) <- deserialize 0 arr
141− return ()
291+#ifdef USE_UNBOX
292+ val1
293+#else
294+ (_, val1)
295+#endif
296+ <- DESERIALIZE_OP 0 arr
297+ -- Ensure that we are actually constructing the type and using it.
298+ -- Otherwise we may just read the values and discard them.
299+ -- The comparison adds to the cost though.
300+ --
301+ if (val1 /= val)
302+ then error "peek: no match"
303+ else return ()
142304
143305{-# INLINE roundtrip #-}
144−roundtrip :: forall a. (Eq a, Serialize a) => a -> Int -> IO ()
306+roundtrip :: forall a. (Eq a, SERIALIZE_CLASS a) => a -> Int -> IO ()
145307roundtrip val times = do
146− let n =
147− case size :: Size a of
148− ConstSize x -> x
149− VarSize f -> f val
308+ -- XXX Size computation should also be part of the loop measuring
309+ -- serialization cost.
310+ let n = getSize val
150311 arr <- newBytes n
151312 replicateM_ times $ do
152− _ <- serialize 0 arr val
153− (_, val1) <- deserialize 0 arr
313+ _ <- SERIALIZE_OP 0 arr val
314+#ifdef USE_UNBOX
315+ val1
316+#else
317+ (_, val1)
318+#endif
319+ <- DESERIALIZE_OP 0 arr
154320 assert (val == val1) (pure ())
321+ -- So that the compiler does not optimize it out
322+ if (val1 /= val)
323+ then error "roundtrip: no match"
324+ else return ()
155325
156326benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
157327benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
@@ -160,35 +330,85 @@ benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
160330-- Benchmarks
161331-------------------------------------------------------------------------------
162332
163−allBenchmarks :: BinTree Int -> BinTree Enumeration -> Int -> [Benchmark]
164−allBenchmarks tInt _tEnum times =
165− [ bgroup "poke"
333+-- Times is scaled by the number of constructors to normalize
334+#ifdef USE_UNBOX
335+allBenchmarks :: Int -> [Benchmark]
336+allBenchmarks times =
337+#else
338+allBenchmarks :: BinTree Int -> [Int] -> Int -> [Benchmark]
339+allBenchmarks tInt lInt times =
340+#endif
341+ [ bgroup "sizeOf"
342+ [
343+#ifndef USE_UNBOX
344+ bench "bintree-int" $ nf sizeOfOnce tInt
345+ , bench "list-int" $ nf sizeOfOnce lInt
346+#endif
347+ ]
348+ , bgroup "poke"
166349 [ benchSink "C1" times
167− (pokeTimes (CDT1C1 :: CustomDT1))
168− , benchSink "C2" times
169− (pokeTimes ((CDT1C2 (5 :: Int)) :: CustomDT1))
170− , benchSink "C3" times
171− (pokeTimes ((CDT1C3 (5 :: Int) True) :: CustomDT1))
350+ (pokeTimes CDT1C1)
351+ , benchSink "C2" (times `div` 2)
352+ (pokeTimes (CDT1C2 5))
353+ , benchSink "C3" (times `div` 3)
354+ (pokeTimes (CDT1C3 5 2))
355+ , benchSink "Sum2" times
356+ (pokeTimes Sum21)
357+ , benchSink "Sum25" times
358+ (pokeTimes Sum2525)
359+ , benchSink "Product25" (times `div` 26)
360+ (pokeTimes (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))
361+#ifndef USE_UNBOX
362+ , benchSink "bintree-int" 1
363+ (pokeTimes tInt)
364+ , benchSink "list-int" 1
365+ (pokeTimes lInt)
366+#endif
172367 ]
173368 , bgroup "peek"
174− [ benchSink "C1" times
175− (peekTimes (CDT1C1 :: CustomDT1))
176− , benchSink "C2" times
177− (peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1))
178− , benchSink "C3" times
179− (peekTimes ((CDT1C3 (5 :: Int) True) :: CustomDT1))
369+ [ let !n = getSize Unit
370+ in benchSink "Unit" times (peekTimes n Unit)
371+ , let !n = getSize CDT1C1
372+ in benchSink "C1" times (peekTimes n CDT1C1)
373+ , let val = CDT1C2 5
374+ !n = getSize val
375+ in benchSink "C2" (times `div` 2) (peekTimes n val)
376+ , let val = CDT1C3 5 2
377+ !n = getSize val
378+ in benchSink "C3" (times `div` 3) (peekTimes n val)
379+ , let !n = getSize Sum21
380+ in benchSink "Sum2" times (peekTimes n Sum21)
381+ , let !n = getSize Sum2525
382+ in benchSink "Sum25" times (peekTimes n Sum2525)
383+ , 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
384+ !n = getSize val
385+ in benchSink "Product25" (times `div` 26) (peekTimes n val)
386+#ifndef USE_UNBOX
387+ , let !n = getSize tInt
388+ in benchSink "bintree-int" 1 (peekTimes n tInt)
389+ , let !n = getSize lInt
390+ in benchSink "list-int" 1 (peekTimes n lInt)
391+#endif
180392 ]
181393 , bgroup "roundtrip"
182394 [ benchSink "C1" times
183− (roundtrip (CDT1C1 :: CustomDT1))
184− , benchSink "C2" times
185− (roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1))
186− , benchSink "C3" times
187− (roundtrip ((CDT1C3 (5 :: Int) True) :: CustomDT1))
395+ (roundtrip CDT1C1)
396+ , benchSink "C2" (times `div` 2)
397+ (roundtrip (CDT1C2 5))
398+ , benchSink "C3" (times `div` 3)
399+ (roundtrip (CDT1C3 5 2))
400+ , benchSink "Sum2" times
401+ (roundtrip Sum21)
402+ , benchSink "Sum25" times
403+ (roundtrip Sum2525)
404+ , benchSink "Product25" (times `div` 26)
405+ (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))
406+#ifndef USE_UNBOX
188407 , benchSink "bintree-int" 1
189408 (roundtrip tInt)
190− -- , benchSink "bintree-enum" 1
191− -- (roundtrip tEnum)
409+ , benchSink "list-int" 1
410+ (roundtrip lInt)
411+#endif
192412 ]
193413 ]
194414
@@ -198,18 +418,38 @@ allBenchmarks tInt _tEnum times =
198418
199419main :: IO ()
200420main = do
201−#ifndef FUSION_CHECK
202− runQC
421+#ifndef USE_UNBOX
422+ -- Approximately 100000 constructors
423+ -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal
424+ -- nodes 1 level = log_2 (100001/3) + 1 = 16
203425 !tInt <- force <$> mkBinTree 16
204− -- Hangs
205− -- !tEnum <- force <$> (mkBinTree 16 :: BinTree Enumeration)
206− runWithCLIOpts defaultStreamSize (allBenchmarks tInt undefined)
426+
427+ -- Approximately 100000 constructors, assuming two constructors (Cons, Int)
428+ -- per element.
429+ let lInt = [1..50000 :: Int]
430+ let !len = length lInt -- evaluate the list
431+#endif
432+#ifndef FUSION_CHECK
433+ -- This can take too much memory/CPU, need to restrict the test
434+ -- runQC
435+#ifdef USE_UNBOX
436+ runWithCLIOpts defaultStreamSize allBenchmarks
437+#else
438+ len `seq` runWithCLIOpts defaultStreamSize (allBenchmarks tInt lInt)
439+#endif
207440#else
208441 -- Enable FUSION_CHECK macro at the beginning of the file
209442 -- Enable one benchmark below, and run the benchmark
210443 -- Check the .dump-simpl output
211444 let value = 100000
212445 -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value
213− roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value
446+ -- peekTimes (Sum2525) value
447+ -- peekTimes (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) value
448+ -- !(tInt :: BinTree Int) <- force <$> mkBinTree 16
449+ -- print $ sizeOfOnce tInt
450+ -- peekTimes tInt 1
451+ -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value
452+ let !n = getSize lEnum
453+ in peekTimes n lEnum 1
214454 return ()
215455#endif