git.iko.soy/streamly
on 43dda21 help sign in
streamly/benchmark/NanoBenchmarks.hs
122 lines 4.3 kB history raw
1-------------------------------------------------------------------------------
2-- Investigate specific benchmarks more closely in isolation, possibly looking
3-- at GHC generated code for optimizing specific problematic cases.
4-------------------------------------------------------------------------------
6{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE ScopedTypeVariables #-}
9import Streamly.Prelude (SerialT)
10import Streamly.Internal.Data.SVar (MonadAsync)
12import qualified Streamly.Data.Array.Foreign as A
13import qualified Streamly.FileSystem.Handle as FH
14import qualified Streamly.Internal.FileSystem.Handle as IFH
15import qualified Streamly.Data.Fold as FL
16import qualified Streamly.Internal.Data.Stream.IsStream as Internal
17import qualified Streamly.Prelude as S
18import qualified Streamly.Internal.Data.Stream.StreamK as K
20import Data.Char (ord)
21import Gauge
22import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
23import System.Random
25maxValue :: Int
26maxValue = 100000
28-- type Stream = K.Stream
29type Stream = SerialT
31{-# INLINE sourceUnfoldrM #-}
32sourceUnfoldrM :: MonadAsync m => Stream m Int
33sourceUnfoldrM = S.unfoldrM step 0
34 where
35 step cnt =
36 if cnt > maxValue
37 then return Nothing
38 else return (Just (cnt, cnt + 1))
40{-# INLINE sourceUnfoldrMN #-}
41sourceUnfoldrMN :: MonadAsync m => Int -> Stream m Int
42sourceUnfoldrMN n = S.unfoldrM step n
43 where
44 step cnt =
45 if cnt > n
46 then return Nothing
47 else return (Just (cnt, cnt + 1))
49{-# INLINE sourceUnfoldr #-}
50sourceUnfoldr :: Monad m => Int -> Stream m Int
51sourceUnfoldr n = S.unfoldr step n
52 where
53 step cnt =
54 if cnt > n + maxValue
55 then Nothing
56 else Just (cnt, cnt + 1)
58-------------------------------------------------------------------------------
59-- take-drop composition
60-------------------------------------------------------------------------------
62takeAllDropOne :: Monad m => Stream m Int -> Stream m Int
63takeAllDropOne = S.drop 1 . S.take maxValue
65-- Requires -fspec-constr-recursive=5 for better fused code
66-- The number depends on how many times we compose it
68{-# INLINE takeDrop #-}
69takeDrop :: Monad m => Stream m Int -> m ()
70takeDrop = S.drain .
71 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
73-------------------------------------------------------------------------------
74-- dropWhileFalse composition
75-------------------------------------------------------------------------------
77dropWhileFalse :: Monad m => Stream m Int -> Stream m Int
78dropWhileFalse = S.dropWhile (> maxValue)
80-- Requires -fspec-constr-recursive=5 for better fused code
81-- The number depends on how many times we compose it
83{-# INLINE dropWhileFalseX4 #-}
84dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
85dropWhileFalseX4 = S.drain
86 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
88-------------------------------------------------------------------------------
89-- iteration
90-------------------------------------------------------------------------------
92{-# INLINE iterateSource #-}
93iterateSource
94 :: MonadAsync m
95 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
96iterateSource g i n = f i (sourceUnfoldrMN n)
97 where
98 f (0 :: Int) m = g m
99 f x m = g (f (x - 1) m)
101-- Keep only the benchmark that is to be investiagted and comment out the rest.
102-- We keep all of them enabled by default for testing the build.
103main :: IO ()
104main = do
105 defaultMain [bench "unfoldr" $ nfIO $
106 randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]
107 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
108 defaultMain [bench "dropWhileFalseX4" $
109 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
110 defaultMain [bench "iterate-mapM" $
111 nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]
113 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
114 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
115 (S.length $ Internal.splitOnSeq (A.fromList $ map (fromIntegral . ord)
116 "abcdefghijklmnopqrstuvwxyz") FL.drain
117 $ IFH.getBytes inText) >>= print
118 ]
119 where
121 mkBenchText name h action =
122 bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)