src/Streamly/Benchmark/Prelude.hs · streamly

git.iko.soy/streamly

on cc2229e help sign in

streamly/src/Streamly/Benchmark/Prelude.hs

889 lines 28 kB history raw

1-- |

2-- Module : Streamly.Benchmark.Prelude

4--

5-- License : MIT

6-- Maintainer : harendra.kumar@gmail.com

8{-# LANGUAGE CPP #-}

9{-# LANGUAGE FlexibleContexts #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE DeriveAnyClass #-}

12{-# LANGUAGE DeriveGeneric #-}

14#ifdef __HADDOCK_VERSION__

15#undef INSPECTION

16#endif

18#ifdef INSPECTION

19{-# LANGUAGE TemplateHaskell #-}

20{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}

21#endif

23module Streamly.Benchmark.Prelude where

25import Control.DeepSeq (NFData)

26import Control.Monad (when)

27import Control.Monad.IO.Class (MonadIO)

28import Data.Functor.Identity (Identity, runIdentity)

29import Data.Maybe (fromJust)

30import GHC.Generics (Generic)

31import Prelude

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

33 subtract, undefined, Maybe(..), odd, Bool, not, (>>=), mapM_, curry,

34 maxBound, div, IO, compare, Double, fromIntegral, Integer, (<$>),

35 (<*>), flip, (**), (/))

36import qualified Prelude as P

37import qualified Data.Foldable as F

38import qualified GHC.Exts as GHC

40#ifdef INSPECTION

41import Test.Inspection

43import qualified Streamly.Streams.StreamD as D

44#endif

46import qualified Streamly as S hiding (foldMapWith, runStream)

47import qualified Streamly.Prelude as S

48import qualified Streamly.Internal.Prelude as Internal

49import qualified Streamly.Internal.Data.Unfold as UF

50import qualified Streamly.Internal.Data.Pipe as Pipe

52value, maxValue, value2 :: Int

53#ifdef LINEAR_ASYNC

54value = 10000

55#else

56value = 100000

57#endif

58maxValue = value + 1

59value2 = P.round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop

61-------------------------------------------------------------------------------

62-- Benchmark ops

63-------------------------------------------------------------------------------

65-------------------------------------------------------------------------------

66-- Stream generation and elimination

67-------------------------------------------------------------------------------

69type Stream m a = S.SerialT m a

71{-# INLINE source #-}

72source :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int

73source n = sourceUnfoldrM n

75{-# INLINE sourceIntFromTo #-}

76sourceIntFromTo :: (Monad m, S.IsStream t) => Int -> t m Int

77sourceIntFromTo n = S.enumerateFromTo n (n + value)

79{-# INLINE sourceIntFromThenTo #-}

80sourceIntFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Int

81sourceIntFromThenTo n = S.enumerateFromThenTo n (n + 1) (n + value)

83{-# INLINE sourceFracFromTo #-}

84sourceFracFromTo :: (Monad m, S.IsStream t) => Int -> t m Double

85sourceFracFromTo n =

86 S.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))

88{-# INLINE sourceFracFromThenTo #-}

89sourceFracFromThenTo :: (Monad m, S.IsStream t) => Int -> t m Double

90sourceFracFromThenTo n = S.enumerateFromThenTo (fromIntegral n)

91 (fromIntegral n + 1.0001) (fromIntegral (n + value))

93{-# INLINE sourceIntegerFromStep #-}

94sourceIntegerFromStep :: (Monad m, S.IsStream t) => Int -> t m Integer

95sourceIntegerFromStep n =

96 S.take value $ S.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)

98{-# INLINE sourceFromList #-}

99sourceFromList :: (Monad m, S.IsStream t) => Int -> t m Int

100sourceFromList n = S.fromList [n..n+value]

101

102{-# INLINE sourceFromListM #-}

103sourceFromListM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int

104sourceFromListM n = S.fromListM (Prelude.fmap return [n..n+value])

105

106{-# INLINE sourceFromIndices #-}

107sourceFromIndices :: (Monad m, S.IsStream t) => Int -> t m Int

108sourceFromIndices n = S.take value $ S.fromIndices (+ n)

109

110{-# INLINE sourceFromIndicesM #-}

111sourceFromIndicesM :: (S.MonadAsync m, S.IsStream t) => Int -> t m Int

112sourceFromIndicesM n = S.take value $ S.fromIndicesM (Prelude.fmap return (+ n))

113

114{-# INLINE sourceFromFoldable #-}

115sourceFromFoldable :: S.IsStream t => Int -> t m Int

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

117

118{-# INLINE sourceFromFoldableM #-}

119sourceFromFoldableM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

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

121

122{-# INLINE sourceFoldMapWith #-}

123sourceFoldMapWith :: (S.IsStream t, S.Semigroup (t m Int))

124 => Int -> t m Int

125sourceFoldMapWith n = S.foldMapWith (S.<>) S.yield [n..n+value]

126

127{-# INLINE sourceFoldMapWithM #-}

128sourceFoldMapWithM :: (S.IsStream t, Monad m, S.Semigroup (t m Int))

129 => Int -> t m Int

130sourceFoldMapWithM n = S.foldMapWith (S.<>) (S.yieldM . return) [n..n+value]

131

132{-# INLINE sourceFoldMapM #-}

133sourceFoldMapM :: (S.IsStream t, Monad m, P.Monoid (t m Int))

134 => Int -> t m Int

135sourceFoldMapM n = F.foldMap (S.yieldM . return) [n..n+value]

136

137{-# INLINE sourceConcatMapId #-}

138sourceConcatMapId :: (S.IsStream t, Monad m)

139 => Int -> t m Int

140sourceConcatMapId n =

141 S.concatMap P.id $ S.fromFoldable $ P.map (S.yieldM . return) [n..n+value]

142

143{-# INLINE sourceUnfoldr #-}

144sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> t m Int

145sourceUnfoldr n = S.unfoldr step n

146 where

147 step cnt =

148 if cnt > n + value

149 then Nothing

150 else Just (cnt, cnt + 1)

151

152{-# INLINE sourceUnfoldrN #-}

153sourceUnfoldrN :: (Monad m, S.IsStream t) => Int -> Int -> t m Int

154sourceUnfoldrN upto start = S.unfoldr step start

155 where

156 step cnt =

157 if cnt > start + upto

158 then Nothing

159 else Just (cnt, cnt + 1)

160

161{-# INLINE sourceUnfoldrM #-}

162sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> t m Int

163sourceUnfoldrM n = S.unfoldrM step n

164 where

165 step cnt =

166 if cnt > n + value

167 then return Nothing

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

169

170{-# INLINE sourceUnfoldrMN #-}

171sourceUnfoldrMN :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int

172sourceUnfoldrMN upto start = S.unfoldrM step start

173 where

174 step cnt =

175 if cnt > start + upto

176 then return Nothing

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

178

179{-# INLINE sourceUnfoldrMAction #-}

180sourceUnfoldrMAction :: (S.IsStream t, S.MonadAsync m) => Int -> t m (m Int)

181sourceUnfoldrMAction n = S.serially $ S.unfoldrM step n

182 where

183 step cnt =

184 if cnt > n + value

185 then return Nothing

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

187

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

189-- Pure stream generation

190-------------------------------------------------------------------------------

191

192{-# INLINE sourceIsList #-}

193sourceIsList :: Int -> S.SerialT Identity Int

194sourceIsList n = GHC.fromList [n..n+value]

195

196{-# INLINE sourceIsString #-}

197sourceIsString :: Int -> S.SerialT Identity P.Char

198sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')

199

200-------------------------------------------------------------------------------

201-- Elimination

202-------------------------------------------------------------------------------

203

204{-# INLINE runStream #-}

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

206runStream = S.drain

207

208{-# INLINE toList #-}

209toList :: Monad m => Stream m Int -> m [Int]

210

211{-# INLINE head #-}

212{-# INLINE last #-}

213{-# INLINE maximum #-}

214{-# INLINE minimum #-}

215{-# INLINE find #-}

216{-# INLINE findIndex #-}

217{-# INLINE elemIndex #-}

218{-# INLINE foldl1'Reduce #-}

219head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce

220 :: Monad m => Stream m Int -> m (Maybe Int)

221

222{-# INLINE minimumBy #-}

223{-# INLINE maximumBy #-}

224minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)

225

226{-# INLINE foldl'Reduce #-}

227{-# INLINE foldl'ReduceMap #-}

228{-# INLINE foldlM'Reduce #-}

229{-# INLINE foldrMReduce #-}

230{-# INLINE length #-}

231{-# INLINE sum #-}

232{-# INLINE product #-}

233foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product

234 :: Monad m

235 => Stream m Int -> m Int

236

237{-# INLINE foldl'Build #-}

238{-# INLINE foldlM'Build #-}

239{-# INLINE foldrMBuild #-}

240foldrMBuild, foldl'Build, foldlM'Build

241 :: Monad m

242 => Stream m Int -> m [Int]

243

244{-# INLINE all #-}

245{-# INLINE any #-}

246{-# INLINE and #-}

247{-# INLINE or #-}

248{-# INLINE null #-}

249{-# INLINE elem #-}

250{-# INLINE notElem #-}

251null, elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool

252

253{-# INLINE toNull #-}

254toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()

255toNull t = runStream . t

256

257{-# INLINE uncons #-}

258uncons :: Monad m => Stream m Int -> m ()

259uncons s = do

260 r <- S.uncons s

261 case r of

262 Nothing -> return ()

263 Just (_, t) -> uncons t

264

265{-# INLINE init #-}

266init :: Monad m => Stream m a -> m ()

267init s = S.init s >>= Prelude.mapM_ S.drain

268

269{-# INLINE tail #-}

270tail :: Monad m => Stream m a -> m ()

271tail s = S.tail s >>= Prelude.mapM_ tail

272

273{-# INLINE nullHeadTail #-}

274nullHeadTail :: Monad m => Stream m Int -> m ()

275nullHeadTail s = do

276 r <- S.null s

277 when (not r) $ do

278 _ <- S.head s

279 S.tail s >>= Prelude.mapM_ nullHeadTail

280

281{-# INLINE mapM_ #-}

282mapM_ :: Monad m => Stream m Int -> m ()

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

284

285toList = S.toList

286

287{-# INLINE toListRev #-}

288toListRev :: Monad m => Stream m Int -> m [Int]

289toListRev = Internal.toListRev

290

291foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])

292foldl'Build = S.foldl' (flip (:)) []

293foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []

294

295foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)

296foldl'Reduce = S.foldl' (+) 0

297foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0

298foldl1'Reduce = S.foldl1' (+)

299foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0

300

301last = S.last

302null = S.null

303head = S.head

304elem = S.elem maxValue

305notElem = S.notElem maxValue

306length = S.length

307all = S.all (<= maxValue)

308any = S.any (> maxValue)

309and = S.and . S.map (<= maxValue)

310or = S.or . S.map (> maxValue)

311find = S.find (== maxValue)

312findIndex = S.findIndex (== maxValue)

313elemIndex = S.elemIndex maxValue

314maximum = S.maximum

315minimum = S.minimum

316sum = S.sum

317product = S.product

318minimumBy = S.minimumBy compare

319maximumBy = S.maximumBy compare

320

321-------------------------------------------------------------------------------

322-- Transformation

323-------------------------------------------------------------------------------

324

325{-# INLINE transform #-}

326transform :: Monad m => Stream m a -> m ()

327transform = runStream

328

329{-# INLINE composeN #-}

330composeN

331 :: MonadIO m

332 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()

333composeN n f =

334 case n of

335 1 -> transform . f

336 2 -> transform . f . f

337 3 -> transform . f . f . f

338 4 -> transform . f . f . f . f

339 _ -> undefined

340

341-- polymorphic stream version of composeN

342{-# INLINE composeN' #-}

343composeN'

344 :: (S.IsStream t, Monad m)

345 => Int -> (t m Int -> Stream m Int) -> t m Int -> m ()

346composeN' n f =

347 case n of

348 1 -> transform . f

349 2 -> transform . f . S.adapt . f

350 3 -> transform . f . S.adapt . f . S.adapt . f

351 4 -> transform . f . S.adapt . f . S.adapt . f . S.adapt . f

352 _ -> undefined

353

354{-# INLINE scan #-}

355{-# INLINE scanl1' #-}

356{-# INLINE map #-}

357{-# INLINE fmap #-}

358{-# INLINE mapMaybe #-}

359{-# INLINE filterEven #-}

360{-# INLINE filterAllOut #-}

361{-# INLINE filterAllIn #-}

362{-# INLINE takeOne #-}

363{-# INLINE takeAll #-}

364{-# INLINE takeWhileTrue #-}

365{-# INLINE takeWhileMTrue #-}

366{-# INLINE dropOne #-}

367{-# INLINE dropAll #-}

368{-# INLINE dropWhileTrue #-}

369{-# INLINE dropWhileMTrue #-}

370{-# INLINE dropWhileFalse #-}

371{-# INLINE findIndices #-}

372{-# INLINE elemIndices #-}

373{-# INLINE insertBy #-}

374{-# INLINE deleteBy #-}

375{-# INLINE reverse #-}

376{-# INLINE reverse' #-}

377{-# INLINE foldrS #-}

378{-# INLINE foldrSMap #-}

379{-# INLINE foldrT #-}

380{-# INLINE foldrTMap #-}

381scan, scanl1', map, fmap, mapMaybe, filterEven, filterAllOut,

382 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

383 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

384 findIndices, elemIndices, insertBy, deleteBy, reverse, reverse',

385 foldrS, foldrSMap, foldrT, foldrTMap

386 :: MonadIO m

387 => Int -> Stream m Int -> m ()

388

389{-# INLINE mapMaybeM #-}

390{-# INLINE intersperse #-}

391mapMaybeM, intersperse :: S.MonadAsync m => Int -> Stream m Int -> m ()

392

393{-# INLINE mapM #-}

394{-# INLINE map' #-}

395{-# INLINE fmap' #-}

396mapM, map' :: (S.IsStream t, S.MonadAsync m)

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

398

399fmap' :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))

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

401

402{-# INLINE sequence #-}

403sequence :: (S.IsStream t, S.MonadAsync m)

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

405

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

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

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

409fmap' t n = composeN' n $ t . Prelude.fmap (+1)

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

411map' t n = composeN' n $ t . S.map (+1)

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

413

414{-# INLINE transformMapM #-}

415{-# INLINE transformComposeMapM #-}

416{-# INLINE transformTeeMapM #-}

417{-# INLINE transformZipMapM #-}

418

419transformMapM, transformComposeMapM, transformTeeMapM,

420 transformZipMapM :: (S.IsStream t, S.MonadAsync m)

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

422

423transformMapM t n = composeN' n $ t . Internal.transform (Pipe.mapM return)

424transformComposeMapM t n = composeN' n $ t . Internal.transform

425 (Pipe.mapM (\x -> return (x + 1))

426 `Pipe.compose` Pipe.mapM (\x -> return (x + 2)))

427transformTeeMapM t n = composeN' n $ t . Internal.transform

428 (Pipe.mapM (\x -> return (x + 1))

429 `Pipe.tee` Pipe.mapM (\x -> return (x + 2)))

430transformZipMapM t n = composeN' n $ t . Internal.transform

431 (Pipe.zipWith (+) (Pipe.mapM (\x -> return (x + 1)))

432 (Pipe.mapM (\x -> return (x + 2))))

433

434mapMaybe n = composeN n $ S.mapMaybe

435 (\x -> if Prelude.odd x then Nothing else Just x)

436mapMaybeM n = composeN n $ S.mapMaybeM

437 (\x -> if Prelude.odd x then return Nothing else return $ Just x)

438sequence t = transform . t . S.sequence

439filterEven n = composeN n $ S.filter even

440filterAllOut n = composeN n $ S.filter (> maxValue)

441filterAllIn n = composeN n $ S.filter (<= maxValue)

442takeOne n = composeN n $ S.take 1

443takeAll n = composeN n $ S.take maxValue

444takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)

445takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))

446dropOne n = composeN n $ S.drop 1

447dropAll n = composeN n $ S.drop maxValue

448dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)

449dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))

450dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)

451findIndices n = composeN n $ S.findIndices (== maxValue)

452elemIndices n = composeN n $ S.elemIndices maxValue

453intersperse n = composeN n $ S.intersperse maxValue

454insertBy n = composeN n $ S.insertBy compare maxValue

455deleteBy n = composeN n $ S.deleteBy (>=) maxValue

456reverse n = composeN n $ S.reverse

457reverse' n = composeN n $ Internal.reverse'

458foldrS n = composeN n $ Internal.foldrS S.cons S.nil

459foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil

460foldrT n = composeN n $ Internal.foldrT S.cons S.nil

461foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil

462

463-------------------------------------------------------------------------------

464-- Iteration

465-------------------------------------------------------------------------------

466

467iterStreamLen, maxIters :: Int

468iterStreamLen = 10

469maxIters = 10000

470

471{-# INLINE iterateSource #-}

472iterateSource

473 :: S.MonadAsync m

474 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int

475iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)

476 where

477 f (0 :: Int) m = g m

478 f x m = g (f (x P.- 1) m)

479

480{-# INLINE iterateMapM #-}

481{-# INLINE iterateScan #-}

482{-# INLINE iterateScanl1 #-}

483{-# INLINE iterateFilterEven #-}

484{-# INLINE iterateTakeAll #-}

485{-# INLINE iterateDropOne #-}

486{-# INLINE iterateDropWhileFalse #-}

487{-# INLINE iterateDropWhileTrue #-}

488iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

489 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

490 :: S.MonadAsync m

491 => Int -> Stream m Int

492

493-- this is quadratic

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

495-- so is this

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

497

498iterateMapM = iterateSource (S.mapM return) maxIters

499iterateFilterEven = iterateSource (S.filter even) maxIters

500iterateTakeAll = iterateSource (S.take maxValue) maxIters

501iterateDropOne = iterateSource (S.drop 1) maxIters

502iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters

503iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters

504

505-------------------------------------------------------------------------------

506-- Zipping and concat

507-------------------------------------------------------------------------------

508

509{-# INLINE zip #-}

510zip :: Int -> Int -> IO ()

511zip count n =

512 S.drain $ S.zipWith (,)

513 (sourceUnfoldrMN count n)

514 (sourceUnfoldrMN count (n + 1))

515

516#ifdef INSPECTION

517inspect $ hasNoTypeClasses 'zip

518inspect $ 'zip `hasNoType` ''D.Step

519#endif

520

521{-# INLINE zipM #-}

522zipM :: Int -> Int -> IO ()

523zipM count n =

524 S.drain $ S.zipWithM (curry return)

525 (sourceUnfoldrMN count n)

526 (sourceUnfoldrMN count (n + 1))

527

528#ifdef INSPECTION

529inspect $ hasNoTypeClasses 'zipM

530inspect $ 'zipM `hasNoType` ''D.Step

531#endif

532

533{-# INLINE mergeBy #-}

534mergeBy :: Int -> Int -> IO ()

535mergeBy count n =

536 S.drain $ S.mergeBy P.compare

537 (sourceUnfoldrMN count n)

538 (sourceUnfoldrMN count (n + 1))

539

540#ifdef INSPECTION

541inspect $ hasNoTypeClasses 'mergeBy

542inspect $ 'mergeBy `hasNoType` ''D.Step

543#endif

544

545{-# INLINE serial2 #-}

546serial2 :: Int -> Int -> IO ()

547serial2 count n =

548 S.drain $ S.serial

549 (sourceUnfoldrMN count n)

550 (sourceUnfoldrMN count (n + 1))

551

552{-# INLINE serial4 #-}

553serial4 :: Int -> Int -> IO ()

554serial4 count n =

555 S.drain $ S.serial

556 ((S.serial (sourceUnfoldrMN count n)

557 (sourceUnfoldrMN count (n + 1))))

558 ((S.serial (sourceUnfoldrMN count (n+2))

559 (sourceUnfoldrMN count (n + 3))))

560

561{-# INLINE append2 #-}

562append2 :: Int -> Int -> IO ()

563append2 count n =

564 S.drain $ Internal.append

565 (sourceUnfoldrMN count n)

566 (sourceUnfoldrMN count (n + 1))

567

568{-# INLINE append4 #-}

569append4 :: Int -> Int -> IO ()

570append4 count n =

571 S.drain $ Internal.append

572 ((Internal.append (sourceUnfoldrMN count n)

573 (sourceUnfoldrMN count (n + 1))))

574 ((Internal.append (sourceUnfoldrMN count (n+2))

575 (sourceUnfoldrMN count (n + 3))))

576

577#ifdef INSPECTION

578inspect $ hasNoTypeClasses 'append2

579inspect $ 'append2 `hasNoType` ''D.AppendState

580#endif

581

582{-# INLINE wSerial2 #-}

583wSerial2 :: Int -> IO ()

584wSerial2 n = S.drain $ S.wSerial

585 (sourceUnfoldrMN (value `div` 2) n)

586 (sourceUnfoldrMN (value `div` 2) (n + 1))

587

588{-# INLINE interleave2 #-}

589interleave2 :: Int -> IO ()

590interleave2 n = S.drain $ Internal.interleave

591 (sourceUnfoldrMN (value `div` 2) n)

592 (sourceUnfoldrMN (value `div` 2) (n + 1))

593

594#ifdef INSPECTION

595inspect $ hasNoTypeClasses 'interleave2

596inspect $ 'interleave2 `hasNoType` ''D.InterleaveState

597#endif

598

599{-# INLINE roundRobin2 #-}

600roundRobin2 :: Int -> IO ()

601roundRobin2 n = S.drain $ Internal.roundrobin

602 (sourceUnfoldrMN (value `div` 2) n)

603 (sourceUnfoldrMN (value `div` 2) (n + 1))

604

605#ifdef INSPECTION

606inspect $ hasNoTypeClasses 'roundRobin2

607inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState

608#endif

609

610{-# INLINE isPrefixOf #-}

611{-# INLINE isSubsequenceOf #-}

612isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool

613

614isPrefixOf src = S.isPrefixOf src src

615isSubsequenceOf src = S.isSubsequenceOf src src

616

617{-# INLINE stripPrefix #-}

618stripPrefix :: Monad m => Stream m Int -> m ()

619stripPrefix src = do

620 _ <- S.stripPrefix src src

621 return ()

622

623{-# INLINE zipAsync #-}

624{-# INLINE zipAsyncM #-}

625{-# INLINE zipAsyncAp #-}

626zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()

627

628zipAsync src = do

629 r <- S.tail src

630 let src1 = fromJust r

631 transform (S.zipAsyncWith (,) src src1)

632

633zipAsyncM src = do

634 r <- S.tail src

635 let src1 = fromJust r

636 transform (S.zipAsyncWithM (curry return) src src1)

637

638zipAsyncAp src = do

639 r <- S.tail src

640 let src1 = fromJust r

641 transform (S.zipAsyncly $ (,) <$> S.serially src

642 <*> S.serially src1)

643

644{-# INLINE eqBy' #-}

645eqBy' :: (Monad m, P.Eq a) => Stream m a -> m P.Bool

646eqBy' src = S.eqBy (==) src src

647

648{-# INLINE eqBy #-}

649eqBy :: Int -> IO Bool

650eqBy n = eqBy' (source n)

651

652#ifdef INSPECTION

653inspect $ hasNoTypeClasses 'eqBy

654inspect $ 'eqBy `hasNoType` ''D.Step

655#endif

656

657

658{-# INLINE eqByPure #-}

659eqByPure :: Int -> Identity Bool

660eqByPure n = eqBy' (sourceUnfoldr n)

661

662#ifdef INSPECTION

663inspect $ hasNoTypeClasses 'eqByPure

664inspect $ 'eqByPure `hasNoType` ''D.Step

665#endif

666

667{-# INLINE cmpBy' #-}

668cmpBy' :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering

669cmpBy' src = S.cmpBy P.compare src src

670

671{-# INLINE cmpBy #-}

672cmpBy :: Int -> IO P.Ordering

673cmpBy n = cmpBy' (source n)

674

675#ifdef INSPECTION

676inspect $ hasNoTypeClasses 'cmpBy

677inspect $ 'cmpBy `hasNoType` ''D.Step

678#endif

679

680{-# INLINE cmpByPure #-}

681cmpByPure :: Int -> Identity P.Ordering

682cmpByPure n = cmpBy' (sourceUnfoldr n)

683

684#ifdef INSPECTION

685inspect $ hasNoTypeClasses 'cmpByPure

686inspect $ 'cmpByPure `hasNoType` ''D.Step

687#endif

688

689{-# INLINE concatMap #-}

690concatMap :: Int -> Int -> Int -> IO ()

691concatMap outer inner n =

692 S.drain $ S.concatMap

693 (\_ -> sourceUnfoldrMN inner n)

694 (sourceUnfoldrMN outer n)

695

696#ifdef INSPECTION

697inspect $ hasNoTypeClasses 'concatMap

698#endif

699

700{-# INLINE concatMapPure #-}

701concatMapPure :: Int -> Int -> Int -> IO ()

702concatMapPure outer inner n =

703 S.drain $ S.concatMap

704 (\_ -> sourceUnfoldrN inner n)

705 (sourceUnfoldrN outer n)

706

707#ifdef INSPECTION

708inspect $ hasNoTypeClasses 'concatMapPure

709#endif

710

711{-# INLINE concatMapRepl4xN #-}

712concatMapRepl4xN :: Int -> IO ()

713concatMapRepl4xN n = S.drain $ S.concatMap (S.replicate 4)

714 (sourceUnfoldrMN (value `div` 4) n)

715

716#ifdef INSPECTION

717inspect $ hasNoTypeClasses 'concatMapRepl4xN

718#endif

719

720{-# INLINE concatUnfoldRepl4xN #-}

721concatUnfoldRepl4xN :: Int -> IO ()

722concatUnfoldRepl4xN n =

723 S.drain $ S.concatUnfold

724 (UF.replicateM 4)

725 (sourceUnfoldrMN (value `div` 4) n)

726

727#ifdef INSPECTION

728inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN

729inspect $ 'concatUnfoldRepl4xN `hasNoType` ''D.ConcatMapUState

730#endif

731

732{-# INLINE concatMapWithSerial #-}

733concatMapWithSerial :: Int -> Int -> Int -> IO ()

734concatMapWithSerial outer inner n =

735 S.drain $ S.concatMapWith S.serial

736 (\_ -> sourceUnfoldrMN inner n)

737 (sourceUnfoldrMN outer n)

738

739#ifdef INSPECTION

740inspect $ hasNoTypeClasses 'concatMapWithSerial

741#endif

742

743{-# INLINE concatMapWithAppend #-}

744concatMapWithAppend :: Int -> Int -> Int -> IO ()

745concatMapWithAppend outer inner n =

746 S.drain $ S.concatMapWith Internal.append

747 (\_ -> sourceUnfoldrMN inner n)

748 (sourceUnfoldrMN outer n)

749

750#ifdef INSPECTION

751inspect $ hasNoTypeClasses 'concatMapWithAppend

752#endif

753

754{-# INLINE concatMapWithWSerial #-}

755concatMapWithWSerial :: Int -> Int -> Int -> IO ()

756concatMapWithWSerial outer inner n =

757 S.drain $ S.concatMapWith S.wSerial

758 (\_ -> sourceUnfoldrMN inner n)

759 (sourceUnfoldrMN outer n)

760

761#ifdef INSPECTION

762inspect $ hasNoTypeClasses 'concatMapWithWSerial

763#endif

764

765{-# INLINE concatUnfoldInterleaveRepl4xN #-}

766concatUnfoldInterleaveRepl4xN :: Int -> IO ()

767concatUnfoldInterleaveRepl4xN n =

768 S.drain $ Internal.concatUnfoldInterleave

769 (UF.replicateM 4)

770 (sourceUnfoldrMN (value `div` 4) n)

771

772#ifdef INSPECTION

773inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN

774-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState

775#endif

776

777{-# INLINE concatUnfoldRoundrobinRepl4xN #-}

778concatUnfoldRoundrobinRepl4xN :: Int -> IO ()

779concatUnfoldRoundrobinRepl4xN n =

780 S.drain $ Internal.concatUnfoldRoundrobin

781 (UF.replicateM 4)

782 (sourceUnfoldrMN (value `div` 4) n)

783

784#ifdef INSPECTION

785inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN

786-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''D.ConcatUnfoldInterleaveState

787#endif

788

789-------------------------------------------------------------------------------

790-- Mixed Composition

791-------------------------------------------------------------------------------

792

793{-# INLINE scanMap #-}

794{-# INLINE dropMap #-}

795{-# INLINE dropScan #-}

796{-# INLINE takeDrop #-}

797{-# INLINE takeScan #-}

798{-# INLINE takeMap #-}

799{-# INLINE filterDrop #-}

800{-# INLINE filterTake #-}

801{-# INLINE filterScan #-}

802{-# INLINE filterScanl1 #-}

803{-# INLINE filterMap #-}

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

805 filterTake, filterScan, filterScanl1, filterMap

806 :: MonadIO m => Int -> Stream m Int -> m ()

807

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

809dropMap n = composeN n $ S.map (subtract 1) . S.drop 1

810dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1

811takeDrop n = composeN n $ S.drop 1 . S.take maxValue

812takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue

813takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue

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

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

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

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

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

819

820data Pair a b = Pair !a !b deriving (Generic, NFData)

821

822{-# INLINE sumProductFold #-}

823sumProductFold :: Monad m => Stream m Int -> m (Int, Int)

824sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)

825

826{-# INLINE sumProductScan #-}

827sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)

828sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)

829 . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)

830

831-------------------------------------------------------------------------------

832-- Pure stream operations

833-------------------------------------------------------------------------------

834

835{-# INLINE eqInstance #-}

836eqInstance :: Stream Identity Int -> Bool

837eqInstance src = src == src

838

839{-# INLINE eqInstanceNotEq #-}

840eqInstanceNotEq :: Stream Identity Int -> Bool

841eqInstanceNotEq src = src P./= src

842

843{-# INLINE ordInstance #-}

844ordInstance :: Stream Identity Int -> Bool

845ordInstance src = src P.< src

846

847{-# INLINE ordInstanceMin #-}

848ordInstanceMin :: Stream Identity Int -> Stream Identity Int

849ordInstanceMin src = P.min src src

850

851{-# INLINE showInstance #-}

852showInstance :: Stream Identity Int -> P.String

853showInstance src = P.show src

854

855{-# INLINE showInstanceList #-}

856showInstanceList :: [Int] -> P.String

857showInstanceList src = P.show src

858

859{-# INLINE readInstance #-}

860readInstance :: P.String -> Stream Identity Int

861readInstance str =

862 let r = P.reads str

863 in case r of

864 [(x,"")] -> x

865 _ -> P.error "readInstance: no parse"

866

867{-# INLINE readInstanceList #-}

868readInstanceList :: P.String -> [Int]

869readInstanceList str =

870 let r = P.reads str

871 in case r of

872 [(x,"")] -> x

873 _ -> P.error "readInstance: no parse"

874

875{-# INLINE pureFoldl' #-}

876pureFoldl' :: Stream Identity Int -> Int

877pureFoldl' = runIdentity . S.foldl' (+) 0

878

879{-# INLINE foldableFoldl' #-}

880foldableFoldl' :: Stream Identity Int -> Int

881foldableFoldl' = F.foldl' (+) 0

882

883{-# INLINE foldableSum #-}

884foldableSum :: Stream Identity Int -> Int

885foldableSum = P.sum

886

887{-# INLINE traversableMapM #-}

888traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)

889traversableMapM = P.mapM return