2018-11-06 02:06:41 +03:00
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- Investigate specific benchmarks more closely in isolation, possibly looking
|
|
|
|
-- at GHC generated code for optimizing specific problematic cases.
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
2018-12-27 11:29:25 +03:00
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
2018-11-06 02:06:41 +03:00
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
2018-12-27 11:29:25 +03:00
|
|
|
import Streamly.SVar (MonadAsync)
|
2018-12-26 22:22:33 +03:00
|
|
|
import qualified Streamly.Streams.StreamK as S
|
2018-11-06 02:06:41 +03:00
|
|
|
import Gauge
|
2018-12-26 22:22:33 +03:00
|
|
|
import System.Random
|
2018-11-06 02:06:41 +03:00
|
|
|
|
|
|
|
maxValue :: Int
|
|
|
|
maxValue = 100000
|
|
|
|
|
|
|
|
{-# INLINE sourceUnfoldrM #-}
|
2018-12-27 11:29:25 +03:00
|
|
|
sourceUnfoldrM :: MonadAsync m => S.Stream m Int
|
2018-11-06 02:06:41 +03:00
|
|
|
sourceUnfoldrM = S.unfoldrM step 0
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > maxValue
|
|
|
|
then return Nothing
|
|
|
|
else return (Just (cnt, cnt + 1))
|
|
|
|
|
|
|
|
{-# INLINE sourceUnfoldrMN #-}
|
2018-12-27 11:29:25 +03:00
|
|
|
sourceUnfoldrMN :: MonadAsync m => Int -> S.Stream m Int
|
2018-11-06 02:06:41 +03:00
|
|
|
sourceUnfoldrMN n = S.unfoldrM step n
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > n
|
|
|
|
then return Nothing
|
|
|
|
else return (Just (cnt, cnt + 1))
|
|
|
|
|
2018-12-26 22:22:33 +03:00
|
|
|
{-# INLINE sourceUnfoldr #-}
|
|
|
|
sourceUnfoldr :: Monad m => Int -> S.Stream m Int
|
|
|
|
sourceUnfoldr n = S.unfoldr step n
|
|
|
|
where
|
|
|
|
step cnt =
|
|
|
|
if cnt > n + maxValue
|
|
|
|
then Nothing
|
|
|
|
else Just (cnt, cnt + 1)
|
|
|
|
|
2018-11-06 02:06:41 +03:00
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- take-drop composition
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
takeAllDropOne :: Monad m => S.Stream m Int -> S.Stream m Int
|
|
|
|
takeAllDropOne = S.drop 1 . S.take maxValue
|
|
|
|
|
|
|
|
-- Requires -fspec-constr-recursive=5 for better fused code
|
|
|
|
-- The number depends on how many times we compose it
|
|
|
|
|
|
|
|
{-# INLINE takeDrop #-}
|
|
|
|
takeDrop :: Monad m => S.Stream m Int -> m ()
|
|
|
|
takeDrop = S.runStream .
|
|
|
|
takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
|
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- dropWhileFalse composition
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
dropWhileFalse :: Monad m => S.Stream m Int -> S.Stream m Int
|
|
|
|
dropWhileFalse = S.dropWhile (> maxValue)
|
|
|
|
|
|
|
|
-- Requires -fspec-constr-recursive=5 for better fused code
|
|
|
|
-- The number depends on how many times we compose it
|
|
|
|
|
|
|
|
{-# INLINE dropWhileFalseX4 #-}
|
|
|
|
dropWhileFalseX4 :: Monad m => S.Stream m Int -> m ()
|
|
|
|
dropWhileFalseX4 = S.runStream
|
|
|
|
. dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
|
|
|
|
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
-- iteration
|
|
|
|
-------------------------------------------------------------------------------
|
|
|
|
|
|
|
|
{-# INLINE iterateSource #-}
|
|
|
|
iterateSource
|
2018-12-27 11:29:25 +03:00
|
|
|
:: MonadAsync m
|
2018-11-06 02:06:41 +03:00
|
|
|
=> (S.Stream m Int -> S.Stream m Int) -> Int -> Int -> S.Stream m Int
|
|
|
|
iterateSource g i n = f i (sourceUnfoldrMN n)
|
|
|
|
where
|
|
|
|
f (0 :: Int) m = g m
|
|
|
|
f x m = g (f (x - 1) m)
|
|
|
|
|
|
|
|
-- Keep only the benchmark that is to be investiagted and comment out the rest.
|
|
|
|
-- We keep all of them enabled by default for testing the build.
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2018-12-26 22:22:33 +03:00
|
|
|
defaultMain [bench "unfoldr" $ nfIO $
|
|
|
|
randomRIO (1,1) >>= \n -> S.runStream (sourceUnfoldr n)]
|
2018-11-06 02:06:41 +03:00
|
|
|
defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
|
|
|
|
defaultMain [bench "dropWhileFalseX4" $
|
|
|
|
nfIO $ dropWhileFalseX4 sourceUnfoldrM]
|
|
|
|
defaultMain [bench "iterate-mapM" $
|
|
|
|
nfIO $ S.runStream $ iterateSource (S.mapM return) 100000 10]
|