@@ -36,7 +36,7 @@ import Prelude
3636 (Monad, String, Int, (+), ($), (.), return, even, (>), (<=), (==), (>=),
3737 subtract, undefined, Maybe(..), Bool, not, (>>=), curry,
3838 maxBound, div, IO, compare, Double, fromIntegral, Integer, (<$>),
39− (<*>), flip)
39+ (<*>), flip, sqrt, round, (*), seq)
4040import qualified Prelude as P
4141import qualified Data.Foldable as F
4242import qualified GHC.Exts as GHC
@@ -48,7 +48,22 @@ import Test.Inspection
4848import qualified Streamly.Internal.Data.Stream.StreamD as D
4949#endif
5050
51−import Streamly (SerialT, IsStream, wSerially, zipSerially, serially)
51+import Streamly
52+ ( IsStream
53+ , SerialT
54+ , aheadly
55+ , asyncly
56+ , serially
57+ , wAsyncly
58+ , wSerially
59+ , zipSerially
60+ , ahead
61+ , async
62+ , wAsync
63+ , maxBuffer
64+ , maxThreads
65+ )
66+
5267import qualified Streamly as S hiding (runStream)
5368import qualified Streamly.Prelude as S
5469import qualified Streamly.Internal.Prelude as Internal
@@ -1289,9 +1304,25 @@ benchPureSinkIO
12891304benchPureSinkIO value name f =
12901305 bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
12911306
1307+{-# INLINE benchIO #-}
12921308benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
12931309benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
12941310
1311+-- | Takes a source, and uses it with a default drain/fold method.
1312+{-# INLINE benchSrcIO #-}
1313+benchSrcIO
1314+ :: (t IO a -> SerialT IO a)
1315+ -> String
1316+ -> (Int -> t IO a)
1317+ -> Benchmark
1318+benchSrcIO t name f
1319+ = bench name $ nfIO $ randomRIO (1,1) >>= toNull t . f
1320+
1321+{-# INLINE benchMonadicSrcIO #-}
1322+benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark
1323+benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
1324+
1325+
12951326-------------------------------------------------------------------------------
12961327-- Serial : O(1) Space
12971328-------------------------------------------------------------------------------
@@ -2192,3 +2223,264 @@ o_n_stack_serial_iterated value =
21922223 ]
21932224 ]
21942225 ]
2226+
2227+o_1_space_async_generation :: Int -> [Benchmark]
2228+o_1_space_async_generation value =
2229+ [ bgroup
2230+ "asyncly"
2231+ [ bgroup
2232+ "generation"
2233+ [ benchSrcIO asyncly "unfoldr" (sourceUnfoldr value)
2234+ , benchSrcIO asyncly "unfoldrM" (sourceUnfoldrM value)
2235+ , benchSrcIO asyncly "fromFoldable" (sourceFromFoldable value)
2236+ , benchSrcIO asyncly "fromFoldableM" (sourceFromFoldableM value)
2237+ , benchSrcIO
2238+ asyncly
2239+ "unfoldrM maxThreads 1"
2240+ (maxThreads 1 . sourceUnfoldrM value)
2241+ , benchSrcIO
2242+ asyncly
2243+ "unfoldrM maxBuffer 1 (x/10 ops)"
2244+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2245+ ]
2246+ ]
2247+ ]
2248+
2249+o_1_space_async_concatFoldable :: Int -> [Benchmark]
2250+o_1_space_async_concatFoldable value =
2251+ [ bgroup
2252+ "asyncly"
2253+ [ bgroup
2254+ "concat-foldable"
2255+ [ benchSrcIO asyncly "foldMapWith" (sourceFoldMapWith value)
2256+ , benchSrcIO
2257+ asyncly
2258+ "foldMapWithM"
2259+ (sourceFoldMapWithM value)
2260+ , benchSrcIO asyncly "foldMapM" (sourceFoldMapM value)
2261+ ]
2262+ ]
2263+ ]
2264+
2265+
2266+o_1_space_async_concatMap :: Int -> [Benchmark]
2267+o_1_space_async_concatMap value =
2268+ value2 `seq`
2269+ [ bgroup
2270+ "asyncly"
2271+ [ bgroup
2272+ "concatMap"
2273+ [ benchMonadicSrcIO
2274+ "concatMapWith (2,x/2)"
2275+ (concatStreamsWith async 2 (value `div` 2))
2276+ , benchMonadicSrcIO
2277+ "concatMapWith (sqrt x,sqrt x)"
2278+ (concatStreamsWith async value2 value2)
2279+ , benchMonadicSrcIO
2280+ "concatMapWith (sqrt x * 2,sqrt x / 2)"
2281+ (concatStreamsWith async (value2 * 2) (value2 `div` 2))
2282+ ]
2283+ ]
2284+ ]
2285+ where
2286+ value2 = round $ sqrt $ (fromIntegral value :: Double)
2287+
2288+
2289+o_1_space_async_transformation :: Int -> [Benchmark]
2290+o_1_space_async_transformation value =
2291+ [ bgroup
2292+ "asyncly"
2293+ [ bgroup
2294+ "transformation"
2295+ [ benchIOSink value "map" $ map' asyncly 1
2296+ , benchIOSink value "fmap" $ fmap' asyncly 1
2297+ , benchIOSink value "mapM" $ mapM asyncly 1
2298+ ]
2299+ ]
2300+ ]
2301+
2302+o_1_space_wAsync_generation :: Int -> [Benchmark]
2303+o_1_space_wAsync_generation value =
2304+ [ bgroup
2305+ "wAsyncly"
2306+ [ bgroup
2307+ "generation"
2308+ [ benchSrcIO wAsyncly "unfoldr" (sourceUnfoldr value)
2309+ , benchSrcIO wAsyncly "unfoldrM" (sourceUnfoldrM value)
2310+ , benchSrcIO wAsyncly "fromFoldable" (sourceFromFoldable value)
2311+ , benchSrcIO
2312+ wAsyncly
2313+ "fromFoldableM"
2314+ (sourceFromFoldableM value)
2315+ , benchSrcIO
2316+ wAsyncly
2317+ "unfoldrM maxThreads 1"
2318+ (maxThreads 1 . sourceUnfoldrM value)
2319+ , benchSrcIO
2320+ wAsyncly
2321+ "unfoldrM maxBuffer 1 (x/10 ops)"
2322+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2323+ ]
2324+ ]
2325+ ]
2326+
2327+o_1_space_wAsync_concatFoldable :: Int -> [Benchmark]
2328+o_1_space_wAsync_concatFoldable value =
2329+ [ bgroup
2330+ "wAsyncly"
2331+ [ bgroup
2332+ "concat-foldable"
2333+ [ benchSrcIO wAsyncly "foldMapWith" (sourceFoldMapWith value)
2334+ , benchSrcIO wAsyncly "foldMapWithM" (sourceFoldMapWithM value)
2335+ , benchSrcIO wAsyncly "foldMapM" (sourceFoldMapM value)
2336+ ]
2337+ ]
2338+ ]
2339+
2340+-- When we merge streams using wAsync the size of the queue increases
2341+-- slowly because of the binary composition adding just one more item
2342+-- to the work queue only after every scheduling pass through the
2343+-- work queue.
2344+--
2345+-- We should see the memory consumption increasing slowly if these
2346+-- benchmarks are left to run on infinite number of streams of infinite
2347+-- sizes.
2348+o_1_space_wAsync_concatMap :: Int -> [Benchmark]
2349+o_1_space_wAsync_concatMap value =
2350+ value2 `seq`
2351+ [ bgroup
2352+ "wAsyncly"
2353+ [ benchMonadicSrcIO
2354+ "concatMapWith (2,x/2)"
2355+ (concatStreamsWith wAsync 2 (value `div` 2))
2356+ , benchMonadicSrcIO
2357+ "concatMapWith (sqrt x,sqrt x)"
2358+ (concatStreamsWith wAsync value2 value2)
2359+ , benchMonadicSrcIO
2360+ "concatMapWith (sqrt x * 2,sqrt x / 2)"
2361+ (concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
2362+ ]
2363+ ]
2364+ where
2365+ value2 = round $ sqrt $ (fromIntegral value :: Double)
2366+
2367+
2368+o_1_space_wAsync_transformation :: Int -> [Benchmark]
2369+o_1_space_wAsync_transformation value =
2370+ [ bgroup
2371+ "wAsyncly"
2372+ [ bgroup
2373+ "transformation"
2374+ [ benchIOSink value "map" $ map' wAsyncly 1
2375+ , benchIOSink value "fmap" $ fmap' wAsyncly 1
2376+ , benchIOSink value "mapM" $ mapM wAsyncly 1
2377+ ]
2378+ ]
2379+ ]
2380+
2381+-- unfoldr and fromFoldable are always serial and therefore the same for
2382+-- all stream types. They can be removed to reduce the number of benchmarks.
2383+o_1_space_ahead_generation :: Int -> [Benchmark]
2384+o_1_space_ahead_generation value =
2385+ [ bgroup
2386+ "aheadly"
2387+ [ bgroup
2388+ "generation"
2389+ [ benchSrcIO aheadly "unfoldr" (sourceUnfoldr value)
2390+ , benchSrcIO aheadly "unfoldrM" (sourceUnfoldrM value)
2391+-- , benchSrcIO aheadly "fromFoldable" (sourceFromFoldable value)
2392+ , benchSrcIO
2393+ aheadly
2394+ "fromFoldableM"
2395+ (sourceFromFoldableM value)
2396+ , benchSrcIO
2397+ aheadly
2398+ "unfoldrM maxThreads 1"
2399+ (maxThreads 1 . sourceUnfoldrM value)
2400+ , benchSrcIO
2401+ aheadly
2402+ "unfoldrM maxBuffer 1 (x/10 ops)"
2403+ (maxBuffer 1 . sourceUnfoldrMN (value `div` 10))
2404+ ]
2405+ ]
2406+ ]
2407+
2408+o_1_space_ahead_concatFoldable :: Int -> [Benchmark]
2409+o_1_space_ahead_concatFoldable value =
2410+ [ bgroup
2411+ "aheadly"
2412+ [ bgroup
2413+ "concat-foldable"
2414+ [ benchSrcIO aheadly "foldMapWith" (sourceFoldMapWith value)
2415+ , benchSrcIO aheadly "foldMapWithM" (sourceFoldMapWithM value)
2416+ , benchSrcIO aheadly "foldMapM" (sourceFoldMapM value)
2417+ ]
2418+ ]
2419+ ]
2420+
2421+o_1_space_ahead_concatMap :: Int -> [Benchmark]
2422+o_1_space_ahead_concatMap value =
2423+ value2 `seq`
2424+ [ bgroup
2425+ "aheadly"
2426+ [ benchMonadicSrcIO
2427+ "concatMapWith (2,x/2)"
2428+ (concatStreamsWith ahead 2 (value `div` 2))
2429+ , benchMonadicSrcIO
2430+ "concatMapWith (sqrt x,sqrt x)"
2431+ (concatStreamsWith ahead value2 value2)
2432+ , benchMonadicSrcIO
2433+ "concatMapWith (sqrt x * 2,sqrt x / 2)"
2434+ (concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
2435+ ]
2436+ ]
2437+ where
2438+ value2 = round $ sqrt $ (fromIntegral value :: Double)
2439+
2440+
2441+o_1_space_ahead_transformation :: Int -> [Benchmark]
2442+o_1_space_ahead_transformation value =
2443+ [ bgroup
2444+ "aheadly"
2445+ [ bgroup
2446+ "transformation"
2447+ [ benchIOSink value "map" $ map' aheadly 1
2448+ , benchIOSink value "fmap" $ fmap' aheadly 1
2449+ , benchIOSink value "mapM" $ mapM aheadly 1
2450+ ]
2451+ ]
2452+ ]
2453+
2454+o_1_space_async_zip :: Int -> [Benchmark]
2455+o_1_space_async_zip value =
2456+ [ bgroup
2457+ "asyncly"
2458+ [ bgroup
2459+ "zip"
2460+ [ benchSrcIO
2461+ serially
2462+ "zipAsync (2,x/2)"
2463+ (zipAsync (value `div` 2))
2464+ , benchSrcIO
2465+ serially
2466+ "zipAsyncM (2,x/2)"
2467+ (zipAsyncM (value `div` 2))
2468+ , benchSrcIO
2469+ serially
2470+ "zipAsyncAp (2,x/2)"
2471+ (zipAsyncAp (value `div` 2))
2472+ , benchIOSink value "fmap zipAsyncly" $ fmap' S.zipAsyncly 1
2473+ , benchSrcIO
2474+ serially
2475+ "mergeAsyncBy (2,x/2)"
2476+ (mergeAsyncBy (value `div` 2))
2477+ , benchSrcIO
2478+ serially
2479+ "mergeAsyncByM (2,x/2)"
2480+ (mergeAsyncByM (value `div` 2))
2481+ -- Parallel stages in a pipeline
2482+ , benchIOSink value "parAppMap" parAppMap
2483+ , benchIOSink value "parAppSum" parAppSum
2484+ ]
2485+ ]
2486+ ]