benchmark/LinearOps.hs · streamly

git.iko.soy/streamly

on ede29df help sign in

streamly/benchmark/LinearOps.hs

559 lines 18 kB history raw

1-- |

2-- Module : BenchmarkOps

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 #-}

14module LinearOps where

16import Control.Monad (when)

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

18import Data.Maybe (fromJust)

19import Prelude

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

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

22 maxBound, div, IO, compare, Double, fromIntegral, Integer)

23import qualified Prelude as P

24import qualified Data.Foldable as F

25import qualified GHC.Exts as GHC

26import Control.DeepSeq (NFData)

27import GHC.Generics (Generic)

29import qualified Streamly as S

30import qualified Streamly.Prelude as S

32value, maxValue :: Int

33#ifdef LINEAR_ASYNC

34value = 10000

35#else

36value = 100000

37#endif

38maxValue = value + 1

40-------------------------------------------------------------------------------

41-- Benchmark ops

42-------------------------------------------------------------------------------

44-------------------------------------------------------------------------------

45-- Stream generation and elimination

46-------------------------------------------------------------------------------

48type Stream m a = S.SerialT m a

50{-# INLINE source #-}

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

52source n = sourceUnfoldrM n

54{-# INLINE sourceIntFromTo #-}

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

56sourceIntFromTo n = S.intFromTo n (n + value)

58{-# INLINE sourceIntFromThenTo #-}

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

60sourceIntFromThenTo n = S.intFromThenTo n (n + 1) (n + value)

62{-# INLINE sourceFracFromTo #-}

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

64sourceFracFromTo n = S.fracFromTo (fromIntegral n) (fromIntegral (n + value))

66{-# INLINE sourceFracFromThenTo #-}

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

68sourceFracFromThenTo n = S.fracFromThenTo (fromIntegral n)

69 (fromIntegral n + 1.0001) (fromIntegral (n + value))

71{-# INLINE sourceIntegerFromStep #-}

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

73sourceIntegerFromStep n = S.take value $ S.intFromStep (fromIntegral n) 1

75{-# INLINE sourceFromList #-}

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

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

79{-# INLINE sourceFromListM #-}

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

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

83{-# INLINE sourceFromFoldable #-}

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

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

87{-# INLINE sourceFromFoldableM #-}

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

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

91{-# INLINE sourceFoldMapWith #-}

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

93 => Int -> t m Int

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

96{-# INLINE sourceFoldMapWithM #-}

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

98 => Int -> t m Int

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

100

101{-# INLINE sourceFoldMapM #-}

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

103 => Int -> t m Int

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

105

106{-# INLINE sourceUnfoldr #-}

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

108sourceUnfoldr n = S.unfoldr step n

109 where

110 step cnt =

111 if cnt > n + value

112 then Nothing

113 else Just (cnt, cnt + 1)

114

115{-# INLINE sourceUnfoldrM #-}

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

117sourceUnfoldrM n = S.unfoldrM step n

118 where

119 step cnt =

120 if cnt > n + value

121 then return Nothing

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

123

124{-# INLINE sourceUnfoldrMN #-}

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

126sourceUnfoldrMN m n = S.unfoldrM step n

127 where

128 step cnt =

129 if cnt > n + m

130 then return Nothing

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

132

133{-# INLINE sourceUnfoldrMAction #-}

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

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

136 where

137 step cnt =

138 if cnt > n + value

139 then return Nothing

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

141

142-------------------------------------------------------------------------------

143-- Pure stream generation

144-------------------------------------------------------------------------------

145

146{-# INLINE sourceIsList #-}

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

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

149

150{-# INLINE sourceIsString #-}

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

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

153

154-------------------------------------------------------------------------------

155-- Elimination

156-------------------------------------------------------------------------------

157

158{-# INLINE runStream #-}

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

160runStream = S.runStream

161

162{-# INLINE toList #-}

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

164

165{-# INLINE last #-}

166{-# INLINE maximum #-}

167{-# INLINE minimum #-}

168{-# INLINE find #-}

169{-# INLINE findIndex #-}

170{-# INLINE elemIndex #-}

171{-# INLINE foldl1' #-}

172{-# INLINE foldr1 #-}

173last, minimum, maximum, find, findIndex, elemIndex, foldl1', foldr1

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

175

176{-# INLINE minimumBy #-}

177{-# INLINE maximumBy #-}

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

179

180{-# INLINE foldl' #-}

181{-# INLINE foldr #-}

182{-# INLINE foldrM #-}

183{-# INLINE length #-}

184{-# INLINE sum #-}

185{-# INLINE product #-}

186foldl', foldr, foldrM, length, sum, product :: Monad m => Stream m Int -> m Int

187

188{-# INLINE all #-}

189{-# INLINE any #-}

190{-# INLINE and #-}

191{-# INLINE or #-}

192{-# INLINE elem #-}

193{-# INLINE notElem #-}

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

195

196{-# INLINE toNull #-}

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

198toNull t = runStream . t

199

200{-# INLINE uncons #-}

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

202uncons s = do

203 r <- S.uncons s

204 case r of

205 Nothing -> return ()

206 Just (_, t) -> uncons t

207

208{-# INLINE init #-}

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

210init s = S.init s >>= Prelude.mapM_ S.runStream

211

212{-# INLINE tail #-}

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

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

215

216{-# INLINE nullHeadTail #-}

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

218nullHeadTail s = do

219 r <- S.null s

220 when (not r) $ do

221 _ <- S.head s

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

223

224{-# INLINE mapM_ #-}

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

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

227

228toList = S.toList

229foldr = S.foldr (+) 0

230foldr1 = S.foldr1 (+)

231foldrM = S.foldrM (\a xs -> return $ a + xs) 0

232foldl' = S.foldl' (+) 0

233foldl1' = S.foldl1' (+)

234last = S.last

235elem = S.elem maxValue

236notElem = S.notElem maxValue

237length = S.length

238all = S.all (<= maxValue)

239any = S.any (> maxValue)

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

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

242find = S.find (== maxValue)

243findIndex = S.findIndex (== maxValue)

244elemIndex = S.elemIndex maxValue

245maximum = S.maximum

246minimum = S.minimum

247sum = S.sum

248product = S.product

249minimumBy = S.minimumBy compare

250maximumBy = S.maximumBy compare

251

252-------------------------------------------------------------------------------

253-- Transformation

254-------------------------------------------------------------------------------

255

256{-# INLINE transform #-}

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

258transform = runStream

259

260{-# INLINE composeN #-}

261composeN

262 :: Monad m

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

264composeN n f =

265 case n of

266 1 -> transform . f

267 2 -> transform . f . f

268 3 -> transform . f . f . f

269 4 -> transform . f . f . f . f

270 _ -> undefined

271

272-- polymorphic stream version of composeN

273{-# INLINE composeN' #-}

274composeN'

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

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

277composeN' n f =

278 case n of

279 1 -> transform . f

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

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

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

283 _ -> undefined

284

285{-# INLINE scan #-}

286{-# INLINE scanl1' #-}

287{-# INLINE map #-}

288{-# INLINE fmap #-}

289{-# INLINE mapMaybe #-}

290{-# INLINE filterEven #-}

291{-# INLINE filterAllOut #-}

292{-# INLINE filterAllIn #-}

293{-# INLINE takeOne #-}

294{-# INLINE takeAll #-}

295{-# INLINE takeWhileTrue #-}

296{-# INLINE takeWhileMTrue #-}

297{-# INLINE dropOne #-}

298{-# INLINE dropAll #-}

299{-# INLINE dropWhileTrue #-}

300{-# INLINE dropWhileMTrue #-}

301{-# INLINE dropWhileFalse #-}

302{-# INLINE findIndices #-}

303{-# INLINE elemIndices #-}

304{-# INLINE insertBy #-}

305{-# INLINE deleteBy #-}

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

307 filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,

308 dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,

309 findIndices, elemIndices, insertBy, deleteBy

310 :: Monad m

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

312

313{-# INLINE mapMaybeM #-}

314mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()

315

316{-# INLINE mapM #-}

317{-# INLINE map' #-}

318{-# INLINE fmap' #-}

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

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

321

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

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

324

325{-# INLINE sequence #-}

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

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

328

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

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

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

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

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

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

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

336mapMaybe n = composeN n $ S.mapMaybe

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

338mapMaybeM n = composeN n $ S.mapMaybeM

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

340sequence t = transform . t . S.sequence

341filterEven n = composeN n $ S.filter even

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

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

344takeOne n = composeN n $ S.take 1

345takeAll n = composeN n $ S.take maxValue

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

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

348dropOne n = composeN n $ S.drop 1

349dropAll n = composeN n $ S.drop maxValue

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

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

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

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

354elemIndices n = composeN n $ S.elemIndices maxValue

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

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

357

358-------------------------------------------------------------------------------

359-- Iteration

360-------------------------------------------------------------------------------

361

362iterStreamLen, maxIters :: Int

363iterStreamLen = 10

364maxIters = 10000

365

366{-# INLINE iterateSource #-}

367iterateSource

368 :: S.MonadAsync m

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

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

371 where

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

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

374

375{-# INLINE iterateMapM #-}

376{-# INLINE iterateScan #-}

377{-# INLINE iterateScanl1 #-}

378{-# INLINE iterateFilterEven #-}

379{-# INLINE iterateTakeAll #-}

380{-# INLINE iterateDropOne #-}

381{-# INLINE iterateDropWhileFalse #-}

382{-# INLINE iterateDropWhileTrue #-}

383iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,

384 iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue

385 :: S.MonadAsync m

386 => Int -> Stream m Int

387

388-- this is quadratic

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

390-- so is this

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

392

393iterateMapM = iterateSource (S.mapM return) maxIters

394iterateFilterEven = iterateSource (S.filter even) maxIters

395iterateTakeAll = iterateSource (S.take maxValue) maxIters

396iterateDropOne = iterateSource (S.drop 1) maxIters

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

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

399

400-------------------------------------------------------------------------------

401-- Zipping and concat

402-------------------------------------------------------------------------------

403

404{-# INLINE zip #-}

405{-# INLINE zipM #-}

406{-# INLINE mergeBy #-}

407zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()

408

409zip src = do

410 r <- S.tail src

411 let src1 = fromJust r

412 transform (S.zipWith (,) src src1)

413zipM src = do

414 r <- S.tail src

415 let src1 = fromJust r

416 transform (S.zipWithM (curry return) src src1)

417

418mergeBy src = do

419 r <- S.tail src

420 let src1 = fromJust r

421 transform (S.mergeBy P.compare src src1)

422

423{-# INLINE isPrefixOf #-}

424{-# INLINE isSubsequenceOf #-}

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

426

427isPrefixOf src = S.isPrefixOf src src

428isSubsequenceOf src = S.isSubsequenceOf src src

429

430{-# INLINE stripPrefix #-}

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

432stripPrefix src = do

433 _ <- S.stripPrefix src src

434 return ()

435

436{-# INLINE zipAsync #-}

437{-# INLINE zipAsyncM #-}

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

439

440zipAsync src = do

441 r <- S.tail src

442 let src1 = fromJust r

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

444zipAsyncM src = do

445 r <- S.tail src

446 let src1 = fromJust r

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

448

449{-# INLINE eqBy #-}

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

451eqBy src = S.eqBy (==) src src

452

453{-# INLINE cmpBy #-}

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

455cmpBy src = S.cmpBy P.compare src src

456

457concatStreamLen, maxNested :: Int

458concatStreamLen = 1

459maxNested = 100000

460

461{-# INLINE concatMap #-}

462concatMap :: S.MonadAsync m => Int -> Stream m Int

463concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)

464 (sourceUnfoldrMN concatStreamLen n)

465

466-------------------------------------------------------------------------------

467-- Mixed Composition

468-------------------------------------------------------------------------------

469

470{-# INLINE scanMap #-}

471{-# INLINE dropMap #-}

472{-# INLINE dropScan #-}

473{-# INLINE takeDrop #-}

474{-# INLINE takeScan #-}

475{-# INLINE takeMap #-}

476{-# INLINE filterDrop #-}

477{-# INLINE filterTake #-}

478{-# INLINE filterScan #-}

479{-# INLINE filterScanl1 #-}

480{-# INLINE filterMap #-}

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

482 filterTake, filterScan, filterScanl1, filterMap

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

484

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

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

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

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

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

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

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

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

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

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

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

496

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

498

499{-# INLINE sumProductFold #-}

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

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

502

503{-# INLINE sumProductScan #-}

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

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

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

507

508-------------------------------------------------------------------------------

509-- Pure stream operations

510-------------------------------------------------------------------------------

511

512{-# INLINE eqInstance #-}

513eqInstance :: Stream Identity Int -> Bool

514eqInstance src = src == src

515

516{-# INLINE eqInstanceNotEq #-}

517eqInstanceNotEq :: Stream Identity Int -> Bool

518eqInstanceNotEq src = src P./= src

519

520{-# INLINE ordInstance #-}

521ordInstance :: Stream Identity Int -> Bool

522ordInstance src = src P.< src

523

524{-# INLINE ordInstanceMin #-}

525ordInstanceMin :: Stream Identity Int -> Stream Identity Int

526ordInstanceMin src = P.min src src

527

528{-# INLINE showInstance #-}

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

530showInstance src = P.show src

531

532{-# INLINE showInstanceList #-}

533showInstanceList :: Stream Identity Int -> P.String

534showInstanceList src = P.show (GHC.toList src P.++ [2..value])

535

536{-# INLINE readInstance #-}

537readInstance :: Stream Identity Int -> Stream Identity Int

538readInstance src =

539 let r = P.reads ("fromList [1"

540 P.++ P.concat (P.replicate value ",1") P.++ "]")

541 in case r of

542 [(x,"")] -> src S.<> x

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

544

545{-# INLINE pureFoldl' #-}

546pureFoldl' :: Stream Identity Int -> Int

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

548

549{-# INLINE foldableFoldl' #-}

550foldableFoldl' :: Stream Identity Int -> Int

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

552

553{-# INLINE foldableSum #-}

554foldableSum :: Stream Identity Int -> Int

555foldableSum = P.sum

556

557{-# INLINE traversableMapM #-}

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

559traversableMapM = P.mapM return