6530e76 · streamly · git.iko.soy

git.iko.soy/streamly

push uncons/null/head/tail to StreamK

and implement direct versions of these as well.

commit6530e7634f6bb306c7f81f8212230aad24523cea authorHarendra Kumar <harendra.kumar@gmail.com> dateWed 27 Jun 2018, 05:20 (8 years ago) parent9b78a64

8 files changed+163−34

compare with master

unifiedsplit

benchmark/BaseStreams.hs+9−1 benchmark/Linear.hs+2 benchmark/LinearOps.hs+19−2 benchmark/StreamDOps.hs+19−2 benchmark/StreamKOps.hs+22−4 src/Streamly/Prelude.hs+7−20 src/Streamly/Streams/StreamD.hs+40−3 src/Streamly/Streams/StreamK.hs+45−2

benchmark/BaseStreams.hs+9−1

@@ -40,6 +40,11 @@ main = do

4040 , benchIO "fromFoldable" D.toNull D.sourceFromFoldable

4141 -- , benchIO "fromFoldableM" D.sourceFromFoldableM

4242 ]

43+ , bgroup "elimination"

44+ [ benchIO "toNull" D.toNull D.sourceUnfoldrM

45+ , benchIO "uncons" D.uncons D.sourceUnfoldrM

46+ , benchIO "nullHeadTail" D.nullHeadTail D.sourceUnfoldrM

47+ ]

4348 , bgroup "transformation"

4449 [ -- benchIO "scan" D.scan D.sourceUnfoldrM

4550 benchIO "map" D.map D.sourceUnfoldrM

@@ -66,7 +71,10 @@ main = do

6671 , benchIO "foldMapWithM" K.toNull K.sourceFoldMapWithM

6772 ]

6873 , bgroup "elimination"

69− [ benchFold "toList" K.toList K.sourceUnfoldrM

74+ [ benchIO "toNull" K.toNull K.sourceUnfoldrM

75+ , benchIO "uncons" K.uncons K.sourceUnfoldrM

76+ , benchIO "nullHeadTail" K.nullHeadTail K.sourceUnfoldrM

77+ , benchFold "toList" K.toList K.sourceUnfoldrM

7078 , benchFold "fold" K.foldl K.sourceUnfoldrM

7179 , benchFold "last" K.last K.sourceUnfoldrM

7280 ]

benchmark/Linear.hs+2

@@ -55,6 +55,8 @@ main = do

5555 ]

5656 , bgroup "elimination"

5757 [ benchIO "toNull" $ Ops.toNull serially

58+ , benchIO "uncons" Ops.uncons

59+ , benchIO "nullHeadTail" Ops.nullHeadTail

5860 , benchIO "mapM_" Ops.mapM_

5961 , benchIO "toList" Ops.toList

6062 , benchIO "foldr" Ops.foldr

benchmark/LinearOps.hs+19−2

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

1111

1212import Prelude

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

14− subtract, undefined, Maybe(..), odd, Bool)

14+ subtract, undefined, Maybe(..), odd, Bool, not)

1515

1616import qualified Streamly as S

1717import qualified Streamly.Prelude as S

@@ -24,6 +24,8 @@ maxValue = value + 1000

2424-- Benchmark ops

2525-------------------------------------------------------------------------------

2626

27+{-# INLINE uncons #-}

28+{-# INLINE nullHeadTail #-}

2729{-# INLINE scan #-}

2830{-# INLINE mapM_ #-}

2931{-# INLINE map #-}

@@ -44,7 +46,7 @@ maxValue = value + 1000

4446{-# INLINE composeAllInFilters #-}

4547{-# INLINE composeAllOutFilters #-}

4648{-# INLINE composeMapAllInFilter #-}

47−scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,

49+uncons, nullHeadTail, scan, mapM_, map, fmap, mapMaybe, filterEven, filterAllOut,

4850 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropAll,

4951 dropWhileTrue, dropWhileMTrue, zip,

5052 concat, composeAllInFilters, composeAllOutFilters,

@@ -163,6 +165,21 @@ runStream :: Monad m => Stream m a -> m ()

163165runStream = S.runStream

164166

165167toNull t = runStream . t

168+uncons s = do

169+ r <- S.uncons s

170+ case r of

171+ Nothing -> return ()

172+ Just (_, t) -> uncons t

173+nullHeadTail s = do

174+ r <- S.null s

175+ if not r

176+ then do

177+ _ <- S.head s

178+ t <- S.tail s

179+ case t of

180+ Nothing -> return ()

181+ Just x -> nullHeadTail x

182+ else return ()

166183mapM_ = S.mapM_ (\_ -> return ())

167184toList = S.toList

168185foldr = S.foldr (:) []

benchmark/StreamDOps.hs+19−2

@@ -14,7 +14,7 @@ module StreamDOps where

1414 -- subtract, undefined, Maybe(..))

1515import Prelude

1616 (Monad, Int, (+), (.), return, (>), even, (<=),

17− Maybe(..))

17+ Maybe(..), not)

1818

1919import qualified Streamly.Streams.StreamD as S

2020

@@ -26,6 +26,8 @@ maxValue = value + 1000

2626-- Benchmark ops

2727-------------------------------------------------------------------------------

2828

29+{-# INLINE uncons #-}

30+{-# INLINE nullHeadTail #-}

2931-- {-# INLINE scan #-}

3032{-# INLINE map #-}

3133{-# INLINE filterEven #-}

@@ -43,7 +45,7 @@ maxValue = value + 1000

4345{-# INLINE composeAllOutFilters #-}

4446{-# INLINE composeMapAllInFilter #-}

4547-}

46−map, filterEven, filterAllOut,

48+uncons, nullHeadTail, map, filterEven, filterAllOut,

4749 filterAllIn, takeOne, takeAll -- takeWhileTrue, dropAll, dropWhileTrue, zip,

4850 -- concat, composeAllInFilters, composeAllOutFilters,

4951 -- composeMapAllInFilter

@@ -111,6 +113,21 @@ runStream :: Monad m => Stream m a -> m ()

111113runStream = S.runStream

112114

113115toNull = runStream

116+uncons s = do

117+ r <- S.uncons s

118+ case r of

119+ Nothing -> return ()

120+ Just (_, t) -> uncons t

121+nullHeadTail s = do

122+ r <- S.null s

123+ if not r

124+ then do

125+ _ <- S.head s

126+ t <- S.tail s

127+ case t of

128+ Nothing -> return ()

129+ Just x -> nullHeadTail x

130+ else return ()

114131toList = S.toList

115132foldl = S.foldl' (+) 0

116133last = S.last

benchmark/StreamKOps.hs+22−4

@@ -11,7 +11,7 @@ module StreamKOps where

1111

1212import Prelude

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

14− subtract, undefined, Maybe(..))

14+ subtract, undefined, Maybe(..), not)

1515

1616import qualified Streamly.Streams.StreamK as S hiding (runStream)

1717-- import qualified Streamly.Streams.Serial as S

@@ -26,6 +26,9 @@ maxValue = value + 1000

2626-- Benchmark ops

2727-------------------------------------------------------------------------------

2828

29+{-# INLINE toNull #-}

30+{-# INLINE uncons #-}

31+{-# INLINE nullHeadTail #-}

2932{-# INLINE scan #-}

3033{-# INLINE map #-}

3134{-# INLINE filterEven #-}

@@ -41,7 +44,7 @@ maxValue = value + 1000

4144{-# INLINE composeAllInFilters #-}

4245{-# INLINE composeAllOutFilters #-}

4346{-# INLINE composeMapAllInFilter #-}

44−scan, map, filterEven, filterAllOut,

47+toNull, uncons, nullHeadTail, scan, map, filterEven, filterAllOut,

4548 filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropWhileTrue, zip,

4649 concat, composeAllInFilters, composeAllOutFilters,

4750 composeMapAllInFilter

@@ -58,9 +61,7 @@ foldl :: Monad m => Stream m Int -> m Int

5861{-# INLINE last #-}

5962last :: Monad m => Stream m Int -> m (Maybe Int)

6063

61−{-# INLINE toNull #-}

6264{-# INLINE mapM #-}

63−toNull :: Monad m => Stream m Int -> m ()

6465mapM :: S.MonadAsync m => Stream m Int -> m ()

6566

6667-------------------------------------------------------------------------------

@@ -122,6 +123,23 @@ runStream :: Monad m => Stream m a -> m ()

122123runStream = S.runStream

123124

124125toNull = runStream

126+uncons s = do

127+ r <- S.uncons s

128+ case r of

129+ Nothing -> return ()

130+ Just (_, t) -> uncons t

131+

132+nullHeadTail s = do

133+ r <- S.null s

134+ if not r

135+ then do

136+ _ <- S.head s

137+ t <- S.tail s

138+ case t of

139+ Nothing -> return ()

140+ Just x -> nullHeadTail x

141+ else return ()

142+

125143toList = S.toList

126144foldl = S.foldl' (+) 0

127145last = S.last

src/Streamly/Prelude.hs+7−20

@@ -210,11 +210,7 @@ toStreamD = D.fromStreamK . toStream

210210--

211211-- @since 0.1.0

212212uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))

213−uncons m =

214− let stop = return Nothing

215− single a = return (Just (a, K.nil))

216− yieldk a r = return (Just (a, fromStream r))

217− in (K.unStream (toStream m)) Nothing stop single yieldk

213+uncons m = K.uncons (K.adapt m)

218214

219215------------------------------------------------------------------------------

220216-- Generation by Unfolding

@@ -500,32 +496,23 @@ foldlM' step begin m = S.foldlM' step begin $ toStreamS m

500496-- | Determine whether the stream is empty.

501497--

502498-- @since 0.1.1

499+{-# INLINE null #-}

503500null :: Monad m => SerialT m a -> m Bool

504−null m =

505− let stop = return True

506− single _ = return False

507− yieldk _ _ = return False

508− in (K.unStream (toStream m)) Nothing stop single yieldk

501+null m = K.null m

509502

510503-- | Extract the first element of the stream, if any.

511504--

512505-- @since 0.1.0

506+{-# INLINE head #-}

513507head :: Monad m => SerialT m a -> m (Maybe a)

514−head m =

515− let stop = return Nothing

516− single a = return (Just a)

517− yieldk a _ = return (Just a)

518− in (K.unStream (toStream m)) Nothing stop single yieldk

508+head m = K.head m

519509

520510-- | Extract all but the first element of the stream, if any.

521511--

522512-- @since 0.1.1

513+{-# INLINE tail #-}

523514tail :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (t m a))

524−tail m =

525− let stop = return Nothing

526− single _ = return $ Just K.nil

527− yieldk _ r = return $ Just $ fromStream r

528− in (K.unStream (toStream m)) Nothing stop single yieldk

515+tail m = K.tail (K.adapt m)

529516

530517-- | Extract the last element of the stream, if any.

531518--

src/Streamly/Streams/StreamD.hs+40−3

@@ -30,7 +30,7 @@

3030-- import qualified Streamly.Streams.StreamD as D

3131-- @

3232

33−-- A majority of functions in this file have been adapted from the vector

33+-- Some of functions in this file have been adapted from the vector

3434-- library, https://hackage.haskell.org/package/vector.

3535

3636module Streamly.Streams.StreamD

@@ -74,6 +74,9 @@ module Streamly.Streams.StreamD

7474

7575 -- ** Specialized Folds

7676 , runStream

77+ , null

78+ , head

79+ , tail

7780 , last

7881 , elem

7982 , notElem

@@ -119,7 +122,7 @@ import GHC.Types ( SPEC(..) )

119122import Prelude

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

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

122− notElem)

125+ notElem, null, head, tail)

123126

124127import Streamly.SVar (MonadAsync)

125128import qualified Streamly.Streams.StreamK as K

@@ -151,7 +154,7 @@ data Stream m a = forall s. Stream (s -> m (Step s a)) s

151154nil :: Monad m => Stream m a

152155nil = Stream (const $ return Stop) ()

153156

154−-- | Note that the cons operation is not scalable as it has O(n^2) complexity.

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

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

156159cons x (Stream step state) = Stream step1 Nothing

157160 where

@@ -166,6 +169,7 @@ cons x (Stream step state) = Stream step1 Nothing

166169-- Deconstruction

167170-------------------------------------------------------------------------------

168171

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

169173{-# INLINE_NORMAL uncons #-}

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

171175uncons (Stream step state) = go state

@@ -311,6 +315,39 @@ runStream (Stream step state) = go SPEC state

311315 Yield _ s -> go SPEC s

312316 Stop -> return ()

313317

318+{-# INLINE_NORMAL null #-}

319+null :: Monad m => Stream m a -> m Bool

320+null (Stream step state) = go state

321+ where

322+ go st = do

323+ r <- step st

324+ case r of

325+ Yield _ _ -> return False

326+ Stop -> return True

327+

328+-- XXX SPEC?

329+{-# INLINE_NORMAL head #-}

330+head :: Monad m => Stream m a -> m (Maybe a)

331+head (Stream step state) = go state

332+ where

333+ go st = do

334+ r <- step st

335+ case r of

336+ Yield x _ -> return (Just x)

337+ Stop -> return Nothing

338+

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

340+{-# INLINE_NORMAL tail #-}

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

342+tail (Stream step state) = go state

343+ where

344+ go st = do

345+ r <- step st

346+ case r of

347+ Yield _ s -> return (Just $ Stream step s)

348+ Stop -> return Nothing

349+

350+-- XXX will it fuse? need custom impl?

314351{-# INLINE_NORMAL last #-}

315352last :: Monad m => Stream m a -> m (Maybe a)

316353last = foldl' (\_ y -> Just y) Nothing

src/Streamly/Streams/StreamK.hs+45−2

@@ -48,6 +48,9 @@ module Streamly.Streams.StreamK

4848 , yieldK

4949 , consK

5050

51+ -- * Deconstruction

52+ , uncons

53+

5154 -- * Generation

5255 -- ** Unfolds

5356 , unfoldr

@@ -75,6 +78,9 @@ module Streamly.Streams.StreamK

7578

7679 -- ** Specialized Folds

7780 , runStream

81+ , null

82+ , head

83+ , tail

7884 , elem

7985 , notElem

8086 , all

@@ -131,7 +137,7 @@ import Data.Semigroup (Semigroup(..))

131137import Prelude

132138 hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,

133139 take, filter, all, any, takeWhile, drop, dropWhile, minimum,

134− maximum, elem, notElem)

140+ maximum, elem, notElem, null, head, tail)

135141import qualified Prelude

136142

137143import Streamly.SVar

@@ -337,6 +343,18 @@ instance IsStream Stream where

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

338344 (|:) = consMSerial

339345

346+-------------------------------------------------------------------------------

347+-- Deconstruction

348+-------------------------------------------------------------------------------

349+

350+{-# INLINE uncons #-}

351+uncons :: (IsStream t, Monad m) => t m a -> m (Maybe (a, t m a))

352+uncons m =

353+ let stop = return Nothing

354+ single a = return (Just (a, nil))

355+ yieldk a r = return (Just (a, fromStream r))

356+ in (unStream (toStream m)) Nothing stop single yieldk

357+

340358-------------------------------------------------------------------------------

341359-- Generation

342360-------------------------------------------------------------------------------

@@ -514,6 +532,7 @@ foldlM' step begin m = foldxM step (return begin) return m

514532-- Specialized folds

515533------------------------------------------------------------------------------

516534

535+{-# INLINE runStream #-}

517536runStream :: (Monad m, IsStream t) => t m a -> m ()

518537runStream m = go (toStream m)

519538 where

@@ -521,7 +540,31 @@ runStream m = go (toStream m)

521540 let stop = return ()

522541 single _ = return ()

523542 yieldk _ r = go (toStream r)

524− in (unStream m1) Nothing stop single yieldk

543+ in unStream m1 Nothing stop single yieldk

544+

545+{-# INLINE null #-}

546+null :: (IsStream t, Monad m) => t m a -> m Bool

547+null m =

548+ let stop = return True

549+ single _ = return False

550+ yieldk _ _ = return False

551+ in unStream (toStream m) Nothing stop single yieldk

552+

553+{-# INLINE head #-}

554+head :: (IsStream t, Monad m) => t m a -> m (Maybe a)

555+head m =

556+ let stop = return Nothing

557+ single a = return (Just a)

558+ yieldk a _ = return (Just a)

559+ in unStream (toStream m) Nothing stop single yieldk

560+

561+{-# INLINE tail #-}

562+tail :: (IsStream t, Monad m) => t m a -> m (Maybe (t m a))

563+tail m =

564+ let stop = return Nothing

565+ single _ = return $ Just nil

566+ yieldk _ r = return $ Just $ fromStream r

567+ in unStream (toStream m) Nothing stop single yieldk

525568

526569{-# INLINE elem #-}

527570elem :: (IsStream t, Monad m, Eq a) => a -> t m a -> m Bool