3b64278 · streamly · git.iko.soy

git.iko.soy/streamly

Add fromFoldableM

Also, - INLINE consM and once - add benchmarking for various ways of sourcing (unfoldr(M), fromFoldable(M), foldMapWith serial)

commit3b6427818faf8f40e550eb54de1bb98718d2247c authorHarendra Kumar <harendra.kumar@gmail.com> dateMon 21 May 2018, 17:54 (8 years ago) parent21758e0

7 files changed+68−16

compare with master

unifiedsplit

Changelog.md+1 benchmark/Linear.hs+9−2 benchmark/LinearOps.hs+27−2 benchmark/NestedOps.hs+6−1 src/Streamly/Core.hs+11−8 src/Streamly/Prelude.hs+13−2 src/Streamly/Streams.hs+1−1

Changelog.md+1

@@ -1,6 +1,7 @@

11## Unreleased

33* Add concurrent lookahead stream type `Ahead`

4+* Add `fromFoldableM` to create a stream from a container of monadic actions

56## 0.2.0

benchmark/Linear.hs+9−2

@@ -15,13 +15,16 @@ import Gauge

1515

1616-- We need a monadic bind here to make sure that the function f does not get

1717-- completely optimized out by the compiler in some cases.

18−benchIO :: (NFData b) => String -> (Ops.Stream m Int -> IO b) -> Benchmark

18+benchIO :: NFData b => String -> (Ops.Stream m Int -> IO b) -> Benchmark

1919benchIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= f . Ops.source

2020

21+benchSrcIO :: String -> (Int -> Ops.Stream IO Int) -> Benchmark

22+benchSrcIO name f = bench name $ nfIO $ randomRIO (1,1000) >>= Ops.toNull . f

23+

2124benchIOAppend :: (NFData b) => String -> (Int -> IO b) -> Benchmark

2225benchIOAppend name f = bench name $ nfIO $ randomRIO (1,1000) >>= f

2326

24−_benchId :: (NFData b) => String -> (Ops.Stream m Int -> Identity b) -> Benchmark

27+_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark

2528_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)

2629

2730main :: IO ()

@@ -29,6 +32,10 @@ main = do

2932 defaultMain

3033 [ bgroup "elimination"

3134 [ benchIO "toNull" Ops.toNull

35+ , benchSrcIO "fromFoldable" Ops.sourceFromFoldable

36+ , benchSrcIO "fromFoldableM" Ops.sourceFromFoldableM

37+ , benchSrcIO "foldMapWith" Ops.sourceFoldMapWith

38+ , benchSrcIO "unfoldrM" Ops.sourceUnfoldrM

3239 , benchIO "toList" Ops.toList

3340 , benchIO "fold" Ops.foldl

3441 , benchIO "last" Ops.last

benchmark/LinearOps.hs+27−2

@@ -9,7 +9,7 @@ module LinearOps where

1010import Prelude

1111 (Monad, Int, (+), ($), (.), return, fmap, even, (>), (<=),

12− subtract, undefined, Maybe, Monoid, foldMap)

12+ subtract, undefined, Maybe(..), Monoid, foldMap)

1313

1414import qualified Streamly as S

1515import qualified Streamly.Prelude as S

@@ -61,8 +61,33 @@ last :: Monad m => Stream m Int -> m (Maybe Int)

6161

6262type Stream m a = S.SerialT m a

6363

64+{-# INLINE source #-}

6465source :: Int -> Stream m Int

65−source n = S.fromFoldable [n..n+value]

66+source n = S.unfoldr step n

67+ where

68+ step cnt =

69+ if cnt > n + value

70+ then Nothing

71+ else (Just (cnt, cnt + 1))

72+

73+sourceFromFoldable :: Int -> Stream m Int

74+sourceFromFoldable n = S.fromFoldable [n..n+value]

75+

76+{-# INLINE sourceFromFoldableM #-}

77+sourceFromFoldableM :: Monad m => Int -> Stream m Int

78+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])

79+

80+sourceFoldMapWith :: Monad m => Int -> Stream m Int

81+sourceFoldMapWith n = S.foldMapWith S.serial return [n..n+value]

82+

83+{-# INLINE sourceUnfoldrM #-}

84+sourceUnfoldrM :: Monad m => Int -> Stream m Int

85+sourceUnfoldrM n = S.unfoldrM step n

86+ where

87+ step cnt =

88+ if cnt > n + value

89+ then return Nothing

90+ else return (Just (cnt, cnt + 1))

6691

6792{-# INLINE runStream #-}

6893runStream :: Monad m => Stream m a -> m ()

benchmark/NestedOps.hs+6−1

@@ -29,7 +29,12 @@ type Stream m a = S.SerialT m a

2929

3030{-# INLINE source #-}

3131source :: S.IsStream t => Int -> Int -> t m Int

32−source start n = S.fromFoldable [start..start+n]

32+source start n = S.unfoldr step start

33+ where

34+ step cnt =

35+ if cnt > start + n

36+ then Nothing

37+ else (Just (cnt, cnt + 1))

3338

3439{-# INLINE runStream #-}

3540runStream :: Monad m => Stream m a -> m ()

src/Streamly/Core.hs+11−8

@@ -228,21 +228,22 @@ newtype Stream m a =

228228nil :: Stream m a

229229nil = Stream $ \_ stp _ _ -> stp

230230

231−once :: Monad m => m a -> Stream m a

232−once m = Stream $ \_ _ single _ -> m >>= single

231+-- | faster than consM because there is no bind.

232+cons :: a -> Stream m a -> Stream m a

233+cons a r = Stream $ \_ _ _ yld -> yld a r

233234

234−{-# INLINE singleton #-}

235−-- | Same as @once . return@

235+-- | Same as @once . return@ but may be faster because there is no bind

236236singleton :: a -> Stream m a

237237singleton a = Stream $ \_ _ single _ -> single a

238238

239+{-# INLINE once #-}

240+once :: Monad m => m a -> Stream m a

241+once m = Stream $ \_ _ single _ -> m >>= single

242+

243+{-# INLINE consM #-}

239244consM :: Monad m => m a -> Stream m a -> Stream m a

240245consM m r = Stream $ \_ _ _ yld -> m >>= \a -> yld a r

241246

242−-- | Same as @consM . return@

243−cons :: a -> Stream m a -> Stream m a

244−cons a r = Stream $ \_ _ _ yld -> yld a r

245−

246247repeat :: a -> Stream m a

247248repeat a = let x = cons a x in x

248249

@@ -252,6 +253,7 @@ repeat a = let x = cons a x in x

252253

253254-- | Concatenates two streams sequentially i.e. the first stream is

254255-- exhausted completely before yielding any element from the second stream.

256+{-# INLINE serial #-}

255257serial :: Stream m a -> Stream m a -> Stream m a

256258serial m1 m2 = go m1

257259 where

@@ -276,6 +278,7 @@ instance Monoid (Stream m a) where

276278-- Interleave

277279------------------------------------------------------------------------------

278280

281+{-# INLINE wSerial #-}

279282wSerial :: Stream m a -> Stream m a -> Stream m a

280283wSerial m1 m2 = Stream $ \_ stp sng yld -> do

281284 let stop = (runStream m2) Nothing stp sng yld

src/Streamly/Prelude.hs+13−2

@@ -55,6 +55,7 @@ module Streamly.Prelude

5555 , iterate

5656 , iterateM

5757 , fromFoldable

58+ , fromFoldableM

5859

5960 -- * Deconstruction

6061 , uncons

@@ -145,6 +146,7 @@ import Streamly.Streams

145146-- | Build a Stream by unfolding pure steps starting from a seed.

146147--

147148-- @since 0.1.0

149+{-# INLINE unfoldr #-}

148150unfoldr :: IsStream t => (b -> Maybe (a, b)) -> b -> t m a

149151unfoldr step = fromStream . go

150152 where

@@ -156,6 +158,7 @@ unfoldr step = fromStream . go

156158-- | Build a Stream by unfolding monadic steps starting from a seed.

157159--

158160-- @since 0.1.0

161+{-# INLINE unfoldrM #-}

159162unfoldrM :: (IsStream t, Monad m) => (b -> m (Maybe (a, b))) -> b -> t m a

160163unfoldrM step = fromStream . go

161164 where

@@ -165,13 +168,20 @@ unfoldrM step = fromStream . go

165168 Nothing -> stp

166169 Just (a, b) -> yld a (go b)

167170

168−-- | Construct a stream from a 'Foldable' container.

171+-- | Construct a stream from a 'Foldable' containing pure values.

169172--

170173-- @since 0.2.0

171174{-# INLINE fromFoldable #-}

172175fromFoldable :: (IsStream t, Foldable f) => f a -> t m a

173176fromFoldable = Prelude.foldr cons nil

174177

178+-- | Construct a stream from a 'Foldable' containing monadic actions.

179+--

180+-- @since 0.3.0

181+{-# INLINE fromFoldableM #-}

182+fromFoldableM :: (IsStream t, Monad m, Foldable f) => f (m a) -> t m a

183+fromFoldableM = Prelude.foldr consM nil

184+

175185-- | Same as 'fromFoldable'.

176186--

177187-- @since 0.1.0

@@ -294,7 +304,8 @@ foldrM step acc m = go (toStream m)

294304-- @since 0.2.0

295305{-# INLINE scanx #-}

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

297−scanx step begin done m = cons (done begin) $ fromStream $ go (toStream m) begin

307+scanx step begin done m =

308+ cons (done begin) $ fromStream $ go (toStream m) begin

298309 where

299310 go m1 !acc = Stream $ \_ stp sng yld ->

300311 let single a = sng (done $ step acc a)

src/Streamly/Streams.hs+1−1

@@ -190,7 +190,7 @@ infixr 5 |:

190190infixr 5 `cons`

191191

192192-- | Construct a stream by adding a pure value at the head of an existing

193−-- stream. Same as @consM . return@. For example:

193+-- stream. For pure values it can be faster than 'consM'. For example:

194194--

195195-- @

196196-- > toList $ 1 \`cons` 2 \`cons` 3 \`cons` nil