src/Streamly/Benchmark/Prelude.hs · streamly

git.iko.soy/streamly

on df93350 help sign in

streamly/src/Streamly/Benchmark/Prelude.hs

893 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 as Internal

49import qualified Streamly.Unfold as UF

50-- import qualified Streamly.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-- Temporarily commented these ops as they depend on the hidden

415-- Pipe module.

416{-

417{-# INLINE transformMapM #-}

418{-# INLINE transformComposeMapM #-}

419{-# INLINE transformTeeMapM #-}

420{-# INLINE transformZipMapM #-}

421

422transformMapM, transformComposeMapM, transformTeeMapM,

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

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

425

426transformMapM t n = composeN' n $ t . S.transform (Pipe.mapM return)

427transformComposeMapM t n = composeN' n $ t . S.transform

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

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

430transformTeeMapM t n = composeN' n $ t . S.transform

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

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

433transformZipMapM t n = composeN' n $ t . S.transform

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

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

436-}

437

438mapMaybe n = composeN n $ S.mapMaybe

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

440mapMaybeM n = composeN n $ S.mapMaybeM

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

442sequence t = transform . t . S.sequence

443filterEven n = composeN n $ S.filter even

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

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

446takeOne n = composeN n $ S.take 1

447takeAll n = composeN n $ S.take maxValue

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

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

450dropOne n = composeN n $ S.drop 1

451dropAll n = composeN n $ S.drop maxValue

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

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

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

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

456elemIndices n = composeN n $ S.elemIndices maxValue

457intersperse n = composeN n $ S.intersperse maxValue

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

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

460reverse n = composeN n $ S.reverse

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

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

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

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

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

466

467-------------------------------------------------------------------------------

468-- Iteration

469-------------------------------------------------------------------------------

470

471iterStreamLen, maxIters :: Int

472iterStreamLen = 10

473maxIters = 10000

474

475{-# INLINE iterateSource #-}

476iterateSource

477 :: S.MonadAsync m

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

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

480 where

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

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

483

484{-# INLINE iterateMapM #-}

485{-# INLINE iterateScan #-}

486{-# INLINE iterateScanl1 #-}

487{-# INLINE iterateFilterEven #-}

488{-# INLINE iterateTakeAll #-}

489{-# INLINE iterateDropOne #-}

490{-# INLINE iterateDropWhileFalse #-}

491{-# INLINE iterateDropWhileTrue #-}

492iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

493 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

494 :: S.MonadAsync m

495 => Int -> Stream m Int

496

497-- this is quadratic

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

499-- so is this

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

501

502iterateMapM = iterateSource (S.mapM return) maxIters

503iterateFilterEven = iterateSource (S.filter even) maxIters

504iterateTakeAll = iterateSource (S.take maxValue) maxIters

505iterateDropOne = iterateSource (S.drop 1) maxIters

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

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

508

509-------------------------------------------------------------------------------

510-- Zipping and concat

511-------------------------------------------------------------------------------

512

513{-# INLINE zip #-}

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

515zip count n =

516 S.drain $ S.zipWith (,)

517 (sourceUnfoldrMN count n)

518 (sourceUnfoldrMN count (n + 1))

519

520#ifdef INSPECTION

521inspect $ hasNoTypeClasses 'zip

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

523#endif

524

525{-# INLINE zipM #-}

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

527zipM count n =

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

529 (sourceUnfoldrMN count n)

530 (sourceUnfoldrMN count (n + 1))

531

532#ifdef INSPECTION

533inspect $ hasNoTypeClasses 'zipM

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

535#endif

536

537{-# INLINE mergeBy #-}

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

539mergeBy count n =

540 S.drain $ S.mergeBy P.compare

541 (sourceUnfoldrMN count n)

542 (sourceUnfoldrMN count (n + 1))

543

544#ifdef INSPECTION

545inspect $ hasNoTypeClasses 'mergeBy

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

547#endif

548

549{-# INLINE serial2 #-}

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

551serial2 count n =

552 S.drain $ S.serial

553 (sourceUnfoldrMN count n)

554 (sourceUnfoldrMN count (n + 1))

555

556{-# INLINE serial4 #-}

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

558serial4 count n =

559 S.drain $ S.serial

560 ((S.serial (sourceUnfoldrMN count n)

561 (sourceUnfoldrMN count (n + 1))))

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

563 (sourceUnfoldrMN count (n + 3))))

564

565{-# INLINE append2 #-}

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

567append2 count n =

568 S.drain $ Internal.append

569 (sourceUnfoldrMN count n)

570 (sourceUnfoldrMN count (n + 1))

571

572{-# INLINE append4 #-}

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

574append4 count n =

575 S.drain $ Internal.append

576 ((Internal.append (sourceUnfoldrMN count n)

577 (sourceUnfoldrMN count (n + 1))))

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

579 (sourceUnfoldrMN count (n + 3))))

580

581#ifdef INSPECTION

582inspect $ hasNoTypeClasses 'append2

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

584#endif

585

586{-# INLINE wSerial2 #-}

587wSerial2 :: Int -> IO ()

588wSerial2 n = S.drain $ S.wSerial

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

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

591

592{-# INLINE interleave2 #-}

593interleave2 :: Int -> IO ()

594interleave2 n = S.drain $ Internal.interleave

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

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

597

598#ifdef INSPECTION

599inspect $ hasNoTypeClasses 'interleave2

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

601#endif

602

603{-# INLINE roundRobin2 #-}

604roundRobin2 :: Int -> IO ()

605roundRobin2 n = S.drain $ Internal.roundrobin

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

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

608

609#ifdef INSPECTION

610inspect $ hasNoTypeClasses 'roundRobin2

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

612#endif

613

614{-# INLINE isPrefixOf #-}

615{-# INLINE isSubsequenceOf #-}

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

617

618isPrefixOf src = S.isPrefixOf src src

619isSubsequenceOf src = S.isSubsequenceOf src src

620

621{-# INLINE stripPrefix #-}

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

623stripPrefix src = do

624 _ <- S.stripPrefix src src

625 return ()

626

627{-# INLINE zipAsync #-}

628{-# INLINE zipAsyncM #-}

629{-# INLINE zipAsyncAp #-}

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

631

632zipAsync src = do

633 r <- S.tail src

634 let src1 = fromJust r

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

636

637zipAsyncM src = do

638 r <- S.tail src

639 let src1 = fromJust r

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

641

642zipAsyncAp src = do

643 r <- S.tail src

644 let src1 = fromJust r

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

646 <*> S.serially src1)

647

648{-# INLINE eqBy' #-}

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

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

651

652{-# INLINE eqBy #-}

653eqBy :: Int -> IO Bool

654eqBy n = eqBy' (source n)

655

656#ifdef INSPECTION

657inspect $ hasNoTypeClasses 'eqBy

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

659#endif

660

661

662{-# INLINE eqByPure #-}

663eqByPure :: Int -> Identity Bool

664eqByPure n = eqBy' (sourceUnfoldr n)

665

666#ifdef INSPECTION

667inspect $ hasNoTypeClasses 'eqByPure

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

669#endif

670

671{-# INLINE cmpBy' #-}

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

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

674

675{-# INLINE cmpBy #-}

676cmpBy :: Int -> IO P.Ordering

677cmpBy n = cmpBy' (source n)

678

679#ifdef INSPECTION

680inspect $ hasNoTypeClasses 'cmpBy

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

682#endif

683

684{-# INLINE cmpByPure #-}

685cmpByPure :: Int -> Identity P.Ordering

686cmpByPure n = cmpBy' (sourceUnfoldr n)

687

688#ifdef INSPECTION

689inspect $ hasNoTypeClasses 'cmpByPure

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

691#endif

692

693{-# INLINE concatMap #-}

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

695concatMap outer inner n =

696 S.drain $ S.concatMap

697 (\_ -> sourceUnfoldrMN inner n)

698 (sourceUnfoldrMN outer n)

699

700#ifdef INSPECTION

701inspect $ hasNoTypeClasses 'concatMap

702#endif

703

704{-# INLINE concatMapPure #-}

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

706concatMapPure outer inner n =

707 S.drain $ S.concatMap

708 (\_ -> sourceUnfoldrN inner n)

709 (sourceUnfoldrN outer n)

710

711#ifdef INSPECTION

712inspect $ hasNoTypeClasses 'concatMapPure

713#endif

714

715{-# INLINE concatMapRepl4xN #-}

716concatMapRepl4xN :: Int -> IO ()

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

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

719

720#ifdef INSPECTION

721inspect $ hasNoTypeClasses 'concatMapRepl4xN

722#endif

723

724{-# INLINE concatUnfoldRepl4xN #-}

725concatUnfoldRepl4xN :: Int -> IO ()

726concatUnfoldRepl4xN n =

727 S.drain $ Internal.concatMapU

728 (UF.replicateM 4)

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

730

731#ifdef INSPECTION

732inspect $ hasNoTypeClasses 'concatUnfoldRepl4xN

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

734#endif

735

736{-# INLINE concatMapWithSerial #-}

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

738concatMapWithSerial outer inner n =

739 S.drain $ S.concatMapWith S.serial

740 (\_ -> sourceUnfoldrMN inner n)

741 (sourceUnfoldrMN outer n)

742

743#ifdef INSPECTION

744inspect $ hasNoTypeClasses 'concatMapWithSerial

745#endif

746

747{-# INLINE concatMapWithAppend #-}

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

749concatMapWithAppend outer inner n =

750 S.drain $ S.concatMapWith Internal.append

751 (\_ -> sourceUnfoldrMN inner n)

752 (sourceUnfoldrMN outer n)

753

754#ifdef INSPECTION

755inspect $ hasNoTypeClasses 'concatMapWithAppend

756#endif

757

758{-# INLINE concatMapWithWSerial #-}

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

760concatMapWithWSerial outer inner n =

761 S.drain $ S.concatMapWith S.wSerial

762 (\_ -> sourceUnfoldrMN inner n)

763 (sourceUnfoldrMN outer n)

764

765#ifdef INSPECTION

766inspect $ hasNoTypeClasses 'concatMapWithWSerial

767#endif

768

769{-# INLINE concatUnfoldInterleaveRepl4xN #-}

770concatUnfoldInterleaveRepl4xN :: Int -> IO ()

771concatUnfoldInterleaveRepl4xN n =

772 S.drain $ Internal.concatUnfoldInterleave

773 (UF.replicateM 4)

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

775

776#ifdef INSPECTION

777inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN

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

779#endif

780

781{-# INLINE concatUnfoldRoundrobinRepl4xN #-}

782concatUnfoldRoundrobinRepl4xN :: Int -> IO ()

783concatUnfoldRoundrobinRepl4xN n =

784 S.drain $ Internal.concatUnfoldRoundrobin

785 (UF.replicateM 4)

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

787

788#ifdef INSPECTION

789inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN

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

791#endif

792

793-------------------------------------------------------------------------------

794-- Mixed Composition

795-------------------------------------------------------------------------------

796

797{-# INLINE scanMap #-}

798{-# INLINE dropMap #-}

799{-# INLINE dropScan #-}

800{-# INLINE takeDrop #-}

801{-# INLINE takeScan #-}

802{-# INLINE takeMap #-}

803{-# INLINE filterDrop #-}

804{-# INLINE filterTake #-}

805{-# INLINE filterScan #-}

806{-# INLINE filterScanl1 #-}

807{-# INLINE filterMap #-}

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

809 filterTake, filterScan, filterScanl1, filterMap

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

811

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

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

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

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

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

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

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

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

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

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

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

823

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

825

826{-# INLINE sumProductFold #-}

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

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

829

830{-# INLINE sumProductScan #-}

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

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

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

834

835-------------------------------------------------------------------------------

836-- Pure stream operations

837-------------------------------------------------------------------------------

838

839{-# INLINE eqInstance #-}

840eqInstance :: Stream Identity Int -> Bool

841eqInstance src = src == src

842

843{-# INLINE eqInstanceNotEq #-}

844eqInstanceNotEq :: Stream Identity Int -> Bool

845eqInstanceNotEq src = src P./= src

846

847{-# INLINE ordInstance #-}

848ordInstance :: Stream Identity Int -> Bool

849ordInstance src = src P.< src

850

851{-# INLINE ordInstanceMin #-}

852ordInstanceMin :: Stream Identity Int -> Stream Identity Int

853ordInstanceMin src = P.min src src

854

855{-# INLINE showInstance #-}

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

857showInstance src = P.show src

858

859{-# INLINE showInstanceList #-}

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

861showInstanceList src = P.show src

862

863{-# INLINE readInstance #-}

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

865readInstance str =

866 let r = P.reads str

867 in case r of

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

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

870

871{-# INLINE readInstanceList #-}

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

873readInstanceList str =

874 let r = P.reads str

875 in case r of

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

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

878

879{-# INLINE pureFoldl' #-}

880pureFoldl' :: Stream Identity Int -> Int

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

882

883{-# INLINE foldableFoldl' #-}

884foldableFoldl' :: Stream Identity Int -> Int

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

886

887{-# INLINE foldableSum #-}

888foldableSum :: Stream Identity Int -> Int

889foldableSum = P.sum

890

891{-# INLINE traversableMapM #-}

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

893traversableMapM = P.mapM return