@@ -0,0 +1,188 @@
1+
2+
3+-------------------------------------------------------------------------------
4+-- Benchmark helpers
5+-------------------------------------------------------------------------------
6+
7+{-# INLINE benchIO #-}
8+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
9+benchIO name src f = bench name $ nfIO $
10+ randomRIO (1,1) >>= src >>= return . f
11+
12+{-# INLINE benchPureSink #-}
13+benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
14+benchPureSink value name f = benchIO name (sourceIntFromTo value) f
15+
16+{-# INLINE benchIO' #-}
17+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
18+benchIO' name src f = bench name $ nfIO $
19+ randomRIO (1,1) >>= src >>= f
20+
21+{-# INLINE benchIOSink #-}
22+benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
23+benchIOSink value name f = benchIO' name (sourceIntFromTo value) f
24+
25+-------------------------------------------------------------------------------
26+-- Bench Ops
27+-------------------------------------------------------------------------------
28+
29+{-# INLINE sourceUnfoldr #-}
30+sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
31+sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n
32+ where
33+ step cnt =
34+ if cnt > n + value
35+ then Nothing
36+ else (Just (cnt, cnt + 1))
37+
38+{-# INLINE sourceIntFromTo #-}
39+sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
40+sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
41+
42+{-# INLINE sourceFromList #-}
43+sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
44+sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]
45+
46+-------------------------------------------------------------------------------
47+-- Transformation
48+-------------------------------------------------------------------------------
49+
50+{-# INLINE composeN #-}
51+composeN :: P.Monad m
52+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
53+composeN n f x =
54+ case n of
55+ 1 -> f x
56+ 2 -> f x P.>>= f
57+ 3 -> f x P.>>= f P.>>= f
58+ 4 -> f x P.>>= f P.>>= f P.>>= f
59+ _ -> undefined
60+
61+{-# INLINE scanl' #-}
62+{-# INLINE scanl1' #-}
63+{-# INLINE map #-}
64+
65+scanl' , scanl1', map
66+ :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
67+
68+
69+{-# INLINE onArray #-}
70+onArray
71+ :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)
72+ -> Stream Int
73+ -> m (Stream Int)
74+onArray value f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
75+
76+scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0
77+scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)
78+map value n = composeN n $ onArray value $ S.map (+1)
79+-- map n = composeN n $ A.map (+1)
80+
81+{-# INLINE eqInstance #-}
82+eqInstance :: Stream Int -> Bool
83+eqInstance src = src == src
84+
85+{-# INLINE eqInstanceNotEq #-}
86+eqInstanceNotEq :: Stream Int -> Bool
87+eqInstanceNotEq src = src P./= src
88+
89+{-# INLINE ordInstance #-}
90+ordInstance :: Stream Int -> Bool
91+ordInstance src = src P.< src
92+
93+{-# INLINE ordInstanceMin #-}
94+ordInstanceMin :: Stream Int -> Stream Int
95+ordInstanceMin src = P.min src src
96+
97+{-# INLINE showInstance #-}
98+showInstance :: Stream Int -> P.String
99+showInstance src = P.show src
100+
101+{-# INLINE pureFoldl' #-}
102+pureFoldl' :: MonadIO m => Stream Int -> m Int
103+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
104+
105+
106+-------------------------------------------------------------------------------
107+-- Elimination
108+-------------------------------------------------------------------------------
109+
110+{-# INLINE unfoldReadDrain #-}
111+unfoldReadDrain :: MonadIO m => Stream Int -> m ()
112+unfoldReadDrain = S.drain . S.unfold A.read
113+
114+{-# INLINE toStreamRevDrain #-}
115+toStreamRevDrain :: MonadIO m => Stream Int -> m ()
116+toStreamRevDrain = S.drain . A.toStreamRev
117+
118+-------------------------------------------------------------------------------
119+-- Bench groups
120+-------------------------------------------------------------------------------
121+
122+common_o_1_space_generation :: Int -> [Benchmark]
123+common_o_1_space_generation value =
124+ [ bgroup
125+ "generation"
126+ [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
127+ , benchIOSrc
128+ "fromList . intFromTo"
129+ (sourceIntFromToFromList value)
130+ , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
131+ , benchIOSrc "writeN . fromList" (sourceFromList value)
132+ , benchPureSink value "show" showInstance
133+ ]
134+ ]
135+
136+common_o_1_space_elimination :: Int -> [Benchmark]
137+common_o_1_space_elimination value =
138+ [ bgroup "elimination"
139+ [ benchPureSink value "id" id
140+ , benchPureSink value "==" eqInstance
141+ , benchPureSink value "/=" eqInstanceNotEq
142+ , benchPureSink value "<" ordInstance
143+ , benchPureSink value "min" ordInstanceMin
144+ , benchIOSink value "foldl'" pureFoldl'
145+ , benchIOSink value "read" unfoldReadDrain
146+ , benchIOSink value "toStreamRev" toStreamRevDrain
147+ ]
148+ ]
149+
150+common_o_n_heap_serial :: Int -> [Benchmark]
151+common_o_n_heap_serial value =
152+ [ bgroup "elimination"
153+ [
154+ -- Converting the stream to an array
155+ benchFold "writeN" (S.fold (A.writeN value))
156+ (P.sourceUnfoldrM value)
157+ ]
158+ ]
159+
160+common_o_1_space_transformation :: Int -> [Benchmark]
161+common_o_1_space_transformation value =
162+ [ bgroup "transformation"
163+ [ benchIOSink value "scanl'" (scanl' value 1)
164+ , benchIOSink value "scanl1'" (scanl1' value 1)
165+ , benchIOSink value "map" (map value 1)
166+ ]
167+ ]
168+
169+common_o_1_space_transformationX4 :: Int -> [Benchmark]
170+common_o_1_space_transformationX4 value =
171+ [ bgroup "transformationX4"
172+ [ benchIOSink value "scanl'" (scanl' value 4)
173+ , benchIOSink value "scanl1'" (scanl1' value 4)
174+ , benchIOSink value "map" (map value 4)
175+ ]
176+ ]
177+
178+commonBenchmarks :: Int -> [Benchmark]
179+commonBenchmarks size =
180+ [ bgroup (o_1_space_prefix moduleName) $ concat
181+ [ common_o_1_space_generation size
182+ , common_o_1_space_elimination size
183+ , common_o_1_space_transformation size
184+ , common_o_1_space_transformationX4 size
185+ ]
186+ , bgroup (o_n_space_prefix moduleName) $
187+ common_o_n_heap_serial size
188+ ]