git.iko.soy/streamly
on d6c883c help sign in
streamly/benchmark/StreamDOps.hs
353 lines 11 kB history raw
1-- |
2-- Module : StreamDOps
3-- Copyright : (c) 2018 Harendra Kumar
4--
5-- License : BSD3
6-- Maintainer : streamly@composewell.com
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11module StreamDOps where
13import Control.Monad (when)
14import Data.Maybe (isJust)
15import Prelude
16 (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,
17 subtract, undefined, Maybe(..), not, (>>=),
18 maxBound, fmap, odd, (==), flip, (<$>), (<*>), round, (/), (**), (<))
19import qualified Prelude as P
21import qualified Streamly.Internal.Data.Stream.StreamD as S
22import qualified Streamly.Internal.Data.Unfold as UF
24-- We try to keep the total number of iterations same irrespective of nesting
25-- of the loops so that the overhead is easy to compare.
26value, value2, value3, value16, maxValue :: Int
27value = 100000
28value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31maxValue = value
33-------------------------------------------------------------------------------
34-- Stream generation and elimination
35-------------------------------------------------------------------------------
37type Stream m a = S.Stream m a
39{-# INLINE sourceUnfoldr #-}
40sourceUnfoldr :: Monad m => Int -> Stream m Int
41sourceUnfoldr n = S.unfoldr step n
42 where
43 step cnt =
44 if cnt > n + value
45 then Nothing
46 else Just (cnt, cnt + 1)
48{-# INLINE sourceUnfoldrN #-}
49sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int
50sourceUnfoldrN m n = S.unfoldr step n
51 where
52 step cnt =
53 if cnt > n + m
54 then Nothing
55 else Just (cnt, cnt + 1)
57{-# INLINE sourceUnfoldrMN #-}
58sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int
59sourceUnfoldrMN m n = S.unfoldrM step n
60 where
61 step cnt =
62 if cnt > n + m
63 then return Nothing
64 else return (Just (cnt, cnt + 1))
66{-# INLINE sourceUnfoldrM #-}
67sourceUnfoldrM :: Monad m => Int -> Stream m Int
68sourceUnfoldrM n = S.unfoldrM step n
69 where
70 step cnt =
71 if cnt > n + value
72 then return Nothing
73 else return (Just (cnt, cnt + 1))
75{-# INLINE sourceIntFromTo #-}
76sourceIntFromTo :: Monad m => Int -> Stream m Int
77sourceIntFromTo n = S.enumerateFromToIntegral n (n + value)
79{-# INLINE sourceFromList #-}
80sourceFromList :: Monad m => Int -> Stream m Int
81sourceFromList n = S.fromList [n..n+value]
83{-# INLINE source #-}
84source :: Monad m => Int -> Stream m Int
85source = sourceUnfoldrM
87-------------------------------------------------------------------------------
88-- Elimination
89-------------------------------------------------------------------------------
91{-# INLINE runStream #-}
92runStream :: Monad m => Stream m a -> m ()
93runStream = S.drain
95{-# INLINE mapM_ #-}
96mapM_ :: Monad m => Stream m a -> m ()
97mapM_ = S.mapM_ (\_ -> return ())
99{-# INLINE toNull #-}
100toNull :: Monad m => Stream m Int -> m ()
101toNull = runStream
103{-# INLINE uncons #-}
104{-# INLINE nullTail #-}
105{-# INLINE headTail #-}
106uncons, nullTail, headTail
107 :: Monad m
108 => Stream m Int -> m ()
110uncons s = do
111 r <- S.uncons s
112 case r of
113 Nothing -> return ()
114 Just (_, t) -> uncons t
116{-# INLINE tail #-}
117tail :: Monad m => Stream m a -> m ()
118tail s = S.tail s >>= P.mapM_ tail
120nullTail s = do
121 r <- S.null s
122 when (not r) $ S.tail s >>= P.mapM_ nullTail
124headTail s = do
125 h <- S.head s
126 when (isJust h) $ S.tail s >>= P.mapM_ headTail
128{-# INLINE toList #-}
129toList :: Monad m => Stream m Int -> m [Int]
130toList = S.toList
132{-# INLINE foldl #-}
133foldl :: Monad m => Stream m Int -> m Int
134foldl = S.foldl' (+) 0
136{-# INLINE last #-}
137last :: Monad m => Stream m Int -> m (Maybe Int)
138last = S.last
140-------------------------------------------------------------------------------
141-- Transformation
142-------------------------------------------------------------------------------
144{-# INLINE transform #-}
145transform :: Monad m => Stream m a -> m ()
146transform = runStream
148{-# INLINE composeN #-}
149composeN
150 :: Monad m
151 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
152composeN n f =
153 case n of
154 1 -> transform . f
155 2 -> transform . f . f
156 3 -> transform . f . f . f
157 4 -> transform . f . f . f . f
158 _ -> undefined
160{-# INLINE scan #-}
161{-# INLINE map #-}
162{-# INLINE fmap #-}
163{-# INLINE mapM #-}
164{-# INLINE mapMaybe #-}
165{-# INLINE mapMaybeM #-}
166{-# INLINE filterEven #-}
167{-# INLINE filterAllOut #-}
168{-# INLINE filterAllIn #-}
169{-# INLINE takeOne #-}
170{-# INLINE takeAll #-}
171{-# INLINE takeWhileTrue #-}
172{-# INLINE takeWhileMTrue #-}
173{-# INLINE dropOne #-}
174{-# INLINE dropAll #-}
175{-# INLINE dropWhileTrue #-}
176{-# INLINE dropWhileMTrue #-}
177{-# INLINE dropWhileFalse #-}
178{-# INLINE foldrS #-}
179{-# INLINE foldlS #-}
180{-# INLINE concatMap #-}
181{-# INLINE intersperse #-}
182scan, map, fmap, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,
183 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,
184 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse, foldrS, foldlS,
185 concatMap, intersperse
186 :: Monad m
187 => Int -> Stream m Int -> m ()
189scan n = composeN n $ S.scanl' (+) 0
190fmap n = composeN n $ Prelude.fmap (+1)
191map n = composeN n $ S.map (+1)
192mapM n = composeN n $ S.mapM return
193mapMaybe n = composeN n $ S.mapMaybe
194 (\x -> if Prelude.odd x then Nothing else Just x)
195mapMaybeM n = composeN n $ S.mapMaybeM
196 (\x -> if Prelude.odd x then return Nothing else return $ Just x)
197filterEven n = composeN n $ S.filter even
198filterAllOut n = composeN n $ S.filter (> maxValue)
199filterAllIn n = composeN n $ S.filter (<= maxValue)
200takeOne n = composeN n $ S.take 1
201takeAll n = composeN n $ S.take maxValue
202takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
203takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
204dropOne n = composeN n $ S.drop 1
205dropAll n = composeN n $ S.drop maxValue
206dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
207dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
208dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
209foldrS n = composeN n $ S.foldrS S.cons S.nil
210foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
211concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
212intersperse n = composeN n $ S.intersperse maxValue
214-------------------------------------------------------------------------------
215-- Iteration
216-------------------------------------------------------------------------------
218iterStreamLen, maxIters :: Int
219iterStreamLen = 10
220maxIters = 10000
222{-# INLINE iterateSource #-}
223iterateSource
224 :: Monad m
225 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
226iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
227 where
228 f (0 :: Int) m = g m
229 f x m = g (f (x P.- 1) m)
231{-# INLINE iterateMapM #-}
232{-# INLINE iterateScan #-}
233{-# INLINE iterateFilterEven #-}
234{-# INLINE iterateTakeAll #-}
235{-# INLINE iterateDropOne #-}
236{-# INLINE iterateDropWhileFalse #-}
237{-# INLINE iterateDropWhileTrue #-}
238iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
239 iterateDropWhileFalse, iterateDropWhileTrue
240 :: Monad m
241 => Int -> Stream m Int
243-- this is quadratic
244iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
245iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
246 (maxIters `div` 10)
248iterateMapM = iterateSource (S.mapM return) maxIters
249iterateFilterEven = iterateSource (S.filter even) maxIters
250iterateTakeAll = iterateSource (S.take maxValue) maxIters
251iterateDropOne = iterateSource (S.drop 1) maxIters
252iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
254-------------------------------------------------------------------------------
255-- Zipping and concat
256-------------------------------------------------------------------------------
258{-# INLINE eqBy #-}
259eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
260eqBy src = S.eqBy (==) src src
262{-# INLINE cmpBy #-}
263cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
264cmpBy src = S.cmpBy P.compare src src
266{-# INLINE zip #-}
267zip :: Monad m => Stream m Int -> m ()
268zip src = transform $ S.zipWith (,) src src
270{-# INLINE concatMapRepl4xN #-}
271concatMapRepl4xN :: Monad m => Stream m Int -> m ()
272concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
274{-# INLINE concatMapURepl4xN #-}
275concatMapURepl4xN :: Monad m => Stream m Int -> m ()
276concatMapURepl4xN src = transform $ S.concatMapU (UF.replicateM 4) src
278-------------------------------------------------------------------------------
279-- Mixed Composition
280-------------------------------------------------------------------------------
282{-# INLINE scanMap #-}
283{-# INLINE dropMap #-}
284{-# INLINE dropScan #-}
285{-# INLINE takeDrop #-}
286{-# INLINE takeScan #-}
287{-# INLINE takeMap #-}
288{-# INLINE filterDrop #-}
289{-# INLINE filterTake #-}
290{-# INLINE filterScan #-}
291{-# INLINE filterMap #-}
292scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
293 filterTake, filterScan, filterMap
294 :: Monad m => Int -> Stream m Int -> m ()
296scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
297dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
298dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
299takeDrop n = composeN n $ S.drop 1 . S.take maxValue
300takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
301takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
302filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
303filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
304filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
305filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
307-------------------------------------------------------------------------------
308-- Nested Composition
309-------------------------------------------------------------------------------
311{-# INLINE toNullApNested #-}
312toNullApNested :: Monad m => Stream m Int -> m ()
313toNullApNested s = runStream $ do
314 (+) <$> s <*> s
316{-# INLINE toNullNested #-}
317toNullNested :: Monad m => Stream m Int -> m ()
318toNullNested s = runStream $ do
319 x <- s
320 y <- s
321 return $ x + y
323{-# INLINE toNullNested3 #-}
324toNullNested3 :: Monad m => Stream m Int -> m ()
325toNullNested3 s = runStream $ do
326 x <- s
327 y <- s
328 z <- s
329 return $ x + y + z
331{-# INLINE filterAllOutNested #-}
332filterAllOutNested
333 :: Monad m
334 => Stream m Int -> m ()
335filterAllOutNested str = runStream $ do
336 x <- str
337 y <- str
338 let s = x + y
339 if s < 0
340 then return s
341 else S.nil
343{-# INLINE filterAllInNested #-}
344filterAllInNested
345 :: Monad m
346 => Stream m Int -> m ()
347filterAllInNested str = runStream $ do
348 x <- str
349 y <- str
350 let s = x + y
351 if s > 0
352 then return s
353 else S.nil