c042050 · streamly · git.iko.soy

git.iko.soy/streamly

Fix performance for some ops

especially map/mapM for StreamK and uncons/tail for StreamD

commitc0420503a1f3694b17184e8b6e89dac2972501b7 authorHarendra Kumar <harendra.kumar@gmail.com> dateThu 27 Dec 2018, 18:04 (8 years ago) parent9c8a750

5 files changed+45−17

compare with master

unifiedsplit

src/Streamly/Streams/Serial.hs+10−4 src/Streamly/Streams/StreamD.hs+2−2 src/Streamly/Streams/StreamK.hs+15−1 src/Streamly/Streams/StreamK/Type.hs+7−6 src/Streamly/Streams/Zip.hs+11−4

src/Streamly/Streams/Serial.hs+10−4

@@ -149,6 +149,9 @@ type StreamT = SerialT

149149serially :: IsStream t => SerialT m a -> t m a

150150serially = adapt

151151

152+consMSerial :: Monad m => m a -> SerialT m a -> SerialT m a

153+consMSerial m ms = fromStream $ K.consMStream m (toStream ms)

154+

152155instance IsStream SerialT where

153156 toStream = getSerialT

154157 fromStream = SerialT

@@ -156,12 +159,12 @@ instance IsStream SerialT where

156159 {-# INLINE consM #-}

157160 {-# SPECIALIZE consM :: IO a -> SerialT IO a -> SerialT IO a #-}

158161 consM :: Monad m => m a -> SerialT m a -> SerialT m a

159− consM = K.consMSerial

162+ consM = consMSerial

160163

161164 {-# INLINE (|:) #-}

162165 {-# SPECIALIZE (|:) :: IO a -> SerialT IO a -> SerialT IO a #-}

163166 (|:) :: Monad m => m a -> SerialT m a -> SerialT m a

164− (|:) = K.consMSerial

167+ (|:) = consMSerial

165168

166169------------------------------------------------------------------------------

167170-- Monad

@@ -267,6 +270,9 @@ wSerially = adapt

267270interleaving :: IsStream t => WSerialT m a -> t m a

268271interleaving = wSerially

269272

273+consMWSerial :: Monad m => m a -> WSerialT m a -> WSerialT m a

274+consMWSerial m ms = fromStream $ K.consMStream m (toStream ms)

275+

270276instance IsStream WSerialT where

271277 toStream = getWSerialT

272278 fromStream = WSerialT

@@ -274,12 +280,12 @@ instance IsStream WSerialT where

274280 {-# INLINE consM #-}

275281 {-# SPECIALIZE consM :: IO a -> WSerialT IO a -> WSerialT IO a #-}

276282 consM :: Monad m => m a -> WSerialT m a -> WSerialT m a

277− consM = K.consMSerial

283+ consM = consMWSerial

278284

279285 {-# INLINE (|:) #-}

280286 {-# SPECIALIZE (|:) :: IO a -> WSerialT IO a -> WSerialT IO a #-}

281287 (|:) :: Monad m => m a -> WSerialT m a -> WSerialT m a

282− (|:) = K.consMSerial

288+ (|:) = consMWSerial

283289

284290------------------------------------------------------------------------------

285291-- Semigroup

src/Streamly/Streams/StreamD.hs+2−2

@@ -235,7 +235,7 @@ cons x (Stream step state) = Stream step1 Nothing

235235-- Does not fuse, has the same performance as the StreamK version.

236236{-# INLINE_NORMAL uncons #-}

237237uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))

238−uncons (Stream step state) = go state

238+uncons (UnStream step state) = go state

239239 where

240240 go st = do

241241 r <- step defState st

@@ -575,7 +575,7 @@ head (Stream step state) = go state

575575-- Does not fuse, has the same performance as the StreamK version.

576576{-# INLINE_NORMAL tail #-}

577577tail :: Monad m => Stream m a -> m (Maybe (Stream m a))

578−tail (Stream step state) = go state

578+tail (UnStream step state) = go state

579579 where

580580 go st = do

581581 r <- step defState st

src/Streamly/Streams/StreamK.hs+15−1

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

151151 , serial

152152

153153 -- * Utilities

154− , consMSerial

154+ , consMStream

155155 , bindWith

156156 , withLocal

157157

@@ -197,6 +197,7 @@ infixr 5 `cons`

197197-- @

198198--

199199-- @since 0.1.0

200+{-# INLINE cons #-}

200201cons :: IsStream t => a -> t m a -> t m a

201202cons a r = mkStream $ \_ yld _ _ -> yld a r

202203

@@ -210,6 +211,7 @@ infixr 5 .:

210211-- @

211212--

212213-- @since 0.1.1

214+{-# INLINE (.:) #-}

213215(.:) :: IsStream t => a -> t m a -> t m a

214216(.:) = cons

215217

@@ -269,6 +271,7 @@ unfoldrM step = go

269271-- Special generation

270272-------------------------------------------------------------------------------

271273

274+{-# INLINE yield #-}

272275yield :: IsStream t => a -> t m a

273276yield a = mkStream $ \_ _ single _ -> single a

274277

@@ -289,14 +292,17 @@ once = yieldM

289292-- Generate an infinite stream by repeating a pure value.

290293--

291294-- @since 0.4.0

295+{-# INLINE repeat #-}

292296repeat :: IsStream t => a -> t m a

293297repeat a = let x = cons a x in x

294298

299+{-# INLINE replicateM #-}

295300replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a

296301replicateM n m = go n

297302 where

298303 go cnt = if cnt <= 0 then nil else m |: go (cnt - 1)

299304

305+{-# INLINE replicate #-}

300306replicate :: IsStream t => Int -> a -> t m a

301307replicate n a = go n

302308 where

@@ -331,6 +337,7 @@ fromStreamK = fromStream

331337-------------------------------------------------------------------------------

332338

333339-- | Lazy right associative fold.

340+{-# INLINE foldr #-}

334341foldr :: (IsStream t, Monad m) => (a -> b -> b) -> b -> t m a -> m b

335342foldr step acc m = go m

336343 where

@@ -405,6 +412,7 @@ foldl' step begin = foldx step begin id

405412

406413-- XXX replace the recursive "go" with explicit continuations.

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

415+{-# INLINABLE foldxM #-}

408416foldxM :: (IsStream t, Monad m)

409417 => (x -> a -> m x) -> m x -> (x -> m b) -> t m a -> m b

410418foldxM step begin done m = go begin m

@@ -416,6 +424,7 @@ foldxM step begin done m = go begin m

416424 in foldStream defState yieldk single stop m1

417425

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

427+{-# INLINE foldlM' #-}

419428foldlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> m b

420429foldlM' step begin = foldxM step (return begin) return

421430

@@ -494,6 +503,7 @@ notElem e m = go m

494503 yieldk a r = if a == e then return False else go r

495504 in foldStream defState yieldk single stop m1

496505

506+{-# INLINABLE all #-}

497507all :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool

498508all p m = go m

499509 where

@@ -504,6 +514,7 @@ all p m = go m

504514 | otherwise = return False

505515 in foldStream defState yieldk single (return True) m1

506516

517+{-# INLINABLE any #-}

507518any :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> m Bool

508519any p m = go m

509520 where

@@ -741,6 +752,7 @@ takeWhile p m = go m

741752 | otherwise = stp

742753 in foldStream st yieldk single stp m1

743754

755+{-# INLINE drop #-}

744756drop :: IsStream t => Int -> t m a -> t m a

745757drop n m = go n m

746758 where

@@ -874,6 +886,7 @@ zipWith f = go

874886-- | Zip two streams serially using a monadic zipping function.

875887--

876888-- @since 0.1.0

889+{-# INLINABLE zipWithM #-}

877890zipWithM :: (IsStream t, Monad m) => (a -> b -> m c) -> t m a -> t m b -> t m c

878891zipWithM f m1 m2 = go m1 m2

879892 where

@@ -974,6 +987,7 @@ _alt m1 m2 = mkStream $ \st yld sng stp ->

974987-- MonadReader

975988------------------------------------------------------------------------------

976989

990+{-# INLINABLE withLocal #-}

977991withLocal :: MonadReader r m => (r -> r) -> Stream m a -> Stream m a

978992withLocal f m =

979993 mkStream $ \st yld sng stp ->

src/Streamly/Streams/StreamK/Type.hs+7−6

@@ -44,7 +44,7 @@ module Streamly.Streams.StreamK.Type

4444 , foldStreamSVar

4545

4646 -- instances

47− , consMSerial

47+ , consMStream

4848

4949 , nil

5050 , serial

@@ -184,6 +184,7 @@ adapt = fromStream . toStream

184184--

185185-- | Build a stream from an 'SVar', a stop continuation, a singleton stream

186186-- continuation and a yield continuation.

187+{-# INLINABLE mkStream #-}

187188mkStream:: IsStream t

188189 => (forall r. State Stream m a

189190 -> (a -> t m a -> m r)

@@ -279,9 +280,9 @@ foldStreamSVar sv st yld sng stp m =

279280-- Instances

280281-------------------------------------------------------------------------------

281282

282−{-# INLINE consMSerial #-}

283−consMSerial :: (IsStream t, Monad m) => m a -> t m a -> t m a

284−consMSerial m r = mkStream $ \_ yld _ _ -> m >>= \a -> yld a r

283+{-# INLINE consMStream #-}

284+consMStream :: (Monad m) => m a -> Stream m a -> Stream m a

285+consMStream m r = MkStream $ \_ yld _ _ -> m >>= \a -> yld a r

285286

286287-------------------------------------------------------------------------------

287288-- IsStream Stream

@@ -294,12 +295,12 @@ instance IsStream Stream where

294295 {-# INLINE consM #-}

295296 {-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}

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

297− consM = consMSerial

298+ consM = consMStream

298299

299300 {-# INLINE (|:) #-}

300301 {-# SPECIALIZE (|:) :: IO a -> Stream IO a -> Stream IO a #-}

301302 (|:) :: Monad m => m a -> Stream m a -> Stream m a

302− (|:) = consMSerial

303+ (|:) = consMStream

303304

304305------------------------------------------------------------------------------

305306-- Semigroup

src/Streamly/Streams/Zip.hs+11−4

@@ -106,6 +106,9 @@ zipSerially = K.adapt

106106zipping :: IsStream t => ZipSerialM m a -> t m a

107107zipping = zipSerially

108108

109+consMZip :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a

110+consMZip m ms = fromStream $ K.consMStream m (toStream ms)

111+

109112instance IsStream ZipSerialM where

110113 toStream = getZipSerialM

111114 fromStream = ZipSerialM

@@ -113,12 +116,12 @@ instance IsStream ZipSerialM where

113116 {-# INLINE consM #-}

114117 {-# SPECIALIZE consM :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}

115118 consM :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a

116− consM = K.consMSerial

119+ consM = consMZip

117120

118121 {-# INLINE (|:) #-}

119122 {-# SPECIALIZE (|:) :: IO a -> ZipSerialM IO a -> ZipSerialM IO a #-}

120123 (|:) :: Monad m => m a -> ZipSerialM m a -> ZipSerialM m a

121− (|:) = K.consMSerial

124+ (|:) = consMZip

122125

123126LIST_INSTANCES(ZipSerialM)

124127

@@ -199,6 +202,10 @@ zipAsyncly = K.adapt

199202{-# DEPRECATED zippingAsync "Please use zipAsyncly instead." #-}

200203zippingAsync :: IsStream t => ZipAsyncM m a -> t m a

201204zippingAsync = zipAsyncly

205+

206+consMZipAsync :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a

207+consMZipAsync m ms = fromStream $ K.consMStream m (toStream ms)

208+

202209instance IsStream ZipAsyncM where

203210 toStream = getZipAsyncM

204211 fromStream = ZipAsyncM

@@ -206,12 +213,12 @@ instance IsStream ZipAsyncM where

206213 {-# INLINE consM #-}

207214 {-# SPECIALIZE consM :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}

208215 consM :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a

209− consM = K.consMSerial

216+ consM = consMZipAsync

210217

211218 {-# INLINE (|:) #-}

212219 {-# SPECIALIZE (|:) :: IO a -> ZipAsyncM IO a -> ZipAsyncM IO a #-}

213220 (|:) :: Monad m => m a -> ZipAsyncM m a -> ZipAsyncM m a

214− (|:) = K.consMSerial

221+ (|:) = consMZipAsync

215222

216223instance Monad m => Functor (ZipAsyncM m) where

217224 fmap = map