db2c560 · streamly · git.iko.soy

git.iko.soy/streamly

add direct versions of monolithic scan/map and fold/map

After perf measurement these seems to perform the same as a scan followed by map therefore we have not exposed these but kept for perf comparison and just in case use. * Deprecate `scanx`, `foldx`, `foldxM` * Remove deprecated APIs `scan`, `foldl`, `foldlM`

commitdb2c560a658eb296a814e01a209490f33320662a authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 4 May 2019, 15:08 (7 years ago) parentc8fc696

9 files changed+161−38

compare with master

unifiedsplit

Changelog.md+4 benchmark/Linear.hs+7−2 benchmark/LinearOps.hs+3−1 src/Streamly/Prelude.hs+8−26 src/Streamly/Streams/Prelude.hs+45 src/Streamly/Streams/StreamD.hs+77 src/Streamly/Streams/StreamK.hs+5−5 test/Main.hs+10−2 test/nested-loops.hs+2−2

Changelog.md+4

@@ -3,6 +3,7 @@

33### Breaking changes

55* Change the signature of `foldrM` to ensure that it is lazy

6+* `scanx` would require an additional `Monad m` constraint.

78### Enhancements

@@ -21,6 +22,9 @@

2122* `runStream`, `foldWith`, `foldMapWith`, `forEachWith` have been moved from

2223 "Streamly" module to "Streamly.Prelude" module.

2324

25+* Deprecate `scanx`, `foldx`, `foldxM`

26+* Remove deprecated APIs `scan`, `foldl`, `foldlM`

27+

2428## 0.6.1

2529

2630### Bug Fixes

benchmark/Linear.hs+7−2

@@ -178,7 +178,7 @@ main =

178178 , benchIOSink "toRevList" Ops.toRevList

179179 ]

180180 , bgroup "transformation"

181− [ benchIOSink "scan" (Ops.scan 1)

181+ [ benchIOSink "scanl" (Ops.scan 1)

182182 , benchIOSink "scanl1'" (Ops.scanl1' 1)

183183 , benchIOSink "map" (Ops.map 1)

184184 , benchIOSink "fmap" (Ops.fmap 1)

@@ -249,8 +249,13 @@ main =

249249 , benchIOSink "stripPrefix" Ops.stripPrefix

250250 , benchIOSrc serially "concatMap" Ops.concatMap

251251 ]

252+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl

253+ -- library. If scan/fold followed by a map is efficient enough we may not

254+ -- need monolithic implementations of these.

252255 , bgroup "mixed"

253− [ benchIOSink "sum-product-fold" Ops.sumProductFold

256+ [ benchIOSink "scanl-map" (Ops.scanMap 1)

257+ , benchIOSink "foldl-map" Ops.foldl'ReduceMap

258+ , benchIOSink "sum-product-fold" Ops.sumProductFold

254259 , benchIOSink "sum-product-scan" Ops.sumProductScan

255260 ]

256261 , bgroup "mixedX4"

benchmark/LinearOps.hs+3−1

@@ -181,12 +181,13 @@ head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce

181181minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)

182182

183183{-# INLINE foldl'Reduce #-}

184+{-# INLINE foldl'ReduceMap #-}

184185{-# INLINE foldlM'Reduce #-}

185186{-# INLINE foldrMReduce #-}

186187{-# INLINE length #-}

187188{-# INLINE sum #-}

188189{-# INLINE product #-}

189−foldl'Reduce, foldlM'Reduce, foldrMReduce, length, sum, product

190+foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product

190191 :: Monad m

191192 => Stream m Int -> m Int

192193

@@ -250,6 +251,7 @@ foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []

250251

251252foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)

252253foldl'Reduce = S.foldl' (+) 0

254+foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0

253255foldl1'Reduce = S.foldl1' (+)

254256foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0

255257

src/Streamly/Prelude.hs+8−26

@@ -180,8 +180,6 @@ module Streamly.Prelude

180180 , foldl'

181181 , foldl1'

182182 , foldlM'

183− , foldx

184− , foldxM

185183

186184 -- ** Strict Full Folds

187185 -- | Folds that are guaranteed to evaluate the whole stream.

@@ -321,7 +319,6 @@ module Streamly.Prelude

321319 -- , prescanlM'

322320 , scanl1'

323321 , scanl1M'

324− , scanx

325322

326323 , indexed

327324 , indexedR

@@ -458,11 +455,11 @@ module Streamly.Prelude

458455 -- * Deprecated

459456 , K.once

460457 , each

461− , scan

458+ , scanx

462459 , foldr

463460 , foldr1

464− , foldl

465− , foldlM

461+ , foldx

462+ , foldxM

466463 )

467464where

468465

@@ -1027,16 +1024,11 @@ foldr1 f m = S.foldr1 f (toStreamS m)

10271024-- @foldl@ library. The suffix @x@ is a mnemonic for extraction.

10281025--

10291026-- @since 0.2.0

1027+{-# DEPRECATED foldx "Please use foldl' followed by fmap instead." #-}

10301028{-# INLINE foldx #-}

10311029foldx :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b

10321030foldx = P.foldlx'

10331031

1034−-- |

1035−-- @since 0.1.0

1036−{-# DEPRECATED foldl "Please use foldx instead." #-}

1037−foldl :: Monad m => (x -> a -> x) -> x -> (x -> b) -> SerialT m a -> m b

1038−foldl = P.foldlx'

1039−

10401032-- | Strict left associative/push fold. Note that the observations below about

10411033-- the behavior of a left fold assume that we are working on a right associated

10421034-- structure like cons lists and streamly streams. If we are working on a left

@@ -1150,16 +1142,11 @@ foldl1' step m = do

11501142-- | Like 'foldx', but with a monadic step function.

11511143--

11521144-- @since 0.2.0

1145+{-# DEPRECATED foldxM "Please use foldlM' followed by fmap instead." #-}

11531146{-# INLINE foldxM #-}

11541147foldxM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b

11551148foldxM = P.foldlMx'

11561149

1157−-- |

1158−-- @since 0.1.0

1159−{-# DEPRECATED foldlM "Please use foldxM instead." #-}

1160−foldlM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> SerialT m a -> m b

1161−foldlM = P.foldlMx'

1162−

11631150-- | Like 'foldl'' but with a monadic step function.

11641151--

11651152-- @since 0.2.0

@@ -1543,15 +1530,10 @@ toHandle h m = go m

15431530-- extraction.

15441531--

15451532-- @since 0.2.0

1533+{-# DEPRECATED scanx "Please use scanl followed by map instead." #-}

15461534{-# INLINE scanx #-}

1547−scanx :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

1548−scanx = K.scanx'

1549−

1550−-- |

1551−-- @since 0.1.1

1552−{-# DEPRECATED scan "Please use scanx instead." #-}

1553−scan :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

1554−scan = scanx

1535+scanx :: (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

1536+scanx = P.scanlx'

15551537

15561538-- XXX this needs to be concurrent

15571539-- | Like 'scanl'' but with a monadic fold function.

src/Streamly/Streams/Prelude.hs+45

@@ -42,6 +42,11 @@ module Streamly.Streams.Prelude

4242 , foldlS

4343 , foldlT

4444

45+ , scanlx'

46+ , scanlMx'

47+ , postscanlx'

48+ , postscanlMx'

49+

4550 -- * Zip style operations

4651 , eqBy

4752 , cmpBy

@@ -174,6 +179,46 @@ foldlT :: (Monad m, IsStream t, Monad (s m), MonadTrans s)

174179 => (s m b -> a -> s m b) -> s m b -> t m a -> s m b

175180foldlT f z s = S.foldlT f z (toStreamS s)

176181

182+------------------------------------------------------------------------------

183+-- Scans

184+------------------------------------------------------------------------------

185+

186+-- postscanlM' followed by mapM

187+{-# INLINE postscanlMx' #-}

188+postscanlMx' :: (IsStream t, Monad m)

189+ => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> t m b

190+postscanlMx' step begin done m =

191+ D.fromStreamD $ D.postscanlMx' step begin done $ D.toStreamD m

192+

193+-- postscanl' followed by map

194+{-# INLINE postscanlx' #-}

195+postscanlx' :: (IsStream t, Monad m)

196+ => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

197+postscanlx' step begin done m =

198+ D.fromStreamD $ D.postscanlx' step begin done $ D.toStreamD m

199+

200+-- scanlM' followed by mapM

201+--

202+{-# INLINE scanlMx' #-}

203+scanlMx' :: (IsStream t, Monad m)

204+ => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> t m b

205+scanlMx' step begin done m =

206+ D.fromStreamD $ D.scanlMx' step begin done $ D.toStreamD m

207+

208+-- scanl followed by map

209+--

210+-- | Strict left scan with an extraction function. Like 'scanl'', but applies a

211+-- user supplied extraction function (the third argument) at each step. This is

212+-- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for

213+-- extraction.

214+--

215+-- @since 0.7.0

216+{-# INLINE scanlx' #-}

217+scanlx' :: (IsStream t, Monad m)

218+ => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

219+scanlx' step begin done m =

220+ fromStreamS $ S.scanlx' step begin done $ toStreamS m

221+

177222------------------------------------------------------------------------------

178223-- Comparison

179224------------------------------------------------------------------------------

src/Streamly/Streams/StreamD.hs+77

@@ -155,11 +155,17 @@ module Streamly.Streams.StreamD

155155

156156 , prescanl'

157157 , prescanlM'

158+

158159 , postscanl

159160 , postscanlM

160161 , postscanl'

161162 , postscanlM'

162163

164+ , postscanlx'

165+ , postscanlMx'

166+ , scanlMx'

167+ , scanlx'

168+

163169 -- * Filtering

164170 , filter

165171 , filterM

@@ -229,6 +235,23 @@ import qualified Streamly.Streams.StreamK as K

229235nil :: Monad m => Stream m a

230236nil = Stream (\_ _ -> return Stop) ()

231237

238+{-# INLINE_NORMAL consM #-}

239+consM :: Monad m => m a -> Stream m a -> Stream m a

240+consM m (Stream step state) = Stream step1 Nothing

241+ where

242+ {-# INLINE_LATE step1 #-}

243+ step1 _ Nothing = m >>= \x -> return $ Yield x (Just state)

244+ step1 gst (Just st) = do

245+ r <- step gst st

246+ return $

247+ case r of

248+ Yield a s -> Yield a (Just s)

249+ Skip s -> Skip (Just s)

250+ Stop -> Stop

251+

252+-- XXX implement in terms of consM?

253+-- cons x = consM (return x)

254+--

232255-- | Can fuse but has O(n^2) complexity.

233256{-# INLINE_NORMAL cons #-}

234257cons :: Monad m => a -> Stream m a -> Stream m a

@@ -983,6 +1006,10 @@ fromStreamD = K.fromStream . toStreamK

9831006-- Transformation by Folding (Scans)

9841007------------------------------------------------------------------------------

9851008

1009+------------------------------------------------------------------------------

1010+-- Prescans

1011+------------------------------------------------------------------------------

1012+

9861013-- XXX Is a prescan useful, discarding the last step does not sound useful? I

9871014-- am not sure about the utility of this function, so this is implemented but

9881015-- not exposed. We can expose it if someone provides good reasons why this is

@@ -1011,6 +1038,56 @@ prescanlM' f mz (Stream step state) = Stream step' (state, mz)

10111038prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

10121039prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)

10131040

1041+------------------------------------------------------------------------------

1042+-- Monolithic postscans (postscan followed by a map)

1043+------------------------------------------------------------------------------

1044+

1045+-- The performance of a modular postscan followed by a map seems to be

1046+-- equivalent to this monolithic scan followed by map therefore we may not need

1047+-- this implementation. We just have it for performance comparison and in case

1048+-- modular version does not perform well in some situation.

1049+--

1050+{-# INLINE_NORMAL postscanlMx' #-}

1051+postscanlMx' :: Monad m

1052+ => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

1053+postscanlMx' fstep begin done (Stream step state) = do

1054+ Stream step' (state, begin)

1055+ where

1056+ {-# INLINE_LATE step' #-}

1057+ step' gst (st, acc) = do

1058+ r <- step (adaptState gst) st

1059+ case r of

1060+ Yield x s -> do

1061+ old <- acc

1062+ y <- fstep old x

1063+ v <- done y

1064+ v `seq` y `seq` return (Yield v (s, return y))

1065+ Skip s -> return $ Skip (s, acc)

1066+ Stop -> return Stop

1067+

1068+{-# INLINE_NORMAL postscanlx' #-}

1069+postscanlx' :: Monad m

1070+ => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

1071+postscanlx' fstep begin done s =

1072+ postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

1073+

1074+-- XXX do we need consM strict to evaluate the begin value?

1075+{-# INLINE scanlMx' #-}

1076+scanlMx' :: Monad m

1077+ => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

1078+scanlMx' fstep begin done s =

1079+ (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s

1080+

1081+{-# INLINE scanlx' #-}

1082+scanlx' :: Monad m

1083+ => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

1084+scanlx' fstep begin done s =

1085+ scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

1086+

1087+------------------------------------------------------------------------------

1088+-- postscans

1089+------------------------------------------------------------------------------

1090+

10141091-- XXX if we make the initial value of the accumulator monadic then should we

10151092-- execute it even if the stream is empty? In that case we would have generated

10161093-- the effect but discarded the value, but that is what a fold does when the

src/Streamly/Streams/StreamK.hs+5−5

@@ -117,7 +117,7 @@ module Streamly.Streams.StreamK

117117 -- * Transformation

118118 -- ** By folding (scans)

119119 , scanl'

120− , scanx'

120+ , scanlx'

121121

122122 -- ** Filtering

123123 , filter

@@ -757,9 +757,9 @@ toStreamK = id

757757-- Transformation by folding (Scans)

758758-------------------------------------------------------------------------------

759759

760−{-# INLINE scanx' #-}

761−scanx' :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

762−scanx' step begin done m =

760+{-# INLINE scanlx' #-}

761+scanlx' :: IsStream t => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

762+scanlx' step begin done m =

763763 cons (done begin) $ go m begin

764764 where

765765 go m1 !acc = mkStream $ \st yld sng stp ->

@@ -771,7 +771,7 @@ scanx' step begin done m =

771771

772772{-# INLINE scanl' #-}

773773scanl' :: IsStream t => (b -> a -> b) -> b -> t m a -> t m b

774−scanl' step begin = scanx' step begin id

774+scanl' step begin = scanlx' step begin id

775775

776776-------------------------------------------------------------------------------

777777-- Filtering

test/Main.hs+10−2

@@ -490,11 +490,13 @@ parallelTests = H.parallel $ do

490490 -- Left folds are strict enough

491491 ---------------------------------------------------------------------------

492492

493+#ifdef DEVBUILD

493494 it "foldx is strict enough" checkFoldxStrictness

494− it "foldl' is strict enough" checkFoldl'Strictness

495495 it "scanx is strict enough" checkScanxStrictness

496− it "scanl' is strict enough" checkScanl'Strictness

497496 it "foldxM is strict enough" (checkFoldMStrictness foldxMStrictCheck)

497+#endif

498+ it "foldl' is strict enough" checkFoldl'Strictness

499+ it "scanl' is strict enough" checkScanl'Strictness

498500 it "foldlM' is strict enough" (checkFoldMStrictness foldlM'StrictCheck)

499501 it "scanlM' is strict enough" (checkScanlMStrictness scanlM'StrictCheck)

500502

@@ -645,6 +647,7 @@ checkFoldrLaziness = do

645647 $ (S.fromList (2:4:5:undefined) :: SerialT IO Int))

646648 `shouldReturn` [True]

647649

650+#ifdef DEVBUILD

648651checkFoldxStrictness :: IO ()

649652checkFoldxStrictness = do

650653 let s = return (1 :: Int) `S.consM` error "failure"

@@ -654,6 +657,7 @@ checkFoldxStrictness = do

654657 ErrorCall err -> return err

655658 _ -> throw e)

656659 `shouldReturn` "success"

660+#endif

657661

658662checkFoldl'Strictness :: IO ()

659663checkFoldl'Strictness = do

@@ -665,6 +669,7 @@ checkFoldl'Strictness = do

665669 _ -> throw e)

666670 `shouldReturn` "success"

667671

672+#ifdef DEVBUILD

668673checkScanxStrictness :: IO ()

669674checkScanxStrictness = do

670675 let s = return (1 :: Int) `S.consM` error "failure"

@@ -682,6 +687,7 @@ checkScanxStrictness = do

682687 ErrorCall err -> return err

683688 _ -> throw e)

684689 `shouldReturn` "success"

690+#endif

685691

686692checkScanl'Strictness :: IO ()

687693checkScanl'Strictness = do

@@ -705,8 +711,10 @@ checkScanl'Strictness = do

705711foldlM'StrictCheck :: IORef Int -> SerialT IO Int -> IO ()

706712foldlM'StrictCheck ref = S.foldlM' (\_ _ -> writeIORef ref 1) ()

707713

714+#ifdef DEVBUILD

708715foldxMStrictCheck :: IORef Int -> SerialT IO Int -> IO ()

709716foldxMStrictCheck ref = S.foldxM (\_ _ -> writeIORef ref 1) (return ()) return

717+#endif

710718

711719checkFoldMStrictness :: (IORef Int -> SerialT IO Int -> IO ()) -> IO ()

712720checkFoldMStrictness f = do

test/nested-loops.hs+2−2

@@ -1,8 +1,8 @@

11import Control.Concurrent (myThreadId)

22import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))

33import System.Random (randomIO)

4−import Streamly

5−import Streamly.Prelude (nil, yieldM)

4+import Streamly hiding (runStream)

5+import Streamly.Prelude (runStream, nil, yieldM)

77main :: IO ()

88main = runStream $ do