@@ -17,11 +17,12 @@ module Main (main) where
1717-- Imports
1818-------------------------------------------------------------------------------
1919
20−import Control.DeepSeq (NFData(..))
20+import Control.DeepSeq (NFData(..), force)
2121import Control.Exception (assert)
2222import Control.Monad (replicateM_)
2323import GHC.Generics (Generic)
2424import System.Random (randomRIO)
25+import Test.QuickCheck
2526
2627import Streamly.Internal.Data.Unbox (newBytes)
2728import Streamly.Internal.Data.Serialize
@@ -37,6 +38,7 @@ import Streamly.Benchmark.Common
3738-- Types
3839-------------------------------------------------------------------------------
3940
41+-- Simple non-recursive ADT
4042data CustomDT1
4143 = CDT1C1
4244 | CDT1C2 Int
@@ -49,6 +51,67 @@ instance Serialize CustomDT1
4951$(deriveSerialize ''CustomDT1)
5052#endif
5153
54+-- Recursive ADT
55+data BinTree a
56+ = Tree (BinTree a) (BinTree a)
57+ | Leaf a
58+ deriving (Show, Read, Eq, Generic)
59+
60+#ifndef USE_TH
61+instance Serialize (BinTree a)
62+#else
63+$(deriveSerialize ''BinTree)
64+#endif
65+
66+instance NFData a => NFData (BinTree a) where
67+ rnf (Leaf a) = rnf a `seq` ()
68+ rnf (Tree l r) = rnf l `seq` rnf r `seq` ()
69+
70+instance Arbitrary a => Arbitrary (BinTree a) where
71+ arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
72+
73+mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
74+mkBinTree = go (generate $ arbitrary)
75+
76+ where
77+
78+ go r 0 = Leaf <$> r
79+ go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
80+
81+prop :: Property
82+prop = forAll arbitrary (ioProperty . test)
83+
84+ where
85+
86+ test :: BinTree Int -> IO Bool
87+ test t = do
88+ let n =
89+ case size :: Size (BinTree Int) of
90+ ConstSize x -> x
91+ VarSize f -> f t
92+ arr <- newBytes n
93+ _ <- serialize 0 arr t
94+ (_, t1) <- deserialize 0 arr
95+ return $ t1 == t
96+
97+runQC :: IO ()
98+runQC = 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)
113+#endif
114+
52115-------------------------------------------------------------------------------
53116-- Helpers
54117-------------------------------------------------------------------------------
@@ -97,8 +160,8 @@ benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
97160-- Benchmarks
98161-------------------------------------------------------------------------------
99162
100−allBenchmarks :: Int -> [Benchmark]
101−allBenchmarks times =
163+allBenchmarks :: BinTree Int -> BinTree Enumeration -> Int -> [Benchmark]
164+allBenchmarks tInt _tEnum times =
102165 [ bgroup "poke"
103166 [ benchSink "C1" times
104167 (pokeTimes (CDT1C1 :: CustomDT1))
@@ -122,6 +185,10 @@ allBenchmarks times =
122185 (roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1))
123186 , benchSink "C3" times
124187 (roundtrip ((CDT1C3 (5 :: Int) True) :: CustomDT1))
188+ , benchSink "bintree-int" 1
189+ (roundtrip tInt)
190+ -- , benchSink "bintree-enum" 1
191+ -- (roundtrip tEnum)
125192 ]
126193 ]
127194
@@ -132,7 +199,11 @@ allBenchmarks times =
132199main :: IO ()
133200main = do
134201#ifndef FUSION_CHECK
135− runWithCLIOpts defaultStreamSize allBenchmarks
202+ runQC
203+ !tInt <- force <$> mkBinTree 16
204+ -- Hangs
205+ -- !tEnum <- force <$> (mkBinTree 16 :: BinTree Enumeration)
206+ runWithCLIOpts defaultStreamSize (allBenchmarks tInt undefined)
136207#else
137208 -- Enable FUSION_CHECK macro at the beginning of the file
138209 -- Enable one benchmark below, and run the benchmark