git.iko.soy/streamly
on efecb26 help sign in
streamly/benchmark/Streamly/Benchmark/Data/Stream/Lift.hs
146 lines 4.4 kB history raw
1-- |
2-- Module : Stream.Lift
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
7{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
12#ifdef USE_PRELUDE
13{-# OPTIONS_GHC -Wno-deprecations #-}
14#endif
16module Stream.Lift (benchmarks) where
18import Control.DeepSeq (NFData(..))
19import Control.Monad.State.Strict (StateT, get, put)
20import Data.Functor.Identity (Identity)
21import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
22import System.Random (randomRIO)
24import qualified Stream.Common as Common
25import qualified Streamly.Internal.Data.Fold as Fold
27#ifdef USE_PRELUDE
28import qualified Streamly.Internal.Data.Stream.IsStream as Stream
29#else
30import Streamly.Internal.Data.Stream (Stream)
31import qualified Streamly.Internal.Data.Stream as Stream
32#ifdef USE_STREAMK
33import Stream.Common (benchIO, drain)
34import Streamly.Internal.Data.StreamK (StreamK)
35import qualified Streamly.Internal.Data.StreamK as StreamK
36import qualified Control.Monad.State.Strict as State
37#endif
38#endif
40import Gauge
41import Streamly.Benchmark.Common
42import Prelude hiding (reverse, tail)
44#ifdef USE_PRELUDE
45type Stream = Stream.SerialT
46#endif
48-------------------------------------------------------------------------------
49-- Monad transformation (hoisting etc.)
50-------------------------------------------------------------------------------
52{-# INLINE sourceUnfoldrState #-}
53sourceUnfoldrState :: Common.MonadAsync m =>
54 Int -> Int -> Stream (StateT Int m) Int
55sourceUnfoldrState value n = Stream.unfoldrM step n
56 where
57 step cnt =
58 if cnt > n + value
59 then return Nothing
60 else do
61 s <- get
62 put (s + 1)
63 return (Just (s, cnt + 1))
65{-# INLINE evalStateT #-}
66evalStateT :: Common.MonadAsync m => Int -> Int -> Stream m Int
67evalStateT value n =
68 Stream.evalStateT (return 0) (sourceUnfoldrState value n)
70{-# INLINE withState #-}
71withState :: Common.MonadAsync m => Int -> Int -> Stream m Int
72withState value n =
73 Stream.evalStateT
74 (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
76{-# INLINE benchHoistSink #-}
77benchHoistSink
78 :: (NFData b)
79 => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
80benchHoistSink value name f =
81 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
83o_1_space_hoisting :: Int -> [Benchmark]
84o_1_space_hoisting value =
85 [ bgroup "hoisting"
86 [ benchIOSrc "evalState" (evalStateT value)
87 , benchIOSrc "withState" (withState value)
88#ifndef USE_PRELUDE
89 , benchHoistSink value "generalizeInner"
90 ((\xs -> Stream.fold Fold.length xs :: IO Int)
91 . Stream.generalizeInner)
92#endif
93 ]
94 ]
96#ifdef USE_STREAMK
97{-# INLINE iterateStateIO #-}
98iterateStateIO ::
99 Monad m
100 => Int
101 -> StateT Int m Int
102iterateStateIO n = do
103 x <- get
104 if x > n
105 then do
106 put (x - 1)
107 iterateStateIO n
108 else return x
110-- XXX This is basically testing the perf of concatEffect, change it to just
111-- use concatEffect and move it along with other concatMap benchmarks.
112{-# INLINE iterateStateT #-}
113iterateStateT :: Int -> StreamK (StateT Int IO) Int
114iterateStateT n = StreamK.concatEffect $ do
115 x <- get
116 if x > n
117 then do
118 put (x - 1)
119 return $ iterateStateT n
120 else return $ StreamK.fromPure x
122o_n_heap_transformer :: Int -> [Benchmark]
123o_n_heap_transformer value =
124 [ bgroup "transformer"
125 [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
126 State.evalStateT (iterateStateIO n) value
127 , benchIO "Stream (StateT Int IO) (n times)" $ \n ->
128 State.evalStateT (drain $ Common.toStream (iterateStateT n)) value
129 ]
130 ]
131#endif
133-------------------------------------------------------------------------------
134-- Main
135-------------------------------------------------------------------------------
137-- In addition to gauge options, the number of elements in the stream can be
138-- passed using the --stream-size option.
139--
140benchmarks :: String -> Int -> [Benchmark]
141benchmarks moduleName size =
142 [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
143#ifdef USE_STREAMK
144 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
145#endif
146 ]