a5e483b · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Refactor Unfold module

a5e483bHarendra Kumar6 years ago

benchmark/Streamly/Benchmark/Data/Unfold.hs+54−23

compare with master

unifiedsplit

@@ -115,7 +115,7 @@ lmapM size start =

115{-# INLINE supply #-}

116supply :: Monad m => Int -> Int -> m ()

117supply size start =

118− drainTransformationDefault (size + start) (flip UF.supply start) undefined

118+ drainTransformationDefault (size + start) (UF.supply start) undefined

119

120

121{-# INLINE supplyFirst #-}

@@ -123,7 +123,7 @@ supplyFirst :: Monad m => Int -> Int -> m ()

123supplyFirst size start =

124 drainTransformation

125 (UF.take size UF.enumerateFromStepIntegral)

126− (flip UF.supplyFirst start)

126+ (UF.supplyFirst start)

127 1

128

129{-# INLINE supplySecond #-}

@@ -131,7 +131,7 @@ supplySecond :: Monad m => Int -> Int -> m ()

131supplySecond size start =

132 drainTransformation

133 (UF.take size UF.enumerateFromStepIntegral)

134− (flip UF.supplySecond 1)

134+ (UF.supplySecond 1)

135 start

136

137{-# INLINE discardFirst #-}

@@ -181,11 +181,6 @@ consM :: Monad m => Int -> Int -> m ()

181consM size start =

182 drainTransformationDefault (size + start) (UF.consM return) start

183

184−{-# INLINE _effect #-}

185−_effect :: Monad m => Int -> Int -> m ()

186−_effect _ start =

187− drainGeneration (UF.effect (return start)) undefined

188−

189{-# INLINE _singletonM #-}

184{-# INLINE _singletonM #-}

190_singletonM :: Monad m => Int -> Int -> m ()

185_singletonM :: Monad m => Int -> Int -> m ()

191_singletonM _ start = drainGeneration (UF.singletonM return) start

186_singletonM _ start = drainGeneration (UF.singletonM return) start

@@ -201,7 +196,7 @@ _identity _ start = drainGeneration UF.identity start

201{-# INLINE _const #-}

196{-# INLINE _const #-}

202_const :: Monad m => Int -> Int -> m ()

197_const :: Monad m => Int -> Int -> m ()

203_const size start =

198_const size start =

204− drainGeneration (UF.take size (UF.const (return start))) undefined

199+ drainGeneration (UF.take size (UF.yieldM (return start))) undefined

205

200

206{-# INLINE unfoldrM #-}

201{-# INLINE unfoldrM #-}

207unfoldrM :: Monad m => Int -> Int -> m ()

202unfoldrM :: Monad m => Int -> Int -> m ()

@@ -413,7 +408,8 @@ toNullAp :: Monad m => Int -> Int -> m ()

413toNullAp value start =

408toNullAp value start =

414 let end = start + nthRoot 2 value

409 let end = start + nthRoot 2 value

415 s = source end

410 s = source end

416− in UF.fold ((+) <$> s <*> s) FL.drain start

411+ -- in UF.fold ((+) <$> s <*> s) FL.drain start

412+ in UF.fold ((+) `fmap` s `UF.apply` s) FL.drain start

417

413

418{-# INLINE _apDiscardFst #-}

414{-# INLINE _apDiscardFst #-}

419_apDiscardFst :: Int -> Int -> m ()

415_apDiscardFst :: Int -> Int -> m ()

@@ -446,10 +442,15 @@ toNull :: Monad m => Int -> Int -> m ()

446toNull value start =

442toNull value start =

447 let end = start + nthRoot 2 value

443 let end = start + nthRoot 2 value

448 src = source end

444 src = source end

445+ {-

449 u = do

446 u = do

450 x <- src

447 x <- src

451 y <- src

448 y <- src

452 return (x + y)

449 return (x + y)

450+ -}

451+ u = src `UF.bind` \x ->

452+ src `UF.bind` \y ->

453+ UF.yield (x + y)

453 in UF.fold u FL.drain start

454 in UF.fold u FL.drain start

454

455

456

@@ -458,11 +459,16 @@ toNull3 :: Monad m => Int -> Int -> m ()

458toNull3 value start =

459toNull3 value start =

459 let end = start + nthRoot 3 value

460 let end = start + nthRoot 3 value

460 src = source end

461 src = source end

462+ {-

461 u = do

463 u = do

462 x <- src

464 x <- src

463 y <- src

465 y <- src

464 z <- src

466 z <- src

465 return (x + y + z)

467 return (x + y + z)

468+ -}

469+ u = src `UF.bind` \x ->

470+ src `UF.bind` \y ->

471+ UF.yield (x + y)

466 in UF.fold u FL.drain start

472 in UF.fold u FL.drain start

467

473

468{-# INLINE toList #-}

474{-# INLINE toList #-}

@@ -470,10 +476,15 @@ toList :: Monad m => Int -> Int -> m [Int]

470toList value start = do

476toList value start = do

471 let end = start + nthRoot 2 value

477 let end = start + nthRoot 2 value

472 src = source end

478 src = source end

479+ {-

473 u = do

480 u = do

474 x <- src

481 x <- src

475 y <- src

482 y <- src

476 return (x + y)

483 return (x + y)

484+ -}

485+ u = src `UF.bind` \x ->

486+ src `UF.bind` \y ->

487+ UF.yield (x + y)

477 in UF.fold u FL.toList start

488 in UF.fold u FL.toList start

478

489

479{-# INLINE toListSome #-}

490{-# INLINE toListSome #-}

@@ -481,10 +492,15 @@ toListSome :: Monad m => Int -> Int -> m [Int]

481toListSome value start = do

492toListSome value start = do

482 let end = start + nthRoot 2 value

493 let end = start + nthRoot 2 value

483 src = source end

494 src = source end

495+ {-

484 u = do

496 u = do

485 x <- src

497 x <- src

486 y <- src

498 y <- src

487 return (x + y)

499 return (x + y)

500+ -}

501+ u = src `UF.bind` \x ->

502+ src `UF.bind` \y ->

503+ UF.yield (x + y)

488 in UF.fold (UF.take 1000 u) FL.toList start

504 in UF.fold (UF.take 1000 u) FL.toList start

489

505

490{-# INLINE filterAllOut #-}

506{-# INLINE filterAllOut #-}

@@ -492,13 +508,17 @@ filterAllOut :: Monad m => Int -> Int -> m ()

492filterAllOut value start = do

508filterAllOut value start = do

493 let end = start + nthRoot 2 value

509 let end = start + nthRoot 2 value

494 src = source end

510 src = source end

511+ {-

495 u = do

512 u = do

496 x <- src

513 x <- src

497 y <- src

514 y <- src

515+ -}

516+ u = src `UF.bind` \x ->

517+ src `UF.bind` \y ->

498 let s = x + y

518 let s = x + y

499− if s < 0

519+ in if s < 0

500− then return s

520+ then UF.yield s

501− else UF.nilM (return . const ())

521+ else UF.nilM (return . const ())

502 in UF.fold u FL.drain start

522 in UF.fold u FL.drain start

503

523

504{-# INLINE filterAllIn #-}

524{-# INLINE filterAllIn #-}

@@ -506,13 +526,17 @@ filterAllIn :: Monad m => Int -> Int -> m ()

506filterAllIn value start = do

526filterAllIn value start = do

507 let end = start + nthRoot 2 value

527 let end = start + nthRoot 2 value

508 src = source end

528 src = source end

529+ {-

509 u = do

530 u = do

510 x <- src

531 x <- src

511 y <- src

532 y <- src

533+ -}

534+ u = src `UF.bind` \x ->

535+ src `UF.bind` \y ->

512 let s = x + y

536 let s = x + y

513− if s > 0

537+ in if s > 0

514− then return s

538+ then UF.yield s

515− else UF.nilM (return . const ())

539+ else UF.nilM (return . const ())

516 in UF.fold u FL.drain start

540 in UF.fold u FL.drain start

517

541

518{-# INLINE filterSome #-}

542{-# INLINE filterSome #-}

@@ -520,13 +544,17 @@ filterSome :: Monad m => Int -> Int -> m ()

520filterSome value start = do

544filterSome value start = do

521 let end = start + nthRoot 2 value

545 let end = start + nthRoot 2 value

522 src = source end

546 src = source end

547+ {-

523 u = do

548 u = do

524 x <- src

549 x <- src

525 y <- src

550 y <- src

551+ -}

552+ u = src `UF.bind` \x ->

553+ src `UF.bind` \y ->

526 let s = x + y

554 let s = x + y

527− if s > 1100000

555+ in if s > 1100000

528− then return s

556+ then UF.yield s

529− else UF.nilM (return . const ())

557+ else UF.nilM (return . const ())

530 in UF.fold u FL.drain start

558 in UF.fold u FL.drain start

531

559

532{-# INLINE breakAfterSome #-}

560{-# INLINE breakAfterSome #-}

@@ -534,13 +562,17 @@ breakAfterSome :: Int -> Int -> IO ()

534breakAfterSome value start =

562breakAfterSome value start =

535 let end = start + nthRoot 2 value

563 let end = start + nthRoot 2 value

536 src = source end

564 src = source end

565+ {-

537 u = do

566 u = do

538 x <- src

567 x <- src

539 y <- src

568 y <- src

569+ -}

570+ u = src `UF.bind` \x ->

571+ src `UF.bind` \y ->

540 let s = x + y

572 let s = x + y

541− if s > 1100000

573+ in if s > 1100000

542− then error "break"

574+ then error "break"

543− else return s

575+ else UF.yield s

544 in do

576 in do

545 (_ :: Either ErrorCall ()) <- try $ UF.fold u FL.drain start

577 (_ :: Either ErrorCall ()) <- try $ UF.fold u FL.drain start

546 return ()

578 return ()

@@ -594,7 +626,6 @@ o_1_space_generation size =

594 -- Very small benchmarks, reporting in ns

626 -- Very small benchmarks, reporting in ns

595 -- , benchIO "nilM" $ nilM size

627 -- , benchIO "nilM" $ nilM size

596 , benchIO "consM" $ consM size

628 , benchIO "consM" $ consM size

597− -- , benchIO "effect" $ effect size

598 -- , benchIO "singletonM" $ singletonM size

629 -- , benchIO "singletonM" $ singletonM size

599 -- , benchIO "singleton" $ singleton size

630 -- , benchIO "singleton" $ singleton size

600 -- , benchIO "identity" $ identity size

631 -- , benchIO "identity" $ identity size

src/Streamly/Data/Unfold.hs+57−1

@@ -55,8 +55,64 @@ module Streamly.Data.Unfold

55 (

56 -- * Unfold Type

57 Unfold

58+

59+ -- * Folding

60+ , fold

61+

62+ -- * Unfolds

63+ -- One to one correspondence with

64+ -- "Streamly.Internal.Data.Stream.IsStream.Generate"

65+

66+ -- ** Generators

67+ -- | Generate a monadic stream from a seed.

68+ , unfoldrM

69+ , repeatM

70+ , replicateM

71+ , iterateM

72+

73+ -- ** From Containers

74+ , fromList

75+ , fromListM

76+ , fromStream

77+

78+ -- * Combinators

79+ -- ** Mapping on Input

80+ , lmap

81+ , lmapM

82+

83+ -- ** Mapping on Output

84+ , mapM

85+

86+ -- ** Filtering

87+ , takeWhileM

88+ , takeWhile

89+ , take

90+ , filter

91+ , filterM

92+ , drop

93+ , dropWhile

94+ , dropWhileM

95+

96+ -- ** Zipping

97+ , zipWithM

98+ , zipWith

99+

100+ -- ** Nesting

101+ , cross

102+ , many

103+

104+ -- ** Exceptions

105+ , before

106+ , after

107+ , onException

108+ , finally

109+ , bracket

110+ , handle

58 )

111 )

59where

112where

113

114+import Prelude hiding

61−import Prelude hiding (concat, map, takeWhile, take, filter, const)

115+ ( concat, map, mapM, takeWhile, take, filter, const, drop, dropWhile

116+ , zipWith

117+ )

62import Streamly.Internal.Data.Unfold

118import Streamly.Internal.Data.Unfold

src/Streamly/Internal/Data/Unfold.hs+129−89

@@ -75,65 +75,78 @@

75module Streamly.Internal.Data.Unfold

76 (

77 -- * Unfold Type

78+ Step(..)

78− Unfold

79+ , Unfold

80− -- * Operations on Input

81+ -- * Folding

81− , lmap

82− , lmapM

83− , supply

84− , supplyFirst

85− , supplySecond

86− , discardFirst

87− , discardSecond

88− , swap

89− -- coapply

90− -- comonad

91−

92− -- * Operations on Output

93 , fold

82 , fold

94 -- pipe

83 -- pipe

96 -- * Unfolds

85 -- * Unfolds

97− , fromStream

86+ -- One to one correspondence with

98− , fromStreamK

87+ -- "Streamly.Internal.Data.Stream.IsStream.Generate"

99− , fromStreamD

88+ -- ** Primitives

100− , nilM

101− , consM

102− , effect

103 , singletonM

89 , singletonM

104 , singleton

90 , singleton

105 , identity

91 , identity

106− , const

92+ , yieldM

107− , unfoldrM

93+ , yield

108−

94+ , nilM

109− , fromList

95+ , consM

110− , fromListM

111−

112− , fromSVar

113− , fromProducer

114

115− -- ** Specialized Generation

97+ -- ** Generators

116 -- | Generate a monadic stream from a seed.

98 -- | Generate a monadic stream from a seed.

117− , replicateM

99+ , unfoldrM

118 , repeatM

100 , repeatM

119− , iterateM

101+ , replicateM

120 , fromIndicesM

102 , fromIndicesM

103+ , iterateM

121

104

122 -- ** Enumerations

105 -- ** Enumerations

106+ -- *** Enumerate Num

107+ , enumerateFromStepNum

108+ , numFrom

109+

110+ -- *** Enumerate Integral

123 , enumerateFromStepIntegral

111 , enumerateFromStepIntegral

124 , enumerateFromToIntegral

112 , enumerateFromToIntegral

125 , enumerateFromIntegral

113 , enumerateFromIntegral

126

114

127− , enumerateFromStepNum

115+ -- *** Enumerate Fractional

128− , numFrom

116+ -- | Use 'Num' enumerations for fractional or floating point number

117+ -- enumerations.

129 , enumerateFromToFractional

118 , enumerateFromToFractional

130

119

131− -- * Transformations

120+ -- ** From Containers

121+ , fromList

122+ , fromListM

123+

124+ , fromStream

125+ , fromStreamK

126+ , fromStreamD

127+

128+ , fromSVar

129+ , fromProducer

130+

131+ -- * Combinators

132+ -- ** Mapping on Input

133+ , lmap

134+ , lmapM

135+ , supply

136+ , supplyFirst

137+ , supplySecond

138+ , discardFirst

139+ , discardSecond

140+ , swap

141+ -- coapply

142+ -- comonad

143+

144+ -- ** Mapping on Output

132 , map

145 , map

133 , mapM

146 , mapM

134 , mapMWithInput

147 , mapMWithInput

135

148

136− -- * Filtering

149+ -- ** Filtering

137 , takeWhileM

150 , takeWhileM

138 , takeWhile

151 , takeWhile

139 , take

152 , take

@@ -143,18 +156,21 @@ module Streamly.Internal.Data.Unfold

143 , dropWhile

156 , dropWhile

144 , dropWhileM

157 , dropWhileM

145

158

146− -- * Zipping

159+ -- ** Zipping

147 , zipWithM

160 , zipWithM

148 , zipWith

161 , zipWith

149 , teeZipWith

162 , teeZipWith

150

163

151− -- * Nesting

164+ -- ** Nesting

165+ , cross

166+ , apply

152 , ConcatState (..)

167 , ConcatState (..)

153 , many

168 , many

154 , concatMapM

169 , concatMapM

170+ , bind

155 , outerProduct

171 , outerProduct

156

172

157− -- * Exceptions

173+ -- ** Exceptions

158 , gbracket_

174 , gbracket_

159 , gbracket

175 , gbracket

160 , before

176 , before

@@ -206,7 +222,7 @@ import Prelude

206-- | Map an action on the input argument of the 'Unfold'.

222-- | Map an action on the input argument of the 'Unfold'.

207--

223--

208-- @

224-- @

209−-- lmapM f = many (singletonM f)

225+-- lmapM f = Unfold.many (Unfold.singletonM f)

210-- @

226-- @

211--

227--

212-- /Pre-release/

228-- /Pre-release/

@@ -214,47 +230,54 @@ import Prelude

214lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b

230lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b

215lmapM f (Unfold ustep uinject) = Unfold ustep (f >=> uinject)

231lmapM f (Unfold ustep uinject) = Unfold ustep (f >=> uinject)

216

232

217−-- XXX change the signature to the following?

218−-- supply :: a -> Unfold m a b -> Unfold m Void b

219−--

220-- | Supply the seed to an unfold closing the input end of the unfold.

233-- | Supply the seed to an unfold closing the input end of the unfold.

221--

234--

235+-- @

236+-- supply a = Unfold.lmap (Prelude.const a)

237+-- @

238+--

222-- /Pre-release/

239-- /Pre-release/

223--

240--

224{-# INLINE_NORMAL supply #-}

241{-# INLINE_NORMAL supply #-}

225−supply :: Unfold m a b -> a -> Unfold m Void b

242+supply :: a -> Unfold m a b -> Unfold m Void b

226−supply unf a = lmap (Prelude.const a) unf

243+supply a = lmap (Prelude.const a)

227

244

228−-- XXX change the signature to the following?

229−-- supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c

230−--

231-- | Supply the first component of the tuple to an unfold that accepts a tuple

245-- | Supply the first component of the tuple to an unfold that accepts a tuple

232-- as a seed resulting in a fold that accepts the second component of the tuple

246-- as a seed resulting in a fold that accepts the second component of the tuple

233-- as a seed.

247-- as a seed.

234--

248--

249+-- @

250+-- supplyFirst a = Unfold.lmap (a, )

251+-- @

252+--

235-- /Pre-release/

253-- /Pre-release/

236--

254--

237{-# INLINE_NORMAL supplyFirst #-}

255{-# INLINE_NORMAL supplyFirst #-}

238−supplyFirst :: Unfold m (a, b) c -> a -> Unfold m b c

256+supplyFirst :: a -> Unfold m (a, b) c -> Unfold m b c

239−supplyFirst unf a = lmap (a, ) unf

257+supplyFirst a = lmap (a, )

240

258

241−-- XXX change the signature to the following?

242−-- supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c

243−--

244-- | Supply the second component of the tuple to an unfold that accepts a tuple

259-- | Supply the second component of the tuple to an unfold that accepts a tuple

245-- as a seed resulting in a fold that accepts the first component of the tuple

260-- as a seed resulting in a fold that accepts the first component of the tuple

246-- as a seed.

261-- as a seed.

247--

262--

263+-- @

264+-- supplySecond b = Unfold.lmap (, b)

265+-- @

266+--

248-- /Pre-release/

267-- /Pre-release/

249--

268--

250{-# INLINE_NORMAL supplySecond #-}

269{-# INLINE_NORMAL supplySecond #-}

251−supplySecond :: Unfold m (a, b) c -> b -> Unfold m a c

270+supplySecond :: b -> Unfold m (a, b) c -> Unfold m a c

252−supplySecond unf b = lmap (, b) unf

271+supplySecond b = lmap (, b)

253

272

254-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,

273-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,

255-- using the argument of the original fold as the second element of tuple and

274-- using the argument of the original fold as the second element of tuple and

256-- discarding the first element of the tuple.

275-- discarding the first element of the tuple.

257--

276--

277+-- @

278+-- discardFirst = Unfold.lmap snd

279+-- @

280+--

258-- /Pre-release/

281-- /Pre-release/

259--

282--

260{-# INLINE_NORMAL discardFirst #-}

283{-# INLINE_NORMAL discardFirst #-}

@@ -265,6 +288,10 @@ discardFirst = lmap snd

265-- using the argument of the original fold as the first element of tuple and

288-- using the argument of the original fold as the first element of tuple and

266-- discarding the second element of the tuple.

289-- discarding the second element of the tuple.

267--

290--

291+-- @

292+-- discardSecond = Unfold.lmap fst

293+-- @

294+--

268-- /Pre-release/

295-- /Pre-release/

269--

296--

270{-# INLINE_NORMAL discardSecond #-}

297{-# INLINE_NORMAL discardSecond #-}

@@ -274,6 +301,10 @@ discardSecond = lmap fst

274-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold

301-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold

275-- that accepts a tuple with elements swapped.

302-- that accepts a tuple with elements swapped.

276--

303--

304+-- @

305+-- swap = Unfold.lmap Tuple.swap

306+-- @

307+--

277-- /Pre-release/

308-- /Pre-release/

278--

309--

279{-# INLINE_NORMAL swap #-}

310{-# INLINE_NORMAL swap #-}

@@ -393,7 +424,8 @@ nilM f = Unfold step return

393 {-# INLINE_LATE step #-}

424 {-# INLINE_LATE step #-}

394 step x = f x >> return Stop

425 step x = f x >> return Stop

395

426

396−-- | Prepend a monadic single element generator function to an 'Unfold'.

427+-- | Prepend a monadic single element generator function to an 'Unfold'. The

428+-- same seed is used in the action as well as the unfold.

397--

429--

398-- /Pre-release/

430-- /Pre-release/

399{-# INLINE_NORMAL consM #-}

431{-# INLINE_NORMAL consM #-}

@@ -414,17 +446,6 @@ consM action unf = Unfold step inject

414 Skip s -> return $ Skip (Right (Stream step1 s))

446 Skip s -> return $ Skip (Right (Stream step1 s))

415 Stop -> return Stop

447 Stop -> return Stop

416

448

417−-- | Lift a monadic effect into an unfold generating a singleton stream.

418−--

419−{-# INLINE effect #-}

420−effect :: Monad m => m b -> Unfold m Void b

421−effect eff = Unfold step inject

422− where

423− inject _ = return True

424− {-# INLINE_LATE step #-}

425− step True = eff >>= \r -> return $ Yield r False

426− step False = return Stop

427−

428-- | Convert a list of pure values to a 'Stream'

449-- | Convert a list of pure values to a 'Stream'

429{-# INLINE_LATE fromList #-}

450{-# INLINE_LATE fromList #-}

430fromList :: Monad m => Unfold m [a] a

451fromList :: Monad m => Unfold m [a] a

@@ -514,6 +535,10 @@ iterateM f = Unfold step id

514-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@

535-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@

515-- starting from the seed.

536-- starting from the seed.

516--

537--

538+-- @

539+-- fromIndicesM f = Unfold.mapM f $ Unfold.enumerateFrom 0

540+-- @

541+--

517-- /Pre-release/

542-- /Pre-release/

518--

543--

519{-# INLINE_NORMAL fromIndicesM #-}

544{-# INLINE_NORMAL fromIndicesM #-}

@@ -655,9 +680,37 @@ dropWhileM f (Unfold step inject) = Unfold step' inject'

655dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b

680dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b

656dropWhile f = dropWhileM (return . f)

681dropWhile f = dropWhileM (return . f)

657

682

658−-------------------------------------------------------------------------------

683+------------------------------------------------------------------------------

684+-- Enumeration of Num

685+------------------------------------------------------------------------------

686+

687+-- | Generate an infinite stream starting from a starting value with increments

688+-- of the given stride. The implementation is numerically stable for floating

689+-- point values.

690+--

691+-- Note 'enumerateFromStepIntegral' is faster for integrals.

692+--

693+-- /Pre-release/

694+--

695+{-# INLINE enumerateFromStepNum #-}

696+enumerateFromStepNum :: (Monad m, Num a) => a -> Unfold m a a

697+enumerateFromStepNum stride = Unfold step return

698+ where

699+ -- XXX This is numerically unstable.

700+ {-# INLINE_LATE step #-}

701+ step !s = return $ (Yield $! s) $! (s + stride)

702+

703+-- | @numFrom = enumerateFromStepNum 1@

704+--

705+-- /Pre-release/

706+--

707+{-# INLINE_NORMAL numFrom #-}

708+numFrom :: (Monad m, Num a) => Unfold m a a

709+numFrom = enumerateFromStepNum 1

710+

711+------------------------------------------------------------------------------

659−-- Enumeration

712+-- Enumeration of Integrals

660−-------------------------------------------------------------------------------

713+------------------------------------------------------------------------------

661

714

662-- | Can be used to enumerate unbounded integrals. This does not check for

715-- | Can be used to enumerate unbounded integrals. This does not check for

663-- overflow or underflow for bounded integrals.

716-- overflow or underflow for bounded integrals.

@@ -674,34 +727,20 @@ enumerateFromStepIntegral = Unfold step inject

674{-# INLINE enumerateFromToIntegral #-}

727{-# INLINE enumerateFromToIntegral #-}

675enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a

728enumerateFromToIntegral :: (Monad m, Integral a) => a -> Unfold m a a

676enumerateFromToIntegral to =

729enumerateFromToIntegral to =

677− takeWhile (<= to) $ supplySecond enumerateFromStepIntegral 1

730+ takeWhile (<= to) $ supplySecond 1 enumerateFromStepIntegral

678

731

679{-# INLINE enumerateFromIntegral #-}

732{-# INLINE enumerateFromIntegral #-}

680enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a

733enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => Unfold m a a

681enumerateFromIntegral = enumerateFromToIntegral maxBound

734enumerateFromIntegral = enumerateFromToIntegral maxBound

682

735

683−-- | Generate an infinite stream starting from the seed with increments of the

736+------------------------------------------------------------------------------

684−-- given stride.

737+-- Enumeration of Fractionals

685−--

738+------------------------------------------------------------------------------

686−-- /Pre-release/

687−--

688−{-# INLINE enumerateFromStepNum #-}

689−enumerateFromStepNum :: (Monad m, Num a) => a -> Unfold m a a

690−enumerateFromStepNum stride = Unfold step return

691− where

692− {-# INLINE_LATE step #-}

693− step !s = return $ (Yield $! s) $! (s + stride)

694−

695−-- | @numFrom = enumerateFromStepNum 1@

696−--

697−-- /Pre-release/

698−--

699−{-# INLINE_NORMAL numFrom #-}

700−numFrom :: (Monad m, Num a) => Unfold m a a

701−numFrom = enumerateFromStepNum 1

702

739

703-- | /Internal/

740-- | /Internal/

704--

741--

742+-- > enumerateFromToFractional to = takeWhile (<= to + 1 / 2) $ enumerateFromStepNum 1

743+--

705{-# INLINE_NORMAL enumerateFromToFractional #-}

744{-# INLINE_NORMAL enumerateFromToFractional #-}

706enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> Unfold m a a

745enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> Unfold m a a

707enumerateFromToFractional to =

746enumerateFromToFractional to =

@@ -862,6 +901,7 @@ data OuterProductState s1 s2 sy x y =

862 OuterProductOuter s1 y | OuterProductInner s1 sy s2 x

901 OuterProductOuter s1 y | OuterProductInner s1 sy s2 x

863

902

864-- XXX this can be written in terms of "cross".

903-- XXX this can be written in terms of "cross".

904+-- XXX Remove this in favor of cross?

865--

905--

866-- | Create an outer product (vector product or cartesian product) of the

906-- | Create an outer product (vector product or cartesian product) of the

867-- output streams of two unfolds.

907-- output streams of two unfolds.

src/Streamly/Internal/Data/Unfold/Type.hs+79−16

@@ -8,19 +8,31 @@

9module Streamly.Internal.Data.Unfold.Type

10 ( Unfold (..)

11+

12+ -- * From values

11 , singletonM

13 , singletonM

12 , singleton

14 , singleton

13 , identity

15 , identity

14− , ConcatState (..)

16+ , yieldM

15− , many

17+ , yield

18+

19+ -- * Transformations

16 , lmap

20 , lmap

17 , map

21 , map

18− , const

22+

23+ -- * Nesting

24+ , ConcatState (..)

25+ , many

26+

19 , apSequence

27 , apSequence

20 , apDiscardSnd

28 , apDiscardSnd

21 , cross

29 , cross

30+ , apply

31+ , bind

32+

22 , concatMapM

33 , concatMapM

23 , concatMap

34 , concatMap

35+

24 , zipWithM

36 , zipWithM

25 , zipWith

37 , zipWith

26 )

38 )

@@ -28,8 +40,8 @@ where

29#include "inline.hs"

41#include "inline.hs"

31−import Control.Arrow (Arrow(..))

43+-- import Control.Arrow (Arrow(..))

32−import Control.Category (Category(..))

44+-- import Control.Category (Category(..))

33import Fusion.Plugin.Types (Fuse(..))

45import Fusion.Plugin.Types (Fuse(..))

34import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

46import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))

@@ -60,7 +72,7 @@ data Unfold m a b =

60-- | Map a function on the input argument of the 'Unfold'.

72-- | Map a function on the input argument of the 'Unfold'.

61--

73--

62-- @

74-- @

63−-- lmap f = many (singleton f)

75+-- lmap f = Unfold.many (Unfold.singleton f)

64-- @

76-- @

65--

77--

66-- /Pre-release/

78-- /Pre-release/

@@ -93,9 +105,12 @@ instance Functor m => Functor (Unfold m a) where

93-- Applicative

105-- Applicative

94------------------------------------------------------------------------------

106------------------------------------------------------------------------------

107

108+-- | The unfold discards its input and generates a singleton stream using the

109+-- supplied monadic action.

110+--

96−{-# INLINE const #-}

111+{-# INLINE yieldM #-}

97−const :: Applicative m => m b -> Unfold m a b

112+yieldM :: Applicative m => m b -> Unfold m a b

98−const m = Unfold step inject

113+yieldM m = Unfold step inject

114

100 where

115 where

101

116

@@ -104,6 +119,10 @@ const m = Unfold step inject

104 step False = (`Yield` True) <$> m

119 step False = (`Yield` True) <$> m

105 step True = pure Stop

120 step True = pure Stop

106

121

122+-- | Discards the unfold input and always returns the argument of 'yield'.

123+yield :: Applicative m => b -> Unfold m a b

124+yield = yieldM . pure

125+

107-- | Outer product discarding the first element.

126-- | Outer product discarding the first element.

108--

127--

109-- /Unimplemented/

128-- /Unimplemented/

@@ -154,9 +173,15 @@ cross (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject

154 Skip s -> Skip (CrossInner a s1 b s)

173 Skip s -> Skip (CrossInner a s1 b s)

155 Stop -> Skip (CrossOuter a s1)

174 Stop -> Skip (CrossOuter a s1)

156

175

176+apply :: Monad m => Unfold m a (b -> c) -> Unfold m a b -> Unfold m a c

177+apply u1 u2 = fmap (\(a, b) -> a b) (cross u1 u2)

178+

179+{-

157-- | Example:

180-- | Example:

158--

181--

182+-- >>> rlist = Unfold.lmap fst Unfold.fromList

183+-- >>> llist = Unfold.lmap snd Unfold.fromList

159−-- >>> Stream.toList $ Stream.unfold ((,) <$> Unfold.lmap fst Unfold.fromList <*> Unfold.lmap snd Unfold.fromList) ([1,2],[3,4])

184+-- >>> Stream.toList $ Stream.unfold ((,) <$> rlist <*> llist) ([1,2],[3,4])

160-- [(1,3),(1,4),(2,3),(2,4)]

185-- [(1,3),(1,4),(2,3),(2,4)]

161--

186--

162instance Monad m => Applicative (Unfold m a) where

187instance Monad m => Applicative (Unfold m a) where

@@ -164,13 +189,14 @@ instance Monad m => Applicative (Unfold m a) where

164 pure = const Prelude.. return

189 pure = const Prelude.. return

165

190

166 {-# INLINE (<*>) #-}

191 {-# INLINE (<*>) #-}

167− u1 <*> u2 = fmap (\(a, b) -> a b) (cross u1 u2)

192+ (<*>) = apply

168

193

169 -- {-# INLINE (*>) #-}

194 -- {-# INLINE (*>) #-}

170 -- (*>) = apSequence

195 -- (*>) = apSequence

171

196

172 -- {-# INLINE (<*) #-}

197 -- {-# INLINE (<*) #-}

173 -- (<*) = apDiscardSnd

198 -- (<*) = apDiscardSnd

199+-}

174

200

175------------------------------------------------------------------------------

201------------------------------------------------------------------------------

176-- Monad

202-- Monad

@@ -216,15 +242,30 @@ concatMapM f (Unfold step1 inject1) = Unfold step inject

216concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c

242concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c

217concatMap f = concatMapM (return Prelude.. f)

243concatMap f = concatMapM (return Prelude.. f)

218

244

245+infixl 1 `bind`

246+

247+{-# INLINE bind #-}

248+bind :: Monad m => Unfold m a b -> (b -> Unfold m a c) -> Unfold m a c

249+bind = flip concatMap

250+

251+{-

219-- Note: concatMap and Monad instance for unfolds have performance comparable

252-- Note: concatMap and Monad instance for unfolds have performance comparable

220-- to Stream. In fact, concatMap is slower than Stream, that may be some

253-- to Stream. In fact, concatMap is slower than Stream, that may be some

221-- optimization issue though.

254-- optimization issue though.

222--

255--

256+-- Monad allows an unfold to depend on the output of a previous unfold.

257+-- However, it is probably easier to use streams in such situations.

258+--

223-- | Example:

259-- | Example:

224--

260--

225−-- >>> u = do { x <- Unfold.lmap fst Unfold.fromList; y <- Unfold.lmap snd Unfold.fromList; return (x,y); }

261+-- >>> :{

262+-- u = do

263+-- x <- Unfold.enumerateFromToIntegral 4

264+-- y <- Unfold.enumerateFromToIntegral x

265+-- return (x, y)

266+-- :}

226−-- >>> Stream.toList $ Stream.unfold u ([1,2],[3,4])

267+-- >>> Stream.toList $ Stream.unfold u 1

227−-- [(1,3),(1,4),(2,3),(2,4)]

268+-- [(1,1),(2,1),(2,2),(3,1),(3,2),(3,3),(4,1),(4,2),(4,3),(4,4)]

228--

269--

229instance Monad m => Monad (Unfold m a) where

270instance Monad m => Monad (Unfold m a) where

230 {-# INLINE return #-}

271 {-# INLINE return #-}

@@ -235,6 +276,7 @@ instance Monad m => Monad (Unfold m a) where

235

276

236 -- {-# INLINE (>>) #-}

277 -- {-# INLINE (>>) #-}

237 -- (>>) = (*>)

278 -- (>>) = (*>)

279+-}

238

280

239-------------------------------------------------------------------------------

281-------------------------------------------------------------------------------

240-- Category

282-- Category

@@ -258,6 +300,8 @@ singletonM f = Unfold step inject

258

300

259-- | Lift a pure function into an unfold generating a singleton stream.

301-- | Lift a pure function into an unfold generating a singleton stream.

260--

302--

303+-- > singleton f = singletonM $ return . f

304+--

261{-# INLINE singleton #-}

305{-# INLINE singleton #-}

262singleton :: Monad m => (a -> b) -> Unfold m a b

306singleton :: Monad m => (a -> b) -> Unfold m a b

263singleton f = singletonM $ return Prelude.. f

307singleton f = singletonM $ return Prelude.. f

@@ -265,11 +309,11 @@ singleton f = singletonM $ return Prelude.. f

265-- | Identity unfold. Generates a singleton stream with the seed as the only

309-- | Identity unfold. Generates a singleton stream with the seed as the only

266-- element in the stream.

310-- element in the stream.

267--

311--

268−-- > identity = singletonM return

312+-- > identity = singleton Prelude.id

269--

313--

270{-# INLINE identity #-}

314{-# INLINE identity #-}

271identity :: Monad m => Unfold m a a

315identity :: Monad m => Unfold m a a

272−identity = singletonM return

316+identity = singleton Prelude.id

273

317

274{-# ANN type ConcatState Fuse #-}

318{-# ANN type ConcatState Fuse #-}

275data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2

319data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2

@@ -306,17 +350,25 @@ many (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject

306 Skip s -> Skip (ConcatInner ost s)

350 Skip s -> Skip (ConcatInner ost s)

307 Stop -> Skip (ConcatOuter ost)

351 Stop -> Skip (ConcatOuter ost)

308

352

353+{-

354+-- XXX There are multiple possible ways to combine the unfolds, "many" appends

355+-- them, we could also have other variants of "many" e.g. manyInterleave.

356+-- Should we even have a category instance or just use these functions

357+-- directly?

358+--

309instance Monad m => Category (Unfold m) where

359instance Monad m => Category (Unfold m) where

310 {-# INLINE id #-}

360 {-# INLINE id #-}

311 id = identity

361 id = identity

312

362

313 {-# INLINE (.) #-}

363 {-# INLINE (.) #-}

314 (.) = flip many

364 (.) = flip many

365+-}

315

366

316-------------------------------------------------------------------------------

367-------------------------------------------------------------------------------

317-- Arrow

368-- Arrow

318-------------------------------------------------------------------------------

369-------------------------------------------------------------------------------

319

370

371+-- | Stops as soon as any of the unfolds stops.

320{-# INLINE_NORMAL zipWithM #-}

372{-# INLINE_NORMAL zipWithM #-}

321zipWithM :: Monad m

373zipWithM :: Monad m

322 => (a -> b -> m c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c

374 => (a -> b -> m c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c

@@ -364,6 +416,16 @@ zipWith :: Monad m

364 => (a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c

416 => (a -> b -> c) -> Unfold m x a -> Unfold m y b -> Unfold m (x, y) c

365zipWith f = zipWithM (\a b -> return (f a b))

417zipWith f = zipWithM (\a b -> return (f a b))

366

418

419+{-

420+-- XXX There are multiple ways of combining the outputs of two unfolds, we

421+-- could zip, merge, append and more. What is the preferred way for Arrow

422+-- instance? Should we even have an arrow instance or just use these functions

423+-- directly?

424+--

425+-- | '***' is a zip like operation, in fact it is the same as @Unfold.zipWith

426+-- (,)@, '&&&' is a tee like operation i.e. distributes the input to both the

427+-- unfolds and then zips the output.

428+--

367{-# ANN module "HLint: ignore Use zip" #-}

429{-# ANN module "HLint: ignore Use zip" #-}

368instance Monad m => Arrow (Unfold m) where

430instance Monad m => Arrow (Unfold m) where

369 {-# INLINE arr #-}

431 {-# INLINE arr #-}

@@ -371,3 +433,4 @@ instance Monad m => Arrow (Unfold m) where

371

433

372 {-# INLINE (***) #-}

434 {-# INLINE (***) #-}

373 (***) = zipWith (,)

435 (***) = zipWith (,)

436+-}

src/Streamly/Internal/FileSystem/Handle.hs+2−2

@@ -262,7 +262,7 @@ getBytes = toBytes stdin

262-- @since 0.7.0

263{-# INLINE readChunks #-}

264readChunks :: MonadIO m => Unfold m Handle (Array Word8)

265−readChunks = UF.supplyFirst readChunksWithBufferOf defaultChunkSize

265+readChunks = UF.supplyFirst defaultChunkSize readChunksWithBufferOf

266

267-------------------------------------------------------------------------------

268-- Read File to Stream

@@ -299,7 +299,7 @@ toBytesWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h

299-- @since 0.7.0

300{-# INLINE read #-}

301read :: MonadIO m => Unfold m Handle Word8

302−read = UF.supplyFirst readWithBufferOf defaultChunkSize

302+read = UF.supplyFirst defaultChunkSize readWithBufferOf

303

304-- | Generate a byte stream from a file 'Handle'.

305--

src/Streamly/Internal/Network/Inet/TCP.hs+3−3

@@ -161,7 +161,7 @@ acceptOnAddr = acceptOnAddrWith []

161acceptOnPortWith :: MonadIO m

162 => [(SocketOption, Int)]

163 -> Unfold m PortNumber Socket

164−acceptOnPortWith opts = UF.supplyFirst (acceptOnAddrWith opts) (0,0,0,0)

164+acceptOnPortWith opts = UF.supplyFirst (0,0,0,0) (acceptOnAddrWith opts)

165

166-- | Like 'acceptOnAddr' but binds on the IPv4 address @0.0.0.0@ i.e. on all

167-- IPv4 addresses/interfaces of the machine and listens for TCP connections on

@@ -172,7 +172,7 @@ acceptOnPortWith opts = UF.supplyFirst (acceptOnAddrWith opts) (0,0,0,0)

172-- @since 0.7.0

173{-# INLINE acceptOnPort #-}

174acceptOnPort :: MonadIO m => Unfold m PortNumber Socket

175−acceptOnPort = UF.supplyFirst acceptOnAddr (0,0,0,0)

175+acceptOnPort = UF.supplyFirst (0,0,0,0) acceptOnAddr

176

177-- | Like 'acceptOnAddr' but binds on the localhost IPv4 address @127.0.0.1@.

178-- The server can only be accessed from the local host, it cannot be accessed

@@ -183,7 +183,7 @@ acceptOnPort = UF.supplyFirst acceptOnAddr (0,0,0,0)

183-- @since 0.7.0

184{-# INLINE acceptOnPortLocal #-}

185acceptOnPortLocal :: MonadIO m => Unfold m PortNumber Socket

186−acceptOnPortLocal = UF.supplyFirst acceptOnAddr (127,0,0,1)

186+acceptOnPortLocal = UF.supplyFirst (127,0,0,1) acceptOnAddr

187

188-------------------------------------------------------------------------------

189-- Accept (streams)

src/Streamly/Internal/Network/Socket.hs+2−2

@@ -387,7 +387,7 @@ readChunksWithBufferOf = Unfold step return

387-- @since 0.7.0

388{-# INLINE readChunks #-}

389readChunks :: MonadIO m => Unfold m Socket (Array Word8)

390−readChunks = UF.supplyFirst readChunksWithBufferOf A.defaultChunkSize

390+readChunks = UF.supplyFirst A.defaultChunkSize readChunksWithBufferOf

391

392-------------------------------------------------------------------------------

393-- Read File to Stream

@@ -434,7 +434,7 @@ readWithBufferOf = UF.many readChunksWithBufferOf A.read

434-- @since 0.7.0

435{-# INLINE read #-}

436read :: MonadIO m => Unfold m Socket Word8

437−read = UF.supplyFirst readWithBufferOf A.defaultChunkSize

437+read = UF.supplyFirst A.defaultChunkSize readWithBufferOf

438

439-------------------------------------------------------------------------------

440-- Writing

test/Streamly/Test/Data/Unfold.hs+4−10

@@ -72,17 +72,17 @@ lmapM =

73supply :: Bool

74supply =

75− let unf = UF.supply (UF.singleton id) 1

75+ let unf = UF.supply 1 (UF.singleton id)

76 in testUnfold unf undefined ([1] :: [Int])

78supplyFirst :: Bool

79supplyFirst =

80− let unf = UF.supplyFirst (UF.singleton id) 1

80+ let unf = UF.supplyFirst 1 (UF.singleton id)

81 in testUnfold unf 2 ([(1, 2)] :: [(Int, Int)])

83supplySecond :: Bool

84supplySecond =

85− let unf = UF.supplySecond (UF.singleton id) 1

85+ let unf = UF.supplySecond 1 (UF.singleton id)

86 in testUnfold unf 2 ([(2, 1)] :: [(Int, Int)])

88discardFirst :: Bool

@@ -134,11 +134,6 @@ consM =

134 unf = cns $ cns $ UF.nilM $ \a -> modify (+ a)

135 in testUnfoldMD unf 1 0 3 [1, 2]

136

137−effect :: Bool

138−effect =

139− let unf = UF.effect (modify (+ 1) >> get)

140− in testUnfoldMD unf undefined 0 1 [1]

141−

142singletonM :: Bool

137singletonM :: Bool

143singletonM =

138singletonM =

144 let unf = UF.singletonM (\a -> modify (+ a) >> get)

139 let unf = UF.singletonM (\a -> modify (+ a) >> get)

@@ -146,7 +141,7 @@ singletonM =

146

141

147const :: Bool

142const :: Bool

148const =

143const =

149− let unf = UF.const (modify (+ 1) >> get)

144+ let unf = UF.yieldM (modify (+ 1) >> get)

150 in testUnfoldMD unf (0 :: Int) 0 1 [1]

145 in testUnfoldMD unf (0 :: Int) 0 1 [1]

151

146

152unfoldrM :: Property

147unfoldrM :: Property

@@ -380,7 +375,6 @@ testGeneration =

380 prop "fromStreamD" fromStreamD

375 prop "fromStreamD" fromStreamD

381 prop "nilM" nilM

376 prop "nilM" nilM

382 prop "consM" consM

377 prop "consM" consM

383− prop "effect" effect

384 prop "singletonM" singletonM

378 prop "singletonM" singletonM

385 -- prop "singleton" singleton

379 -- prop "singleton" singleton

386 -- prop "identity" identity

380 -- prop "identity" identity

test/Streamly/Test/Prelude/Serial.hs+1−1

@@ -457,7 +457,7 @@ unfold0 :: Property

457unfold0 = monadicIO $ do

458 a <- pick $ choose (0, max_length `div` 2)

459 b <- pick $ choose (0, max_length)

460− let unf = UF.supply (UF.enumerateFromToIntegral b) a

460+ let unf = UF.supply a (UF.enumerateFromToIntegral b)

461 ls <- S.toList $ IS.unfold0 unf

462 return $ ls == [a..b]

463

test/lib/Streamly/Test/Prelude/Common.hs+1−1

@@ -1202,7 +1202,7 @@ transformCombineOpsCommon constr desc eq t = do

1202 forAll (choose (0, 100)) $ \n ->

1203 transform (concatMap (const [1..n]))

1204 t (S.unfoldMany (UF.lmap (const undefined)

1205− $ UF.supply UF.fromList [1..n]))

1205+ $ UF.supply [1..n] UF.fromList))

1206

1207toListFL :: Monad m => FL.Fold m a [a]

1208toListFL = FL.toList