7f82af4 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add scanl1, scanl1M, scanl1', scanl1M', scanl, scanlM to StreamD.

7f82af4Pranay Sashank8 years ago

benchmark/Linear.hs+4

compare with master

unifiedsplit

@@ -127,6 +127,7 @@ main =

127 ]

128 , bgroup "transformation"

129 [ benchIOSink "scan" (Ops.scan 1)

130+ , benchIOSink "scanl1" (Ops.scanl1 1)

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

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

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

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

132 , benchIOSink "mapM" (Ops.mapM serially 1)

133 , benchIOSink "mapM" (Ops.mapM serially 1)

@@ -140,6 +141,7 @@ main =

140 ]

141 ]

141 , bgroup "transformationX4"

142 , bgroup "transformationX4"

142 [ benchIOSink "scan" (Ops.scan 4)

143 [ benchIOSink "scan" (Ops.scan 4)

144+ , benchIOSink "scanl1" (Ops.scanl1 4)

143 , benchIOSink "map" (Ops.map 4)

145 , benchIOSink "map" (Ops.map 4)

144 , benchIOSink "fmap" (Ops.fmap 4)

146 , benchIOSink "fmap" (Ops.fmap 4)

145 , benchIOSink "mapM" (Ops.mapM serially 4)

147 , benchIOSink "mapM" (Ops.mapM serially 4)

@@ -194,11 +196,13 @@ main =

194 , benchIOSink "filter-drop" (Ops.filterDrop 4)

196 , benchIOSink "filter-drop" (Ops.filterDrop 4)

195 , benchIOSink "filter-take" (Ops.filterTake 4)

197 , benchIOSink "filter-take" (Ops.filterTake 4)

196 , benchIOSink "filter-scan" (Ops.filterScan 4)

198 , benchIOSink "filter-scan" (Ops.filterScan 4)

199+ , benchIOSink "filter-scanl1" (Ops.filterScanl1 4)

197 , benchIOSink "filter-map" (Ops.filterMap 4)

200 , benchIOSink "filter-map" (Ops.filterMap 4)

198 ]

201 ]

199 , bgroup "iterated"

202 , bgroup "iterated"

200 [ benchIOSrc serially "mapM" Ops.iterateMapM

203 [ benchIOSrc serially "mapM" Ops.iterateMapM

201 , benchIOSrc serially "scan(1/100)" Ops.iterateScan

204 , benchIOSrc serially "scan(1/100)" Ops.iterateScan

205+ , benchIOSrc serially "scanl1(1/100)" Ops.iterateScanl1

202 , benchIOSrc serially "filterEven" Ops.iterateFilterEven

206 , benchIOSrc serially "filterEven" Ops.iterateFilterEven

203 , benchIOSrc serially "takeAll" Ops.iterateTakeAll

207 , benchIOSrc serially "takeAll" Ops.iterateTakeAll

204 , benchIOSrc serially "dropOne" Ops.iterateDropOne

208 , benchIOSrc serially "dropOne" Ops.iterateDropOne

benchmark/LinearOps.hs+11−4

@@ -254,6 +254,7 @@ composeN' n f =

254 _ -> undefined

255

256{-# INLINE scan #-}

257+{-# INLINE scanl1 #-}

257{-# INLINE map #-}

258{-# INLINE map #-}

258{-# INLINE fmap #-}

259{-# INLINE fmap #-}

259{-# INLINE mapMaybe #-}

260{-# INLINE mapMaybe #-}

@@ -271,7 +272,7 @@ composeN' n f =

271{-# INLINE dropWhileFalse #-}

272{-# INLINE dropWhileFalse #-}

272{-# INLINE findIndices #-}

273{-# INLINE findIndices #-}

273{-# INLINE elemIndices #-}

274{-# INLINE elemIndices #-}

274−scan, map, fmap, mapMaybe, filterEven, filterAllOut,

275+scan, scanl1, map, fmap, mapMaybe, filterEven, filterAllOut,

275 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

276 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

276 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

277 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

277 findIndices, elemIndices

278 findIndices, elemIndices

@@ -290,6 +291,7 @@ sequence :: (S.IsStream t, S.MonadAsync m)

290 => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()

291 => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()

291

292

292scan n = composeN n $ S.scanl' (+) 0

293scan n = composeN n $ S.scanl' (+) 0

294+scanl1 n = composeN n $ S.scanl1' (+)

293fmap n = composeN n $ Prelude.fmap (+1)

295fmap n = composeN n $ Prelude.fmap (+1)

294map n = composeN n $ S.map (+1)

296map n = composeN n $ S.map (+1)

295mapM t n = composeN' n $ t . S.mapM return

297mapM t n = composeN' n $ t . S.mapM return

@@ -332,18 +334,21 @@ iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)

332

334

333{-# INLINE iterateMapM #-}

335{-# INLINE iterateMapM #-}

334{-# INLINE iterateScan #-}

336{-# INLINE iterateScan #-}

337+{-# INLINE iterateScanl1 #-}

335{-# INLINE iterateFilterEven #-}

338{-# INLINE iterateFilterEven #-}

336{-# INLINE iterateTakeAll #-}

339{-# INLINE iterateTakeAll #-}

337{-# INLINE iterateDropOne #-}

340{-# INLINE iterateDropOne #-}

338{-# INLINE iterateDropWhileFalse #-}

341{-# INLINE iterateDropWhileFalse #-}

339{-# INLINE iterateDropWhileTrue #-}

342{-# INLINE iterateDropWhileTrue #-}

340−iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,

343+iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

341− iterateDropWhileFalse, iterateDropWhileTrue

344+ iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

342 :: S.MonadAsync m

345 :: S.MonadAsync m

343 => Int -> Stream m Int

346 => Int -> Stream m Int

344

347

345-- this is quadratic

348-- this is quadratic

346iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)

349iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)

350+-- so is this

351+iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)

347

352

348iterateMapM = iterateSource (S.mapM return) maxIters

353iterateMapM = iterateSource (S.mapM return) maxIters

349iterateFilterEven = iterateSource (S.filter even) maxIters

354iterateFilterEven = iterateSource (S.filter even) maxIters

@@ -412,9 +417,10 @@ cmpBy src = S.cmpBy P.compare src src

412{-# INLINE filterDrop #-}

417{-# INLINE filterDrop #-}

413{-# INLINE filterTake #-}

418{-# INLINE filterTake #-}

414{-# INLINE filterScan #-}

419{-# INLINE filterScan #-}

420+{-# INLINE filterScanl1 #-}

415{-# INLINE filterMap #-}

421{-# INLINE filterMap #-}

416scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,

422scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,

417− filterTake, filterScan, filterMap

423+ filterTake, filterScan, filterScanl1, filterMap

418 :: Monad m => Int -> Stream m Int -> m ()

424 :: Monad m => Int -> Stream m Int -> m ()

419

425

420scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0

426scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0

@@ -426,6 +432,7 @@ takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue

426filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)

432filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)

427filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)

433filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)

428filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)

434filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)

435+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)

429filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)

436filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)

430

437

431-------------------------------------------------------------------------------

438-------------------------------------------------------------------------------

src/Streamly/Prelude.hs+44−1

@@ -169,6 +169,12 @@ module Streamly.Prelude

169 -- transformation like map can be expressed in terms of this.

170 , scanl'

171 , scanlM'

172+ , scanlM

173+ , scanl

174+ , scanl1M'

175+ , scanl1'

176+ , scanl1M

177+ , scanl1

172 , scanx

178 , scanx

173

179

174 -- ** Mapping

180 -- ** Mapping

@@ -243,7 +249,7 @@ import Prelude

243 foldl, mapM, mapM_, sequence, all, any, sum, product, elem,

249 foldl, mapM, mapM_, sequence, all, any, sum, product, elem,

244 notElem, maximum, minimum, head, last, tail, length, null,

250 notElem, maximum, minimum, head, last, tail, length, null,

245 reverse, iterate, init, and, or, lookup, foldr1, (!!),

251 reverse, iterate, init, and, or, lookup, foldr1, (!!),

246− splitAt)

252+ splitAt, scanl, scanl1)

247import qualified Prelude

253import qualified Prelude

248import qualified System.IO as IO

254import qualified System.IO as IO

249

255

@@ -851,6 +857,43 @@ scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m

851scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

857scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

852scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m

858scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m

853

859

860+-- | Like 'scanlM'' but with a non-strict accumulator.

861+--

862+{-# INLINE scanlM #-}

863+scanlM :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b

864+scanlM step begin m = fromStreamD $ D.scanlM step begin $ toStreamD m

865+

866+-- | Like 'scanl'' but with a non-strict accumulator.

867+{-# INLINE scanl #-}

868+scanl :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

869+scanl step z m = fromStreamD $ D.scanl step z $ toStreamD m

870+

871+-- | Left scan with a monadic step function. Uses the first element of

872+-- the stream as the starting value. Returns an empty stream if the

873+-- given stream is empty.

874+--

875+{-# INLINE scanl1M #-}

876+scanl1M :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a

877+scanl1M step m = fromStreamD $ D.scanl1M step $ toStreamD m

878+

879+-- | Like 'scanl1M' but with a strict accumulator.

880+--

881+{-# INLINE scanl1M' #-}

882+scanl1M' :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a

883+scanl1M' step m = fromStreamD $ D.scanl1M' step $ toStreamD m

884+

885+-- | Left scan, uses the first element of the stream as the starting

886+-- value. Returns an empty stream if the given stream is empty.

887+{-# INLINE scanl1 #-}

888+scanl1 :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a

889+scanl1 step m = fromStreamD $ D.scanl1 step $ toStreamD m

890+

891+-- | Like 'scanl1'' but with a strict accumulator.

892+--

893+{-# INLINE scanl1' #-}

894+scanl1' :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a

895+scanl1' step m = fromStreamD $ D.scanl1' step $ toStreamD m

896+

854------------------------------------------------------------------------------

897------------------------------------------------------------------------------

855-- Transformation by Filtering

898-- Transformation by Filtering

856------------------------------------------------------------------------------

899------------------------------------------------------------------------------

src/Streamly/Streams/StreamD.hs+79−1

@@ -103,6 +103,12 @@ module Streamly.Streams.StreamD

103 -- ** By folding (scans)

104 , scanlM'

105 , scanl'

106+ , scanlM

107+ , scanl

108+ , scanl1M'

109+ , scanl1'

110+ , scanl1M

111+ , scanl1

106

112

107 -- * Filtering

113 -- * Filtering

108 , filter

114 , filter

@@ -148,7 +154,7 @@ import Prelude

148 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

154 hiding (map, mapM, mapM_, repeat, foldr, last, take, filter,

149 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

155 takeWhile, drop, dropWhile, all, any, maximum, minimum, elem,

150 notElem, null, head, tail, zipWith, lookup, foldr1, sequence,

156 notElem, null, head, tail, zipWith, lookup, foldr1, sequence,

151− (!!))

157+ (!!), scanl, scanl1)

152

158

153import Streamly.SVar (MonadAsync, State(..), defState, rstState)

159import Streamly.SVar (MonadAsync, State(..), defState, rstState)

154

160

@@ -630,6 +636,20 @@ postscanlM' fstep begin (Stream step state) =

630 Skip s -> return $ Skip (s, acc)

636 Skip s -> return $ Skip (s, acc)

631 Stop -> return Stop

637 Stop -> return Stop

632

638

639+{-# INLINE_NORMAL postscanlM #-}

640+postscanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

641+postscanlM fstep begin (Stream step state) = Stream step' (state, begin)

642+ where

643+ {-# INLINE_LATE step' #-}

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

645+ r <- step (rstState gst) st

646+ case r of

647+ Yield x s -> do

648+ y <- fstep acc x

649+ return (Yield y (s, y))

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

651+ Stop -> return Stop

652+

633{-# INLINE_NORMAL scanlM' #-}

653{-# INLINE_NORMAL scanlM' #-}

634scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

654scanlM' :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

635scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)

655scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)

@@ -638,6 +658,64 @@ scanlM' fstep begin s = begin `seq` (begin `cons` postscanlM' fstep begin s)

638scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

658scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

639scanl' f = scanlM' (\a b -> return (f a b))

659scanl' f = scanlM' (\a b -> return (f a b))

640

660

661+{-# INLINE_NORMAL scanlM #-}

662+scanlM :: Monad m => (b -> a -> m b) -> b -> Stream m a -> Stream m b

663+scanlM fstep begin s = begin `cons` postscanlM fstep begin s

664+

665+{-# INLINE scanl #-}

666+scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

667+scanl f = scanlM (\a b -> return (f a b))

668+

669+{-# INLINE_NORMAL scanl1M #-}

670+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

671+scanl1M fstep (Stream step state) = Stream step' (state, Nothing)

672+ where

673+ {-# INLINE_LATE step' #-}

674+ step' gst (st, Nothing) = do

675+ r <- step (rstState gst) st

676+ case r of

677+ Yield x s -> return $ Yield x (s, Just x)

678+ Skip s -> return $ Skip (s, Nothing)

679+ Stop -> return Stop

680+

681+ step' gst (st, Just acc) = do

682+ r <- step (rstState gst) st

683+ case r of

684+ Yield y s -> do

685+ z <- fstep acc y

686+ return $ Yield z (s, Just z)

687+ Skip s -> return $ Skip (s, Just acc)

688+ Stop -> return Stop

689+

690+{-# INLINE scanl1 #-}

691+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

692+scanl1 f = scanl1M (\x y -> return (f x y))

693+

694+{-# INLINE_NORMAL scanl1M' #-}

695+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

696+scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)

697+ where

698+ {-# INLINE_LATE step' #-}

699+ step' gst (st, Nothing) = do

700+ r <- step (rstState gst) st

701+ case r of

702+ Yield x s -> x `seq` return $ Yield x (s, Just x)

703+ Skip s -> return $ Skip (s, Nothing)

704+ Stop -> return Stop

705+

706+ step' gst (st, Just acc) = acc `seq` do

707+ r <- step (rstState gst) st

708+ case r of

709+ Yield y s -> do

710+ z <- fstep acc y

711+ z `seq` return $ Yield z (s, Just z)

712+ Skip s -> return $ Skip (s, Just acc)

713+ Stop -> return Stop

714+

715+{-# INLINE scanl1' #-}

716+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

717+scanl1' f = scanl1M' (\x y -> return (f x y))

718+

641-------------------------------------------------------------------------------

719-------------------------------------------------------------------------------

642-- Filtering

720-- Filtering

643-------------------------------------------------------------------------------

721-------------------------------------------------------------------------------

test/Prop.hs+14−1

@@ -464,10 +464,23 @@ transformCombineOpsCommon constr desc eq t = do

464 prop (desc <> " mapM (+1)") $

465 transform (fmap (+1)) t (S.mapM (\x -> return (x + 1)))

466

467− prop (desc <> " scan") $ transform (scanl' (flip const) 0) t

467+ prop (desc <> " scanl'") $ transform (scanl' (flip const) 0) t

468 (S.scanl' (flip const) 0)

469 prop (desc <> " scanlM'") $ transform (scanl' (flip const) 0) t

470 (S.scanlM' (\_ a -> return a) 0)

471+ prop (desc <> " scanl") $ transform (scanl' (flip const) 0) t

472+ (S.scanl' (flip const) 0)

473+ prop (desc <> " scanlM") $ transform (scanl (flip const) 0) t

474+ (S.scanlM (\_ a -> return a) 0)

475+ prop (desc <> " scanl1") $ transform (scanl1 (flip const)) t

476+ (S.scanl1 (flip const))

477+ prop (desc <> " scanl1M") $ transform (scanl1 (flip const)) t

478+ (S.scanl1M (\_ a -> return a))

479+ prop (desc <> " scanl1'") $ transform (scanl1 (flip const)) t

480+ (S.scanl1' (flip const))

481+ prop (desc <> " scanl1M'") $ transform (scanl1 (flip const)) t

482+ (S.scanl1M' (\_ a -> return a))

483+

471 prop (desc <> " reverse") $ transform reverse t S.reverse

484 prop (desc <> " reverse") $ transform reverse t S.reverse

472

485

473 prop (desc <> " intersperseM") $

486 prop (desc <> " intersperseM") $