git.iko.soy/streamly
on 5054813 help sign in
streamly/benchmark/StreamDOps.hs
357 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{-# INLINE iterateM #-}
255iterateM :: Monad m => Int -> Stream m Int
256iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))
258-------------------------------------------------------------------------------
259-- Zipping and concat
260-------------------------------------------------------------------------------
262{-# INLINE eqBy #-}
263eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
264eqBy src = S.eqBy (==) src src
266{-# INLINE cmpBy #-}
267cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
268cmpBy src = S.cmpBy P.compare src src
270{-# INLINE zip #-}
271zip :: Monad m => Stream m Int -> m ()
272zip src = transform $ S.zipWith (,) src src
274{-# INLINE concatMapRepl4xN #-}
275concatMapRepl4xN :: Monad m => Stream m Int -> m ()
276concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
278{-# INLINE concatMapURepl4xN #-}
279concatMapURepl4xN :: Monad m => Stream m Int -> m ()
280concatMapURepl4xN src = transform $ S.concatMapU (UF.replicateM 4) src
282-------------------------------------------------------------------------------
283-- Mixed Composition
284-------------------------------------------------------------------------------
286{-# INLINE scanMap #-}
287{-# INLINE dropMap #-}
288{-# INLINE dropScan #-}
289{-# INLINE takeDrop #-}
290{-# INLINE takeScan #-}
291{-# INLINE takeMap #-}
292{-# INLINE filterDrop #-}
293{-# INLINE filterTake #-}
294{-# INLINE filterScan #-}
295{-# INLINE filterMap #-}
296scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
297 filterTake, filterScan, filterMap
298 :: Monad m => Int -> Stream m Int -> m ()
300scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
301dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
302dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
303takeDrop n = composeN n $ S.drop 1 . S.take maxValue
304takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
305takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
306filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
307filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
308filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
309filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
311-------------------------------------------------------------------------------
312-- Nested Composition
313-------------------------------------------------------------------------------
315{-# INLINE toNullApNested #-}
316toNullApNested :: Monad m => Stream m Int -> m ()
317toNullApNested s = runStream $ do
318 (+) <$> s <*> s
320{-# INLINE toNullNested #-}
321toNullNested :: Monad m => Stream m Int -> m ()
322toNullNested s = runStream $ do
323 x <- s
324 y <- s
325 return $ x + y
327{-# INLINE toNullNested3 #-}
328toNullNested3 :: Monad m => Stream m Int -> m ()
329toNullNested3 s = runStream $ do
330 x <- s
331 y <- s
332 z <- s
333 return $ x + y + z
335{-# INLINE filterAllOutNested #-}
336filterAllOutNested
337 :: Monad m
338 => Stream m Int -> m ()
339filterAllOutNested str = runStream $ do
340 x <- str
341 y <- str
342 let s = x + y
343 if s < 0
344 then return s
345 else S.nil
347{-# INLINE filterAllInNested #-}
348filterAllInNested
349 :: Monad m
350 => Stream m Int -> m ()
351filterAllInNested str = runStream $ do
352 x <- str
353 y <- str
354 let s = x + y
355 if s > 0
356 then return s
357 else S.nil