git.iko.soy/streamly
on 430f06d help sign in
streamly/benchmark/NanoBenchmarks.hs
127 lines 4.4 kB history raw
1{-# OPTIONS_GHC -Wno-deprecations #-}
3-------------------------------------------------------------------------------
4-- Investigate specific benchmarks more closely in isolation, possibly looking
5-- at GHC generated code for optimizing specific problematic cases.
6-------------------------------------------------------------------------------
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11import Data.Char (ord)
12import Streamly.Internal.Data.Stream (Stream)
13import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
15import qualified Streamly.Data.Array as A
16import qualified Streamly.Internal.FileSystem.Handle as IFH
17import qualified Streamly.Data.Fold as FL
18import qualified Streamly.Internal.Data.Stream as S
19import qualified Streamly.Internal.Data.Stream.IsStream as Internal
21import Gauge
22import System.Random
24maxValue :: Int
25maxValue = 100000
27drain :: Monad m => S.Stream m a -> m ()
28drain = S.fold FL.drain
30{-# INLINE sourceUnfoldrM #-}
31sourceUnfoldrM :: Monad m => Stream m Int
32sourceUnfoldrM = S.unfoldrM step 0
33 where
34 step cnt =
35 if cnt > maxValue
36 then return Nothing
37 else return (Just (cnt, cnt + 1))
39{-# INLINE sourceUnfoldrMN #-}
40sourceUnfoldrMN :: Monad m => Int -> Stream m Int
41sourceUnfoldrMN n = S.unfoldrM step n
42 where
43 step cnt =
44 if cnt > n
45 then return Nothing
46 else return (Just (cnt, cnt + 1))
48{-# INLINE sourceUnfoldr #-}
49sourceUnfoldr :: Monad m => Int -> Stream m Int
50sourceUnfoldr n = S.unfoldr step n
51 where
52 step cnt =
53 if cnt > n + maxValue
54 then Nothing
55 else Just (cnt, cnt + 1)
57-------------------------------------------------------------------------------
58-- take-drop composition
59-------------------------------------------------------------------------------
61takeAllDropOne :: Monad m => Stream m Int -> Stream m Int
62takeAllDropOne = S.drop 1 . S.take maxValue
64-- Requires -fspec-constr-recursive=5 for better fused code
65-- The number depends on how many times we compose it
67{-# INLINE takeDrop #-}
68takeDrop :: Monad m => Stream m Int -> m ()
69takeDrop = drain .
70 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
72-------------------------------------------------------------------------------
73-- dropWhileFalse composition
74-------------------------------------------------------------------------------
76dropWhileFalse :: Monad m => Stream m Int -> Stream m Int
77dropWhileFalse = S.dropWhile (> maxValue)
79-- Requires -fspec-constr-recursive=5 for better fused code
80-- The number depends on how many times we compose it
82{-# INLINE dropWhileFalseX4 #-}
83dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
84dropWhileFalseX4 = drain
85 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
87-------------------------------------------------------------------------------
88-- iteration
89-------------------------------------------------------------------------------
91{-# INLINE iterateSource #-}
92iterateSource
93 :: Monad m
94 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
95iterateSource g i n = f i (sourceUnfoldrMN n)
96 where
97 f (0 :: Int) m = g m
98 f x m = g (f (x - 1) m)
100-- Keep only the benchmark that is to be investiagted and comment out the rest.
101-- We keep all of them enabled by default for testing the build.
102main :: IO ()
103main = do
104 defaultMain [bench "unfoldr" $ nfIO $
105 randomRIO (1,1) >>= \n -> drain (sourceUnfoldr n)]
106 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
107 defaultMain [bench "dropWhileFalseX4" $
108 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
109 defaultMain [bench "iterate-mapM" $
110 nfIO $ drain $ iterateSource (S.mapM return) 100000 10]
112 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
113 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
114 S.fold FL.length
115 (Internal.splitOnSeq
116 (A.fromList
117 $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"
118 )
119 FL.drain
120 $ IFH.read inText
121 )
122 >>= print
123 ]
124 where
126 mkBenchText name h action =
127 env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)