@@ -1,531 +0,0 @@
1−-- |
2−-- Module : ArrayOps
3−-- Copyright : (c) 2018 Harendra Kumar
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE DeriveAnyClass #-}
12−{-# LANGUAGE DeriveGeneric #-}
13−
14−module Streamly.Benchmark.Memory.ArrayOps where
15−
16−-- import Control.Monad (when)
17−import Control.Monad.IO.Class (MonadIO)
18−-- import Data.Maybe (fromJust)
19−import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20−import qualified Prelude as P
21−#ifdef DEVBUILD
22−import qualified Data.Foldable as F
23−#endif
24−import qualified GHC.Exts as GHC
25−-- import Control.DeepSeq (NFData)
26−-- import GHC.Generics (Generic)
27−
28−import qualified Streamly as S hiding (foldMapWith, runStream)
29−import qualified Streamly.Memory.Array as A
30−import qualified Streamly.Prelude as S
31−
32−value, maxValue :: Int
33−#ifdef LINEAR_ASYNC
34−value = 10000
35−#else
36−value = 100000
37−#endif
38−maxValue = value + 1
39−
40−-------------------------------------------------------------------------------
41−-- Benchmark ops
42−-------------------------------------------------------------------------------
43−
44−-------------------------------------------------------------------------------
45−-- Stream generation and elimination
46−-------------------------------------------------------------------------------
47−
48−type Stream = A.Array
49−
50−{-# INLINE sourceUnfoldr #-}
51−sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
52−sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
53− where
54− step cnt =
55− if cnt > n + value
56− then Nothing
57− else (Just (cnt, cnt + 1))
58−
59−{-# INLINE sourceIntFromTo #-}
60−sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
61−sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
62−
63−{-# INLINE sourceIntFromToFromStream #-}
64−sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
65−sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
66−
67−sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
68−sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
69−
70−{-# INLINE sourceFromList #-}
71−sourceFromList :: MonadIO m => Int -> m (Stream Int)
72−sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
73−
74−{-# INLINE sourceIsList #-}
75−sourceIsList :: Int -> Stream Int
76−sourceIsList n = GHC.fromList [n..n+value]
77−
78−{-# INLINE sourceIsString #-}
79−sourceIsString :: Int -> Stream P.Char
80−sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
81−
82−{-
83−-------------------------------------------------------------------------------
84−-- Elimination
85−-------------------------------------------------------------------------------
86−
87−{-# INLINE runStream #-}
88−runStream :: Monad m => Stream m a -> m ()
89−runStream = S.runStream
90−
91−{-# INLINE toList #-}
92−toList :: Monad m => Stream m Int -> m [Int]
93−
94−{-# INLINE head #-}
95−{-# INLINE last #-}
96−{-# INLINE maximum #-}
97−{-# INLINE minimum #-}
98−{-# INLINE find #-}
99−{-# INLINE findIndex #-}
100−{-# INLINE elemIndex #-}
101−{-# INLINE foldl1'Reduce #-}
102−head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce
103− :: Monad m => Stream m Int -> m (Maybe Int)
104−
105−{-# INLINE minimumBy #-}
106−{-# INLINE maximumBy #-}
107−minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
108−
109−{-# INLINE foldl'Reduce #-}
110−{-# INLINE foldl'ReduceMap #-}
111−{-# INLINE foldlM'Reduce #-}
112−{-# INLINE foldrMReduce #-}
113−{-# INLINE length #-}
114−{-# INLINE sum #-}
115−{-# INLINE product #-}
116−foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product
117− :: Monad m
118− => Stream m Int -> m Int
119−
120−{-# INLINE foldl'Build #-}
121−{-# INLINE foldlM'Build #-}
122−{-# INLINE foldrMBuild #-}
123−foldrMBuild, foldl'Build, foldlM'Build
124− :: Monad m
125− => Stream m Int -> m [Int]
126−
127−{-# INLINE all #-}
128−{-# INLINE any #-}
129−{-# INLINE and #-}
130−{-# INLINE or #-}
131−{-# INLINE null #-}
132−{-# INLINE elem #-}
133−{-# INLINE notElem #-}
134−null, elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool
135−
136−{-# INLINE toNull #-}
137−toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
138−toNull t = runStream . t
139−
140−{-# INLINE uncons #-}
141−uncons :: Monad m => Stream m Int -> m ()
142−uncons s = do
143− r <- S.uncons s
144− case r of
145− Nothing -> return ()
146− Just (_, t) -> uncons t
147−
148−{-# INLINE init #-}
149−init :: Monad m => Stream m a -> m ()
150−init s = S.init s >>= Prelude.mapM_ S.runStream
151−
152−{-# INLINE tail #-}
153−tail :: Monad m => Stream m a -> m ()
154−tail s = S.tail s >>= Prelude.mapM_ tail
155−
156−{-# INLINE nullHeadTail #-}
157−nullHeadTail :: Monad m => Stream m Int -> m ()
158−nullHeadTail s = do
159− r <- S.null s
160− when (not r) $ do
161− _ <- S.head s
162− S.tail s >>= Prelude.mapM_ nullHeadTail
163−
164−{-# INLINE mapM_ #-}
165−mapM_ :: Monad m => Stream m Int -> m ()
166−mapM_ = S.mapM_ (\_ -> return ())
167−
168−toList = S.toList
169−
170−{-# INLINE toRevList #-}
171−toRevList :: Monad m => Stream m Int -> m [Int]
172−toRevList = S.toRevList
173−
174−foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
175−foldl'Build = S.foldl' (flip (:)) []
176−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
177−
178−foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
179−foldl'Reduce = S.foldl' (+) 0
180−foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0
181−foldl1'Reduce = S.foldl1' (+)
182−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
183−
184−last = S.last
185−null = S.null
186−head = S.head
187−elem = S.elem maxValue
188−notElem = S.notElem maxValue
189−length = S.length
190−all = S.all (<= maxValue)
191−any = S.any (> maxValue)
192−and = S.and . S.map (<= maxValue)
193−or = S.or . S.map (> maxValue)
194−find = S.find (== maxValue)
195−findIndex = S.findIndex (== maxValue)
196−elemIndex = S.elemIndex maxValue
197−maximum = S.maximum
198−minimum = S.minimum
199−sum = S.sum
200−product = S.product
201−minimumBy = S.minimumBy compare
202−maximumBy = S.maximumBy compare
203−-}
204−
205−-------------------------------------------------------------------------------
206−-- Transformation
207−-------------------------------------------------------------------------------
208−
209−{-
210−{-# INLINE transform #-}
211−transform :: Stream a -> Stream a
212−transform = P.id
213−-}
214−
215−{-# INLINE composeN #-}
216−composeN :: P.Monad m
217− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
218−composeN n f x =
219− case n of
220− 1 -> f x
221− 2 -> f x P.>>= f
222− 3 -> f x P.>>= f P.>>= f
223− 4 -> f x P.>>= f P.>>= f P.>>= f
224− _ -> undefined
225−
226−{-# INLINE scanl' #-}
227−{-# INLINE scanl1' #-}
228−{-# INLINE map #-}
229−{-
230−{-# INLINE fmap #-}
231−{-# INLINE mapMaybe #-}
232−{-# INLINE filterEven #-}
233−{-# INLINE filterAllOut #-}
234−{-# INLINE filterAllIn #-}
235−{-# INLINE takeOne #-}
236−{-# INLINE takeAll #-}
237−{-# INLINE takeWhileTrue #-}
238−{-# INLINE takeWhileMTrue #-}
239−{-# INLINE dropOne #-}
240−{-# INLINE dropAll #-}
241−{-# INLINE dropWhileTrue #-}
242−{-# INLINE dropWhileMTrue #-}
243−{-# INLINE dropWhileFalse #-}
244−{-# INLINE findIndices #-}
245−{-# INLINE elemIndices #-}
246−{-# INLINE insertBy #-}
247−{-# INLINE deleteBy #-}
248−{-# INLINE reverse #-}
249−{-# INLINE foldrS #-}
250−{-# INLINE foldrSMap #-}
251−{-# INLINE foldrT #-}
252−{-# INLINE foldrTMap #-}
253− -}
254−scanl' , scanl1', map{-, fmap, mapMaybe, filterEven, filterAllOut,
255− filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,
256− dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,
257− findIndices, elemIndices, insertBy, deleteBy, reverse,
258− foldrS, foldrSMap, foldrT, foldrTMap -}
259− :: MonadIO m => Int -> Stream Int -> m (Stream Int)
260−
261−{-
262−{-# INLINE mapMaybeM #-}
263−mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
264−
265−{-# INLINE mapM #-}
266−{-# INLINE map' #-}
267−{-# INLINE fmap' #-}
268−mapM, map' :: (S.IsStream t, S.MonadAsync m)
269− => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
270−
271−fmap' :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))
272− => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
273−
274−{-# INLINE sequence #-}
275−sequence :: (S.IsStream t, S.MonadAsync m)
276− => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()
277− -}
278−
279−{-# INLINE onArray #-}
280−onArray
281− :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
282− -> Stream Int
283− -> m (Stream Int)
284−onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
285−
286−scanl' n = composeN n $ onArray $ S.scanl' (+) 0
287−scanl1' n = composeN n $ onArray $ S.scanl1' (+)
288−map n = composeN n $ onArray $ S.map (+1)
289−-- map n = composeN n $ A.map (+1)
290−{-
291−fmap n = composeN n $ Prelude.fmap (+1)
292−fmap' t n = composeN' n $ t . Prelude.fmap (+1)
293−map' t n = composeN' n $ t . S.map (+1)
294−mapM t n = composeN' n $ t . S.mapM return
295−mapMaybe n = composeN n $ S.mapMaybe
296− (\x -> if Prelude.odd x then Nothing else Just x)
297−mapMaybeM n = composeN n $ S.mapMaybeM
298− (\x -> if Prelude.odd x then return Nothing else return $ Just x)
299−sequence t = transform . t . S.sequence
300−filterEven n = composeN n $ S.filter even
301−filterAllOut n = composeN n $ S.filter (> maxValue)
302−filterAllIn n = composeN n $ S.filter (<= maxValue)
303−takeOne n = composeN n $ S.take 1
304−takeAll n = composeN n $ S.take maxValue
305−takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
306−takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
307−dropOne n = composeN n $ S.drop 1
308−dropAll n = composeN n $ S.drop maxValue
309−dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
310−dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
311−dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
312−findIndices n = composeN n $ S.findIndices (== maxValue)
313−elemIndices n = composeN n $ S.elemIndices maxValue
314−insertBy n = composeN n $ S.insertBy compare maxValue
315−deleteBy n = composeN n $ S.deleteBy (>=) maxValue
316−reverse n = composeN n $ S.reverse
317−foldrS n = composeN n $ S.foldrS S.cons S.nil
318−foldrSMap n = composeN n $ S.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
319−foldrT n = composeN n $ S.foldrT S.cons S.nil
320−foldrTMap n = composeN n $ S.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
321−
322−-------------------------------------------------------------------------------
323−-- Iteration
324−-------------------------------------------------------------------------------
325−
326−iterStreamLen, maxIters :: Int
327−iterStreamLen = 10
328−maxIters = 10000
329−
330−{-# INLINE iterateSource #-}
331−iterateSource
332− :: S.MonadAsync m
333− => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
334−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
335− where
336− f (0 :: Int) m = g m
337− f x m = g (f (x P.- 1) m)
338−
339−{-# INLINE iterateMapM #-}
340−{-# INLINE iterateScan #-}
341−{-# INLINE iterateScanl1 #-}
342−{-# INLINE iterateFilterEven #-}
343−{-# INLINE iterateTakeAll #-}
344−{-# INLINE iterateDropOne #-}
345−{-# INLINE iterateDropWhileFalse #-}
346−{-# INLINE iterateDropWhileTrue #-}
347−iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,
348− iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue
349− :: S.MonadAsync m
350− => Int -> Stream m Int
351−
352−-- this is quadratic
353−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
354−-- so is this
355−iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
356−
357−iterateMapM = iterateSource (S.mapM return) maxIters
358−iterateFilterEven = iterateSource (S.filter even) maxIters
359−iterateTakeAll = iterateSource (S.take maxValue) maxIters
360−iterateDropOne = iterateSource (S.drop 1) maxIters
361−iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters
362−iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
363−
364−-------------------------------------------------------------------------------
365−-- Zipping and concat
366−-------------------------------------------------------------------------------
367−
368−{-# INLINE zip #-}
369−{-# INLINE zipM #-}
370−{-# INLINE mergeBy #-}
371−zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()
372−
373−zip src = do
374− r <- S.tail src
375− let src1 = fromJust r
376− transform (S.zipWith (,) src src1)
377−zipM src = do
378− r <- S.tail src
379− let src1 = fromJust r
380− transform (S.zipWithM (curry return) src src1)
381−
382−mergeBy src = do
383− r <- S.tail src
384− let src1 = fromJust r
385− transform (S.mergeBy P.compare src src1)
386−
387−{-# INLINE isPrefixOf #-}
388−{-# INLINE isSubsequenceOf #-}
389−isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
390−
391−isPrefixOf src = S.isPrefixOf src src
392−isSubsequenceOf src = S.isSubsequenceOf src src
393−
394−{-# INLINE stripPrefix #-}
395−stripPrefix :: Monad m => Stream m Int -> m ()
396−stripPrefix src = do
397− _ <- S.stripPrefix src src
398− return ()
399−
400−{-# INLINE zipAsync #-}
401−{-# INLINE zipAsyncM #-}
402−{-# INLINE zipAsyncAp #-}
403−zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
404−
405−zipAsync src = do
406− r <- S.tail src
407− let src1 = fromJust r
408− transform (S.zipAsyncWith (,) src src1)
409−
410−zipAsyncM src = do
411− r <- S.tail src
412− let src1 = fromJust r
413− transform (S.zipAsyncWithM (curry return) src src1)
414−
415−zipAsyncAp src = do
416− r <- S.tail src
417− let src1 = fromJust r
418− transform (S.zipAsyncly $ (,) <$> S.serially src
419− <*> S.serially src1)
420−
421−{-# INLINE eqBy #-}
422−eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
423−eqBy src = S.eqBy (==) src src
424−
425−{-# INLINE cmpBy #-}
426−cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
427−cmpBy src = S.cmpBy P.compare src src
428−
429−concatStreamLen, maxNested :: Int
430−concatStreamLen = 1
431−maxNested = 100000
432−
433−{-# INLINE concatMap #-}
434−concatMap :: S.MonadAsync m => Int -> Stream m Int
435−concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)
436− (sourceUnfoldrMN concatStreamLen n)
437−
438−-------------------------------------------------------------------------------
439−-- Mixed Composition
440−-------------------------------------------------------------------------------
441−
442−{-# INLINE scanMap #-}
443−{-# INLINE dropMap #-}
444−{-# INLINE dropScan #-}
445−{-# INLINE takeDrop #-}
446−{-# INLINE takeScan #-}
447−{-# INLINE takeMap #-}
448−{-# INLINE filterDrop #-}
449−{-# INLINE filterTake #-}
450−{-# INLINE filterScan #-}
451−{-# INLINE filterScanl1 #-}
452−{-# INLINE filterMap #-}
453−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
454− filterTake, filterScan, filterScanl1, filterMap
455− :: Monad m => Int -> Stream m Int -> m ()
456−
457−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
458−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
459−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
460−takeDrop n = composeN n $ S.drop 1 . S.take maxValue
461−takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
462−takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
463−filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
464−filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
465−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
466−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
467−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
468−
469−data Pair a b = Pair !a !b deriving (Generic, NFData)
470−
471−{-# INLINE sumProductFold #-}
472−sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
473−sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
474−
475−{-# INLINE sumProductScan #-}
476−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
477−sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
478− . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
479−
480−-------------------------------------------------------------------------------
481−-- Pure stream operations
482−-------------------------------------------------------------------------------
483−
484−-}
485−{-# INLINE eqInstance #-}
486−eqInstance :: Stream Int -> Bool
487−eqInstance src = src == src
488−
489−{-# INLINE eqInstanceNotEq #-}
490−eqInstanceNotEq :: Stream Int -> Bool
491−eqInstanceNotEq src = src P./= src
492−
493−{-# INLINE ordInstance #-}
494−ordInstance :: Stream Int -> Bool
495−ordInstance src = src P.< src
496−
497−{-# INLINE ordInstanceMin #-}
498−ordInstanceMin :: Stream Int -> Stream Int
499−ordInstanceMin src = P.min src src
500−
501−{-# INLINE showInstance #-}
502−showInstance :: Stream Int -> P.String
503−showInstance src = P.show src
504−
505−{-# INLINE readInstance #-}
506−readInstance :: P.String -> Stream Int
507−readInstance str =
508− let r = P.reads str
509− in case r of
510− [(x,"")] -> x
511− _ -> P.error "readInstance: no parse"
512−
513−{-# INLINE pureFoldl' #-}
514−pureFoldl' :: MonadIO m => Stream Int -> m Int
515−pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
516−
517−#ifdef DEVBUILD
518−{-# INLINE foldableFoldl' #-}
519−foldableFoldl' :: Stream Int -> Int
520−foldableFoldl' = F.foldl' (+) 0
521−
522−{-# INLINE foldableSum #-}
523−foldableSum :: Stream Int -> Int
524−foldableSum = P.sum
525−#endif
526−
527−{-
528−{-# INLINE traversableMapM #-}
529−traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
530−traversableMapM = P.mapM return
531−-}