git.iko.soy/streamly
on 3d884d4 help sign in
30c5a56
swap
0 ahead, 2858 behind
558 files changed+47522−153295
since splitsnapshots
unifiedsplit
.circleci/config.yml+113−108 .ghci−1 .github/workflows/haskell.yml+44−225 .github/workflows/packdiff.yml−39 .github/workflows/regression-check.yml−165 .gitignore+3−8 .hlint.ignore−40 .hlint.yaml+3−26 .packcheck.ignore−36 .travis.yml+231 CHANGELOG.md−1 CONTRIBUTING.md+255−1 docs/User/Project/Changelog.md → Changelog.md+15−282 INSTALL.md+82 LICENSE+1−69 MAINTAINING.md+178 README.md+612−1 appveyor.yml+6−8 bench.sh+450 benchmark/Streamly/Benchmark/Prelude/Adaptive.hs → benchmark/Adaptive.hs+41−52 benchmark/Array.hs+251 benchmark/ArrayOps.hs+531 benchmark/BaseStreams.hs+380 benchmark/Chart.hs+467 benchmark/Common.hs+95 benchmark/Streamly/Benchmark/Prelude/Concurrent.hs → benchmark/Concurrent.hs+24−32 benchmark/FileIO.hs+340 benchmark/Linear.hs+575 benchmark/LinearAsync.hs+147 benchmark/LinearRate.hs+68 benchmark/NanoBenchmarks.hs+23−28 benchmark/Nested.hs+61 benchmark/NestedConcurrent.hs+84 benchmark/NestedOps.hs+174 benchmark/NestedUnfold.hs+38 benchmark/NestedUnfoldOps.hs+126 benchmark/Parallel.hs+93 benchmark/README.md+102−1 benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/StreamDKOps.hs+16−48 benchmark/StreamDOps.hs+357 benchmark/StreamKOps.hs+410 benchmark/Streamly/Benchmark/Data/Array.hs+71−115 benchmark/Streamly/Benchmark/Data/Array/Common.hs−185 benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs−16 benchmark/Streamly/Benchmark/Data/Array/Generic.hs−119 benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs−95 benchmark/Streamly/Benchmark/Data/Array/Stream.hs−309 benchmark/Streamly/Benchmark/Data/ArrayOps.hs+148 benchmark/Streamly/Benchmark/Data/Fold.hs−541 benchmark/Streamly/Benchmark/Data/Fold/Window.hs−191 benchmark/Streamly/Benchmark/Data/MutArray.hs−300 benchmark/Streamly/Benchmark/Data/Parser.hs−887 benchmark/Streamly/Benchmark/Data/ParserK.hs−437 benchmark/Streamly/Benchmark/Data/Prim/Array.hs+100 benchmark/Streamly/Benchmark/Data/Prim/ArrayOps.hs+153 benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hs−69 benchmark/Streamly/Benchmark/Data/Serialize.hs−591 benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hs−24 benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hs−21 benchmark/Streamly/Benchmark/Data/Serialize/TH.hs−76 benchmark/Streamly/Benchmark/Data/SmallArray.hs+95 benchmark/Streamly/Benchmark/Data/SmallArrayOps.hs+136 benchmark/Streamly/Benchmark/Data/Stream.hs−114 benchmark/Streamly/Benchmark/Data/Stream/Common.hs−518 benchmark/Streamly/Benchmark/Data/Stream/Concurrent.hs−20 benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs−208 benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hs−25 benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hs−25 benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hs−25 benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs−748 benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs−371 benchmark/Streamly/Benchmark/Data/Stream/Expand.hs−563 benchmark/Streamly/Benchmark/Data/Stream/Generate.hs−278 benchmark/Streamly/Benchmark/Data/Stream/Lift.hs−146 benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs−588 benchmark/Streamly/Benchmark/Data/Stream/Split.hs−244 benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs−658 benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs−934 benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs−938 benchmark/Streamly/Benchmark/Data/Stream/Transform.hs−687 benchmark/Streamly/Benchmark/Data/Unfold.hs−856 benchmark/Streamly/Benchmark/FileIO/Array.hs+259 benchmark/Streamly/Benchmark/FileIO/Stream.hs+651 benchmark/Streamly/Benchmark/FileSystem/Handle.hs−52 benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs−305 benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs−214 benchmark/Streamly/Benchmark/Prelude.hs+1202 benchmark/Streamly/Benchmark/Prelude/Ahead.hs−135 benchmark/Streamly/Benchmark/Prelude/Async.hs−204 benchmark/Streamly/Benchmark/Prelude/Merge.hs−298 benchmark/Streamly/Benchmark/Prelude/Parallel.hs−240 benchmark/Streamly/Benchmark/Prelude/Rate.hs−110 benchmark/Streamly/Benchmark/Prelude/WAsync.hs−186 benchmark/Streamly/Benchmark/Prelude/WSerial.hs−369 benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs−97 benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs−187 benchmark/Streamly/Benchmark/Unicode/Char.hs−90 benchmark/Streamly/Benchmark/Unicode/Parser.hs−107 benchmark/Streamly/Benchmark/Unicode/Stream.hs−349 benchmark/Streamly/Benchmark/Unicode/Utf8.hs−55 benchmark/Streamly/Benchmark/Unicode/data/AllChars.txt−216 benchmark/Streamly/Benchmark/Unicode/data/Deutsch.txt−153 benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txt−699 benchmark/Streamly/Benchmark/Unicode/data/English.txt−58 benchmark/Streamly/Benchmark/Unicode/data/Japanese.txt−855 benchmark/Streamly/Benchmark/Unicode/data/Korean.txt−493 benchmark/Streamly/Benchmark/Unicode/data/Vietnamese.txt−402 benchmark/bench-runner/Main.hs−183 benchmark/bench-runner/bench-runner.cabal−42 benchmark/bench-runner/cabal.project−4 benchmark/bench-runner/default.nix−164 benchmark/lib/Streamly/Benchmark/Common.hs−257 benchmark/lib/Streamly/Benchmark/Common/Handle.hs−228 benchmark/lib/Streamly/Benchmark/Prelude.hs−597 benchmark/streamly-benchmarks.cabal−778 bin/ghc.sh−45 bin/mk-hscope.sh−46 bin/mk-tags.sh−25 bin/repl−3 bin/run-ci.sh−334 bin/run-repl-quick.sh−113 cabal.project−5 cabal.project.O0−24 cabal.project.Werror−17 cabal.project.Werror-nocode−21 cabal.project.ci+6 cabal.project.coverage−14 cabal.project.doctest−24 cabal.project.ghc-head−35 cabal.project.hpc-coveralls−9 cabal.project.packdiff−9 cabal.project.report−30 cabal.project.streamly−10 docs/User/HowTo/streamly-vs-list-time.svg → charts-0/streamly-vs-list-time.svg configure+1310−1297 configure.ac+5−11 core/Changelog.md−1 core/LICENSE−322 core/Setup.hs−6 core/configure−4349 core/configure.ac−17 core/docs/ApiChangelogs/0.1.0-0.2.0.txt−1471 core/docs/ApiChangelogs/0.1.0.txt−405 core/docs/ApiChangelogs/0.2.0-0.2.2.txt−306 core/docs/Changelog.md−97 core/docs/Readme.md−1 core/src/DocTestDataArray.hs−22 core/src/DocTestDataFold.hs−27 core/src/DocTestDataMutArray.hs−10 core/src/DocTestDataMutArrayGeneric.hs−10 core/src/DocTestDataParser.hs−20 core/src/DocTestDataParserK.hs−15 core/src/DocTestDataStream.hs−39 core/src/DocTestDataStreamK.hs−21 core/src/DocTestDataUnfold.hs−12 core/src/DocTestFileSystemHandle.hs−15 core/src/DocTestUnicodeParser.hs−9 core/src/DocTestUnicodeStream.hs−12 core/src/DocTestUnicodeString.hs−5 core/src/Streamly/Console/Stdio.hs−30 core/src/Streamly/Data/Array.hs−167 core/src/Streamly/Data/Array/Generic.hs−51 core/src/Streamly/Data/Fold.hs−415 core/src/Streamly/Data/MutArray.hs−110 core/src/Streamly/Data/MutArray/Generic.hs−70 core/src/Streamly/Data/MutByteArray.hs−106 core/src/Streamly/Data/Parser.hs−247 core/src/Streamly/Data/ParserK.hs−139 core/src/Streamly/Data/Stream.hs−746 core/src/Streamly/Data/StreamK.hs−194 core/src/Streamly/Data/Unfold.hs−233 core/src/Streamly/FileSystem/Dir.hs−23 core/src/Streamly/FileSystem/File.hs−60 core/src/Streamly/FileSystem/Handle.hs−117 core/src/Streamly/Internal/Console/Stdio.hs−228 core/src/Streamly/Internal/Control/Exception.hs−38 core/src/Streamly/Internal/Control/ForkIO.hs−50 core/src/Streamly/Internal/Data/Array.hs−1018 core/src/Streamly/Internal/Data/Array/ArrayMacros.h−43 core/src/Streamly/Internal/Data/Array/Generic.hs−342 core/src/Streamly/Internal/Data/Array/Stream.hs−725 core/src/Streamly/Internal/Data/Array/Type.hs−1148 core/src/Streamly/Internal/Data/Binary/Parser.hs−399 core/src/Streamly/Internal/Data/Binary/Stream.hs−383 core/src/Streamly/Internal/Data/Builder.hs−82 core/src/Streamly/Internal/Data/Either/Strict.hs−57 core/src/Streamly/Internal/Data/Fold.hs−33 core/src/Streamly/Internal/Data/Fold/Chunked.hs−379 core/src/Streamly/Internal/Data/Fold/Combinators.hs−2452 core/src/Streamly/Internal/Data/Fold/Container.hs−783 core/src/Streamly/Internal/Data/Fold/Step.hs−83 core/src/Streamly/Internal/Data/Fold/Tee.hs−184 core/src/Streamly/Internal/Data/Fold/Type.hs−2099 core/src/Streamly/Internal/Data/Fold/Window.hs−357 core/src/Streamly/Internal/Data/IOFinalizer.hs−101 core/src/Streamly/Internal/Data/IORef/Unboxed.hs−101 core/src/Streamly/Internal/Data/IsMap.hs−60 core/src/Streamly/Internal/Data/List.hs−234 core/src/Streamly/Internal/Data/Maybe/Strict.hs−57 core/src/Streamly/Internal/Data/MutArray.hs−207 core/src/Streamly/Internal/Data/MutArray/Generic.hs−947 core/src/Streamly/Internal/Data/MutArray/Stream.hs−145 core/src/Streamly/Internal/Data/MutArray/Type.hs−3318 core/src/Streamly/Internal/Data/MutByteArray.hs−251 core/src/Streamly/Internal/Data/MutByteArray/Type.hs−321 core/src/Streamly/Internal/Data/Parser.hs−3621 core/src/Streamly/Internal/Data/Parser/Tee.hs−617 core/src/Streamly/Internal/Data/Parser/Type.hs−1452 core/src/Streamly/Internal/Data/ParserK.hs−16 core/src/Streamly/Internal/Data/ParserK/Type.hs−752 core/src/Streamly/Internal/Data/Pipe.hs−273 core/src/Streamly/Internal/Data/Producer.hs−81 core/src/Streamly/Internal/Data/Producer/Source.hs−303 core/src/Streamly/Internal/Data/Producer/Type.hs−186 core/src/Streamly/Internal/Data/Refold/Type.hs−251 core/src/Streamly/Internal/Data/Ring.hs−619 core/src/Streamly/Internal/Data/Ring/Generic.hs−185 core/src/Streamly/Internal/Data/SVar/Type.hs−540 core/src/Streamly/Internal/Data/Serialize/TH.hs−530 core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hs−475 core/src/Streamly/Internal/Data/Serialize/TH/Common.hs−70 core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs−411 core/src/Streamly/Internal/Data/Serialize/Type.hs−317 core/src/Streamly/Internal/Data/Stream.hs−42 core/src/Streamly/Internal/Data/Stream/Container.hs−310 core/src/Streamly/Internal/Data/Stream/Eliminate.hs−849 core/src/Streamly/Internal/Data/Stream/Exception.hs−501 core/src/Streamly/Internal/Data/Stream/Generate.hs−1191 core/src/Streamly/Internal/Data/Stream/Lift.hs−129 core/src/Streamly/Internal/Data/Stream/Nesting.hs−3024 core/src/Streamly/Internal/Data/Stream/Step.hs−39 core/src/Streamly/Internal/Data/Stream/StreamD.hs−16 core/src/Streamly/Internal/Data/Stream/Top.hs−480 core/src/Streamly/Internal/Data/Stream/Transform.hs−1971 core/src/Streamly/Internal/Data/Stream/Transformer.hs−183 core/src/Streamly/Internal/Data/Stream/Type.hs−2220 core/src/Streamly/Internal/Data/StreamK.hs−1730 core/src/Streamly/Internal/Data/StreamK/Transformer.hs−79 core/src/Streamly/Internal/Data/StreamK/Type.hs−2153 core/src/Streamly/Internal/Data/Time/Clock.hs−180 core/src/Streamly/Internal/Data/Time/Clock/config-clock.h−11 core/src/Streamly/Internal/Data/Time/TimeSpec.hsc−152 core/src/Streamly/Internal/Data/Tuple/Strict.hs−46 core/src/Streamly/Internal/Data/Unbox.hs−908 core/src/Streamly/Internal/Data/Unbox/TH.hs−498 core/src/Streamly/Internal/Data/Unfold.hs−1077 core/src/Streamly/Internal/Data/Unfold/Enumeration.hs−543 core/src/Streamly/Internal/Data/Unfold/Type.hs−999 core/src/Streamly/Internal/FileSystem/Path.hs−515 core/src/Streamly/Internal/System/IO.hs−58 core/src/Streamly/Internal/Unicode/Array.hs−104 core/src/Streamly/Internal/Unicode/Parser.hs−627 core/src/Streamly/Internal/Unicode/Stream.hs−1123 core/src/Streamly/Internal/Unicode/String.hs−158 core/src/Streamly/Unicode/Parser.hs−69 core/src/Streamly/Unicode/String.hs−30 core/src/assert.hs−6 core/src/inline.hs−27 core/streamly-core.cabal−534 credits/CONTRIBUTORS.md+85 credits/COPYRIGHTS.md+64 docs/User/Project/Credits.md → credits/README.md+1−3 credits/Yampa-0.10.6.2.txt+29 credits/base-4.12.0.0.txt+83 credits/bjoern-2008-2009.txt+19 credits/clock-0.7.2.txt+32 credits/foldl-1.4.5.txt+24 credits/pipes-concurrency-2.0.8.txt+24 credits/primitive-0.7.0.0.txt+30 credits/transient-0.5.5.txt+18 credits/vector-0.12.0.2.txt+30 default.nix−150 docs/Developer/dfa-bytes.png → design/dfa-bytes.png docs/Developer/dfa-classes.png → design/dfa-classes.png docs/Developer/dfa-rearr.png → design/dfa-rearr.png design/inlining.md+123 docs/Developer/linked-lists.md → design/linked-lists.md design/module-organization.md+134 docs/Developer/utf8-decoder.md → design/utf8-decoder.md+3−3 docs/Build.md+91 docs/Developer/Benchmarks.md−342 docs/Developer/Contributing.md−271 docs/Developer/Github.link−1 docs/Developer/MAINTAINING.md−422 docs/Developer/Tests.md−139 docs/Developer/ci-tests.md−64 docs/Developer/container-api.md−124 docs/Developer/cps-vs-direct.rst−328 docs/Developer/module-organization.md−250 docs/Developer/optimization-guidelines.md−370 docs/Developer/overview.md−24 docs/Developer/paths.rst−253 docs/Developer/related-packages.md−71 docs/Developer/resources.md−45 docs/Developer/roadmap.md−36 docs/Developer/unicode.md−224 docs/Documentation.md−5 docs/Setup.hs−6 docs/User/Explanatory/Overview.md−468 docs/User/Explanatory/design.md−42 docs/User/Explanatory/monad-transformers.md−65 docs/User/Explanatory/performance.md−7 docs/User/Explanatory/streaming-pradigms.rst−117 docs/User/Explanatory/unified-abstractions.md−275 docs/User/HowTo/Compiling.md−145 docs/User/HowTo/Examples.link−1 docs/User/HowTo/faq.md−94 docs/User/HowTo/interoperation.md−11 docs/User/HowTo/optimizing.md−98 docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt−175 docs/User/Project/ApiChangelogs/0.8.3.txt−261 docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt−424 docs/User/Project/CONTRIBUTORS.md−164 docs/User/Project/Github.link−1 docs/User/Project/README.md−141 docs/User/Project/Roadmap.link−1 docs/User/Project/Upgrading-0.8-to-0.9.md−384 docs/User/Tutorials/ConcurrentStreams.hs−771 docs/User/Tutorials/Examples.link−1 docs/User/Tutorials/ReactiveProgramming.hs−126 docs/User/Tutorials/Tutorial.hs−521 docs/User/Tutorials/before-you-begin.md−77 docs/User/Tutorials/getting-started.md−225 docs/User/Tutorials/haskell-lazy-evaluation.md−215 docs/User/Tutorials/quick-overview.md−517 docs/User/Tutorials/why-haskell-streamly.md−91 docs/User/resources.md−18 docs/streamly-docs.cabal−49 docs/User/HowTo/streamly-vs-async.md → docs/streamly-vs-async.md+17−19 docs/User/HowTo/streamly-vs-lists.md → docs/streamly-vs-lists.md+5−7 docs/transformers.md+32 examples/AcidRain.hs+58 examples/CamelCase.hs+33 examples/CirclingSquare.hs+83 examples/ControlFlow.hs+303 examples/EchoServer.hs+19 examples/FileIOExamples.hs+65 examples/FileSinkServer.hs+38 examples/FromFileClient.hs+21 examples/HandleIO.hs+107 examples/ListDir.hs+25 examples/MergeSort.hs+24 examples/README.md+43−2 examples/SearchQuery.hs+29 examples/Split.hs+44 examples/WordClassifier.hs+75 examples/WordCount.hs+630 hie.yaml−177 core/jsbits/clock.js → jsbits/clock.js src/Streamly.hs+648 src/Streamly/Data/Array.hs+43 src/Streamly/Data/Fold.hs+270 src/Streamly/Data/Fold/Prelude.hs−65 src/Streamly/Data/Fold/Tee.hs−16 src/Streamly/Data/Prim/Array.hs+44 src/Streamly/Data/SmallArray.hs+2−2 src/Streamly/Data/Stream/MkType.hs−115 src/Streamly/Data/Stream/Prelude.hs−232 src/Streamly/Data/Unfold.hs+69 core/src/Streamly/Unicode/Stream.hs → src/Streamly/Data/Unicode/Stream.hs+27−41 src/Streamly/Examples.hs+60 src/Streamly/Internal/FileSystem/FD.hs → src/Streamly/FileSystem/FD.hs+76−91 src/Streamly/Internal/FileSystem/FDIO.hs → src/Streamly/FileSystem/FDIO.hs+22−9 src/Streamly/FileSystem/Handle.hs+88 src/Streamly/Internal/System/IOVec/Type.hsc → src/Streamly/FileSystem/IOVec.hsc+12−15 core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hs+7−15 src/Streamly/Internal/Control/Concurrent.hs−77 src/Streamly/Internal/Control/ForkLifted.hs−66 core/src/Streamly/Internal/Control/Monad.hs → src/Streamly/Internal/Control/Monad.hs+4−2 src/Streamly/Internal/Data/Array.hs+203 src/Streamly/Internal/Data/Atomics.hs+2 src/Streamly/Internal/Data/Channel.hs−19 src/Streamly/Internal/Data/Channel/Dispatcher.hs−294 src/Streamly/Internal/Data/Channel/Types.hs−817 src/Streamly/Internal/Data/Channel/Worker.hs−375 src/Streamly/Internal/Data/Cont.hs−36 src/Streamly/Internal/Data/Fold.hs+1338 src/Streamly/Internal/Data/Fold/Async.hs−133 src/Streamly/Internal/Data/Fold/Concurrent.hs−57 src/Streamly/Internal/Data/Fold/Concurrent/Channel.hs−112 src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hs−331 src/Streamly/Internal/Data/Fold/Prelude.hs−19 src/Streamly/Internal/Data/Fold/SVar.hs−79 src/Streamly/Internal/Data/Fold/Types.hs+478 src/Streamly/Internal/Data/IOFinalizer/Lifted.hs−74 src/Streamly/Internal/Data/IsMap/HashMap.hs−42 src/Streamly/Internal/Data/List.hs+199 src/Streamly/Internal/Data/Pipe.hs+1976 core/src/Streamly/Internal/Data/Pipe/Type.hs → src/Streamly/Internal/Data/Pipe/Types.hs+22−16 src/Streamly/Internal/Data/Prim/Array.hs+205 src/Streamly/Internal/Data/Prim/Array/Types.hs+943 src/Streamly/Internal/Data/SVar.hs+2056−120 src/Streamly/Internal/Data/SVar/Dispatch.hs−739 src/Streamly/Internal/Data/SVar/Pull.hs−164 src/Streamly/Internal/Data/SVar/Worker.hs−544 src/Streamly/Internal/Data/Sink.hs+245 src/Streamly/Internal/Data/Sink/Types.hs+24 src/Streamly/Internal/Data/SmallArray.hs+40−51 src/Streamly/Internal/Data/SmallArray/Type.hs → src/Streamly/Internal/Data/SmallArray/Types.hs+88−14 src/Streamly/Internal/Data/Stream/Ahead.hs+130−173 src/Streamly/Internal/Data/Stream/Async.hs+243−309 src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs → src/Streamly/Internal/Data/Stream/Combinators.hs+16−35 src/Streamly/Internal/Data/Stream/Common.hs−105 src/Streamly/Internal/Data/Stream/Concurrent.hs−903 src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs−109 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hs−1046 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Consumer.hs−127 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hs−417 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hs−252 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs−294 src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hs−172 src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs → src/Streamly/Internal/Data/Stream/Enumeration.hs+52−96 src/Streamly/Internal/Data/Stream/Instances.hs+30−30 src/Streamly/Internal/Data/Stream/IsStream.hs−56 src/Streamly/Internal/Data/Stream/IsStream/Common.hs−747 src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs−1035 src/Streamly/Internal/Data/Stream/IsStream/Exception.hs−284 src/Streamly/Internal/Data/Stream/IsStream/Expand.hs−1158 src/Streamly/Internal/Data/Stream/IsStream/Generate.hs−640 src/Streamly/Internal/Data/Stream/IsStream/Lift.hs−150 src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs−1627 src/Streamly/Internal/Data/Stream/IsStream/Top.hs−749 src/Streamly/Internal/Data/Stream/IsStream/Transform.hs−1595 src/Streamly/Internal/Data/Stream/IsStream/Type.hs−783 src/Streamly/Internal/Data/Stream/Lifted.hs−335 src/Streamly/Internal/Data/Stream/MkType.hs−641 src/Streamly/Internal/Data/Stream/Parallel.hs+258−261 src/Streamly/Internal/Data/Stream/Prelude.hs+328−8 src/Streamly/Internal/Data/Stream/SVar.hs+230−8 src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs−405 src/Streamly/Internal/Data/Stream/SVar/Generate.hs−294 src/Streamly/Internal/Data/Stream/Serial.hs+257−241 src/Streamly/Internal/Data/Stream/StreamD.hs+4271 src/Streamly/Internal/Data/Stream/StreamD/Type.hs+647 src/Streamly/Internal/Data/Stream/StreamDK.hs+165 core/src/Streamly/Internal/Data/StreamK/Alt.hs → src/Streamly/Internal/Data/Stream/StreamDK/Type.hs+8−144 src/Streamly/Internal/Data/Stream/StreamK.hs+1095 src/Streamly/Internal/Data/Stream/StreamK/Type.hs+989 src/Streamly/Internal/Data/Stream/Time.hs−950 src/Streamly/Internal/Data/Stream/Zip.hs+187−95 src/Streamly/Internal/Data/Stream/ZipAsync.hs−134 src/Streamly/Internal/Data/Strict.hs+59 src/Streamly/Internal/Data/Time.hs+74 core/src/Streamly/Internal/Data/Time/Clock/Type.hsc → src/Streamly/Internal/Data/Time/Clock.hsc+67−10 core/src/Streamly/Internal/Data/Time/Clock/Darwin.c → src/Streamly/Internal/Data/Time/Darwin.c core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hs+88−28 core/src/Streamly/Internal/Data/Time/Clock/Windows.c → src/Streamly/Internal/Data/Time/Windows.c core/src/config.h.in → src/Streamly/Internal/Data/Time/config.h.in+5−7 src/Streamly/Internal/Data/Unfold.hs+956 src/Streamly/Internal/Data/Unfold/Exception.hs−214 src/Streamly/Internal/Data/Unfold/Prelude.hs−17 src/Streamly/Internal/Data/Unfold/SVar.hs−161 src/Streamly/Internal/Data/Unfold/Types.hs+31 src/Streamly/Internal/Data/Unicode/Char.hs+50 src/Streamly/Internal/Data/Unicode/Stream.hs+744 core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hs+105−195 src/Streamly/Internal/FileSystem/Event.hs−245 src/Streamly/Internal/FileSystem/Event/Darwin.h−63 src/Streamly/Internal/FileSystem/Event/Darwin.hs−1086 src/Streamly/Internal/FileSystem/Event/Darwin.m−294 src/Streamly/Internal/FileSystem/Event/Linux.hs−1294 src/Streamly/Internal/FileSystem/Event/Windows.hs−640 core/src/Streamly/Internal/FileSystem/File.hs → src/Streamly/Internal/FileSystem/File.hs+181−282 core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hs+300−332 src/Streamly/Internal/Memory/Array.hs+510 src/Streamly/Internal/Memory/Array/Types.hs+1357 src/Streamly/Internal/Memory/ArrayStream.hs+224 src/Streamly/Internal/Memory/Unicode/Array.hs+86 src/Streamly/Internal/Mutable/Prim/Var.hs+88 src/Streamly/Internal/Network/Inet/TCP.hs+158−199 src/Streamly/Internal/Network/Socket.hs+302−279 src/Streamly/Internal/Prelude.hs+4489 src/Streamly/Internal/System/IOVec.hs−132 src/Streamly/Internal/Unicode/Char.hs−328 src/Streamly/Internal/Unicode/Utf8.hs−73 src/Streamly/Data/Array/Foreign.hs → src/Streamly/Memory/Array.hs+11−54 src/Streamly/Memory/Malloc.hs+54 src/Streamly/Memory/Ring.hs+205 src/Streamly/Network/Inet/TCP.hs+6−49 src/Streamly/Network/Socket.hs+21−119 src/Streamly/Prelude.hs+355−670 src/Streamly/Tutorial.hs+1742 src/assert.hs−6 src/config.h.in−43 src/inline.hs+2−2 stack.yaml+13−12 streamly.cabal+1039−427 targets/Targets.hs−213 targets/cabal.project−1 targets/default.nix−163 targets/streamly-targets.cabal−12 test/Main.hs+1152 test/Streamly/Test/Prelude/Rate.hs → test/MaxRate.hs+46−67 test/Prop.hs+1328 test/Streamly/Test/Data/List.hs → test/PureStreams.hs+32−29 test/README.md−1 test/Streamly/Test/Array.hs+178 test/Streamly/Test/Data/Array.hs−276 test/Streamly/Test/Data/Array/Common.hs−101 test/Streamly/Test/Data/Array/CommonImports.hs−13 test/Streamly/Test/Data/Array/Generic.hs−65 test/Streamly/Test/Data/Array/Stream.hs−113 test/Streamly/Test/Data/Fold.hs−815 test/Streamly/Test/Data/Fold/Window.hs−67 test/Streamly/Test/Data/MutArray.hs−152 test/Streamly/Test/Data/Parser.hs−1379 test/Streamly/Test/Data/ParserK.hs−841 test/Streamly/Test/Data/Ring/Unboxed.hs−53 test/Streamly/Test/Data/Serialize.hs−306 test/Streamly/Test/Data/Serialize/CompatV0.hs−46 test/Streamly/Test/Data/Serialize/CompatV1.hs−48 test/Streamly/Test/Data/Serialize/TH.hs−82 test/Streamly/Test/Data/SmallArray.hs−29 test/Streamly/Test/Data/Stream.hs−33 test/Streamly/Test/Data/Stream/Concurrent.hs−363 test/Streamly/Test/Data/Unbox.hs−347 test/Streamly/Test/Data/Unbox/TH.hs−146 test/Streamly/Test/Data/Unfold.hs−701 test/Streamly/Test/FileSystem/Event.hs−28 test/Streamly/Test/FileSystem/Event/Common.hs−422 test/Streamly/Test/FileSystem/Event/Darwin.hs−86 test/Streamly/Test/FileSystem/Event/Linux.hs−163 test/Streamly/Test/FileSystem/Event/Windows.hs−51 test/Streamly/Test/FileSystem/Handle.hs−228 test/Streamly/Test/Internal/Data/Fold.hs+27 test/Streamly/Test/Internal/Prelude.hs+78 test/Streamly/Test/Network/Inet/TCP.hs−144 test/Streamly/Test/Network/Socket.hs−160 test/Streamly/Test/Prelude.hs−188 test/Streamly/Test/Prelude/Ahead.hs−137 test/Streamly/Test/Prelude/Async.hs−147 test/Streamly/Test/Prelude/Concurrent.hs−507 test/Streamly/Test/Prelude/Fold.hs−201 test/Streamly/Test/Prelude/Parallel.hs−121 test/Streamly/Test/Prelude/Serial.hs−741 test/Streamly/Test/Prelude/Top.hs−224 test/Streamly/Test/Prelude/WAsync.hs−222 test/Streamly/Test/Prelude/WSerial.hs−184 test/Streamly/Test/Prelude/ZipAsync.hs−70 test/Streamly/Test/Prelude/ZipSerial.hs−73 test/Streamly/Test/Serialize/Serializable.hs−237 test/Streamly/Test/Unicode/Char.hs−133 test/Streamly/Test/Unicode/Parser.hs−231 test/Streamly/Test/Unicode/Stream.hs−190 test/Streamly/Test/Unicode/extra/NormalizationTest.txt−9 test/Streamly/Test/Unicode/ucd/NormalizationTest.txt−18908 test/String.hs+135 test/lib/Streamly/Test/Common.hs−66 test/lib/Streamly/Test/Prelude/Common.hs−1757 test/loops.hs+76 test/nested-loops.hs+25 test/parallel-loops.hs+27 test/rate-timestamp.hs+26 test/streamly-tests.cabal−593 test/test-runner/Main.hs−33 test/test-runner/cabal.project−4 test/test-runner/default.nix−164 test/test-runner/test-runner.cabal−41
.circleci/config.yml+113−108
@@ -1,7 +1,7 @@
1−version: 2.1
1+version: 2
22
33#-----------------------------------------------------------------------------
4−# packcheck-0.7.0
4+# packcheck-0.4.2
55# Packcheck global environment variables
66#-----------------------------------------------------------------------------
77
@@ -11,8 +11,6 @@ env: &env
1111 # Common options
1212 # ------------------------------------------------------------------------
1313 # GHC_OPTIONS: "-Werror"
14− # For updating see: https://downloads.haskell.org/~ghcup/
15− GHCUP_VERSION: 0.1.20.0
1614 CABAL_REINIT_CONFIG: "y"
1715 LC_ALL: "C.UTF-8"
1816
@@ -20,10 +18,11 @@ env: &env
2018 # What to build
2119 # ------------------------------------------------------------------------
2220 # DISABLE_TEST: "y"
23− # DISABLE_BENCH: "y"
24− # DISABLE_DOCS: "y"
25− # DISABLE_SDIST_BUILD: "y"
26− # DISABLE_DIST_CHECKS: "y"
21+ DISABLE_BENCH: "y"
22+ DISABLE_DOCS: "y"
23+ DISABLE_SDIST_BUILD: "y"
24+ DISABLE_DIST_CHECKS: "y"
25+ # ENABLE_INSTALL: "y"
2726
2827 # ------------------------------------------------------------------------
2928 # stack options
@@ -32,19 +31,21 @@ env: &env
3231 # github API limit while checking and upgrading/downgrading to the specific
3332 # version.
3433 #STACKVER: "1.6.5"
35− STACK_UPGRADE: "y"
34+ #STACK_UPGRADE: "y"
3635 #RESOLVER: "lts-12"
3736
3837 # ------------------------------------------------------------------------
3938 # cabal options
4039 # ------------------------------------------------------------------------
4140 CABAL_CHECK_RELAX: "y"
42− CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
41+ CABAL_NO_SANDBOX: "y"
42+ CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
4343
4444 # ------------------------------------------------------------------------
4545 # Where to find the required tools
4646 # ------------------------------------------------------------------------
47− PATH: /sbin:/usr/sbin:/bin:/usr/bin
47+ PATH: /opt/ghc/bin:/sbin:/usr/sbin:/bin:/usr/bin
48+ #TOOLS_DIR: /opt
4849
4950 # ------------------------------------------------------------------------
5051 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
@@ -56,16 +57,11 @@ env: &env
5657 PACKCHECK: "./packcheck.sh"
5758 # If you have not committed packcheck.sh in your repo at PACKCHECK
5859 # then it is automatically pulled from this URL.
59− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
60− PACKCHECK_GITHUB_COMMIT: "f6cfd7b7a33b4bf6fd63cce6a3fb3d26f5031403"
60+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
61+ PACKCHECK_GITHUB_COMMIT: "b8d39c9cf336e4627e12eb4b1f5827bb7b6afc91"
6162
62−executors:
63− amd64-executor:
6463 docker:
65− - image: ubuntu:latest
66− x86-executor:
67− docker:
68− - image: i386/ubuntu:focal
64+ - image: debian:stretch
6965
7066#-----------------------------------------------------------------------------
7167# Common utility stuff, not to be modified usually
@@ -77,142 +73,151 @@ preinstall: &preinstall
7773 # required for https/cache save and restore
7874 apt-get install -y ca-certificates
7975
80− # Alternative way of installing ghc and cabal, directly from
81− # haskell.org instead of using ghcup. NOTE: this is for Debian
82− # only and is debian release specific.
76+ # For ghc and cabal-install packages from haskell.org
8377 # gnupg is required for apt-key to work
84− #apt-get install -y gnupg
85− #apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
86− #echo "deb http://downloads.haskell.org/debian buster main" >> /etc/apt/sources.list
87− #apt-get update
78+ apt-get install -y gnupg
79+ apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
80+ echo "deb http://downloads.haskell.org/debian stretch main" >> /etc/apt/sources.list
81+ apt-get update
82+
83+ # required for packcheck
84+ apt-get install -y curl
8885
8986 # required for outbound https for stack and for stack setup
9087 apt-get install -y netbase xz-utils make
91− apt-get install -y zlib1g-dev
92−
93− # For ghcup to install ghc
94− if test -n "$GHCUP_VERSION"
95− then
96− apt-get install -y gcc
97− apt-get install -y g++
98− fi
99−
100− # libgmp required by ghc for linking
101− apt-get install -y libgmp-dev
102− apt-get install -y libtinfo-dev
10388
104− # Required by cabal when git URL is specified in project file
105− apt-get install -y git
106−
107− # Required for and by packcheck
108− apt-get install -y curl
89+ # If a custom stack-yaml is specified, replace the default with that
90+ if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
91+ unset STACK_YAML
10992
11093 # Get packcheck if needed
111− if test ! -e "$PACKCHECK"
112− then
113− if test -z "$PACKCHECK_GITHUB_COMMIT"
114− then
115− die "PACKCHECK_GITHUB_COMMIT is not specified."
116− fi
117− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
118− curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
119− chmod +x $PACKCHECK
120− elif test ! -x "$PACKCHECK"
121− then
122− chmod +x $PACKCHECK
123− fi
94+ CURL=$(which curl)
95+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
96+ if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi;
97+ chmod +x $PACKCHECK
12498
12599restore: &restore
126100 # Needs to happen after installing ca-certificates
127101 restore_cache:
128− keys:
129− - v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
130− # Fallback to master branch's cache.
131− - v1-{{ .Environment.CIRCLE_JOB }}-master
132− # Fallback to any branch's cache.
133− - v1-{{ .Environment.CIRCLE_JOB }}-
102+ key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
134103
135104save: &save
136105 save_cache:
137106 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
138107 paths:
139− - ~/.local
140108 - ~/.cabal
109+ - ~/.ghc
110+ - ~/.local
141111 - ~/.stack
142− - ~/.ghcup
143112
144113#-----------------------------------------------------------------------------
145114# Build matrix
146115#-----------------------------------------------------------------------------
147116
148117jobs:
149− cabal-ghc-8_6_5:
118+ cabal-ghc-8.6.5:
150119 <<: *env
151− executor: amd64-executor
152120 steps:
153121 - checkout
122+ - *preinstall
154123 - *restore
124+ - run: |
125+ apt-get install -y ghc-8.6.3
126+ apt-get install -y cabal-install-2.4
127+ bash -c "$PACKCHECK cabal-v2"
128+ - *save
129+ cabal-ghc-8.4.4:
130+ <<: *env
131+ steps:
132+ - checkout
155133 - *preinstall
156− - run:
157− environment:
158− GHCVER: "8.6.5"
159− CABAL_VERSION: "3.6.2.0"
160− CABAL_PROJECT: "cabal.project"
161− DISABLE_SDIST_BUILD: "yes"
162− CABAL_BUILD_OPTIONS: "--flag debug --flag -opt"
163− command: |
164− bash -c "$PACKCHECK cabal"
134+ - *restore
135+ - run: |
136+ apt-get install -y ghc-8.4.4
137+ apt-get install -y cabal-install-2.4
138+ bash -c "$PACKCHECK cabal-v2"
139+ - *save
140+ cabal-ghc-8.2.2:
141+ <<: *env
142+ steps:
143+ - checkout
144+ - *preinstall
145+ - *restore
146+ - run: |
147+ apt-get install -y ghc-8.2.2
148+ apt-get install -y cabal-install-2.4
149+ bash -c "$PACKCHECK cabal-v2"
165150 - *save
166− cabal-ghc-9_8_1-docspec:
151+ cabal-ghc-8.0.2:
167152 <<: *env
168− executor: amd64-executor
169153 steps:
170154 - checkout
155+ - *preinstall
171156 - *restore
157+ - run: |
158+ apt-get install -y ghc-8.0.2
159+ apt-get install -y cabal-install-2.4
160+ bash -c "$PACKCHECK cabal-v2"
161+ - *save
162+ cabal-ghc-7.10.3:
163+ <<: *env
164+ steps:
165+ - checkout
172166 - *preinstall
173− - run:
174− environment:
175− GHCVER: "9.8.1"
176− CABAL_VERSION: "3.10.1.0"
177− CABAL_PROJECT: "cabal.project.doctest"
178− DISABLE_SDIST_BUILD: "y"
179− DISABLE_TEST: "y"
180− DISABLE_BENCH: "y"
181− DISABLE_DOCS: "y"
182− ENABLE_DOCSPEC: "y"
183− DOCSPEC_URL: https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz
184− DOCSPEC_OPTIONS: "--timeout 60 --check-properties --property-variables xs"
185− command: |
186− bash -c "$PACKCHECK cabal"
167+ - *restore
168+ - run: |
169+ apt-get install -y ghc-7.10.3
170+ apt-get install -y cabal-install-2.4
171+ bash -c "$PACKCHECK cabal-v2"
187172 - *save
188− hlint-trailing-spaces:
173+ stack-ghc-8.4:
189174 <<: *env
190− executor: amd64-executor
191175 steps:
192176 - checkout
177+ - *preinstall
193178 - *restore
179+ - run: |
180+ bash -c "$PACKCHECK stack RESOLVER=lts-12"
181+ - *save
182+ stack-ghc-8.2:
183+ <<: *env
184+ steps:
185+ - checkout
194186 - *preinstall
187+ - *restore
188+ - run: |
189+ bash -c "$PACKCHECK stack RESOLVER=lts-11"
190+ - *save
191+ coveralls-ghc-8.2.2:
192+ <<: *env
193+ steps:
194+ - checkout
195+ - *preinstall
196+ - *restore
195197 - run:
196− name: hlint and trailing spaces
197198 environment:
198− DISABLE_SDIST_BUILD: "yes"
199− HLINT_VERSION: 3.6.1
200− HLINT_OPTIONS: lint
201− HLINT_TARGETS: core/src src test benchmark
199+ BUILD: cabal
200+ COVERALLS_OPTIONS: "--repo-token=KlGN45lDWQkw55TNm18nkam2EXRg9lCSH --coverage-mode=StrictlyFullLines --exclude-dir=test test"
201+ GHC_OPTIONS: "-DCOVERAGE_BUILD"
202202 command: |
203− bash -c "$PACKCHECK hlint" || exit 1
204− echo "Checking trailing spaces..."
205− count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
206− exit $count
203+ apt-get install -y ghc-8.2.2
204+ apt-get install -y cabal-install-2.4
205+ # required by hpc-coveralls
206+ apt-get install -y libcurl4-gnutls-dev
207+ apt-get install -y git
208+ apt-get install libtinfo-dev
209+ bash -c "$PACKCHECK cabal-v1"
207210 - *save
208211
209212workflows:
210213 version: 2
211214 build:
212215 jobs:
213− #- cabal-ghc-8_6_5:
214− # name: 8.6.5-debug-unoptimized
215− - cabal-ghc-9_8_1-docspec:
216− name: ghc-9.8.1-docspec
217− - hlint-trailing-spaces:
218− name: hlint and trailing spaces
216+ #- cabal-ghc-8.6.5
217+ #- cabal-ghc-8.4.4
218+ #- cabal-ghc-8.2.2
219+ #- cabal-ghc-8.0.2
220+ #- cabal-ghc-7.10.3
221+ #- stack-ghc-8.4
222+ #- stack-ghc-8.2
223+ - coveralls-ghc-8.2.2
.ghcideleted−1
@@ -1 +0,0 @@
1−:set -fobject-code
.github/workflows/haskell.yml+44−225
@@ -8,251 +8,70 @@ on:
88
99jobs:
1010 build:
11− name: GHC ${{matrix.name}}
11+ name: GHC ${{ matrix.ghc_version }}
1212 env:
13− # packcheck environment variables
13+ CABAL_REINIT_CONFIG: y
1414 LC_ALL: C.UTF-8
15− BUILD: ${{ matrix.build }}
16− # For updating see: https://downloads.haskell.org/~ghcup/
17− GHCUP_VERSION: 0.1.20.0
18− DOCSPEC_URL: https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz
19− DOCSPEC_OPTIONS: "--timeout 60 --check-properties --property-variables xs"
20− GHCUP_GHC_OPTIONS: ${{ matrix.ghcup_ghc_options }}
21− GHCVER: ${{ matrix.ghc_version }}
22− CABALVER: ${{ matrix.cabal_version }}
23− DISABLE_DOCS: ${{ matrix.disable_docs }}
24− ENABLE_DOCSPEC: ${{ matrix.enable_docspec }}
25− DISABLE_TEST: ${{ matrix.disable_test }}
26− DISABLE_BENCH: ${{ matrix.disable_bench }}
27− DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
28− SDIST_OPTIONS: ${{ matrix.sdist_options }}
29− DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
3015
31− # Cabal options
32− CABAL_REINIT_CONFIG: y
33− # Github has machines with 2 CPUS and 6GB memory so the cabal jobs
34− # default (ncpus) is good, this can be checked from the packcheck
35− # output in case it changes.
36− CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }} --flag limit-build-mem
37− CABAL_BUILD_TARGETS: ${{ matrix.cabal_build_targets }}
38− CABAL_PROJECT: ${{ matrix.cabal_project }}
39− CABAL_CHECK_RELAX: y
16+ ENABLE_INSTALL: "n"
4017
41− # Stack options
4218 STACK_UPGRADE: "y"
43− RESOLVER: ${{ matrix.resolver }}
44− STACK_YAML: ${{ matrix.stack_yaml }}
45− STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
46−
47− # packcheck location and revision
48− PACKCHECK: "./packcheck.sh"
49− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
50− PACKCHECK_GITHUB_COMMIT: "v0.7.0"
5119
52− # Pull token from "secrets" setting of the github repo
53− COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
54− COVERAGE: ${{ matrix.coverage }}
20+ CABAL_CHECK_RELAX: y
21+ CABAL_NO_SANDBOX: y
22+ CABAL_HACKAGE_MIRROR: hackage.haskell.org:http://hackage.fpcomplete.com
5523
56− # hlint
57− HLINT_VERSION: 3.6.1
58− HLINT_OPTIONS: "lint"
59− HLINT_TARGETS: "core/src src test benchmark"
24+ PACKCHECK_LOCAL_PATH: "./packcheck.sh"
25+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
26+ PACKCHECK_GITHUB_COMMIT: "b8d39c9cf336e4627e12eb4b1f5827bb7b6afc91"
6027
61− # Subdir
62− SUBDIR: ${{ matrix.subdir }}
28+ BUILD: ${{ matrix.build }}
29+ GHCVER: ${{ matrix.ghc_version }}
30+ CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }}
6331
64− runs-on: ${{ matrix.runner }}
65− continue-on-error: ${{ matrix.ignore_error }}
32+ runs-on: ubuntu-latest
6633 strategy:
67− fail-fast: true
34+ fail-fast: false
6835 matrix:
69− # The order is important to optimize fail-fast.
70− name:
71− - 9.8.1-Werror
72− # - 9.8.1-docspec
73− # - 8.10.7-coverage
74−
75− # Note: if cabal.project is not specified benchmarks and tests won't
76− # run. But we need at least one test where we test without
77− # cabal.project because that is how hackage would build it.
36+ ghc_version: [8.8.1, 8.6.5, 8.6.5]
37+ cabal_version: ["3.0"]
7838 include:
79− - name: head
80− ghc_version: head
81− # The URL may change, to find a working URL go to https://gitlab.haskell.org/ghc/ghc/-/jobs/
82− # Find a debian10/11/12 job, click on a passed/failed status, at the
83− # end of the output you will find the tar.xz name, put that tar
84− # name after "raw/", and put the job name after "job=".
85− # Also see https://github.com/mpickering/ghc-artefact-nix/blob/master/gitlab-artifact.nix
86− #
87− # May also use ghcup for installing ghc head version, use the
88− # version "LatestNightly", and the following config:
89− # ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
90− ghcup_ghc_options: "-u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-deb10-int_native-validate.tar.xz?job=x86_64-linux-deb10-int_native-validate"
91− runner: ubuntu-latest
92− build: cabal
93− cabal_version: 3.10.2.0
94− cabal_project: cabal.project.ghc-head
95− disable_sdist_build: "y"
96− ignore_error: true
97− # Note: use linux for warning build for convenient dev testing
98− - name: 9.8.1-Werror
99− ghc_version: 9.8.1
100− runner: ubuntu-latest
101− build: cabal
102− cabal_version: 3.10.1.0
103− disable_sdist_build: "y"
104− cabal_project: cabal.project.Werror
105− ignore_error: false
106− #- name: 9.8.1-docspec
107− # ghc_version: 9.8.1
108− # runner: ubuntu-latest
109− # build: cabal
110− # cabal_version: 3.10.1.0
111− # cabal_project: cabal.project.doctest
112− # disable_test: "y"
113− # disable_bench: "y"
114− # disable_docs: "y"
115− # enable_docspec: "y"
116− # disable_sdist_build: "y"
117− # ignore_error: false
118− - name: 9.8.1-fusion-inspection
119− ghc_version: 9.8.1
120− runner: ubuntu-latest
121− build: cabal
122− cabal_version: 3.10.1.0
123− disable_sdist_build: "y"
124− cabal_project: cabal.project
125− cabal_build_options: "--flag fusion-plugin --flag inspection"
126− ignore_error: false
127− - name: 9.6.3-macos
128− ghc_version: 9.6.3
129− runner: macos-latest
130− build: cabal
131− cabal_version: 3.10.1.0
132− disable_sdist_build: "y"
133− cabal_project: cabal.project
134− ignore_error: false
135− - name: 9.4.7
136− ghc_version: 9.4.7
137− runner: ubuntu-latest
138− build: cabal
139− cabal_version: 3.8.1.0
140− disable_sdist_build: "y"
141− cabal_project: cabal.project
142− ignore_error: false
143− - name: 9.2.8
144− ghc_version: 9.2.8
145− runner: ubuntu-latest
146− build: cabal
147− cabal_project: cabal.project
148− cabal_version: 3.6.2.0
149− disable_sdist_build: "y"
150− ignore_error: false
151− - name: 9.0.2-streamly-sdist
152− ghc_version: 9.0.2
153− runner: ubuntu-latest
154− build: cabal
155− cabal_version: 3.6.2.0
156− cabal_project: cabal.project.streamly
157− ignore_error: true
158− - name: 9.0.2-streamly-core-sdist
159− ghc_version: 9.0.2
160− runner: ubuntu-latest
161− build: cabal
162− cabal_version: 3.6.2.0
163− subdir: core
164− ignore_error: false
165− - name: 8.10.7-streamly-sdist-stack
166− runner: ubuntu-latest
167− build: stack
168− resolver: lts-20.13
169− stack_yaml: stack.yaml
170− sdist_options: "--ignore-check"
171− stack_build_options: "--flag streamly-benchmarks:-opt"
172− cabal_version: 3.6.2.0
173− ignore_error: false
174− # - name: 8.10.7-coverage
175− # ghc_version: 8.10.7
176− # runner: ubuntu-latest
177− # coverage: "y"
178− # cabal_version: 3.6.2.0
179− # ignore_error: false
180− - name: 8.8.4
181− ghc_version: 8.8.4
182− runner: ubuntu-latest
183− build: cabal
184− cabal_version: 3.6.2.0
185− cabal_project: cabal.project
186− disable_sdist_build: "y"
187− ignore_error: false
188− - name: 8.6.5-debug-unoptimized
189− ghc_version: 8.6.5
190− runner: ubuntu-latest
191− build: cabal
192− cabal_version: 3.6.2.0
193− cabal_project: cabal.project
194− cabal_build_options: "--flag debug --flag -opt"
195− disable_sdist_build: "y"
196− ignore_error: false
197− - name: hlint
198− build: hlint
199− runner: ubuntu-latest
200− ignore_error: true
39+ - ghc_version: 8.8.1
40+ build: cabal-v2
41+ cabal_build_options: "--project-file=cabal.project.ci"
42+ - ghc_version: 8.6.5
43+ build: cabal-v2
44+ cabal_build_options: "--flags streamk"
45+ - ghc_version: 8.6.5
46+ build: cabal-v2
47+ cabal_build_options: "--flags fusion-plugin"
20148
20249 steps:
20350 - uses: actions/checkout@v2
20451
52+ - uses: actions/setup-haskell@v1
53+ with:
54+ ghc-version: ${{ matrix.ghc_version }}
55+ cabal-version: ${{ matrix.cabal_version }}
56+
20557 - uses: actions/cache@v1
206− name: Cache common directories
58+ name: Cache ~/.cabal
20759 with:
208− path: |
209− ~/.local
210− ~/.cabal
211− ~/.stack
212− ~/.ghcup
213− # Bump the key version to clear the cache
214− key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v2
60+ path: ~/.cabal
61+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal
21562
21663 - name: Download packcheck
21764 run: |
218− if test ! -e "$PACKCHECK"
219− then
220− if test -z "$PACKCHECK_GITHUB_COMMIT"
221− then
222− die "PACKCHECK_GITHUB_COMMIT is not specified."
223− fi
224− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
225− curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
226− chmod +x $PACKCHECK
227− elif test ! -x "$PACKCHECK"
228− then
229− chmod +x $PACKCHECK
230− fi
65+ # If a custom stack-yaml is specified, replace the default with that
66+ if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
67+ unset STACK_YAML
68+
69+ # Get packcheck if needed
70+ CURL=$(which curl)
71+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
72+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
73+ chmod +x $PACKCHECK_LOCAL_PATH
23174
232− - name: Run tests
75+ - name: Run packcheck
23376 run: |
234− if test -n "$COVERAGE"
235− then
236− # Run tests with coverage
237− cabal update
238− # Build hpc-coveralls if needed
239− sudo apt-get install -y libcurl4-gnutls-dev
240− export PATH=$HOME/.cabal/bin:$PATH
241− which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
242− # Run tests and upload results to coveralls.io
243− bin/test.sh --coverage --raw
244− # XXX Uncomment this and fix it properly later
245− # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
246− else
247− # /usr/local/opt/curl/bin for macOS
248− export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
249− if test -n "$SUBDIR"
250− then
251− mv "$PACKCHECK" "$SUBDIR/packcheck.sh"
252− # This is required as dist-newstyle will be created on the top level
253− # directory as it is considered the working dir.
254− rm cabal.project
255− cd "$SUBDIR"
256− fi
257− bash -c "$PACKCHECK $BUILD"
258− fi
77+ bash -c "$PACKCHECK_LOCAL_PATH $BUILD"
.github/workflows/packdiff.ymldeleted−39
@@ -1,39 +0,0 @@
1−name: Packdiff
2−
3−on: pull_request
4−
5−jobs:
6− packdiff:
7−
8− runs-on: ubuntu-latest
9−
10− steps:
11−
12− - name: Download ghc
13− run: |
14− GHCUP_VER=0.1.18.0
15− curl -sL -o ./ghcup https://downloads.haskell.org/~ghcup/$GHCUP_VER/x86_64-linux-ghcup-$GHCUP_VER
16− chmod +x ./ghcup
17− GHCVER=8.10.7
18− ./ghcup install ghc $GHCVER
19− ./ghcup set ghc $GHCVER
20− cabal update
21−
22− - uses: actions/cache@v2
23− name: Cache ~/.cabal
24− with:
25− path: |
26− ~/.cabal
27− # Bump the key version to clear the cache
28− key: cache-v2
29−
30− - name: Checkout the current branch
31− uses: actions/checkout@v2
32− with:
33− fetch-depth: 0
34−
35− - name: Run packdiff on streamly-core
36− run: cabal run packdiff --project-file=cabal.project.packdiff -- streamly-core $(git rev-parse origin/master) $(git rev-parse HEAD)
37−
38− - name: Run packdiff on streamly
39− run: cabal run packdiff --project-file=cabal.project.packdiff -- streamly $(git rev-parse origin/master) $(git rev-parse HEAD)
.github/workflows/regression-check.ymldeleted−165
@@ -1,165 +0,0 @@
1−name: Regression checking
2−
3−on:
4− workflow_dispatch:
5− pull_request:
6−
7−# References:
8−# https://docs.github.com/en/actions/managing-workflow-runs/manually-running-a-workflow
9−# https://docs.github.com/en/actions/using-workflows/reusing-workflows#reusable-workflows-and-starter-workflows
10−# https://docs.github.com/en/actions/using-workflows/workflow-syntax-for-github-actions#onworkflow_call
11−# https://docs.github.com/en/actions/learn-github-actions/contexts#about-contexts-and-expressions
12−
13−# You can override the default DIFF_CUTOFF_PERCENT by specifying a cutoff along
14−# with the benchmark target.
15−# Eg, "Data.Async:12" where "Data.Async" is the benchmark target, ":" is the
16−# seperator, and "12" is the new cutoff percent
17−jobs:
18− check-regressions:
19− env:
20− CI_BENCHMARKS_WITH_CUTOFF: >-
21− Data.Array
22− Data.MutArray
23− Data.Array.Generic
24− Data.Ring.Unboxed
25− Data.Fold
26− Data.Fold.Window
27− Data.Parser
28− Data.ParserK
29− Data.StreamD
30− Data.StreamK:6
31− Data.Unfold
32− Data.Stream
33− Data.Stream.Concurrent
34− Data.Stream.ConcurrentEager
35− Data.Stream.ConcurrentInterleaved
36− Data.Stream.ConcurrentOrdered
37− FileSystem.Handle
38− Unicode.Char
39− Unicode.Stream
40− Unicode.Utf8
41− CI_FIELDS: allocated
42− CI_DIFF_CUTOFF_PERCENT: 3
43−
44− runs-on: ubuntu-latest
45−
46− steps:
47−
48− - name: Update environment
49− run: |
50− CI_BENCHMARKS=""
51− for i in $CI_BENCHMARKS_WITH_CUTOFF
52− do
53− bname=$(echo "$i" | cut -d: -f1)
54− CI_BENCHMARKS="$CI_BENCHMARKS $bname"
55− done
56− echo "CI_BENCHMARKS=$CI_BENCHMARKS" >> $GITHUB_ENV
57−
58− - name: Download ghc
59− run: |
60− GHCUP_VER=0.1.18.0
61− curl -sL -o ./ghcup https://downloads.haskell.org/~ghcup/$GHCUP_VER/x86_64-linux-ghcup-$GHCUP_VER
62− chmod +x ./ghcup
63− GHCVER=9.2.7
64− ./ghcup install ghc $GHCVER
65− ./ghcup set ghc $GHCVER
66− cabal update
67−
68− - uses: actions/cache@v2
69− name: Cache ~/.cabal
70− with:
71− path: |
72− ~/.cabal
73− # Bump the key version to clear the cache
74− key: cache-v2
75−
76− - name: Cache bench-runner from pr
77− id: cache-bench-runner-pr
78− uses: actions/cache@v2
79− with:
80− path: bench-runner
81− # Bump the key version to clear the cache
82− key: bench-runner-v1
83−
84− # -----------------------------------------------------------------
85− # -- Install bench-report in the current directory
86− # -----------------------------------------------------------------
87−
88− - name: Checkout the current branch
89− uses: actions/checkout@v2
90− with:
91− clean: false
92−
93− - name: Install bench-runner
94− run: |
95− cabal install bench-runner --project-file=cabal.project.report --installdir=./
96−
97− # -----------------------------------------------------------------
98− # -- Generate reports for the base branch and upload
99− # -----------------------------------------------------------------
100−
101− - name: Checkout the base branch
102− uses: actions/checkout@v2
103− with:
104− ref: master
105− clean: false
106−
107− - name: Run benchmarks
108− run: |
109− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --raw
110−
111− - name: Move charts to charts-master
112− run: mv charts charts-master
113−
114− # -----------------------------------------------------------------
115− # -- Download, generate reports for the current branch and append
116− # -----------------------------------------------------------------
117−
118− - name: Checkout the current branch
119− uses: actions/checkout@v2
120− with:
121− clean: false
122−
123− - name: Copy charts-master to charts
124− run: cp -r charts-master charts
125−
126− - name: Run benchmarks and append
127− run: |
128− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --raw --append
129−
130− # -----------------------------------------------------------------
131− # -- Compare
132− # -----------------------------------------------------------------
133−
134− - name: List all benchmarks
135− run: |
136− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --no-measure
137−
138− - name: Compare benchmarks
139− run: |
140−
141− EXIT_STATUS=0
142−
143− for i in $CI_BENCHMARKS_WITH_CUTOFF
144− do
145− arrI=(${i//:/ })
146−
147− bname=${arrI[0]}
148− cutoff=${arrI[1]}
149−
150− test -z "$cutoff" && cutoff=$CI_DIFF_CUTOFF_PERCENT
151−
152− echo
153− echo "Checking $bname for regressions greater than $cutoff percent"
154− ! ./bench-runner \
155− --package-name streamly-benchmarks \
156− --package-version 0.0.0 \
157− --targets "$bname" \
158− --fields "$CI_FIELDS" \
159− --no-measure --silent \
160− --diff-cutoff-percent $cutoff \
161− | grep -v "^$"
162− test $? -eq 1 && EXIT_STATUS=1
163− done
164−
165− exit $EXIT_STATUS
.gitignore+3−8
@@ -1,11 +1,7 @@
11# Build files/directories
2−.stack-work/
3−dist/
4−dist-newstyle*/
5−.cabal.nix
6−autom4te.cache/
7−benchmark/bench-report/bin/bench-report
8−charts/
2+/.stack-work/
3+/dist/
4+/dist-newstyle/
95
106# Local GHC and Cabal related files
117.ghc.environment*
@@ -18,4 +14,3 @@ cabal.project.local
1814
1915# Other
2016.log
21−_doctests/
.hlint.ignoredeleted−40
@@ -1,40 +0,0 @@
1−core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs
2−core/src/Streamly/Internal/Data/Pipe/Type.hs
3−core/src/Streamly/Internal/Unicode/Stream.hs
4−src/Streamly/Internal/Data/SmallArray/Type.hs
5−src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs
6−src/Streamly/Internal/Data/Stream/Serial.hs
7−src/Streamly/Internal/Data/Stream/Zip.hs
8−test/Streamly/Test/Data/Array.hs
9−test/Streamly/Test/Data/Parser.hs
10−test/Streamly/Test/Data/ParserK.hs
11−test/Streamly/Test/Data/SmallArray.hs
12−test/Streamly/Test/Data/Unfold.hs
13−test/Streamly/Test/FileSystem/Event.hs
14−test/Streamly/Test/Prelude/Concurrent.hs
15−test/Streamly/Test/Data/Stream/Concurrent.hs
16−test/lib/Streamly/Test/Prelude/Common.hs
17−test/Streamly/Test/Prelude/Fold.hs
18−test/Streamly/Test/Prelude/Rate.hs
19−test/Streamly/Test/Prelude/Serial.hs
20−test/Streamly/Test/Unicode/Stream.hs
21−test/Streamly/Test/Data/Unbox.hs
22−benchmark/lib/Streamly/Benchmark/Common.hs
23−benchmark/lib/Streamly/Benchmark/Common/Handle.hs
24−benchmark/lib/Streamly/Benchmark/Prelude.hs
25−benchmark/NanoBenchmarks.hs
26−benchmark/Streamly/Benchmark/Data/Array.hs
27−benchmark/Streamly/Benchmark/Data/Parser.hs
28−benchmark/Streamly/Benchmark/Data/ParserK.hs
29−benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
30−benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
31−benchmark/Streamly/Benchmark/Data/Unfold.hs
32−benchmark/Streamly/Benchmark/FileSystem/Handle.hs
33−benchmark/Streamly/Benchmark/Prelude/Async.hs
34−benchmark/Streamly/Benchmark/Prelude/Concurrent.hs
35−benchmark/Streamly/Benchmark/Prelude/Merge.hs
36−benchmark/Streamly/Benchmark/Prelude/Parallel.hs
37−benchmark/Streamly/Benchmark/Prelude/Rate.hs
38−benchmark/Streamly/Benchmark/Prelude/WAsync.hs
39−benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
40−benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
.hlint.yaml+3−26
@@ -10,38 +10,15 @@
1010- suggest: {name: "Unused LANGUAGE pragma"}
1111- suggest: {name: "Eta reduce"}
1212- suggest: {name: "Reduce duplication"}
13−
14−# Warnings currently ignored
1513- ignore: {name: "Use list literal pattern"}
1614- ignore: {name: "Use tuple-section"} # requires GHC extension
1715- ignore: {name: "Use fromMaybe"} # may want to use this suggestion, but it didn't match the common idiom of the library
1816- ignore: {name: "Use unless"} # low power-to-weight
19−- ignore: {name: "Reduce duplication"}
20−- ignore: {name: "Use <>"}
21−- ignore: {name: "Use fewer imports"}
22−- ignore: {name: "Use camelCase"}
23−- ignore: {name: "Use <$>"}
24−- ignore: {name: "Use uncurry"}
25−- ignore: {name: "Redundant $!"}
26−- ignore: {name: "Use fmap"}
27−- ignore: {name: "Use ++"}
28−
29−# Warnings ignored in specific places
30−- ignore: {name: "Use mapM", within: Stream.Transform}
31−- ignore: {name: "Use traverse", within: Stream.Transform}
32−- ignore: {name: "Redundant <*", within: Stream.Expand}
33−- ignore: {name: "Redundant bracket", within: Stream.Split}
34−- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Parser}
17+
3518
3619# Specify additional command line arguments
3720#
38−- arguments:
39− [ --cpp-include=src
40− , --cpp-include=src/Streamly/Internal/Data/Stream
41− , --cpp-include=src/Streamly/Internal/Data/Array
42− , --cpp-include=test
43− , --cpp-define=CABAL_OS_LINUX
44− ]
21+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
4522
4623
4724# Control which extensions/flags/modules/functions can be used
@@ -71,7 +48,7 @@
7148# Turn on hints that are off by default
7249#
7350# Ban "module X(module X) where", to require a real export list
74−- warn: {name: Use explicit module export list}
51+# - warn: {name: Use explicit module export list}
7552#
7653# Replace a $ b $ c with a . b $ c
7754# - group: {name: dollar, enabled: true}
.packcheck.ignoredeleted−36
@@ -1,36 +0,0 @@
1−.circleci/config.yml
2−.ghci
3−.github/workflows/haskell.yml
4−.github/workflows/regression-check.yml
5−.github/workflows/packdiff.yml
6−.gitignore
7−.hlint.ignore
8−.hlint.yaml
9−.packcheck.ignore
10−appveyor.yml
11−benchmark/bench-runner/default.nix
12−benchmark/bench-runner/cabal.project
13−bin/ghc.sh
14−bin/repl
15−bin/run-ci.sh
16−bin/run-repl-quick.sh
17−cabal.project
18−cabal.project.coverage
19−cabal.project.doctest
20−cabal.project.ghc-head
21−cabal.project.hpc-coveralls
22−cabal.project.O0
23−cabal.project.report
24−cabal.project.packdiff
25−cabal.project.streamly
26−cabal.project.Werror
27−cabal.project.Werror-nocode
28−core/
29−default.nix
30−examples/README.md
31−hie.yaml
32−stack.yaml
33−targets/default.nix
34−targets/cabal.project
35−test/test-runner/default.nix
36−test/test-runner/cabal.project
.travis.ymlnew file+231
@@ -0,0 +1,231 @@
1+# packcheck-0.4.2
2+# You can use any of the options supported by packcheck as environment
3+# variables here. See https://github.com/harendra-kumar/packcheck for all
4+# options and their explanation.
5+
6+if: branch = master
7+
8+# dist: trusty
9+dist: xenial
10+env:
11+ # ------------------------------------------------------------------------
12+ # Global options, you can use these per build as well
13+ # ------------------------------------------------------------------------
14+ global:
15+ # ------------------------------------------------------------------------
16+ # Common options
17+ # ------------------------------------------------------------------------
18+ - GHC_OPTIONS="-Werror"
19+ - CABAL_REINIT_CONFIG=y
20+ - LC_ALL=C.UTF-8
21+
22+ # ------------------------------------------------------------------------
23+ # What to build
24+ # ------------------------------------------------------------------------
25+ # - DISABLE_TEST=y
26+ # - DISABLE_BENCH=y
27+ # - DISABLE_DOCS=y
28+ # - DISABLE_SDIST_BUILD=y
29+ # - DISABLE_DIST_CHECKS=y
30+ - ENABLE_INSTALL=y
31+
32+ # ------------------------------------------------------------------------
33+ # stack options
34+ # ------------------------------------------------------------------------
35+ # Note requiring a specific version of stack using STACKVER may fail due to
36+ # github API limit while checking and upgrading/downgrading to the specific
37+ # version.
38+ #- STACKVER="1.6.5"
39+ - STACK_UPGRADE="y"
40+
41+ # ------------------------------------------------------------------------
42+ # cabal options
43+ # ------------------------------------------------------------------------
44+ - CABAL_CHECK_RELAX=y
45+ - CABAL_NO_SANDBOX=y
46+ - CABAL_HACKAGE_MIRROR=hackage.haskell.org:http://hackage.fpcomplete.com
47+
48+ # ------------------------------------------------------------------------
49+ # Where to find the required tools
50+ # ------------------------------------------------------------------------
51+ - PATH=/bin:/usr/bin
52+ - TOOLS_DIR=/opt
53+
54+ # ------------------------------------------------------------------------
55+ # Location of packcheck.sh (the shell script invoked to perform CI tests ).
56+ # ------------------------------------------------------------------------
57+ # You can either commit the packcheck.sh script at this path in your repo or
58+ # you can use it by specifying the PACKCHECK_REPO_URL option below in which
59+ # case it will be automatically copied from the packcheck repo to this path
60+ # during CI tests. In any case it is finally invoked from this path.
61+ - PACKCHECK_LOCAL_PATH="./packcheck.sh"
62+ # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH
63+ # then it is automatically pulled from this URL.
64+ - PACKCHECK_GITHUB_URL="https://raw.githubusercontent.com/harendra-kumar/packcheck"
65+ - PACKCHECK_GITHUB_COMMIT="b8d39c9cf336e4627e12eb4b1f5827bb7b6afc91"
66+
67+notifications:
68+ email:
69+ on_success: change
70+ on_failure: always
71+
72+# This matrix has total of 6 builds enabled, we try to cover last three major
73+# GHC versions, stack, cabal, Linux and OSX with minimum number of builds
74+# possible. You can uncomment other disabled builds or comment out existing
75+# ones to your taste.
76+#
77+# We pre-install the cabal-install package to not incur the penalty of building
78+# it the first time in cached builds or every time in uncached builds.
79+matrix:
80+ include:
81+
82+ # --------------------------------------------------------------------------
83+ # (Linux) cabal builds (BUILD=cabal-v1, BUILD=cabal-v2). Common envvars are:
84+ # CABAL_CONFIGURE_OPTIONS (cabal-v1), CABAL_BUILD_OPTIONS (cabal-v2)
85+ # --------------------------------------------------------------------------
86+
87+ #- env: BUILD=cabal-v2 GHCVER=head
88+ # addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
89+
90+ - env: BUILD=cabal-v2 GHCVER=8.4.4 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flag debug"
91+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}
92+
93+ # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
94+ #- env: BUILD=cabal-v2 GHCVER=8.2.2 GHC_OPTIONS="" DISABLE_BENCH=y
95+ # addons: {apt: {packages: [cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
96+
97+ - env: BUILD=cabal-v2 GHCVER=8.0.2 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flags examples-sdl"
98+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.0.2,libsdl1.2-dev], sources: [hvr-ghc]}}
99+
100+ - env: BUILD=cabal-v2 GHCVER=7.10.3 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flags examples-sdl"
101+ addons: {apt: {packages: [cabal-install-2.4,ghc-7.10.3,libsdl1.2-dev], sources: [hvr-ghc]}}
102+
103+ # You can specify build flags like this:
104+ #- env: BUILD=cabal-v2 CABAL_BUILD_OPTIONS="--flags=dev"
105+ # addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
106+
107+ # --------------------------------------------------------------------------
108+ # GHCJS cabal builds
109+ # --------------------------------------------------------------------------
110+
111+ # Use CABAL_BUILD_OPTIONS to pass any options to cabal e.g. project-file
112+ # DISABLE_SDIST_BUILD is set because of a cabal issue. 'cabal info'
113+ # unnecessarily requires "ghc".
114+ - env: BUILD=cabal-v2 ENABLE_GHCJS=y DISABLE_TEST=y ENABLE_INSTALL= DISABLE_DOCS=y DISABLE_SDIST_BUILD=y
115+ addons:
116+ apt:
117+ sources:
118+ - hvr-ghc
119+ - sourceline: 'ppa:hvr/ghcjs'
120+ - sourceline: 'deb https://deb.nodesource.com/node_11.x xenial main'
121+ key_url: 'https://deb.nodesource.com/gpgkey/nodesource.gpg.key'
122+ packages: [cabal-install-2.4,ghcjs-8.4]
123+
124+ # --------------------------------------------------------------------------
125+ # (Linux) stack builds (BUILD=stack). Some common envvars for stack builds
126+ # are: STACK_YAML, STACK_OPTIONS, STACK_BUILD_OPTIONS
127+ # --------------------------------------------------------------------------
128+ #
129+ # NOTE: cabal-install is required for some of the packcheck options to work.
130+ # We just install it so that packcheck does not build it from source
131+ # otherwise.
132+
133+ #- env: BUILD=stack RESOLVER=nightly
134+ # addons: {apt: {packages: [cabal-install-1.24], sources: [hvr-ghc]}}
135+
136+ - env: BUILD=stack RESOLVER=lts-13 GHCVER=8.6 STACK_BUILD_OPTIONS="--flag streamly:examples-sdl"
137+ addons: {apt: {packages: [cabal-install-2.4,libsdl1.2-dev], sources: [hvr-ghc]}}
138+
139+ #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
140+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
141+
142+ # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
143+ # So disable the benchmarks for this build.
144+ #- env: BUILD=stack GHCVER=8.2.2 RESOLVER=lts-11 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y DISABLE_BENCH=y
145+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
146+
147+ #- env: BUILD=stack RESOLVER=lts-9 GHCVER=8.0
148+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
149+
150+ #- env: BUILD=stack RESOLVER=lts-6 GHCVER=7.10
151+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
152+
153+ # You can keep a STACK_YAML file at any path location
154+ #- env: BUILD=stack STACK_YAML=.ci/stack-8.0.yaml
155+
156+ # You can specify build flags like this:
157+ #- env: BUILD=stack RESOLVER=lts-12 STACK_BUILD_OPTIONS="--flag packcheck:dev"
158+
159+ # --------------------------------------------------------------------------
160+ # OS X builds
161+ # --------------------------------------------------------------------------
162+
163+ # GHC 8.6 cabal build using stack!
164+ # On OSX autoreconf is not installed therefore disable sdist build
165+ - env: BUILD=cabal-v2 RESOLVER=lts-13 GHCVER=8.6 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y
166+ os: osx
167+
168+ # GHC 8.4/stack
169+ #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
170+ # os: osx
171+
172+ # --------------------------------------------------------------------------
173+ # Lint e.g. HLINT_COMMANDS="hlint lint src; hlint lint test"
174+ # --------------------------------------------------------------------------
175+
176+ - env: BUILD=stack RESOLVER=lts-13 HLINT_COMMANDS="hlint lint ."
177+
178+ # --------------------------------------------------------------------------
179+ # Build and send coverage report to coveralls.io using hpc-coveralls. Add
180+ # your project to coveralls.io first, for available options see hpc-coveralls
181+ # docs. CAVEATS:
182+ # * Works only with BUILD=cabal-v1
183+ # * Does not work for multi-package repos
184+ # * hpc-coveralls does not build with Cabal-2.2/GHC-8.4.3. The workaround is
185+ # to have a prebuilt hpc-coveralls binary installed on the build machine
186+ # and then you can use any version of ghc.
187+ # --------------------------------------------------------------------------
188+
189+ #- env: BUILD=cabal-v1 COVERALLS_OPTIONS="--coverage-mode=StrictlyFullLines --exclude-dir=test test"
190+ # addons: {apt: {packages: [cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
191+
192+ # --------------------------------------------------------------------------
193+ # Builds that are allowed to fail
194+ # --------------------------------------------------------------------------
195+
196+ allow_failures:
197+ - env: BUILD=cabal-v2 GHCVER=head GHC_OPTIONS=""
198+ - env: BUILD=stack RESOLVER=nightly DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y
199+ - env: BUILD=stack RESOLVER=lts-13 HLINT_COMMANDS="hlint lint ."
200+
201+# ------------------------------------------------------------------------
202+# Settings beyond this point are advanced and normally not tweaked
203+# ------------------------------------------------------------------------
204+
205+language: generic
206+sudo: false
207+cache:
208+ directories:
209+ - $HOME/.cabal
210+ - $HOME/.ghc
211+ - $HOME/.ghcjs
212+ - $HOME/.local
213+ - $HOME/.stack
214+install: true
215+
216+script:
217+ - |
218+ # If a custom stack-yaml is specified, replace the default with that
219+ if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
220+ unset STACK_YAML
221+
222+ # Get packcheck if needed
223+ CURL=$(which curl)
224+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
225+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
226+ chmod +x $PACKCHECK_LOCAL_PATH
227+
228+ # This script is governed by various PACKCHECK envvars that are set above.
229+ # In addition, hpc-coveralls needs TRAVIS, TRAVIS_JOB_ID variables set by
230+ # the travis CI environment.
231+ - bash -c "$PACKCHECK_LOCAL_PATH $BUILD PATH=/bin:/usr/bin"
CHANGELOG.mddeleted−1
@@ -1 +0,0 @@
1−docs/User/Project/Changelog.md
CONTRIBUTING.mdmode 120000 → 100644+255−1
@@ -1 +0,0 @@
1−docs/Developer/Contributing.md
@@ -0,0 +1,255 @@
1+# Contributors' Guide
2+
3+## Bug Reports
4+
5+Please feel free to [open an
6+issue](https://github.com/composewell/streamly/issues) for any questions,
7+suggestions, issues or bugs in the library. In case you are reporting a bug
8+we will appreciate if you provide as much detail as possible to reproduce or
9+understand the problem, but nevertheless you are encouraged to open an issue
10+for any problem that you may encounter.
11+
12+## Pull Requests (PR)
13+
14+Please feel free to [send a pull
15+request (PR)](https://github.com/composewell/streamly/pulls) whether it is a
16+single letter typo fix or a complex change. We will accept any PR that makes a
17+net positive change to the package. We encourage you to provide a complete,
18+consistent change with test, documentation and benchmarks. You can contact the
19+[maintainers](https://gitter.im/composewell/streamly) for any help or
20+collaboration needed in that regard. However, if due to lack of time you are
21+not able to complete the PR, you are still welcome to submit it, maintainers
22+will try their best to actively contribute and pick up your change as long as
23+the change is approved.
24+
25+## Pull Request (PR) Checklist
26+
27+Here is a quick checklist for a PR, for details please see the next section:
28+
29+* PR contains one logical changeset
30+* Each commit in the PR consists of a logical change
31+* Commits are rebased/squashed/fixup/reordered as needed
32+* Stylistic changes to irrelevant parts of the code are separated in
33+ independent commits.
34+* Code is formatted as per the style of the file or that of other files
35+* Compiler warnings are fixed
36+* Reasonable hlint suggestions are accepted
37+* Tests are added to cover the changed parts
38+* All [tests](test) pass
39+* [Performance benchmarks](benchmark) are added, where applicable
40+* No significant regressions are reported by [performance benchmarks](benchmark/README.md)
41+* Haddock documentation is added to user visible APIs and data types
42+* Tutorial module, [README](README.md), and [guides](docs) are updated if
43+ necessary.
44+* [Changelog](Changelog.md) is updated if needed
45+
46+## Contributing A Change
47+
48+If the feature makes significant changes to design, we encourage you to open an
49+issue as early as possible so that you do not have to redo much work because of
50+changes in design decisions. However, if you are confident, you can still go
51+ahead and take that risk as the maintainers are supposed to be reasonable
52+people.
53+
54+### Picking Issues to Work on
55+
56+Beginners are encouraged to pick up issues that are marked `help wanted`. It is
57+a good idea to update the issue expressing your intent so that others do not
58+duplicate the effort and people with a background on the issue can help.
59+
60+### Changeset in a PR
61+
62+* Please make sure that a single PR contains a single logical changeset. That
63+ helps the reviewers in quickly understanding and reviewing the change.
64+* You are encouraged to group a logically related set of changes into a single
65+ commit. When the overall changeset is largish you can divide it into
66+ multiple smaller commits, with each commit having a logically grouped
67+ changeset and the title summarizing the logical grouping. Always keep in
68+ mind a logical division helps reviewers understand and review your code
69+ quickly, easier history tracking and when required clean reversal changes.
70+* If your commits reflect how you fixed intermediate problems during testing
71+ or made random changes at different times you may have to squash your changes
72+ (`git rebase -i`) into a single commit or logically related set of commits.
73+* Please resist the temptation to make style related changes to surrounding
74+ code unless you are changing that code anyway . Make sure that your
75+ IDE/Editor is not automatically making sweeping style changes to all the
76+ files you are editing. That makes separating the signal from the noise
77+ very difficult and makes everything harder. If you would like to make style
78+ related changes then please send a separate PR with just those changes and no
79+ other functionality changes.
80+
81+### Resolving Conflicts
82+
83+If during the course of development or before you send the PR you find that
84+your changes are conflicting with the master branch then use `git rebase
85+master` to rebase your changes on top of master. DO NOT MERGE MASTER INTO YOUR
86+BRANCH.
87+
88+### Testing
89+
90+It is a good idea to include tests for the changes where applicable. See the
91+existing tests [here](test).
92+
93+### Documentation
94+
95+For user visible APIs, it is a good idea to provide haddock documentation that
96+is easily understood by the end programmer and does not sound highfalutin,
97+and preferably with examples. If your change affects the tutorial or needs to
98+be mentioned in the tutorial then please update the tutorial. Check if the
99+additional [guides](docs) are affected or need to updated.
100+
101+### Performance Benchmarks
102+
103+It is a good idea to run performance benchmarks to see if your change affects
104+any of the existing performance benchmarks. If you introduced something new
105+then you may want to add benchmarks to check if it performs as well as expected
106+by the programmers to deem it usable.
107+
108+See the [README](benchmark/README) file in the `benchmark` directory for more
109+details on how to run the benchmarks.
110+
111+### Changelog
112+
113+Any new changes that affect the user of the library in some way must be
114+documented under `Unreleased` section at the top of the `Changelog`. The
115+changes in the changelog must be organized in the following categories, in that
116+order:
117+
118+* Breaking Changes
119+* Enhancements
120+* Bug Fixes
121+* Deprecations
122+
123+If there are very few changes then you can just prefix a bullet with these
124+annotations. If there are many changes make sections to group them. A section
125+can be absent if there is nothing to add in it.
126+
127+If you make changes that are incompatible with the released versions
128+of the library please indicate that in the `Changelog` as `Breaking Changes`
129+and also write short notes regarding what the programmers need to do to adapt
130+their existing code to the new change.
131+
132+## Developer documentation
133+
134+To build haddock documentation for all modules, including the ones not exposed
135+to users of the library, use the following commands:
136+
137+```
138+$ cabal v2-haddock --haddock-option="--show-all"
139+$ stack haddock --haddock-arguments "--show-all" --no-haddock-deps
140+```
141+
142+For design documentation see the `design` directory.
143+
144+## Coding
145+
146+### Style
147+
148+As long as possible please try to match the style of the file or the
149+surrounding code. For haskell coding style guidelines, please [see this style
150+guide](https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md).
151+Specifically,
152+
153+* Please use 4 spaces for indentation.
154+* Do not let the code go beyond 80 columns
155+
156+Indent the `where` clause as follows:
157+
158+```
159+f x = ...
160+ where
161+
162+ f1 = ...
163+```
164+
165+In general, we avoid using a prime on the variable names, e.g. we use `step1`
166+instead of `step'`. Numbered indexing is better because it is easier on the
167+eyes and we can represent multiple generations of the variables without adding
168+more characters e.g. we can write `step2` instead of `step''`.
169+
170+Use shorter variable names for shorter scopes, use longer variable names for
171+bigger scopes.
172+
173+Imports:
174+
175+* Import symbols explicitly by names as long as possible
176+* Import qualified is there are too many symbols to be imported
177+
178+### StreamD coding style
179+
180+Some conventions that we follow in the StreamD code are illustrated by the
181+following example:
182+
183+```
184+mapM f (Stream step1 state1) = Stream step state
185+ where
186+
187+ step gst st = do
188+ r <- step1 (adaptState gst) st
189+ case r of
190+ Yield x s -> f x >>= \a -> return $ Yield a s
191+ Skip s -> return $ Skip s
192+ Stop -> return Stop
193+```
194+
195+* For the input streams use numbering for `step` and `state` e.g.
196+ step1/state1. For the ouput stream use `step` and `state`.
197+* For state argument of `step`, use `st`.
198+* For result of executing a `step` use `r` or `res`
199+* For the yielded element use `x`
200+* For the yielded state use `s`
201+
202+In general, the rule is - the shorter the scope of a variable the shorter its
203+name can be. For example, `s` has the shortest scope in the above code, `st`
204+has a bigger scope and `state` has the biggest scope.
205+
206+For better fusion we try to keep a single yield point in the state machine.
207+
208+### Organization
209+
210+Use this simple rule to organize functions in a file: `Define before first
211+use`. In other words, use the `bottom up style` to organize functions.
212+
213+One big benefit of this rule is easier type error debugging. Using a single
214+block comment, at any point in the file up to the end of the file, you can cut
215+the tail and still cleanly compile the remaining head portion of the file.
216+
217+It is very helpful when we make significant changes to the file. We can start
218+compiling a minimal head portion of the file and keep expanding the head by
219+just moving the start of commented block further down. This keeps the scope of
220+type inference minimal and type errors can be discovered incrementally by
221+increasing the scope a little bit at a time. If you use type signatures on all
222+top level declarations then you do not even need to comment out the code. This
223+organization results in a better order of type errors which makes it easier to
224+fix them and when necessary use elimination method by commenting out some code.
225+
226+Similarly when you put modules in the cabal file in dependency order you can
227+do the same there, just comment out a tail of the module list and your library
228+will still compile.
229+
230+Note that this rule does not apply in choosing `let` vs `where` clauses. Use of
231+`let`s leads to bottom up and use of `where`s leads to top down style. But we
232+do not encourage `let` over `where`, you can freely use `where` clauses.
233+
234+Also note that this is not possible in mutually recursive code. The mutually
235+recursive code has to be considered a single block.
236+
237+### Tricky Parts
238+
239+The state-passing through each API is currently fragile. Every time we run a
240+stream we need to be careful about the state we are passing to it. In case of
241+folds where there is no incoming state, we start with the initial state
242+`defState`. When we have an incoming state passed to us there are two cases:
243+
244+1. When we are building a concurrent stream that needs to share the same `SVar`
245+ we pass the incoming state as is.
246+2. In all other cases we must not share the SVar and every time we pass on the
247+ state to run a stream we must use `adaptState` to reset the `SVar` in the
248+ state.
249+
250+When in doubt just use `adaptState` on the state before passing it on, we will at
251+most lose concurrency but the behavior will be correct.
252+
253+There is no type level enforcement about this as of now, and therefore we need
254+to be careful when coding. There are specific tests to detect and report any
255+problems due to this, all transform operations must be added to those tests.
docs/User/Project/Changelog.md → Changelog.mdrenamed+15−282
@@ -1,268 +1,4 @@
1−# Changelog
2−
3−<!-- See rendered changelog at https://streamly.composewell.com -->
4−
5−## 0.10.1 (Jan 2024)
6−
7−* Fix TH macros in `Streamly.Data.Stream.MkType` for GHC 9.6 and above.
8−
9−## 0.10.0 (Nov 2023)
10−
11−See
12−[0.9.0-0.10.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt)
13−for a full list of API changes in this release. Only a few significant
14−changes are mentioned here. For changes to the core functionality
15−please see the changelog of the `streamly-core` package.
16−
17−### Breaking Changes
18−
19−* `MonadTrans` and `MonadBase` instances have been removed for `AsyncT`,
20− `ParallelT`, `AheadT` for GHC versions 9.6 onwards. This is due to a
21− breaking change in `transformers` 0.6. You can replace `lift` with
22− `fromEffect` when using these as top level monads in a monad stack.
23−
24−### Enhancements
25−
26−* __Concurrent Folds__: `Streamly.Data.Fold.Prelude` module added with
27− concurrent fold APIs and a container fold API to fold a key value
28− stream to a HashMap.
29−
30−## 0.9.0 (Mar 2023)
31−
32−Also see the following:
33−
34−* [streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md) or
35− https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/Upgrading.md
36−* [streamly-0.9.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt) or
37− https://hackage.haskell.org/package/streamly-0.9.0/docs/docs/User/ProjectRelated/ApiChangelogs/0.8.3-0.9.0.txt
38−* [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or
39− https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt
40−
41−### Package split
42−
43−`streamly` package is split into two packages, (1) `streamly-core` that
44−has only GHC boot library depdendecies, and (2) `streamly` that contains
45−higher level operations (including concurrent ones) with additional
46−dependencies. Make sure you add a dependency on `streamly-core` to keep old
47−code working.
48−
49−* Moved the following modules from `streamly` package to the
50− `streamly-core` package:
51− * Streamly.Console.Stdio
52− * Streamly.Data.Fold
53− * Streamly.Data.Unfold
54− * Streamly.FileSystem.Handle
55− * Streamly.Unicode.Stream
56−
57−### Breaking Changes
58−
59−* Unboxed arrays now require `Unbox` constraint instead of `Storable`.
60− The `Unbox` typeclass can be imported from `Streamly.Data.Array`. You
61− can use generic deriving to derive Unbox instances.
62−* Stream type in all modules has been changed to the new `Stream` type
63− replacing the existing `IsStream t` or `SerialT` types. Use `fromStream`,
64− `toStream` from `Streamly.Prelude` module to adapt the types.
65−* Signatures changed in `Streamly.Data.Unfold`:
66− * `fromStream`
67− * `replicateM`
68−
69−### Major Changes
70−
71−`Streamly.Prelude` module has been deprecated, equivalent
72−functionality is covered by the `Streamly.Data.Stream`,
73−`Streamly.Data.Stream.Prelude`, and `Streamly.Data.Fold` modules. The
74−new modules use a monomorphic `Stream` type instead of the polymorphic
75−`IsStream t` type.
76−
77−`Streamly.Data.Stream` module and the `Stream` type are meant for
78−writing high-performance fused pipelines not involving explicit
79−recursion. For writing code that may require recursive function calls,
80−`Streamly.Data.Stream.StreamK` module and the `StreamK` type have been
81−added which provide a CPS based stream implementation. `Stream` and
82−`StreamK` types can be easily interconverted.
83−
84−The old code can be adapted to use the new modules with some changes.
85−See the
86−[streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md)
87−for more details on how to adapt your existing code to the new release.
88−
89−### Enhancements
90−
91−* Added the following new modules to the `streamly` package:
92− * Streamly.Data.Stream.MkType
93− * Streamly.Data.Stream.Prelude
94−* Added the following new modules to the `streamly-core` package:
95− * Streamly.Data.Array
96− * Streamly.Data.Array.Generic
97− * Streamly.Data.MutArray
98− * Streamly.Data.MutArray.Generic
99− * Streamly.Data.Parser
100− * Streamly.Data.ParserK
101− * Streamly.Data.Stream
102− * Streamly.Data.StreamK
103− * Streamly.FileSystem.Dir
104− * Streamly.FileSystem.File
105− * Streamly.Unicode.Parser
106− * Streamly.Unicode.String
107−
108−### Deprecations
109−
110−* Remove support for GHC 8.4.*
111−
112−Several modules and functions have been deprecated, equivalent modules or
113−functions are suggested in the deprecation warning messages by the compiler.
114−
115−### Internal module changes
116−
117−If you cannot find an internal module that you were using, it may have
118−been moved to the `streamly-core` package or may have been renamed.
119−
120−Following modules are moved to `streamly-core` package and renamed:
121− * Streamly.Internal.Data.Array.Stream.Foreign -> Streamly.Internal.Data.Stream.Chunked
122− * Streamly.Internal.Data.Array.Stream.Mut.Foreign -> Streamly.Internal.Data.Array.Mut.Stream
123−
124−## 0.8.3 (September 2022)
125−
126−* Fix build with GHC 9.4
127−
128−## 0.8.2 (Mar 2022)
129−
130−* Fix performance issues for GHC-9. These changes coupled with GHC changes
131− expected to land in 9.2.2 will bring the performance back to the same levels
132− as before.
133−
134−## 0.8.1.1 (Dec 2021)
135−
136−* Disable building FileSystem.Events where FS Events isn't supported.
137−
138−## 0.8.1 (Nov 2021)
139−
140−See ApiChangelogs/0.8.3.txt for new APIs introduced.
141−
142−### Bug Fixes
143−
144−* Several bug fixes in the Array module:
145− * Fix writeN fold eating away one element when applied multiple times
146− [#1258](https://github.com/composewell/streamly/issues/1258).
147− * Fix potentially writing beyond allocated memory when shrinking. Likely
148− cause of [#944](https://github.com/composewell/streamly/issues/944).
149− * Fix potentially writing beyond allocated memory when writing the last
150− element. Likely cause of
151− [#944](https://github.com/composewell/streamly/issues/944).
152− * Fix missing pointer touch could potentially cause use of freed memory.
153− * Fix unnecessary additional allocation due to a bug
154−* Fix a bug in classifySessionsBy, see
155− [PR #1311](https://github.com/composewell/streamly/pull/1311). The bug
156− could cause premature ejection of a session when input events with the
157− same key are split into multiple sessions.
158−
159−### Notable Internal API Changes
160−
161−* `tapAsync` from `Streamly.Internal.Data.Stream.Parallel` has been moved to
162− `Streamly.Internal.Data.Stream.IsStream` and renamed to `tapAsyncK`.
163−* `Fold2` has now been renamed to `Refold` and the corresponding `Fold2`
164− combinators have been either renamed or removed.
165−
166−## 0.8.0 (Jun 2021)
167−
168−See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of signature
169−changes and new APIs introduced.
170−
171−### Breaking changes
172−
173−* `Streamly.Prelude`
174− * `fold`: this function may now terminate early without consuming
175− the entire stream. For example, `fold Fold.head stream` would
176− now terminate immediately after consuming the head element from
177− `stream`. This may result in change of behavior in existing programs
178− if the program relies on the evaluation of the full stream.
179−* `Streamly.Data.Unicode.Stream`
180− * The following APIs no longer throw errors on invalid input, use new
181− APIs suffixed with a prime for strict behavior:
182− * decodeUtf8
183− * encodeLatin1
184− * encodeUtf8
185−* `Streamly.Data.Fold`:
186− * Several instances have been moved to the `Streamly.Data.Fold.Tee`
187− module, please use the `Tee` type to adapt to the changes.
188−
189−### Bug Fixes
190−
191−* Concurrent Streams: The monadic state for the stream is now propagated across
192− threads. Please refer to
193− [#369](https://github.com/composewell/streamly/issues/369) for more info.
194−* `Streamly.Prelude`:
195− * `bracket`, `handle`, and `finally` now also work correctly on streams
196− that aren't fully drained. Also, the resource acquisition and release is
197− atomic with respect to async exceptions.
198− * `iterate`, `iterateM` now consume O(1) space instead of O(n).
199− * `fromFoldableM` is fixed to be concurrent.
200−* `Streamly.Network.Inet.TCP`: `accept` and `connect` APIs now close the socket
201− if an exception is thrown.
202−* `Streamly.Network.Socket`: `accept` now closes the socket if an exception is
203− thrown.
204−
205−### Enhancements
206−
207−* See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of new
208− modules and APIs introduced.
209−* The Fold type is now more powerful, the new termination behavior allows
210− to express basic parsing of streams using folds.
211−* Many new Fold and Unfold APIs are added.
212−* A new module for console IO APIs is added.
213−* Experimental modules for the following are added:
214− * Parsing
215− * Deserialization
216− * File system event handling (fsnotify/inotify)
217− * Folds for streams of arrays
218−* Experimental `use-c-malloc` build flag to use the c library `malloc` for
219− array allocations. This could be useful to avoid pinned memory fragmentation.
220−
221−
222−### Notable Internal/Pre-release API Changes
223−
224−Breaking changes:
225−
226−* The `Fold` type has changed to accommodate terminating folds.
227−* Rename: `Streamly.Internal.Prelude` => `Streamly.Internal.Data.Stream.IsStream`
228−* Several other internal modules have been renamed and re-factored.
229−
230−Bug fixes:
231−
232−* A bug was fixed in the conversion of `MicroSecond64` and `MilliSecond64`
233− (commit e5119626)
234−* Bug fix: `classifySessionsBy` now flushes sessions at the end and terminates.
235−
236−### Miscellaneous
237−
238−* Drop support for GHC 7.10.3.
239−* The examples in this package are moved to a new github repo
240− [streamly-examples](https://github.com/composewell/streamly-examples)
241−
242−## 0.7.3 (February 2021)
243−
244−### Build Issues
245−
246−* Fix build issues with primitive package version >= 0.7.1.
247−* Fix build issues on armv7.
248−
249−## 0.7.2 (April 2020)
250−
251−### Bug Fixes
252−
253−* Fix a bug in the `Applicative` and `Functor` instances of the `Fold`
254− data type.
255−
256−### Build Issues
257−
258−* Fix a bug that occasionally caused a build failure on windows when
259− used with `stack` or `stack ghci`.
260−* Now builds on 32-bit machines.
261−* Now builds with `primitive` package version >= 0.5.4 && <= 0.6.4.0
262−* Now builds with newer `QuickCheck` package version >= 2.14 && < 2.15.
263−* Now builds with GHC 8.10.
264−
265−## 0.7.1 (February 2020)
1+## Unreleased
2662
2673### Bug Fixes
2684
@@ -276,8 +12,6 @@ Bug fixes:
27612 The issue occurs only in cases when a worker thread happens to be used
27713 continuously for a long time.
27814* Fix scheduling of WAsyncT stream style to be in round-robin fashion.
279−* Now builds with `containers` package version < 0.5.8.
280−* Now builds with `network` package version >= 3.0.0.0 && < 3.1.0.0.
28115
28216### Behavior change
28317
@@ -289,9 +23,8 @@ Bug fixes:
28923
29024* Now uses `fusion-plugin` package for predictable stream fusion optimizations
29125* Significant improvement in performance of concurrent stream operations.
292−* Improved space and time performance of `Foldable` instance.
29326
294−## 0.7.0 (November 2019)
27+## 0.7.0
29528
29629### Breaking changes
29730
@@ -405,7 +138,7 @@ concurrently using this.
405138 effects
406139 * `tap` redirects a copy of the stream to a `Fold`
407140
408−## 0.6.1 (March 2019)
141+## 0.6.1
409142
410143### Bug Fixes
411144
@@ -417,7 +150,7 @@ concurrently using this.
417150* Add GHCJS support
418151* Remove dependency on "clock" package
419152
420−## 0.6.0 (December 2018)
153+## 0.6.0
421154
422155### Breaking changes
423156
@@ -445,7 +178,7 @@ concurrently using this.
445178* Performance improvements
446179* Add benchmarks to measure composed and iterated operations
447180
448−## 0.5.2 (October 2018)
181+## 0.5.2
449182
450183### Bug Fixes
451184
@@ -460,12 +193,12 @@ concurrently using this.
460193 used in a stateful monad e.g. `StateT`. Particularly, this bug cannot affect
461194 `ReaderT`.
462195
463−## 0.5.1 (September 2018)
196+## 0.5.1
464197
465198* Performance improvements, especially space consumption, for concurrent
466199 streams
467200
468−## 0.5.0 (September 2018)
201+## 0.5.0
469202
470203### Bug Fixes
471204
@@ -491,13 +224,13 @@ concurrently using this.
491224* The `Streamly.Time` module is now deprecated, its functionality is subsumed
492225 by the new rate limiting combinators.
493226
494−## 0.4.1 (July 2018)
227+## 0.4.1
495228
496229### Bug Fixes
497230
498231* foldxM was not fully strict, fixed.
499232
500−## 0.4.0 (July 2018)
233+## 0.4.0
501234
502235### Breaking changes
503236
@@ -524,7 +257,7 @@ concurrently using this.
524257* Add `takeWhileM` and `dropWhileM`
525258* Add `filterM`
526259
527−## 0.3.0 (June 2018)
260+## 0.3.0
528261
529262### Breaking changes
530263
@@ -552,14 +285,14 @@ concurrently using this.
552285 stream processing function application pipeline concurrently.
553286* Added `mapMaybe` and `mapMaybeM`.
554287
555−## 0.2.1 (June 2018)
288+## 0.2.1
556289
557290### Bug Fixes
558291* Fixed a bug that caused some transformation ops to return incorrect results
559292 when used with concurrent streams. The affected ops are `take`, `filter`,
560293 `takeWhile`, `drop`, `dropWhile`, and `reverse`.
561294
562−## 0.2.0 (May 2018)
295+## 0.2.0
563296
564297### Breaking changes
565298* Changed the semantics of the Semigroup instance for `InterleavedT`, `AsyncT`
@@ -637,7 +370,7 @@ concurrently using this.
637370* Put a bound (1500) on the output buffer used for asynchronous tasks
638371* Put a limit (1500) on the number of threads used for Async and WAsync types
639372
640−## 0.1.2 (March 2018)
373+## 0.1.2
641374
642375### Enhancements
643376* Add `iterate`, `iterateM` stream operations
@@ -646,7 +379,7 @@ concurrently using this.
646379* Fixed a bug that caused unexpected behavior when `pure` was used to inject
647380 values in Applicative composition of `ZipStream` and `ZipAsync` types.
648381
649−## 0.1.1 (March 2018)
382+## 0.1.1
650383
651384### Enhancements
652385* Make `cons` right associative and provide an operator form `.:` for it
@@ -657,6 +390,6 @@ concurrently using this.
657390* Fix the `product` operation. Earlier, it always returned 0 due to a bug
658391* Fix the `last` operation, which returned `Nothing` for singleton streams
659392
660−## 0.1.0 (December 2017)
393+## 0.1.0
661394
662395* Initial release
INSTALL.mdnew file+82
@@ -0,0 +1,82 @@
1+# Using `streamly` package
2+
3+* [Latest stable release](https://hackage.haskell.org/package/streamly) is available on
4+ Hackage.
5+* [Latest development version](https://github.com/composewell/streamly) is
6+ available on github.
7+* See [recommended compilation options here](docs/Build.md).
8+
9+If you are using `stack` or `nix` please make sure to add the latest version
10+from Hackage to your tool configuration.
11+
12+## Using with `cabal`
13+
14+Make sure you have `cabal` version 2.4 or later installed and you have `ghc`
15+available in your PATH. Refresh your package list:
16+
17+```
18+$ cabal v2-update
19+```
20+
21+### Using hackage version in repl
22+
23+```
24+# Run repl with the latest version from Hackage
25+$ cabal v2-repl --build-depends streamly
26+
27+# Run repl with a specific version from Hackage
28+$ cabal v2-repl --build-depends streamly==0.6.1
29+```
30+
31+### Using github version in repl
32+
33+Create a directory for your playground (e.g. `test`) and create a
34+`cabal.project` file in it as follows:
35+
36+```
37+packages: .
38+source-repository-package
39+ type: git
40+ location: https://github.com/composewell/streamly
41+ tag: master
42+```
43+
44+Create a cabal file (e.g. `test.cabal`) as follows
45+
46+```
47+cabal-version: 2.4
48+name: test
49+version: 0
50+
51+library
52+ build-depends: base, streamly
53+```
54+
55+Run repl:
56+
57+```
58+$ cabal v2-repl
59+```
60+
61+### Compiling with ghc
62+
63+```
64+$ cat hello.hs
65+import qualified Streamly.Prelude as S
66+
67+main = S.runStream $ S.fromListM [putStrLn "hello", putStrLn "world"]
68+```
69+
70+```
71+$ cabal v2-install streamly-0.6.1
72+$ ghc -package streamly-0.6.1 hello.hs
73+```
74+
75+### Using in a Project
76+
77+Add `streamly` to the `build-depends` section of your library/executable in
78+your `<package>.cabal` file. Appropriate version from Hackage will be picked
79+depending on the version bounds that you specify. See the `github version in
80+repl` section above for a sample `<package>.cabal` file and optionally the
81+`cabal.project` file if you want to use the development version from github in
82+your project.
LICENSE+1−69
@@ -1,4 +1,4 @@
1−Copyright (c) 2017, Composewell Technologies
1+Copyright (c) 2017, Harendra Kumar
22All rights reserved.
33
44Redistribution and use in source and binary forms, with or without
@@ -25,71 +25,3 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
2525CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
2626OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
2727OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28−
29−-------------------------------------------------------------------------------
30−fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
31−-------------------------------------------------------------------------------
32−Copyright (c) 2012, Mark Dittmer
33−
34−All rights reserved.
35−
36−Redistribution and use in source and binary forms, with or without
37−modification, are permitted provided that the following conditions are met:
38−
39− * Redistributions of source code must retain the above copyright
40− notice, this list of conditions and the following disclaimer.
41−
42− * Redistributions in binary form must reproduce the above
43− copyright notice, this list of conditions and the following
44− disclaimer in the documentation and/or other materials provided
45− with the distribution.
46−
47− * Neither the name of Mark Dittmer nor the names of other
48− contributors may be used to endorse or promote products derived
49− from this software without specific prior written permission.
50−
51−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
52−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
53−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
54−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
55−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
56−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
57−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
58−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
59−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
60−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
61−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
62−
63−-------------------------------------------------------------------------------
64−hfsevents-0.1.6 (http://hackage.haskell.org/package/hfsevents-0.1.6)
65−-------------------------------------------------------------------------------
66−Copyright (c) 2012, Luite Stegeman
67−
68−All rights reserved.
69−
70−Redistribution and use in source and binary forms, with or without
71−modification, are permitted provided that the following conditions are met:
72−
73− * Redistributions of source code must retain the above copyright
74− notice, this list of conditions and the following disclaimer.
75−
76− * Redistributions in binary form must reproduce the above
77− copyright notice, this list of conditions and the following
78− disclaimer in the documentation and/or other materials provided
79− with the distribution.
80−
81− * Neither the name of Luite Stegeman nor the names of other
82− contributors may be used to endorse or promote products derived
83− from this software without specific prior written permission.
84−
85−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
86−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
87−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
88−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
89−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
90−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
91−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
92−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
93−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
94−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
95−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
MAINTAINING.mdnew file+178
@@ -0,0 +1,178 @@
1+# Maintainers' Guide
2+
3+## PR Merge Checklist
4+
5+* All the CI tests pass
6+* New tests are added where applicable
7+* Benchmarks are added where applicable
8+* Run benchmarks locally if you suspect any regressions
9+* Documentation is added for any new combinators
10+ * New combinators have time and space complexity annotations
11+ * New combinators have `since` annotation
12+* Changelog entry is added for exposed combinators.
13+* Optionally, look at hlint output if anything in that is worth fixing.
14+* Merge the PR by rebasing. Note that github always creates new commits when
15+ merged with rebase, it records the committer as well as the author in the
16+ commit. This makes the local branch diverge from master. You can rebase and
17+ merge the commit manually in your local git tree and push the resulting
18+ master branch to avoid new commits and divergence from the original tree.
19+
20+## Release Checklist
21+
22+* Check if any critical pending bugs or issues are to be included
23+* If this is a major release check if any previously deprecated features are to
24+ be removed in this release.
25+* _Documentation_:
26+
27+ * README is updated
28+ * Haddock docs are consistent with the changes in the release
29+ * Tutorial has been updated for new changes
30+ * Documents in the `docs` directory are consistent with new changes
31+ * All combinators have time and space complexity annotations
32+ * All combinators have `since` annotation
33+
34+* _Benchmarks_:
35+
36+ * Check regressions from previous release
37+ * Run benchmarks with large stream size (`bench.sh -- long`) to
38+ check for space leaks and to ensure constant memory usage for streaming
39+ operations.
40+ * Run benchmarks with `dev` flag on. Some `fileio` benchmarks are disabled
41+ in regular runs.
42+ * Check comparative benchmarks using streaming-benchmarks
43+
44+* _Tests_:
45+
46+ * Run tests with `dev` flag on. Many tests are disabled in regular runs.
47+
48+* _Update Package Metadata:_
49+
50+ * Update `stack.yaml` to latest stable resolver, cleanup extra-deps
51+ * Make sure the description in cabal file is in sync with README and other docs
52+ * Make sure CI configs include last three major releases of GHC in CI testing.
53+ * Update `tested-with` field
54+ * Make sure all dependency bounds can use latest versions
55+ * Make sure any additional files are added to `extra-source-files` in cabal
56+ file
57+
58+* Copyrights and Contibutors
59+
60+ * Make sure contributors to the release are listed in
61+ `credits/CONTRIBUTORS.md`.
62+ * Bump the release version in `credits/CONTRIBUTORS.md`.
63+ * Make sure any third party code included in the release has been listed in
64+ `credits/COPYRIGHTS.md` and the license is added to the repo.
65+ * Change the `Unreleased` section, if exists, at the top of
66+ `credits/COPYRIGHTS.md` to the new release version number.
67+
68+* _Update changelog & Version_:
69+
70+ * Make sure all the bug fixes being included in this release are marked
71+ with a target release on github. So that users can search by release if
72+ they want.
73+ * Change the `Unreleased` section at the top of changelog file to the new
74+ release version number.
75+ * Bump the package version in cabal file or package.yaml
76+
77+* _Upload_:
78+
79+ * Wait for final CI tests to pass:
80+
81+ * Create a git tag corresponding to the release where X.Y.Z is the new
82+ package version (`git tag vX.Y.Z && git push -f origin vX.Y.Z`).
83+ * Mask out the build status lines from the README
84+ * Upload to hackage
85+ * `cabal v2-sdist`; `cabal upload --publish <tarpath>`
86+ * `stack upload .`
87+ * Add to stackage (`build-constraints.yaml` in Stackage repo) if needed
88+ * Optionally upload `package-X.Y.Z-sdist.tar.gz` to github release page
89+ * Update release contributors on github release page
90+ (`git shortlog -s prev_tag..new_tag | sed $'s/^[0-9 \t]*/* /' | sort -f`)
91+ * Update and if needed release streaming-benchmarks package
92+ * Check https://matrix.hackage.haskell.org/package/streamly
93+ * Check haddocks on Hackage, upload if not built
94+ * Announce to haskell-cafe@haskell.org
95+
96+## Managing Issues
97+
98+### User Impacting Changes
99+
100+__RULE__: Any commit that may affect the end user in some way MUST have either a
101+changelog entry OR MUST have an issue marked with one of the following labels
102+OR both. We can have more than one of these labels on the same issue e.g.
103+breaking, enhancement:
104+
105+* breaking
106+* deprecating
107+* enhancement
108+* performance
109+* usability
110+* documentation
111+* bug
112+
113+Note that if you are making a big feature change you may have a single issue
114+for that feature and attach many commits with it. So you do not necessarily
115+need to have an issue for each commit.
116+
117+### Maintenance Changes
118+
119+Commits that do not impact the end user in any way are not required to have a
120+changelog entry or an issue. Issues that do not have a corresponding commit
121+may be left without a label but preferably should be marked with one of the
122+following:
123+
124+* question
125+* discussion
126+* maintenance
127+* testing
128+* invalid
129+* wontfix
130+
131+### Feature Labels
132+
133+For big features with many issues we can introduce a custom feature label to
134+group the issues together.
135+
136+### Other Labels
137+
138+* help wanted
139+* duplicate
140+* deferred
141+
142+## Correlating Changes, Issues and Releases
143+
144+For planning purposes, open issues may be marked with milestones or target
145+releases. However, it may not always be known which release a fix will finally
146+land in. For example, we may decide to make a minor release instead of a major
147+one if there are no breaking changes yet, so we may not always know what would
148+be the next release version.
149+
150+Trackability means that we should be able to find which issues got fixed in
151+which release. Or what all issues got fixed in a particular release. We track
152+significant changes using the changelog. However, there may be more changes
153+that can only be tracked via issues, PRs or commits. When we make a release we
154+can mark all the issues fixed in that release with a correct release target for
155+future trackability.
156+
157+For better trackability of which issue got fixed in which release we need the
158+following:
159+
160+* Before you close an issue make sure a commit or a PR fixing the issue is
161+ attached with it. In the commit message you can reference an issue like
162+ "fixes #50", you can do the same in a PR as well.
163+* Before we make a new release EVERY issue with a commit included in that
164+ release that affects the end user, especially bugs and breaking changes MUST
165+ have the target release correctly set.
166+
167+## Changelog Management
168+
169+Keep the unreleased changes in the `Unreleased` section at the top of changelog
170+file. Using `Unreleased` instead of the next release number for unreleased
171+changes is important. First, we do not know the next release number in advance,
172+it could be a major or minor release. Second, if we use the next release
173+number instead, then when adding a new change to the changelog, at one look we
174+cannot know whether the release number on top is unreleased or released.
175+
176+## TODO
177+
178+* GPG signed releases and tags
README.mdmode 120000 → 100644+612−1
@@ -1 +0,0 @@
1−docs/User/Project/README.md
@@ -0,0 +1,612 @@
1+# Streamly
2+
3+[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)
4+[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)
5+[![Travis](https://travis-ci.com/composewell/streamly.svg?branch=master)](https://travis-ci.com/composewell/streamly)
6+[![Appveyor](https://ci.appveyor.com/api/projects/status/ajxg0c79raou9ned?svg=true)](https://ci.appveyor.com/project/harendra-kumar/streamly)
7+[![CircleCI](https://circleci.com/gh/composewell/streamly/tree/master.svg?style=svg)](https://circleci.com/gh/composewell/streamly/tree/master)
8+[![Coverage Status](https://coveralls.io/repos/composewell/streamly/badge.svg?branch=master&service=github)](https://coveralls.io/github/composewell/streamly?branch=master)
9+
10+## Learning Materials
11+
12+* Documentation: [Quick](#streaming-concurrently) | [Tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html) | [Reference (Hackage)](https://hackage.haskell.org/package/streamly) | [Reference (Latest)](https://composewell.github.io/streamly) | [Guides](docs)
13+* Installing: [Installing](./INSTALL.md) | [Building for optimal performance](docs/Build.md)
14+* Examples: [streamly](examples) | [streamly-examples](https://github.com/composewell/streamly-examples)
15+* Benchmarks: [Streaming](https://github.com/composewell/streaming-benchmarks) | [Concurrency](https://github.com/composewell/concurrency-benchmarks)
16+* Talks: [Functional Conf 2019 Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Functional Conf 2019 Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)
17+
18+## Streaming Concurrently
19+
20+Haskell lists express pure computations using composable stream operations like
21+`:`, `unfold`, `map`, `filter`, `zip` and `fold`. Streamly is exactly like
22+lists except that it can express sequences of pure as well as monadic
23+computations aka streams. More importantly, it can express monadic sequences
24+with concurrent execution semantics without introducing any additional APIs.
25+
26+Streamly expresses concurrency using standard, well known abstractions.
27+Concurrency semantics are defined for list operations, semigroup, applicative
28+and monadic compositions. Programmer does not need to know any low level
29+notions of concurrency like threads, locking or synchronization. Concurrent
30+and non-concurrent programs are fundamentally the same. A chosen segment of
31+the program can be made concurrent by annotating it with an appropriate
32+combinator. We can choose a combinator for lookahead style or asynchronous
33+concurrency. Concurrency is automatically scaled up or down based on the
34+demand from the consumer application, we can finally say goodbye to managing
35+thread pools and associated sizing issues. The result is truly fearless
36+and declarative monadic concurrency.
37+
38+## Where to use streamly?
39+
40+Streamly is a general purpose programming framework. It can be used equally
41+efficiently from a simple `Hello World!` program to a massively concurrent
42+application. The answer to the question, "where to use streamly?" - would be
43+similar to the answer to - "Where to use Haskell lists or the IO monad?".
44+
45+Streamly simplifies streaming and makes it as intuitive as plain lists. Unlike
46+other streaming libraries, no fancy types are required. Streamly is simply a
47+generalization of Haskell lists to monadic streaming optionally with concurrent
48+composition. The basic stream type in streamly `SerialT m a` can be considered
49+as a list type `[a]` parameterized by the monad `m`. For example, `SerialT IO
50+a` is a moral equivalent of `[a]` in the IO monad. `SerialT Identity a`, is
51+equivalent to pure lists. Streams are constructed very much like lists, except
52+that they use `nil` and `cons` instead of `[]` and `:`. Unlike lists, streams
53+can be constructed from monadic effects, not just pure elements. Streams are
54+processed just like lists, with list like combinators, except that they are
55+monadic and work in a streaming fashion. In other words streamly just completes
56+what lists lack, you do not need to learn anything new. Please see [streamly vs
57+lists](docs/streamly-vs-lists.md) for a detailed comparison.
58+
59+Not surprisingly, the monad instance of streamly is a list transformer, with
60+concurrency capability.
61+
62+## Why data flow programming?
63+
64+If you need some convincing for using streaming or data flow programming
65+paradigm itself then try to answer this question - why do we use lists in
66+Haskell? It boils down to why we use functional programming in the first place.
67+Haskell is successful in enforcing the functional data flow paradigm for pure
68+computations using lists, but not for monadic computations. In the absence of a
69+standard and easy to use data flow programming paradigm for monadic
70+computations, and the IO monad providing an escape hatch to an imperative
71+model, we just love to fall into the imperative trap, and start asking the same
72+fundamental question again - why do we have to use the streaming data model?
73+
74+## Comparative Performance
75+
76+High performance and simplicity are the two primary goals of streamly.
77+`Streamly` employs two different stream representations (CPS and direct style)
78+and interconverts between the two to get the best of both worlds on different
79+operations. It uses both foldr/build (for CPS style) and stream fusion (for
80+direct style) techniques to fuse operations. In terms of performance,
81+Streamly's goal is to compete with equivalent C programs. Streamly redefines
82+"blazing fast" for streaming libraries, it competes with lists and `vector`.
83+Other streaming libraries like "streaming", "pipes" and "conduit" are orders of
84+magnitude slower on most microbenchmarks. See [streaming
85+benchmarks](https://github.com/composewell/streaming-benchmarks) for detailed
86+comparison.
87+
88+The following chart shows a comparison of those streamly and list operations
89+where performance of the two differs by more than 10%. Positive y-axis displays
90+how many times worse is a list operation compared to the same streamly
91+operation, negative y-axis shows where streamly is worse compared to lists.
92+
93+![Streamly vs Lists (time) comparison](charts-0/streamly-vs-list-time.svg)
94+
95+Streamly uses lock-free synchronization for concurrent operations. It employs
96+auto-scaling of the degree of concurrency based on demand. For CPU bound tasks
97+it tries to keep the threads close to the number of CPUs available whereas for
98+IO bound tasks more threads can be utilized. Parallelism can be utilized with
99+little overhead even if the task size is very small. See [concurrency
100+benchmarks](https://github.com/composewell/concurrency-benchmarks) for detailed
101+performance results and a comparison with the `async` package.
102+
103+## Installing and using
104+
105+Please see [INSTALL.md](./INSTALL.md) for instructions on how to use streamly
106+with your Haskell build tool or package manager. You may want to go through it
107+before jumping to run the examples below.
108+
109+The module `Streamly` provides just the core stream types, type casting and
110+concurrency control combinators. Stream construction, transformation, folding,
111+merging, zipping combinators are found in `Streamly.Prelude`.
112+
113+## Streaming Pipelines
114+
115+The following snippet provides a simple stream composition example that reads
116+numbers from stdin, prints the squares of even numbers and exits if an even
117+number more than 9 is entered.
118+
119+``` haskell
120+import Streamly
121+import qualified Streamly.Prelude as S
122+import Data.Function ((&))
123+
124+main = S.drain $
125+ S.repeatM getLine
126+ & fmap read
127+ & S.filter even
128+ & S.takeWhile (<= 9)
129+ & fmap (\x -> x * x)
130+ & S.mapM print
131+```
132+
133+Unlike `pipes` or `conduit` and like `vector` and `streaming`, `streamly`
134+composes stream data instead of stream processors (functions). A stream is
135+just like a list and is explicitly passed around to functions that process the
136+stream. Therefore, no special operator is needed to join stages in a streaming
137+pipeline, just the standard function application (`$`) or reverse function
138+application (`&`) operator is enough.
139+
140+## Concurrent Stream Generation
141+
142+`consM` or its operator form `|:` can be used to construct a stream from
143+monadic actions. A stream constructed with `consM` can run the monadic actions
144+in the stream concurrently when used with appropriate stream type combinator
145+(e.g. `asyncly`, `aheadly` or `parallely`).
146+
147+The following code finishes in 3 seconds (6 seconds when serial), note the
148+order of elements in the resulting output, the outputs are consumed as soon as
149+each action is finished (asyncly):
150+
151+``` haskell
152+> let p n = threadDelay (n * 1000000) >> return n
153+> S.toList $ asyncly $ p 3 |: p 2 |: p 1 |: S.nil
154+[1,2,3]
155+```
156+
157+Use `aheadly` if you want speculative concurrency i.e. execute the actions in
158+the stream concurrently but consume the results in the specified order:
159+
160+``` haskell
161+> S.toList $ aheadly $ p 3 |: p 2 |: p 1 |: S.nil
162+[3,2,1]
163+```
164+
165+Monadic stream generation functions e.g. `unfoldrM`, `replicateM`, `repeatM`,
166+`iterateM` and `fromFoldableM` etc. can work concurrently.
167+
168+The following finishes in 10 seconds (100 seconds when serial):
169+
170+``` haskell
171+S.drain $ asyncly $ S.replicateM 10 $ p 10
172+```
173+
174+## Concurrency Auto Scaling
175+
176+Concurrency is auto-scaled i.e. more actions are executed concurrently if the
177+consumer is consuming the stream at a higher speed. How many tasks are executed
178+concurrently can be controlled by `maxThreads` and how many results are
179+buffered ahead of consumption can be controlled by `maxBuffer`. See the
180+documentation in the `Streamly` module.
181+
182+## Concurrent Streaming Pipelines
183+
184+Use `|&` or `|$` to apply stream processing functions concurrently. The
185+following example prints a "hello" every second; if you use `&` instead of
186+`|&` you will see that the delay doubles to 2 seconds instead because of serial
187+application.
188+
189+``` haskell
190+main = S.drain $
191+ S.repeatM (threadDelay 1000000 >> return "hello")
192+ |& S.mapM (\x -> threadDelay 1000000 >> putStrLn x)
193+```
194+
195+## Mapping Concurrently
196+
197+We can use `mapM` or `sequence` functions concurrently on a stream.
198+
199+``` haskell
200+> let p n = threadDelay (n * 1000000) >> return n
201+> S.drain $ aheadly $ S.mapM (\x -> p 1 >> print x) (serially $ repeatM (p 1))
202+```
203+
204+## Serial and Concurrent Merging
205+
206+Semigroup and Monoid instances can be used to fold streams serially or
207+concurrently. In the following example we compose ten actions in the
208+stream, each with a delay of 1 to 10 seconds, respectively. Since all the
209+actions are concurrent we see one output printed every second:
210+
211+``` haskell
212+import Streamly
213+import qualified Streamly.Prelude as S
214+import Control.Concurrent (threadDelay)
215+
216+main = S.toList $ parallely $ foldMap delay [1..10]
217+ where delay n = S.yieldM $ threadDelay (n * 1000000) >> print n
218+```
219+
220+Streams can be combined together in many ways. We provide some examples
221+below, see the tutorial for more ways. We use the following `delay`
222+function in the examples to demonstrate the concurrency aspects:
223+
224+``` haskell
225+import Streamly
226+import qualified Streamly.Prelude as S
227+import Control.Concurrent
228+
229+delay n = S.yieldM $ do
230+ threadDelay (n * 1000000)
231+ tid <- myThreadId
232+ putStrLn (show tid ++ ": Delay " ++ show n)
233+```
234+### Serial
235+
236+``` haskell
237+main = S.drain $ delay 3 <> delay 2 <> delay 1
238+```
239+```
240+ThreadId 36: Delay 3
241+ThreadId 36: Delay 2
242+ThreadId 36: Delay 1
243+```
244+
245+### Parallel
246+
247+``` haskell
248+main = S.drain . parallely $ delay 3 <> delay 2 <> delay 1
249+```
250+```
251+ThreadId 42: Delay 1
252+ThreadId 41: Delay 2
253+ThreadId 40: Delay 3
254+```
255+
256+## Nested Loops (aka List Transformer)
257+
258+The monad instance composes like a list monad.
259+
260+``` haskell
261+import Streamly
262+import qualified Streamly.Prelude as S
263+
264+loops = do
265+ x <- S.fromFoldable [1,2]
266+ y <- S.fromFoldable [3,4]
267+ S.yieldM $ putStrLn $ show (x, y)
268+
269+main = S.drain loops
270+```
271+```
272+(1,3)
273+(1,4)
274+(2,3)
275+(2,4)
276+```
277+
278+## Concurrent Nested Loops
279+
280+To run the above code with speculative concurrency i.e. each iteration in the
281+loop can run concurrently but the results are presented to the consumer of the
282+output in the same order as serial execution:
283+
284+``` haskell
285+main = S.drain $ aheadly $ loops
286+```
287+
288+Different stream types execute the loop iterations in different ways. For
289+example, `wSerially` interleaves the loop iterations. There are several
290+concurrent stream styles to execute the loop iterations concurrently in
291+different ways, see the `Streamly.Tutorial` module for a detailed treatment.
292+
293+## Magical Concurrency
294+
295+Streams can perform semigroup (<>) and monadic bind (>>=) operations
296+concurrently using combinators like `asyncly`, `parallelly`. For example,
297+to concurrently generate squares of a stream of numbers and then concurrently
298+sum the square roots of all combinations of two streams:
299+
300+``` haskell
301+import Streamly
302+import qualified Streamly.Prelude as S
303+
304+main = do
305+ s <- S.sum $ asyncly $ do
306+ -- Each square is performed concurrently, (<>) is concurrent
307+ x2 <- foldMap (\x -> return $ x * x) [1..100]
308+ y2 <- foldMap (\y -> return $ y * y) [1..100]
309+ -- Each addition is performed concurrently, monadic bind is concurrent
310+ return $ sqrt (x2 + y2)
311+ print s
312+```
313+
314+The concurrency facilities provided by streamly can be compared with
315+[OpenMP](https://en.wikipedia.org/wiki/OpenMP) and
316+[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative
317+expression.
318+
319+## Example: Listing Directories Recursively/Concurrently
320+
321+The following code snippet lists a directory tree recursively, reading multiple
322+directories concurrently:
323+
324+```haskell
325+import Control.Monad.IO.Class (liftIO)
326+import Path.IO (listDir, getCurrentDir) -- from path-io package
327+import Streamly (AsyncT, adapt)
328+import qualified Streamly.Prelude as S
329+
330+listDirRecursive :: AsyncT IO ()
331+listDirRecursive = getCurrentDir >>= readdir >>= liftIO . mapM_ putStrLn
332+ where
333+ readdir dir = do
334+ (dirs, files) <- listDir dir
335+ S.yield (map show dirs ++ map show files) <> foldMap readdir dirs
336+
337+main :: IO ()
338+main = S.drain $ adapt $ listDirRecursive
339+```
340+
341+`AsyncT` is a stream monad transformer. If you are familiar with a list
342+transformer, it is nothing but `ListT` with concurrency semantics. For example,
343+the semigroup operation `<>` is concurrent. This makes `foldMap` concurrent
344+too. You can replace `AsyncT` with `SerialT` and the above code will become
345+serial, exactly equivalent to a `ListT`.
346+
347+## Rate Limiting
348+
349+For bounded concurrent streams, stream yield rate can be specified. For
350+example, to print hello once every second you can simply write this:
351+
352+``` haskell
353+import Streamly
354+import Streamly.Prelude as S
355+
356+main = S.drain $ asyncly $ avgRate 1 $ S.repeatM $ putStrLn "hello"
357+```
358+
359+For some practical uses of rate control, see
360+[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)
361+and
362+[CirclingSquare.hs](https://github.com/composewell/streamly/tree/master/examples/CirclingSquare.hs)
363+.
364+Concurrency of the stream is automatically controlled to match the specified
365+rate. Rate control works precisely even at throughputs as high as millions of
366+yields per second. For more sophisticated rate control see the haddock
367+documentation.
368+
369+## Arrays
370+
371+The `Streamly.Memory.Array` module provides immutable arrays. Arrays are the
372+computing duals of streams. Streams are good at sequential access and immutable
373+transformations of in-transit data whereas arrays are good at random access and
374+in-place transformations of buffered data. Unlike streams which are potentially
375+infinite, arrays are necessarily finite. Arrays can be used as an efficient
376+interface between streams and external storage systems like memory, files and
377+network. Streams and arrays complete each other to provide a general purpose
378+computing system. The design of streamly as a general purpose computing
379+framework is centered around these two fundamental aspects of computing and
380+storage.
381+
382+`Streamly.Memory.Array` uses pinned memory outside GC and therefore avoid any
383+GC overhead for the storage in arrays. Streamly allows efficient
384+transformations over arrays using streams. It uses arrays to transfer data to
385+and from the operating system and to store data in memory.
386+
387+## Folds
388+
389+Folds are consumers of streams. `Streamly.Data.Fold` module provides a `Fold`
390+type that represents a `foldl'`. Such folds can be efficiently composed
391+allowing the compiler to perform stream fusion and therefore implement high
392+performance combinators for consuming streams. A stream can be distributed to
393+multiple folds, or it can be partitioned across multiple folds, or
394+demultiplexed over multiple folds, or unzipped to two folds. We can also use
395+folds to fold segments of stream generating a stream of the folded results.
396+
397+If you are familiar with the `foldl` library, these are the same composable
398+left folds but simpler and better integrated with streamly, and with many more
399+powerful ways of composing and applying them.
400+
401+## Unfolds
402+
403+Unfolds are duals of folds. Folds help us compose consumers of streams
404+efficiently and unfolds help us compose producers of streams efficiently.
405+`Streamly.Data.Unfold` provides an `Unfold` type that represents an `unfoldr`
406+or a stream generator. Such generators can be combined together efficiently
407+allowing the compiler to perform stream fusion and implement high performance
408+stream merging combinators.
409+
410+## File IO
411+
412+The following code snippets implement some common Unix command line utilities
413+using streamly. You can compile these with `ghc -O2 -fspec-constr-recursive=16
414+-fmax-worker-args=16` and compare the performance with regular GNU coreutils
415+available on your system. Though many of these are not most optimal solutions
416+to keep them short and elegant. Source file
417+[HandleIO.hs](https://github.com/composewell/streamly/tree/master/examples/HandleIO.hs)
418+in the examples directory includes these examples.
419+
420+``` haskell
421+module Main where
422+
423+import qualified Streamly.Prelude as S
424+import qualified Streamly.Data.Fold as FL
425+import qualified Streamly.Memory.Array as A
426+import qualified Streamly.FileSystem.Handle as FH
427+import qualified System.IO as FH
428+
429+import Data.Char (ord)
430+import System.Environment (getArgs)
431+import System.IO (openFile, IOMode(..), stdout)
432+
433+withArg f = do
434+ (name : _) <- getArgs
435+ src <- openFile name ReadMode
436+ f src
437+
438+withArg2 f = do
439+ (sname : dname : _) <- getArgs
440+ src <- openFile sname ReadMode
441+ dst <- openFile dname WriteMode
442+ f src dst
443+```
444+
445+### cat
446+
447+``` haskell
448+cat = S.fold (FH.writeChunks stdout) . S.unfold FH.readChunks
449+main = withArg cat
450+```
451+
452+### cp
453+
454+``` haskell
455+cp src dst = S.fold (FH.writeChunks dst) $ S.unfold FH.readChunks src
456+main = withArg2 cp
457+```
458+
459+### wc -l
460+
461+``` haskell
462+wcl = S.length . S.splitOn (== 10) FL.drain . S.unfold FH.read
463+main = withArg wcl >>= print
464+```
465+
466+### Average Line Length
467+
468+``` haskell
469+avgll =
470+ S.fold avg
471+ . S.splitOn (== 10) FL.length
472+ . S.unfold FH.read
473+
474+ where avg = (/) <$> toDouble FL.sum <*> toDouble FL.length
475+ toDouble = fmap (fromIntegral :: Int -> Double)
476+
477+main = withArg avgll >>= print
478+```
479+
480+### Line Length Histogram
481+
482+`classify` is not released yet, and is available in
483+`Streamly.Internal.Data.Fold`
484+
485+``` haskell
486+llhisto =
487+ S.fold (FL.classify FL.length)
488+ . S.map bucket
489+ . S.splitOn (== 10) FL.length
490+ . S.unfold FH.read
491+
492+ where
493+ bucket n = let i = n `mod` 10 in if i > 9 then (9,n) else (i,n)
494+
495+main = withArg llhisto >>= print
496+```
497+
498+## Socket IO
499+
500+Its easy to build concurrent client and server programs using streamly.
501+`Streamly.Network.*` modules provide easy combinators to build network servers
502+and client programs using streamly. See
503+[FromFileClient.hs](https://github.com/composewell/streamly/tree/master/examples/FromFileClient.hs),
504+[EchoServer.hs](https://github.com/composewell/streamly/tree/master/examples/EchoServer.hs),
505+[FileSinkServer.hs](https://github.com/composewell/streamly/tree/master/examples/FileSinkServer.hs)
506+in the examples directory.
507+
508+## Exceptions
509+
510+Exceptions can be thrown at any point using the `MonadThrow` instance. Standard
511+exception handling combinators like `bracket`, `finally`, `handle`,
512+`onException` are provided in `Streamly.Prelude` module.
513+
514+In presence of concurrency, synchronous exceptions work just the way they are
515+supposed to work in non-concurrent code. When concurrent streams
516+are combined together, exceptions from the constituent streams are propagated
517+to the consumer stream. When an exception occurs in any of the constituent
518+streams other concurrent streams are promptly terminated.
519+
520+There is no notion of explicit threads in streamly, therefore, no
521+asynchronous exceptions to deal with. You can just ignore the zillions of
522+blogs, talks, caveats about async exceptions. Async exceptions just don't
523+exist. Please don't use things like `myThreadId` and `throwTo` just for fun!
524+
525+## Reactive Programming (FRP)
526+
527+Streamly is a foundation for first class reactive programming as well by virtue
528+of integrating concurrency and streaming. See
529+[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)
530+for a console based FRP game example and
531+[CirclingSquare.hs](https://github.com/composewell/streamly/tree/master/examples/CirclingSquare.hs)
532+for an SDL based animation example.
533+
534+## Conclusion
535+
536+Streamly, short for streaming concurrently, provides monadic streams, with a
537+simple API, almost identical to standard lists, and an in-built
538+support for concurrency. By using stream-style combinators on stream
539+composition, streams can be generated, merged, chained, mapped, zipped, and
540+consumed concurrently – providing a generalized high level programming
541+framework unifying streaming and concurrency. Controlled concurrency allows
542+even infinite streams to be evaluated concurrently. Concurrency is auto scaled
543+based on feedback from the stream consumer. The programmer does not have to be
544+aware of threads, locking or synchronization to write scalable concurrent
545+programs.
546+
547+Streamly is a programmer first library, designed to be useful and friendly to
548+programmers for solving practical problems in a simple and concise manner. Some
549+key points in favor of streamly are:
550+
551+ * _Simplicity_: Simple list like streaming API, if you know how to use lists
552+ then you know how to use streamly. This library is built with simplicity
553+ and ease of use as a design goal.
554+ * _Concurrency_: Simple, powerful, and scalable concurrency. Concurrency is
555+ built-in, and not intrusive, concurrent programs are written exactly the
556+ same way as non-concurrent ones.
557+ * _Generality_: Unifies functionality provided by several disparate packages
558+ (streaming, concurrency, list transformer, logic programming, reactive
559+ programming) in a concise API.
560+ * _Performance_: Streamly is designed for high performance. It employs stream
561+ fusion optimizations for best possible performance. Serial peformance is
562+ equivalent to the venerable `vector` library in most cases and even better
563+ in some cases. Concurrent performance is unbeatable. See
564+ [streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)
565+ for a comparison of popular streaming libraries on micro-benchmarks.
566+
567+The basic streaming functionality of streamly is equivalent to that provided by
568+streaming libraries like
569+[vector](https://hackage.haskell.org/package/vector),
570+[streaming](https://hackage.haskell.org/package/streaming),
571+[pipes](https://hackage.haskell.org/package/pipes), and
572+[conduit](https://hackage.haskell.org/package/conduit).
573+In addition to providing streaming functionality, streamly subsumes
574+the functionality of list transformer libraries like `pipes` or
575+[list-t](https://hackage.haskell.org/package/list-t), and also the logic
576+programming library [logict](https://hackage.haskell.org/package/logict). On
577+the concurrency side, it subsumes the functionality of the
578+[async](https://hackage.haskell.org/package/async) package, and provides even
579+higher level concurrent composition. Because it supports
580+streaming with concurrency we can write FRP applications similar in concept to
581+[Yampa](https://hackage.haskell.org/package/Yampa) or
582+[reflex](https://hackage.haskell.org/package/reflex).
583+
584+See the `Comparison with existing packages` section at the end of the
585+[tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).
586+
587+## Support
588+
589+Please feel free to ask questions on the
590+[streamly gitter channel](https://gitter.im/composewell/streamly).
591+If you require professional support, consulting, training or timely
592+enhancements to the library please contact
593+[support@composewell.com](mailto:support@composewell.com).
594+
595+## Credits
596+
597+The following authors/libraries have influenced or inspired this library in a
598+significant way:
599+
600+ * Roman Leshchinskiy (vector)
601+ * Gabriel Gonzalez (foldl)
602+ * Alberto G. Corona (transient)
603+
604+See the `credits` directory for full list of contributors, credits and licenses.
605+
606+## Contributing
607+
608+The code is available under BSD-3 license
609+[on github](https://github.com/composewell/streamly). Join the [gitter
610+chat](https://gitter.im/composewell/streamly) channel for discussions. Please
611+ask any questions on the gitter channel or [contact the maintainer
612+directly](mailto:streamly@composewell.com). All contributions are welcome!
appveyor.yml+6−8
@@ -14,8 +14,6 @@ environment:
1414 # ------------------------------------------------------------------------
1515 # Common options
1616 # ------------------------------------------------------------------------
17− # GHC 9.2.7 onwards redundant constraint warnings are incompatible with
18− # older versions
1917 GHC_OPTIONS: "-Werror"
2018 CABAL_REINIT_CONFIG: "y"
2119 LC_ALL: "C.UTF-8"
@@ -36,17 +34,17 @@ environment:
3634 # Note requiring a specific version of stack using STACKVER may fail due to
3735 # github API limit while checking and upgrading/downgrading to the specific
3836 # version.
39− # STACKVER: "1.6.5"
37+ #STACKVER: "1.6.5"
4038 STACK_UPGRADE: "y"
41− # RESOLVER: "lts-18.27"
39+ RESOLVER: "lts-13"
4240 STACK_ROOT: "c:\\sr"
43− STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
44− STACK_YAML: "stack.yaml"
4541
4642 # ------------------------------------------------------------------------
4743 # cabal options
4844 # ------------------------------------------------------------------------
4945 CABAL_CHECK_RELAX: "y"
46+ CABAL_NO_SANDBOX: "y"
47+ CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
5048
5149 # ------------------------------------------------------------------------
5250 # Where to find the required tools
@@ -64,8 +62,8 @@ environment:
6462 PACKCHECK_LOCAL_PATH: "./packcheck.sh"
6563 # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH
6664 # then it is automatically pulled from this URL.
67− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
68− PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
65+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
66+ PACKCHECK_GITHUB_COMMIT: "b8d39c9cf336e4627e12eb4b1f5827bb7b6afc91"
6967
7068 # Override the temp directory to avoid sed escaping issues
7169 # See https://github.com/haskell/cabal/issues/5386
bench.shnew file+450
@@ -0,0 +1,450 @@
1+#!/bin/bash
2+
3+SERIAL_BENCHMARKS="linear linear-rate nested nested-unfold base"
4+# parallel benchmark-suite is separated because we run it with a higher
5+# heap size limit.
6+CONCURRENT_BENCHMARKS="linear-async nested-concurrent parallel concurrent adaptive"
7+ARRAY_BENCHMARKS="array unpinned-array prim-array small-array"
8+
9+INFINITE_BENCHMARKS="$SERIAL_BENCHMARKS linear-async nested-concurrent"
10+FINITE_BENCHMARKS="$ARRAY_BENCHMARKS fileio parallel concurrent adaptive"
11+
12+QUICK_BENCHMARKS="linear-rate concurrent adaptive"
13+VIRTUAL_BENCHMARKS="array-cmp"
14+
15+ALL_BENCHMARKS="$SERIAL_BENCHMARKS $CONCURRENT_BENCHMARKS $ARRAY_BENCHMARKS $VIRTUAL_BENCHMARKS"
16+
17+list_benches () {
18+ for i in $ALL_BENCHMARKS
19+ do
20+ echo -n "|$i"
21+ done
22+}
23+
24+print_help () {
25+ echo "Usage: $0 "
26+ echo " [--benchmarks <ALL|SERIAL|CONCURRENT|ARRAY|INFINITE|FINITE|DEV$(list_benches)>]"
27+ echo " [--group-diff]"
28+ echo " [--graphs]"
29+ echo " [--no-measure]"
30+ echo " [--append]"
31+ echo " [--long]"
32+ echo " [--slow]"
33+ echo " [--quick]"
34+ echo " [--compare] [--base commit] [--candidate commit]"
35+ echo " [--cabal-build-flags]"
36+ echo " -- <gauge options or benchmarks>"
37+ echo
38+ echo "Multiple benchmarks can be specified as a space separated list"
39+ echo " e.g. --benchmarks \"linear nested\""
40+ echo
41+ echo "--group-diff is used to compare groups within a single benchmark"
42+ echo " e.g. StreamD vs StreamK in base benchmark."
43+ echo
44+ echo "When using --compare, by default comparative chart of HEAD^ vs HEAD"
45+ echo "commit is generated, in the 'charts' directory."
46+ echo "Use --base and --candidate to select the commits to compare."
47+ echo
48+ echo "Any arguments after a '--' are passed directly to gauge"
49+ exit
50+}
51+
52+# $1: message
53+die () {
54+ >&2 echo -e "Error: $1"
55+ exit 1
56+}
57+
58+set_benchmarks() {
59+ if test -z "$BENCHMARKS"
60+ then
61+ echo $DEFAULT_BENCHMARKS
62+ else
63+ for i in $(echo $BENCHMARKS)
64+ do
65+ case $i in
66+ ALL) echo -n $ALL_BENCHMARKS ;;
67+ SERIAL) echo -n $SERIAL_BENCHMARKS ;;
68+ CONCURRENT) echo -n $CONCURRENT_BENCHMARKS ;;
69+ ARRAY) echo -n $ARRAY_BENCHMARKS ;;
70+ INFINITE) echo -n $INFINITE_BENCHMARKS ;;
71+ FINITE) echo -n $FINITE_BENCHMARKS ;;
72+ array-cmp) echo -n "$ARRAY_BENCHMARKS array-cmp" ;;
73+ *) echo -n $i ;;
74+ esac
75+ echo -n " "
76+ done
77+ fi
78+}
79+
80+# $1: benchmark name (linear, nested, base)
81+find_report_prog() {
82+ local prog_name="chart"
83+ hash -r
84+ local prog_path=$($WHICH_COMMAND $prog_name)
85+ if test -x "$prog_path"
86+ then
87+ echo $prog_path
88+ else
89+ return 1
90+ fi
91+}
92+
93+# $1: benchmark name (linear, nested, base)
94+build_report_prog() {
95+ local prog_name="chart"
96+ local prog_path=$($WHICH_COMMAND $prog_name)
97+
98+ hash -r
99+ if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"
100+ then
101+ echo "Building bench-graph executables"
102+ BUILD_ONCE=1
103+ $BUILD_CHART_EXE || die "build failed"
104+ elif test ! -x "$prog_path"
105+ then
106+ return 1
107+ fi
108+ return 0
109+}
110+
111+build_report_progs() {
112+ if test "$RAW" = "0"
113+ then
114+ build_report_prog || exit 1
115+ local prog
116+ prog=$(find_report_prog) || \
117+ die "Cannot find bench-graph executable"
118+ echo "Using bench-graph executable [$prog]"
119+ fi
120+}
121+
122+# We run the benchmarks in isolation in a separate process so that different
123+# benchmarks do not interfere with other. To enable that we need to pass the
124+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
125+# own path currently.
126+
127+# The path is dependent on the architecture and cabal version.
128+# Use this command to find the exe if this script fails with an error:
129+# find .stack-work/ -type f -name "benchmarks"
130+
131+stack_bench_prog () {
132+ local bench_name=$1
133+ local bench_prog=`stack path --dist-dir`/build/$bench_name/$bench_name
134+ if test -x "$bench_prog"
135+ then
136+ echo $bench_prog
137+ else
138+ return 1
139+ fi
140+}
141+
142+cabal_bench_prog () {
143+ local bench_name=$1
144+ local bench_prog=`$WHICH_COMMAND $1`
145+ if test -x "$bench_prog"
146+ then
147+ echo $bench_prog
148+ else
149+ return 1
150+ fi
151+}
152+
153+bench_output_file() {
154+ local bench_name=$1
155+ echo "charts/$bench_name/results.csv"
156+}
157+
158+# --min-duration 0 means exactly one iteration per sample. We use a million
159+# iterations in the benchmarking code explicitly and do not use the iterations
160+# done by the benchmarking tool.
161+#
162+# Benchmarking tool by default discards the first iteration to remove
163+# aberrations due to initial evaluations etc. We do not discard it because we
164+# are anyway doing iterations in the benchmarking code and many of them so that
165+# any constant factor gets amortized and anyway it is a cost that we pay in
166+# real life.
167+#
168+# We can pass --min-samples value from the command line as second argument
169+# after the benchmark name in case we want to use more than one sample.
170+
171+run_bench () {
172+ local bench_name=$1
173+ local output_file=$(bench_output_file $bench_name)
174+ local bench_prog
175+ local quick_bench=0
176+ bench_prog=$($GET_BENCH_PROG $bench_name) || \
177+ die "Cannot find benchmark executable for benchmark $bench_name"
178+
179+ mkdir -p `dirname $output_file`
180+
181+ echo "Running benchmark $bench_name ..."
182+
183+ for i in $QUICK_BENCHMARKS
184+ do
185+ if test "$(has_benchmark $i)" = "$bench_name"
186+ then
187+ quick_bench=1
188+ fi
189+ done
190+
191+ local QUICK_OPTS="--quick --time-limit 1 --min-duration 0"
192+ local SPEED_OPTIONS
193+ if test "$LONG" -eq 0
194+ then
195+ if test "$SLOW" -eq 0
196+ then
197+ if test "$QUICK" -eq 0 -a "$quick_bench" -eq 0
198+ then
199+ # reasonably quick
200+ SPEED_OPTIONS="$QUICK_OPTS --min-samples 10"
201+ else
202+ # super quick but less accurate
203+ SPEED_OPTIONS="$QUICK_OPTS --include-first-iter"
204+ fi
205+ else
206+ SPEED_OPTIONS="--min-duration 0"
207+ fi
208+ else
209+ SPEED_OPTIONS="--stream-size 10000000 $QUICK_OPTS --include-first-iter"
210+ fi
211+
212+ $bench_prog $SPEED_OPTIONS \
213+ --csvraw=$output_file \
214+ -v 2 \
215+ --measure-with $bench_prog $GAUGE_ARGS || die "Benchmarking failed"
216+}
217+
218+run_benches() {
219+ for i in $1
220+ do
221+ run_bench $i
222+ done
223+}
224+
225+run_benches_comparing() {
226+ local bench_list=$1
227+
228+ if test -z "$CANDIDATE"
229+ then
230+ CANDIDATE=$(git rev-parse HEAD)
231+ fi
232+ if test -z "$BASE"
233+ then
234+ # XXX Should be where the current branch is forked from master
235+ BASE="$CANDIDATE^"
236+ fi
237+ echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"
238+ echo "Checking out base commit [$BASE] for benchmarking"
239+ git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"
240+
241+ $BUILD_BENCH || die "build failed"
242+ run_benches "$bench_list"
243+
244+ echo "Checking out candidate commit [$CANDIDATE] for benchmarking"
245+ git checkout "$CANDIDATE" || \
246+ die "Checkout of candidate [$CANDIDATE] commit failed"
247+
248+ $BUILD_BENCH || die "build failed"
249+ run_benches "$bench_list"
250+ # XXX reset back to the original commit
251+}
252+
253+backup_output_file() {
254+ local bench_name=$1
255+ local output_file=$(bench_output_file $bench_name)
256+
257+ if test -e $output_file -a "$APPEND" != 1
258+ then
259+ mv -f -v $output_file ${output_file}.prev
260+ fi
261+}
262+
263+run_measurements() {
264+ local bench_list=$1
265+
266+ for i in $bench_list
267+ do
268+ backup_output_file $i
269+ done
270+
271+ if test "$COMPARE" = "0"
272+ then
273+ run_benches "$bench_list"
274+ else
275+ run_benches_comparing "$bench_list"
276+ fi
277+}
278+
279+run_reports() {
280+ local prog
281+ prog=$(find_report_prog) || \
282+ die "Cannot find bench-graph executable"
283+ echo
284+
285+ for i in $1
286+ do
287+ echo "Generating reports for ${i}..."
288+ $prog $(test "$GRAPH" = 1 && echo "--graphs") \
289+ $(test "$GROUP_DIFF" = 1 && echo "--group-diff") \
290+ --benchmark $i
291+ done
292+}
293+
294+#-----------------------------------------------------------------------------
295+# Execution starts here
296+#-----------------------------------------------------------------------------
297+
298+DEFAULT_BENCHMARKS="linear"
299+GROUP_DIFF=0
300+
301+COMPARE=0
302+BASE=
303+CANDIDATE=
304+
305+APPEND=0
306+SLOW=0
307+QUICK=0
308+LONG=0
309+RAW=0
310+GRAPH=0
311+MEASURE=1
312+
313+GAUGE_ARGS=
314+BUILD_ONCE=0
315+USE_STACK=0
316+CABAL_BUILD_FLAGS=""
317+
318+GHC_VERSION=$(ghc --numeric-version)
319+
320+cabal_which() {
321+ find dist-newstyle -type f -path "*${GHC_VERSION}*/$1"
322+}
323+
324+#-----------------------------------------------------------------------------
325+# Read command line
326+#-----------------------------------------------------------------------------
327+
328+while test -n "$1"
329+do
330+ case $1 in
331+ -h|--help|help) print_help ;;
332+ # options with arguments
333+ --benchmarks) shift; BENCHMARKS=$1; shift ;;
334+ --base) shift; BASE=$1; shift ;;
335+ --candidate) shift; CANDIDATE=$1; shift ;;
336+ --cabal-build-flags) shift; CABAL_BUILD_FLAGS=$1; shift ;;
337+ # flags
338+ --slow) SLOW=1; shift ;;
339+ --quick) QUICK=1; shift ;;
340+ --compare) COMPARE=1; shift ;;
341+ --raw) RAW=1; shift ;;
342+ --append) APPEND=1; shift ;;
343+ --long) LONG=1; shift ;;
344+ --group-diff) GROUP_DIFF=1; shift ;;
345+ --graphs) GRAPH=1; shift ;;
346+ --no-measure) MEASURE=0; shift ;;
347+ --) shift; break ;;
348+ -*|--*) print_help ;;
349+ *) break ;;
350+ esac
351+done
352+GAUGE_ARGS=$*
353+
354+BENCHMARKS=$(set_benchmarks)
355+if test "$LONG" -ne 0
356+then
357+ BENCHMARKS=$INFINITE_BENCHMARKS
358+fi
359+
360+only_real_benchmarks () {
361+ for i in $BENCHMARKS
362+ do
363+ local SKIP=0
364+ for j in $VIRTUAL_BENCHMARKS
365+ do
366+ if test $i == $j
367+ then
368+ SKIP=1
369+ fi
370+ done
371+ if test "$SKIP" -eq 0
372+ then
373+ echo -n "$i "
374+ fi
375+ done
376+}
377+
378+BENCHMARKS_ORIG=$BENCHMARKS
379+BENCHMARKS=$(only_real_benchmarks)
380+echo "Using benchmark suites [$BENCHMARKS]"
381+
382+has_benchmark () {
383+ for i in $BENCHMARKS_ORIG
384+ do
385+ if test "$i" = "$1"
386+ then
387+ echo "$i"
388+ break
389+ fi
390+ done
391+}
392+
393+if test "$USE_STACK" = "1"
394+then
395+ WHICH_COMMAND="stack exec which"
396+ BUILD_CHART_EXE="stack build --flag streamly:dev"
397+ GET_BENCH_PROG=stack_bench_prog
398+ BUILD_BENCH="stack build $STACK_BUILD_FLAGS --bench --no-run-benchmarks"
399+else
400+ # XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables
401+ #WHICH_COMMAND="cabal v2-exec which"
402+ WHICH_COMMAND=cabal_which
403+ BUILD_CHART_EXE="cabal v2-build --flags dev chart"
404+ GET_BENCH_PROG=cabal_bench_prog
405+ BUILD_BENCH="cabal v2-build $CABAL_BUILD_FLAGS --enable-benchmarks"
406+fi
407+
408+#-----------------------------------------------------------------------------
409+# Build stuff
410+#-----------------------------------------------------------------------------
411+
412+# We need to build the report progs first at the current (latest) commit before
413+# checking out any other commit for benchmarking.
414+build_report_progs "$BENCHMARKS"
415+
416+#-----------------------------------------------------------------------------
417+# Run benchmarks
418+#-----------------------------------------------------------------------------
419+
420+if test "$MEASURE" = "1"
421+then
422+ echo $BUILD_BENCH
423+ if test "$USE_STACK" = "1"
424+ then
425+ $BUILD_BENCH || die "build failed"
426+ else
427+ $BUILD_BENCH $BENCHMARKS || die "build failed"
428+ fi
429+ run_measurements "$BENCHMARKS"
430+fi
431+
432+#-----------------------------------------------------------------------------
433+# Run reports
434+#-----------------------------------------------------------------------------
435+
436+VIRTUAL_REPORTS=""
437+if test "$(has_benchmark 'array-cmp')" = "array-cmp"
438+then
439+ VIRTUAL_REPORTS="$VIRTUAL_REPORTS array-cmp"
440+ mkdir -p "charts/array-cmp"
441+ cat "charts/array/results.csv" \
442+ "charts/prim-array/results.csv" \
443+ "charts/unpinned-array/results.csv" > "charts/array-cmp/results.csv"
444+fi
445+
446+if test "$RAW" = "0"
447+then
448+ run_reports "$BENCHMARKS"
449+ run_reports "$VIRTUAL_REPORTS"
450+fi
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs → benchmark/Adaptive.hsrenamed+41−52
@@ -1,8 +1,6 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
5−-- Copyright : (c) 2018 Composewell Technologies
3+-- Copyright : (c) 2018 Harendra Kumar
64--
75-- License : BSD3
86-- Maintainer : streamly@composewell.com
@@ -10,7 +8,8 @@
108import Control.Concurrent (threadDelay)
119import Control.Monad (when)
1210import Control.Monad.IO.Class (liftIO)
13−import Test.Tasty.Bench
11+import Gauge
12+import Streamly
1413import Streamly.Prelude as S
1514import System.Random (randomRIO)
1615
@@ -21,9 +20,6 @@ import System.Random (randomRIO)
2120-- Also, the worker dispatch depends on the worker dispatch latency which is
2221-- set to fixed 200 us. We need to keep that in mind when designing tests.
2322
24−moduleName :: String
25−moduleName = "Prelude.Adaptive"
26−
2723value :: Int
2824value = 1000
2925
@@ -36,14 +32,11 @@ source range = S.replicateM value $ do
3632
3733{-# INLINE run #-}
3834run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()
39−run srange crange t = S.drain $ S.mapM action (t $ source srange)
40−
41− where
42−
43− action x = liftIO $ do
44− d <- randomRIO crange
45− when (d /= 0) $ threadDelay d
46− return x
35+run srange crange t = S.drain $ do
36+ n <- t $ source srange
37+ d <- liftIO (randomRIO crange)
38+ when (d /= 0) $ liftIO $ threadDelay d
39+ return n
4740
4841low, medium, high :: Int
4942low = 10
@@ -86,58 +79,54 @@ randomVar = run (low,high) (low,high)
8679
8780main :: IO ()
8881main =
89− defaultMain [bgroup moduleName allBenchmarks]
90−
91− where
92−
93− allBenchmarks =
82+ defaultMain
9483 [
9584 bgroup "serialConstantSlowConsumer"
96− [ bench "serially" $ nfIO $ alwaysConstSlowSerial fromSerial
97− , bench "wSerially" $ nfIO $ alwaysConstSlowSerial fromWSerial
85+ [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially
86+ , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially
9887 ]
9988 , bgroup "default"
100− [ bench "serially" $ nfIO $ noDelay fromSerial
101− , bench "wSerially" $ nfIO $ noDelay fromWSerial
102− , bench "aheadly" $ nfIO $ noDelay fromAhead
103− , bench "asyncly" $ nfIO $ noDelay fromAsync
104− , bench "wAsyncly" $ nfIO $ noDelay fromWAsync
105− , bench "parallely" $ nfIO $ noDelay fromParallel
89+ [ bench "serially" $ nfIO $ noDelay serially
90+ , bench "wSerially" $ nfIO $ noDelay wSerially
91+ , bench "aheadly" $ nfIO $ noDelay aheadly
92+ , bench "asyncly" $ nfIO $ noDelay asyncly
93+ , bench "wAsyncly" $ nfIO $ noDelay wAsyncly
94+ , bench "parallely" $ nfIO $ noDelay parallely
10695 ]
10796 , bgroup "constantSlowConsumer"
108− [ bench "aheadly" $ nfIO $ alwaysConstSlow fromAhead
109− , bench "asyncly" $ nfIO $ alwaysConstSlow fromAsync
110− , bench "wAsyncly" $ nfIO $ alwaysConstSlow fromWAsync
111− , bench "parallely" $ nfIO $ alwaysConstSlow fromParallel
97+ [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly
98+ , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly
99+ , bench "wAsyncly" $ nfIO $ alwaysConstSlow wAsyncly
100+ , bench "parallely" $ nfIO $ alwaysConstSlow parallely
112101 ]
113102 , bgroup "constantFastConsumer"
114− [ bench "aheadly" $ nfIO $ alwaysConstFast fromAhead
115− , bench "asyncly" $ nfIO $ alwaysConstFast fromAsync
116− , bench "wAsyncly" $ nfIO $ alwaysConstFast fromWAsync
117− , bench "parallely" $ nfIO $ alwaysConstFast fromParallel
103+ [ bench "aheadly" $ nfIO $ alwaysConstFast aheadly
104+ , bench "asyncly" $ nfIO $ alwaysConstFast asyncly
105+ , bench "wAsyncly" $ nfIO $ alwaysConstFast wAsyncly
106+ , bench "parallely" $ nfIO $ alwaysConstFast parallely
118107 ]
119108 , bgroup "variableSlowConsumer"
120− [ bench "aheadly" $ nfIO $ alwaysVarSlow fromAhead
121− , bench "asyncly" $ nfIO $ alwaysVarSlow fromAsync
122− , bench "wAsyncly" $ nfIO $ alwaysVarSlow fromWAsync
123− , bench "parallely" $ nfIO $ alwaysVarSlow fromParallel
109+ [ bench "aheadly" $ nfIO $ alwaysVarSlow aheadly
110+ , bench "asyncly" $ nfIO $ alwaysVarSlow asyncly
111+ , bench "wAsyncly" $ nfIO $ alwaysVarSlow wAsyncly
112+ , bench "parallely" $ nfIO $ alwaysVarSlow parallely
124113 ]
125114 , bgroup "variableFastConsumer"
126− [ bench "aheadly" $ nfIO $ alwaysVarFast fromAhead
127− , bench "asyncly" $ nfIO $ alwaysVarFast fromAsync
128− , bench "wAsyncly" $ nfIO $ alwaysVarFast fromWAsync
129− , bench "parallely" $ nfIO $ alwaysVarFast fromParallel
115+ [ bench "aheadly" $ nfIO $ alwaysVarFast aheadly
116+ , bench "asyncly" $ nfIO $ alwaysVarFast asyncly
117+ , bench "wAsyncly" $ nfIO $ alwaysVarFast wAsyncly
118+ , bench "parallely" $ nfIO $ alwaysVarFast parallely
130119 ]
131120 , bgroup "variableSometimesFastConsumer"
132− [ bench "aheadly" $ nfIO $ runVarSometimesFast fromAhead
133− , bench "asyncly" $ nfIO $ runVarSometimesFast fromAsync
134− , bench "wAsyncly" $ nfIO $ runVarSometimesFast fromWAsync
135− , bench "parallely" $ nfIO $ runVarSometimesFast fromParallel
121+ [ bench "aheadly" $ nfIO $ runVarSometimesFast aheadly
122+ , bench "asyncly" $ nfIO $ runVarSometimesFast asyncly
123+ , bench "wAsyncly" $ nfIO $ runVarSometimesFast wAsyncly
124+ , bench "parallely" $ nfIO $ runVarSometimesFast parallely
136125 ]
137126 , bgroup "variableFullOverlap"
138− [ bench "aheadly" $ nfIO $ randomVar fromAhead
139− , bench "asyncly" $ nfIO $ randomVar fromAsync
140− , bench "wAsyncly" $ nfIO $ randomVar fromWAsync
141− , bench "parallely" $ nfIO $ randomVar fromParallel
127+ [ bench "aheadly" $ nfIO $ randomVar aheadly
128+ , bench "asyncly" $ nfIO $ randomVar asyncly
129+ , bench "wAsyncly" $ nfIO $ randomVar wAsyncly
130+ , bench "parallely" $ nfIO $ randomVar parallely
142131 ]
143132 ]
benchmark/Array.hsnew file+251
@@ -0,0 +1,251 @@
1+{-# LANGUAGE CPP #-}
2+-- |
3+-- Module : Main
4+-- Copyright : (c) 2018 Harendra Kumar
5+--
6+-- License : BSD3
7+-- Maintainer : streamly@composewell.com
8+
9+import Control.DeepSeq (NFData(..), deepseq)
10+import Foreign.Storable (Storable(..))
11+import System.Random (randomRIO)
12+
13+import qualified GHC.Exts as GHC
14+
15+import qualified ArrayOps as Ops
16+import qualified Streamly.Internal.Memory.Array as IA
17+import qualified Streamly.Memory.Array as A
18+import qualified Streamly.Prelude as S
19+
20+import Gauge
21+
22+-------------------------------------------------------------------------------
23+--
24+-------------------------------------------------------------------------------
25+
26+{-# INLINE benchPure #-}
27+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark
28+benchPure name src f = bench name $ nfIO $
29+ randomRIO (1,1) >>= return . f . src
30+
31+-- Drain a source that generates a pure array
32+{-# INLINE benchPureSrc #-}
33+benchPureSrc :: (NFData a, Storable a)
34+ => String -> (Int -> Ops.Stream a) -> Benchmark
35+benchPureSrc name src = benchPure name src id
36+
37+{-# INLINE benchIO #-}
38+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
39+benchIO name src f = bench name $ nfIO $
40+ randomRIO (1,1) >>= src >>= return . f
41+
42+-- Drain a source that generates an array in the IO monad
43+{-# INLINE benchIOSrc #-}
44+benchIOSrc :: (NFData a, Storable a)
45+ => String -> (Int -> IO (Ops.Stream a)) -> Benchmark
46+benchIOSrc name src = benchIO name src id
47+
48+{-# INLINE benchPureSink #-}
49+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark
50+benchPureSink name f = benchIO name Ops.sourceIntFromTo f
51+
52+{-# INLINE benchIO' #-}
53+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
54+benchIO' name src f = bench name $ nfIO $
55+ randomRIO (1,1) >>= src >>= f
56+
57+{-# INLINE benchIOSink #-}
58+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark
59+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f
60+
61+mkString :: String
62+mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"
63+
64+main :: IO ()
65+main =
66+ defaultMain
67+ [ bgroup "array"
68+ [ bgroup "generation"
69+ [ benchIOSrc "writeN . intFromTo" Ops.sourceIntFromTo
70+ , benchIOSrc "write . intFromTo" Ops.sourceIntFromToFromStream
71+ , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList
72+ , benchIOSrc "writeN . unfoldr" Ops.sourceUnfoldr
73+ , benchIOSrc "writeN . fromList" Ops.sourceFromList
74+ , benchPureSrc "writeN . IsList.fromList" Ops.sourceIsList
75+ , benchPureSrc "writeN . IsString.fromString" Ops.sourceIsString
76+ , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)
77+ , benchPureSink "show" Ops.showInstance
78+ ]
79+ , bgroup "elimination"
80+ [ benchPureSink "id" id
81+ -- , benchPureSink "eqBy" Ops.eqBy
82+ , benchPureSink "==" Ops.eqInstance
83+ , benchPureSink "/=" Ops.eqInstanceNotEq
84+ {-
85+ , benchPureSink "cmpBy" Ops.cmpBy
86+ -}
87+ , benchPureSink "<" Ops.ordInstance
88+ , benchPureSink "min" Ops.ordInstanceMin
89+ -- length is used to check for foldr/build fusion
90+ , benchPureSink "length . IsList.toList" (length . GHC.toList)
91+ , benchIOSink "foldl'" Ops.pureFoldl'
92+ , benchIOSink "read" (S.drain . S.unfold A.read)
93+ , benchIOSink "toStreamRev" (S.drain . IA.toStreamRev)
94+#ifdef DEVBUILD
95+ , benchPureSink "foldable/foldl'" Ops.foldableFoldl'
96+ , benchPureSink "foldable/sum" Ops.foldableSum
97+ -- , benchPureSinkIO "traversable/mapM" Ops.traversableMapM
98+#endif
99+ ]
100+
101+ {-
102+ [ benchPureSink "uncons" Ops.uncons
103+ , benchPureSink "toNull" $ Ops.toNull serially
104+ , benchPureSink "mapM_" Ops.mapM_
105+
106+ , benchPureSink "init" Ops.init
107+ , benchPureSink "tail" Ops.tail
108+ , benchPureSink "nullHeadTail" Ops.nullHeadTail
109+
110+ -- this is too low and causes all benchmarks reported in ns
111+ -- , benchPureSink "head" Ops.head
112+ , benchPureSink "last" Ops.last
113+ -- , benchPureSink "lookup" Ops.lookup
114+ , benchPureSink "find" Ops.find
115+ , benchPureSink "findIndex" Ops.findIndex
116+ , benchPureSink "elemIndex" Ops.elemIndex
117+
118+ -- this is too low and causes all benchmarks reported in ns
119+ -- , benchPureSink "null" Ops.null
120+ , benchPureSink "elem" Ops.elem
121+ , benchPureSink "notElem" Ops.notElem
122+ , benchPureSink "all" Ops.all
123+ , benchPureSink "any" Ops.any
124+ , benchPureSink "and" Ops.and
125+ , benchPureSink "or" Ops.or
126+
127+ , benchPureSink "length" Ops.length
128+ , benchPureSink "sum" Ops.sum
129+ , benchPureSink "product" Ops.product
130+
131+ , benchPureSink "maximumBy" Ops.maximumBy
132+ , benchPureSink "maximum" Ops.maximum
133+ , benchPureSink "minimumBy" Ops.minimumBy
134+ , benchPureSink "minimum" Ops.minimum
135+
136+ , benchPureSink "toList" Ops.toList
137+ , benchPureSink "toRevList" Ops.toRevList
138+ ]
139+ -}
140+ , bgroup "transformation"
141+ [ benchIOSink "scanl'" (Ops.scanl' 1)
142+ , benchIOSink "scanl1'" (Ops.scanl1' 1)
143+ , benchIOSink "map" (Ops.map 1)
144+ {-
145+ , benchPureSink "fmap" (Ops.fmap 1)
146+ , benchPureSink "mapM" (Ops.mapM serially 1)
147+ , benchPureSink "mapMaybe" (Ops.mapMaybe 1)
148+ , benchPureSink "mapMaybeM" (Ops.mapMaybeM 1)
149+ , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
150+ Ops.sequence serially (Ops.sourceUnfoldrMAction n)
151+ , benchPureSink "findIndices" (Ops.findIndices 1)
152+ , benchPureSink "elemIndices" (Ops.elemIndices 1)
153+ , benchPureSink "reverse" (Ops.reverse 1)
154+ , benchPureSink "foldrS" (Ops.foldrS 1)
155+ , benchPureSink "foldrSMap" (Ops.foldrSMap 1)
156+ , benchPureSink "foldrT" (Ops.foldrT 1)
157+ , benchPureSink "foldrTMap" (Ops.foldrTMap 1)
158+ -}
159+ ]
160+ , bgroup "transformationX4"
161+ [ benchIOSink "scanl'" (Ops.scanl' 4)
162+ , benchIOSink "scanl1'" (Ops.scanl1' 4)
163+ , benchIOSink "map" (Ops.map 4)
164+ {-
165+ , benchPureSink "fmap" (Ops.fmap 4)
166+ , benchPureSink "mapM" (Ops.mapM serially 4)
167+ , benchPureSink "mapMaybe" (Ops.mapMaybe 4)
168+ , benchPureSink "mapMaybeM" (Ops.mapMaybeM 4)
169+ -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
170+ -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)
171+ , benchPureSink "findIndices" (Ops.findIndices 4)
172+ , benchPureSink "elemIndices" (Ops.elemIndices 4)
173+ -}
174+ ]
175+ {-
176+ , bgroup "filtering"
177+ [ benchPureSink "filter-even" (Ops.filterEven 1)
178+ , benchPureSink "filter-all-out" (Ops.filterAllOut 1)
179+ , benchPureSink "filter-all-in" (Ops.filterAllIn 1)
180+ , benchPureSink "take-all" (Ops.takeAll 1)
181+ , benchPureSink "takeWhile-true" (Ops.takeWhileTrue 1)
182+ --, benchPureSink "takeWhileM-true" (Ops.takeWhileMTrue 1)
183+ , benchPureSink "drop-one" (Ops.dropOne 1)
184+ , benchPureSink "drop-all" (Ops.dropAll 1)
185+ , benchPureSink "dropWhile-true" (Ops.dropWhileTrue 1)
186+ --, benchPureSink "dropWhileM-true" (Ops.dropWhileMTrue 1)
187+ , benchPureSink "dropWhile-false" (Ops.dropWhileFalse 1)
188+ , benchPureSink "deleteBy" (Ops.deleteBy 1)
189+ , benchPureSink "insertBy" (Ops.insertBy 1)
190+ ]
191+ , bgroup "filteringX4"
192+ [ benchPureSink "filter-even" (Ops.filterEven 4)
193+ , benchPureSink "filter-all-out" (Ops.filterAllOut 4)
194+ , benchPureSink "filter-all-in" (Ops.filterAllIn 4)
195+ , benchPureSink "take-all" (Ops.takeAll 4)
196+ , benchPureSink "takeWhile-true" (Ops.takeWhileTrue 4)
197+ --, benchPureSink "takeWhileM-true" (Ops.takeWhileMTrue 4)
198+ , benchPureSink "drop-one" (Ops.dropOne 4)
199+ , benchPureSink "drop-all" (Ops.dropAll 4)
200+ , benchPureSink "dropWhile-true" (Ops.dropWhileTrue 4)
201+ --, benchPureSink "dropWhileM-true" (Ops.dropWhileMTrue 4)
202+ , benchPureSink "dropWhile-false" (Ops.dropWhileFalse 4)
203+ , benchPureSink "deleteBy" (Ops.deleteBy 4)
204+ , benchPureSink "insertBy" (Ops.insertBy 4)
205+ ]
206+ , bgroup "multi-stream"
207+ [ benchPureSink "eqBy" Ops.eqBy
208+ , benchPureSink "cmpBy" Ops.cmpBy
209+ , benchPureSink "zip" Ops.zip
210+ , benchPureSink "zipM" Ops.zipM
211+ , benchPureSink "mergeBy" Ops.mergeBy
212+ , benchPureSink "isPrefixOf" Ops.isPrefixOf
213+ , benchPureSink "isSubsequenceOf" Ops.isSubsequenceOf
214+ , benchPureSink "stripPrefix" Ops.stripPrefix
215+ , benchPureSrc serially "concatMap" Ops.concatMap
216+ ]
217+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
218+ -- library. If scan/fold followed by a map is efficient enough we may not
219+ -- need monolithic implementations of these.
220+ , bgroup "mixed"
221+ [ benchPureSink "scanl-map" (Ops.scanMap 1)
222+ , benchPureSink "foldl-map" Ops.foldl'ReduceMap
223+ , benchPureSink "sum-product-fold" Ops.sumProductFold
224+ , benchPureSink "sum-product-scan" Ops.sumProductScan
225+ ]
226+ , bgroup "mixedX4"
227+ [ benchPureSink "scan-map" (Ops.scanMap 4)
228+ , benchPureSink "drop-map" (Ops.dropMap 4)
229+ , benchPureSink "drop-scan" (Ops.dropScan 4)
230+ , benchPureSink "take-drop" (Ops.takeDrop 4)
231+ , benchPureSink "take-scan" (Ops.takeScan 4)
232+ , benchPureSink "take-map" (Ops.takeMap 4)
233+ , benchPureSink "filter-drop" (Ops.filterDrop 4)
234+ , benchPureSink "filter-take" (Ops.filterTake 4)
235+ , benchPureSink "filter-scan" (Ops.filterScan 4)
236+ , benchPureSink "filter-scanl1" (Ops.filterScanl1 4)
237+ , benchPureSink "filter-map" (Ops.filterMap 4)
238+ ]
239+ , bgroup "iterated"
240+ [ benchPureSrc serially "mapM" Ops.iterateMapM
241+ , benchPureSrc serially "scan(1/100)" Ops.iterateScan
242+ , benchPureSrc serially "scanl1(1/100)" Ops.iterateScanl1
243+ , benchPureSrc serially "filterEven" Ops.iterateFilterEven
244+ , benchPureSrc serially "takeAll" Ops.iterateTakeAll
245+ , benchPureSrc serially "dropOne" Ops.iterateDropOne
246+ , benchPureSrc serially "dropWhileFalse" Ops.iterateDropWhileFalse
247+ , benchPureSrc serially "dropWhileTrue" Ops.iterateDropWhileTrue
248+ ]
249+ -}
250+ ]
251+ ]
benchmark/ArrayOps.hsnew file+531
@@ -0,0 +1,531 @@
1+-- |
2+-- Module : ArrayOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : MIT
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE DeriveAnyClass #-}
12+{-# LANGUAGE DeriveGeneric #-}
13+
14+module ArrayOps where
15+
16+-- import Control.Monad (when)
17+import Control.Monad.IO.Class (MonadIO)
18+-- import Data.Maybe (fromJust)
19+import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20+import qualified Prelude as P
21+#ifdef DEVBUILD
22+import qualified Data.Foldable as F
23+#endif
24+import qualified GHC.Exts as GHC
25+-- import Control.DeepSeq (NFData)
26+-- import GHC.Generics (Generic)
27+
28+import qualified Streamly as S hiding (foldMapWith, runStream)
29+import qualified Streamly.Memory.Array as A
30+import qualified Streamly.Prelude as S
31+
32+value, maxValue :: Int
33+#ifdef LINEAR_ASYNC
34+value = 10000
35+#else
36+value = 100000
37+#endif
38+maxValue = value + 1
39+
40+-------------------------------------------------------------------------------
41+-- Benchmark ops
42+-------------------------------------------------------------------------------
43+
44+-------------------------------------------------------------------------------
45+-- Stream generation and elimination
46+-------------------------------------------------------------------------------
47+
48+type Stream = A.Array
49+
50+{-# INLINE sourceUnfoldr #-}
51+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
52+sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
53+ where
54+ step cnt =
55+ if cnt > n + value
56+ then Nothing
57+ else (Just (cnt, cnt + 1))
58+
59+{-# INLINE sourceIntFromTo #-}
60+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
61+sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
62+
63+{-# INLINE sourceIntFromToFromStream #-}
64+sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
65+sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
66+
67+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
68+sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
69+
70+{-# INLINE sourceFromList #-}
71+sourceFromList :: MonadIO m => Int -> m (Stream Int)
72+sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
73+
74+{-# INLINE sourceIsList #-}
75+sourceIsList :: Int -> Stream Int
76+sourceIsList n = GHC.fromList [n..n+value]
77+
78+{-# INLINE sourceIsString #-}
79+sourceIsString :: Int -> Stream P.Char
80+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
81+
82+{-
83+-------------------------------------------------------------------------------
84+-- Elimination
85+-------------------------------------------------------------------------------
86+
87+{-# INLINE runStream #-}
88+runStream :: Monad m => Stream m a -> m ()
89+runStream = S.runStream
90+
91+{-# INLINE toList #-}
92+toList :: Monad m => Stream m Int -> m [Int]
93+
94+{-# INLINE head #-}
95+{-# INLINE last #-}
96+{-# INLINE maximum #-}
97+{-# INLINE minimum #-}
98+{-# INLINE find #-}
99+{-# INLINE findIndex #-}
100+{-# INLINE elemIndex #-}
101+{-# INLINE foldl1'Reduce #-}
102+head, last, minimum, maximum, find, findIndex, elemIndex, foldl1'Reduce
103+ :: Monad m => Stream m Int -> m (Maybe Int)
104+
105+{-# INLINE minimumBy #-}
106+{-# INLINE maximumBy #-}
107+minimumBy, maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
108+
109+{-# INLINE foldl'Reduce #-}
110+{-# INLINE foldl'ReduceMap #-}
111+{-# INLINE foldlM'Reduce #-}
112+{-# INLINE foldrMReduce #-}
113+{-# INLINE length #-}
114+{-# INLINE sum #-}
115+{-# INLINE product #-}
116+foldl'Reduce, foldl'ReduceMap, foldlM'Reduce, foldrMReduce, length, sum, product
117+ :: Monad m
118+ => Stream m Int -> m Int
119+
120+{-# INLINE foldl'Build #-}
121+{-# INLINE foldlM'Build #-}
122+{-# INLINE foldrMBuild #-}
123+foldrMBuild, foldl'Build, foldlM'Build
124+ :: Monad m
125+ => Stream m Int -> m [Int]
126+
127+{-# INLINE all #-}
128+{-# INLINE any #-}
129+{-# INLINE and #-}
130+{-# INLINE or #-}
131+{-# INLINE null #-}
132+{-# INLINE elem #-}
133+{-# INLINE notElem #-}
134+null, elem, notElem, all, any, and, or :: Monad m => Stream m Int -> m Bool
135+
136+{-# INLINE toNull #-}
137+toNull :: Monad m => (t m a -> S.SerialT m a) -> t m a -> m ()
138+toNull t = runStream . t
139+
140+{-# INLINE uncons #-}
141+uncons :: Monad m => Stream m Int -> m ()
142+uncons s = do
143+ r <- S.uncons s
144+ case r of
145+ Nothing -> return ()
146+ Just (_, t) -> uncons t
147+
148+{-# INLINE init #-}
149+init :: Monad m => Stream m a -> m ()
150+init s = S.init s >>= Prelude.mapM_ S.runStream
151+
152+{-# INLINE tail #-}
153+tail :: Monad m => Stream m a -> m ()
154+tail s = S.tail s >>= Prelude.mapM_ tail
155+
156+{-# INLINE nullHeadTail #-}
157+nullHeadTail :: Monad m => Stream m Int -> m ()
158+nullHeadTail s = do
159+ r <- S.null s
160+ when (not r) $ do
161+ _ <- S.head s
162+ S.tail s >>= Prelude.mapM_ nullHeadTail
163+
164+{-# INLINE mapM_ #-}
165+mapM_ :: Monad m => Stream m Int -> m ()
166+mapM_ = S.mapM_ (\_ -> return ())
167+
168+toList = S.toList
169+
170+{-# INLINE toRevList #-}
171+toRevList :: Monad m => Stream m Int -> m [Int]
172+toRevList = S.toRevList
173+
174+foldrMBuild = S.foldrM (\x xs -> xs >>= return . (x :)) (return [])
175+foldl'Build = S.foldl' (flip (:)) []
176+foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) []
177+
178+foldrMReduce = S.foldrM (\x xs -> xs >>= return . (x +)) (return 0)
179+foldl'Reduce = S.foldl' (+) 0
180+foldl'ReduceMap = P.fmap (+1) . S.foldl' (+) 0
181+foldl1'Reduce = S.foldl1' (+)
182+foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) 0
183+
184+last = S.last
185+null = S.null
186+head = S.head
187+elem = S.elem maxValue
188+notElem = S.notElem maxValue
189+length = S.length
190+all = S.all (<= maxValue)
191+any = S.any (> maxValue)
192+and = S.and . S.map (<= maxValue)
193+or = S.or . S.map (> maxValue)
194+find = S.find (== maxValue)
195+findIndex = S.findIndex (== maxValue)
196+elemIndex = S.elemIndex maxValue
197+maximum = S.maximum
198+minimum = S.minimum
199+sum = S.sum
200+product = S.product
201+minimumBy = S.minimumBy compare
202+maximumBy = S.maximumBy compare
203+-}
204+
205+-------------------------------------------------------------------------------
206+-- Transformation
207+-------------------------------------------------------------------------------
208+
209+{-
210+{-# INLINE transform #-}
211+transform :: Stream a -> Stream a
212+transform = P.id
213+-}
214+
215+{-# INLINE composeN #-}
216+composeN :: P.Monad m
217+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
218+composeN n f x =
219+ case n of
220+ 1 -> f x
221+ 2 -> f x P.>>= f
222+ 3 -> f x P.>>= f P.>>= f
223+ 4 -> f x P.>>= f P.>>= f P.>>= f
224+ _ -> undefined
225+
226+{-# INLINE scanl' #-}
227+{-# INLINE scanl1' #-}
228+{-# INLINE map #-}
229+{-
230+{-# INLINE fmap #-}
231+{-# INLINE mapMaybe #-}
232+{-# INLINE filterEven #-}
233+{-# INLINE filterAllOut #-}
234+{-# INLINE filterAllIn #-}
235+{-# INLINE takeOne #-}
236+{-# INLINE takeAll #-}
237+{-# INLINE takeWhileTrue #-}
238+{-# INLINE takeWhileMTrue #-}
239+{-# INLINE dropOne #-}
240+{-# INLINE dropAll #-}
241+{-# INLINE dropWhileTrue #-}
242+{-# INLINE dropWhileMTrue #-}
243+{-# INLINE dropWhileFalse #-}
244+{-# INLINE findIndices #-}
245+{-# INLINE elemIndices #-}
246+{-# INLINE insertBy #-}
247+{-# INLINE deleteBy #-}
248+{-# INLINE reverse #-}
249+{-# INLINE foldrS #-}
250+{-# INLINE foldrSMap #-}
251+{-# INLINE foldrT #-}
252+{-# INLINE foldrTMap #-}
253+ -}
254+scanl' , scanl1', map{-, fmap, mapMaybe, filterEven, filterAllOut,
255+ filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,
256+ dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse,
257+ findIndices, elemIndices, insertBy, deleteBy, reverse,
258+ foldrS, foldrSMap, foldrT, foldrTMap -}
259+ :: MonadIO m => Int -> Stream Int -> m (Stream Int)
260+
261+{-
262+{-# INLINE mapMaybeM #-}
263+mapMaybeM :: S.MonadAsync m => Int -> Stream m Int -> m ()
264+
265+{-# INLINE mapM #-}
266+{-# INLINE map' #-}
267+{-# INLINE fmap' #-}
268+mapM, map' :: (S.IsStream t, S.MonadAsync m)
269+ => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
270+
271+fmap' :: (S.IsStream t, S.MonadAsync m, P.Functor (t m))
272+ => (t m Int -> S.SerialT m Int) -> Int -> t m Int -> m ()
273+
274+{-# INLINE sequence #-}
275+sequence :: (S.IsStream t, S.MonadAsync m)
276+ => (t m Int -> S.SerialT m Int) -> t m (m Int) -> m ()
277+ -}
278+
279+{-# INLINE onArray #-}
280+onArray
281+ :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
282+ -> Stream Int
283+ -> m (Stream Int)
284+onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
285+
286+scanl' n = composeN n $ onArray $ S.scanl' (+) 0
287+scanl1' n = composeN n $ onArray $ S.scanl1' (+)
288+map n = composeN n $ onArray $ S.map (+1)
289+-- map n = composeN n $ A.map (+1)
290+{-
291+fmap n = composeN n $ Prelude.fmap (+1)
292+fmap' t n = composeN' n $ t . Prelude.fmap (+1)
293+map' t n = composeN' n $ t . S.map (+1)
294+mapM t n = composeN' n $ t . S.mapM return
295+mapMaybe n = composeN n $ S.mapMaybe
296+ (\x -> if Prelude.odd x then Nothing else Just x)
297+mapMaybeM n = composeN n $ S.mapMaybeM
298+ (\x -> if Prelude.odd x then return Nothing else return $ Just x)
299+sequence t = transform . t . S.sequence
300+filterEven n = composeN n $ S.filter even
301+filterAllOut n = composeN n $ S.filter (> maxValue)
302+filterAllIn n = composeN n $ S.filter (<= maxValue)
303+takeOne n = composeN n $ S.take 1
304+takeAll n = composeN n $ S.take maxValue
305+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
306+takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
307+dropOne n = composeN n $ S.drop 1
308+dropAll n = composeN n $ S.drop maxValue
309+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
310+dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
311+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
312+findIndices n = composeN n $ S.findIndices (== maxValue)
313+elemIndices n = composeN n $ S.elemIndices maxValue
314+insertBy n = composeN n $ S.insertBy compare maxValue
315+deleteBy n = composeN n $ S.deleteBy (>=) maxValue
316+reverse n = composeN n $ S.reverse
317+foldrS n = composeN n $ S.foldrS S.cons S.nil
318+foldrSMap n = composeN n $ S.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
319+foldrT n = composeN n $ S.foldrT S.cons S.nil
320+foldrTMap n = composeN n $ S.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
321+
322+-------------------------------------------------------------------------------
323+-- Iteration
324+-------------------------------------------------------------------------------
325+
326+iterStreamLen, maxIters :: Int
327+iterStreamLen = 10
328+maxIters = 10000
329+
330+{-# INLINE iterateSource #-}
331+iterateSource
332+ :: S.MonadAsync m
333+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
334+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
335+ where
336+ f (0 :: Int) m = g m
337+ f x m = g (f (x P.- 1) m)
338+
339+{-# INLINE iterateMapM #-}
340+{-# INLINE iterateScan #-}
341+{-# INLINE iterateScanl1 #-}
342+{-# INLINE iterateFilterEven #-}
343+{-# INLINE iterateTakeAll #-}
344+{-# INLINE iterateDropOne #-}
345+{-# INLINE iterateDropWhileFalse #-}
346+{-# INLINE iterateDropWhileTrue #-}
347+iterateMapM, iterateScan, iterateScanl1, iterateFilterEven, iterateTakeAll,
348+ iterateDropOne, iterateDropWhileFalse, iterateDropWhileTrue
349+ :: S.MonadAsync m
350+ => Int -> Stream m Int
351+
352+-- this is quadratic
353+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
354+-- so is this
355+iterateScanl1 = iterateSource (S.scanl1' (+)) (maxIters `div` 10)
356+
357+iterateMapM = iterateSource (S.mapM return) maxIters
358+iterateFilterEven = iterateSource (S.filter even) maxIters
359+iterateTakeAll = iterateSource (S.take maxValue) maxIters
360+iterateDropOne = iterateSource (S.drop 1) maxIters
361+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue)) maxIters
362+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
363+
364+-------------------------------------------------------------------------------
365+-- Zipping and concat
366+-------------------------------------------------------------------------------
367+
368+{-# INLINE zip #-}
369+{-# INLINE zipM #-}
370+{-# INLINE mergeBy #-}
371+zip, zipM, mergeBy :: Monad m => Stream m Int -> m ()
372+
373+zip src = do
374+ r <- S.tail src
375+ let src1 = fromJust r
376+ transform (S.zipWith (,) src src1)
377+zipM src = do
378+ r <- S.tail src
379+ let src1 = fromJust r
380+ transform (S.zipWithM (curry return) src src1)
381+
382+mergeBy src = do
383+ r <- S.tail src
384+ let src1 = fromJust r
385+ transform (S.mergeBy P.compare src src1)
386+
387+{-# INLINE isPrefixOf #-}
388+{-# INLINE isSubsequenceOf #-}
389+isPrefixOf, isSubsequenceOf :: Monad m => Stream m Int -> m Bool
390+
391+isPrefixOf src = S.isPrefixOf src src
392+isSubsequenceOf src = S.isSubsequenceOf src src
393+
394+{-# INLINE stripPrefix #-}
395+stripPrefix :: Monad m => Stream m Int -> m ()
396+stripPrefix src = do
397+ _ <- S.stripPrefix src src
398+ return ()
399+
400+{-# INLINE zipAsync #-}
401+{-# INLINE zipAsyncM #-}
402+{-# INLINE zipAsyncAp #-}
403+zipAsync, zipAsyncAp, zipAsyncM :: S.MonadAsync m => Stream m Int -> m ()
404+
405+zipAsync src = do
406+ r <- S.tail src
407+ let src1 = fromJust r
408+ transform (S.zipAsyncWith (,) src src1)
409+
410+zipAsyncM src = do
411+ r <- S.tail src
412+ let src1 = fromJust r
413+ transform (S.zipAsyncWithM (curry return) src src1)
414+
415+zipAsyncAp src = do
416+ r <- S.tail src
417+ let src1 = fromJust r
418+ transform (S.zipAsyncly $ (,) <$> S.serially src
419+ <*> S.serially src1)
420+
421+{-# INLINE eqBy #-}
422+eqBy :: (Monad m, P.Eq a) => Stream m a -> m P.Bool
423+eqBy src = S.eqBy (==) src src
424+
425+{-# INLINE cmpBy #-}
426+cmpBy :: (Monad m, P.Ord a) => Stream m a -> m P.Ordering
427+cmpBy src = S.cmpBy P.compare src src
428+
429+concatStreamLen, maxNested :: Int
430+concatStreamLen = 1
431+maxNested = 100000
432+
433+{-# INLINE concatMap #-}
434+concatMap :: S.MonadAsync m => Int -> Stream m Int
435+concatMap n = S.concatMap (\_ -> sourceUnfoldrMN maxNested n)
436+ (sourceUnfoldrMN concatStreamLen n)
437+
438+-------------------------------------------------------------------------------
439+-- Mixed Composition
440+-------------------------------------------------------------------------------
441+
442+{-# INLINE scanMap #-}
443+{-# INLINE dropMap #-}
444+{-# INLINE dropScan #-}
445+{-# INLINE takeDrop #-}
446+{-# INLINE takeScan #-}
447+{-# INLINE takeMap #-}
448+{-# INLINE filterDrop #-}
449+{-# INLINE filterTake #-}
450+{-# INLINE filterScan #-}
451+{-# INLINE filterScanl1 #-}
452+{-# INLINE filterMap #-}
453+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
454+ filterTake, filterScan, filterScanl1, filterMap
455+ :: Monad m => Int -> Stream m Int -> m ()
456+
457+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
458+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
459+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
460+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
461+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
462+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
463+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
464+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
465+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
466+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
467+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
468+
469+data Pair a b = Pair !a !b deriving (Generic, NFData)
470+
471+{-# INLINE sumProductFold #-}
472+sumProductFold :: Monad m => Stream m Int -> m (Int, Int)
473+sumProductFold = S.foldl' (\(s,p) x -> (s + x, p P.* x)) (0,1)
474+
475+{-# INLINE sumProductScan #-}
476+sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
477+sumProductScan = S.foldl' (\(Pair _ p) (s0,x) -> Pair s0 (p P.* x)) (Pair 0 1)
478+ . S.scanl' (\(s,_) x -> (s + x,x)) (0,0)
479+
480+-------------------------------------------------------------------------------
481+-- Pure stream operations
482+-------------------------------------------------------------------------------
483+
484+-}
485+{-# INLINE eqInstance #-}
486+eqInstance :: Stream Int -> Bool
487+eqInstance src = src == src
488+
489+{-# INLINE eqInstanceNotEq #-}
490+eqInstanceNotEq :: Stream Int -> Bool
491+eqInstanceNotEq src = src P./= src
492+
493+{-# INLINE ordInstance #-}
494+ordInstance :: Stream Int -> Bool
495+ordInstance src = src P.< src
496+
497+{-# INLINE ordInstanceMin #-}
498+ordInstanceMin :: Stream Int -> Stream Int
499+ordInstanceMin src = P.min src src
500+
501+{-# INLINE showInstance #-}
502+showInstance :: Stream Int -> P.String
503+showInstance src = P.show src
504+
505+{-# INLINE readInstance #-}
506+readInstance :: P.String -> Stream Int
507+readInstance str =
508+ let r = P.reads str
509+ in case r of
510+ [(x,"")] -> x
511+ _ -> P.error "readInstance: no parse"
512+
513+{-# INLINE pureFoldl' #-}
514+pureFoldl' :: MonadIO m => Stream Int -> m Int
515+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
516+
517+#ifdef DEVBUILD
518+{-# INLINE foldableFoldl' #-}
519+foldableFoldl' :: Stream Int -> Int
520+foldableFoldl' = F.foldl' (+) 0
521+
522+{-# INLINE foldableSum #-}
523+foldableSum :: Stream Int -> Int
524+foldableSum = P.sum
525+#endif
526+
527+{-
528+{-# INLINE traversableMapM #-}
529+traversableMapM :: Stream Identity Int -> IO (Stream Identity Int)
530+traversableMapM = P.mapM return
531+-}
benchmark/BaseStreams.hsnew file+380
@@ -0,0 +1,380 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+
10+import Control.DeepSeq (NFData(..))
11+-- import Data.Functor.Identity (Identity, runIdentity)
12+import System.Random (randomRIO)
13+
14+import Gauge
15+import qualified StreamDOps as D
16+import qualified StreamKOps as K
17+import qualified StreamDKOps as DK
18+import qualified Data.List as List
19+
20+#if !MIN_VERSION_deepseq(1,4,3)
21+instance NFData Ordering where rnf = (`seq` ())
22+#endif
23+
24+-- We need a monadic bind here to make sure that the function f does not get
25+-- completely optimized out by the compiler in some cases.
26+{-# INLINE benchIO #-}
27+benchIO :: String -> (a IO Int -> IO ()) -> (Int -> a IO Int) -> Benchmark
28+benchIO name run f = bench name $ nfIO $ randomRIO (1,1) >>= run . f
29+
30+{-# INLINE _benchIOSrcK #-}
31+_benchIOSrcK
32+ :: String
33+ -> (Int -> K.Stream IO Int)
34+ -> Benchmark
35+_benchIOSrcK name f = bench name $ nfIO $ randomRIO (1,1) >>= K.toNull . f
36+
37+{-# INLINE _benchIOSrcD #-}
38+_benchIOSrcD
39+ :: String
40+ -> (Int -> D.Stream IO Int)
41+ -> Benchmark
42+_benchIOSrcD name f = bench name $ nfIO $ randomRIO (1,1) >>= D.toNull . f
43+
44+benchFold :: NFData b
45+ => String -> (t IO Int -> IO b) -> (Int -> t IO Int) -> Benchmark
46+benchFold name f src = bench name $ nfIO $ randomRIO (1,1) >>= f . src
47+
48+#ifdef DEVBUILD
49+-- | Takes a source, and uses it with a default drain/fold method.
50+{-# INLINE benchD #-}
51+benchD :: String -> (Int -> D.Stream IO Int) -> Benchmark
52+benchD name f = bench name $ nfIO $ randomRIO (1,1) >>= D.toNull . f
53+
54+{-# INLINE benchK #-}
55+benchK :: String -> (Int -> K.Stream IO Int) -> Benchmark
56+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= K.toNull . f
57+#endif
58+
59+{-
60+_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
61+_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
62+-}
63+
64+{-# INLINE benchPure #-}
65+benchPure :: String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
66+benchPure name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
67+
68+main :: IO ()
69+main =
70+ defaultMain
71+ [ bgroup "streamD"
72+ [ bgroup "generation"
73+ [ benchIO "unfoldr" D.toNull D.sourceUnfoldr
74+ , benchIO "unfoldrM" D.toNull D.sourceUnfoldrM
75+ , benchIO "intFromTo" D.toNull D.sourceIntFromTo
76+
77+ , benchIO "fromList" D.toNull D.sourceFromList
78+ -- , benchIO "fromFoldableM" D.sourceFromFoldableM
79+ ]
80+ , bgroup "elimination"
81+ [ benchIO "toNull" D.toNull D.sourceUnfoldrM
82+ , benchIO "mapM_" D.mapM_ D.sourceUnfoldrM
83+ , benchIO "uncons" D.uncons D.sourceUnfoldrM
84+#ifdef DEVBUILD
85+ -- XXX these consume too much stack space, need to fix or segregate in
86+ -- another benchmark.
87+ , benchFold "tail" D.tail D.sourceUnfoldrM
88+ , benchIO "nullTail" D.nullTail D.sourceUnfoldrM
89+ , benchIO "headTail" D.headTail D.sourceUnfoldrM
90+ , benchFold "toList" D.toList D.sourceUnfoldrM
91+#endif
92+ , benchFold "foldl'" D.foldl D.sourceUnfoldrM
93+ , benchFold "last" D.last D.sourceUnfoldrM
94+ ]
95+ , bgroup "nested"
96+ [ benchIO "toNullAp" D.toNullApNested (D.sourceUnfoldrMN D.value2)
97+ , benchIO "toNull" D.toNullNested (D.sourceUnfoldrMN D.value2)
98+ , benchIO "toNull3" D.toNullNested3 (D.sourceUnfoldrMN D.value3)
99+ , benchIO "filterAllIn" D.filterAllInNested (D.sourceUnfoldrMN K.value2)
100+ , benchIO "filterAllOut" D.filterAllOutNested (D.sourceUnfoldrMN K.value2)
101+ , benchIO "toNullApPure" D.toNullApNested (D.sourceUnfoldrN K.value2)
102+ , benchIO "toNullPure" D.toNullNested (D.sourceUnfoldrN K.value2)
103+ , benchIO "toNull3Pure" D.toNullNested3 (D.sourceUnfoldrN K.value3)
104+ , benchIO "filterAllInPure" D.filterAllInNested (D.sourceUnfoldrN K.value2)
105+ , benchIO "filterAllOutPure" D.filterAllOutNested (D.sourceUnfoldrN K.value2)
106+ ]
107+ , bgroup "transformation"
108+ [ benchIO "scan" (D.scan 1) D.sourceUnfoldrM
109+ , benchIO "map" (D.map 1) D.sourceUnfoldrM
110+ , benchIO "fmap" (D.fmap 1) D.sourceUnfoldrM
111+ , benchIO "mapM" (D.mapM 1) D.sourceUnfoldrM
112+ , benchIO "mapMaybe" (D.mapMaybe 1) D.sourceUnfoldrM
113+ , benchIO "mapMaybeM" (D.mapMaybeM 1) D.sourceUnfoldrM
114+ , benchIO "concatMapNxN" (D.concatMap 1) (D.sourceUnfoldrMN D.value2)
115+ , benchIO "concatMapRepl4xN" D.concatMapRepl4xN
116+ (D.sourceUnfoldrMN (D.value `div` 4))
117+ , benchIO "concatMapPureNxN" (D.concatMap 1) (D.sourceUnfoldrN D.value2)
118+ , benchIO "concatMapURepl4xN" D.concatMapURepl4xN
119+ (D.sourceUnfoldrMN (D.value `div` 4))
120+ , benchIO "intersperse" (D.intersperse 1) (D.sourceUnfoldrMN D.value2)
121+ , benchIO "interspersePure" (D.intersperse 1) (D.sourceUnfoldrN D.value2)
122+ -- , benchIO "foldrS" (D.foldrS 1) D.sourceUnfoldrM
123+ -- This has horrible performance, never finishes
124+ -- , benchIO "foldlS" (D.foldlS 1) D.sourceUnfoldrM
125+ ]
126+ , bgroup "transformationX4"
127+ [ benchIO "scan" (D.scan 4) D.sourceUnfoldrM
128+ , benchIO "map" (D.map 4) D.sourceUnfoldrM
129+ , benchIO "fmap" (D.fmap 4) D.sourceUnfoldrM
130+ , benchIO "mapM" (D.mapM 4) D.sourceUnfoldrM
131+ , benchIO "mapMaybe" (D.mapMaybe 4) D.sourceUnfoldrM
132+ , benchIO "mapMaybeM" (D.mapMaybeM 4) D.sourceUnfoldrM
133+ -- , benchIO "concatMap" (D.concatMap 4) (D.sourceUnfoldrMN D.value16)
134+ , benchIO "intersperse" (D.intersperse 4) (D.sourceUnfoldrMN D.value16)
135+ ]
136+ , bgroup "filtering"
137+ [ benchIO "filter-even" (D.filterEven 1) D.sourceUnfoldrM
138+ , benchIO "filter-all-out" (D.filterAllOut 1) D.sourceUnfoldrM
139+ , benchIO "filter-all-in" (D.filterAllIn 1) D.sourceUnfoldrM
140+ , benchIO "take-all" (D.takeAll 1) D.sourceUnfoldrM
141+ , benchIO "takeWhile-true" (D.takeWhileTrue 1) D.sourceUnfoldrM
142+ , benchIO "drop-one" (D.dropOne 1) D.sourceUnfoldrM
143+ , benchIO "drop-all" (D.dropAll 1) D.sourceUnfoldrM
144+ , benchIO "dropWhile-true" (D.dropWhileTrue 1) D.sourceUnfoldrM
145+ , benchIO "dropWhile-false" (D.dropWhileFalse 1) D.sourceUnfoldrM
146+ ]
147+ , bgroup "filteringX4"
148+ [ benchIO "filter-even" (D.filterEven 4) D.sourceUnfoldrM
149+ , benchIO "filter-all-out" (D.filterAllOut 4) D.sourceUnfoldrM
150+ , benchIO "filter-all-in" (D.filterAllIn 4) D.sourceUnfoldrM
151+ , benchIO "take-all" (D.takeAll 4) D.sourceUnfoldrM
152+ , benchIO "takeWhile-true" (D.takeWhileTrue 4) D.sourceUnfoldrM
153+ , benchIO "drop-one" (D.dropOne 4) D.sourceUnfoldrM
154+ , benchIO "drop-all" (D.dropAll 4) D.sourceUnfoldrM
155+ , benchIO "dropWhile-true" (D.dropWhileTrue 4) D.sourceUnfoldrM
156+ , benchIO "dropWhile-false" (D.dropWhileFalse 4) D.sourceUnfoldrM
157+ ]
158+ , bgroup "zipping"
159+ [ benchFold "eqBy" D.eqBy D.sourceUnfoldrM
160+ , benchFold "cmpBy" D.cmpBy D.sourceUnfoldrM
161+ , benchIO "zip" D.zip D.sourceUnfoldrM
162+ ]
163+ , bgroup "mixed"
164+ [ benchIO "scan-map" (D.scanMap 1) D.sourceUnfoldrM
165+ , benchIO "drop-map" (D.dropMap 1) D.sourceUnfoldrM
166+ , benchIO "drop-scan" (D.dropScan 1) D.sourceUnfoldrM
167+ , benchIO "take-drop" (D.takeDrop 1) D.sourceUnfoldrM
168+ , benchIO "take-scan" (D.takeScan 1) D.sourceUnfoldrM
169+ , benchIO "take-map" (D.takeMap 1) D.sourceUnfoldrM
170+ , benchIO "filter-drop" (D.filterDrop 1) D.sourceUnfoldrM
171+ , benchIO "filter-take" (D.filterTake 1) D.sourceUnfoldrM
172+ , benchIO "filter-scan" (D.filterScan 1) D.sourceUnfoldrM
173+ , benchIO "filter-map" (D.filterMap 1) D.sourceUnfoldrM
174+ ]
175+ , bgroup "mixedX2"
176+ [ benchIO "scan-map" (D.scanMap 2) D.sourceUnfoldrM
177+ , benchIO "drop-map" (D.dropMap 2) D.sourceUnfoldrM
178+ , benchIO "drop-scan" (D.dropScan 2) D.sourceUnfoldrM
179+ , benchIO "take-drop" (D.takeDrop 2) D.sourceUnfoldrM
180+ , benchIO "take-scan" (D.takeScan 2) D.sourceUnfoldrM
181+ , benchIO "take-map" (D.takeMap 2) D.sourceUnfoldrM
182+ , benchIO "filter-drop" (D.filterDrop 2) D.sourceUnfoldrM
183+ , benchIO "filter-take" (D.filterTake 2) D.sourceUnfoldrM
184+ , benchIO "filter-scan" (D.filterScan 2) D.sourceUnfoldrM
185+ , benchIO "filter-map" (D.filterMap 2) D.sourceUnfoldrM
186+ ]
187+ , bgroup "mixedX4"
188+ [ benchIO "scan-map" (D.scanMap 4) D.sourceUnfoldrM
189+ , benchIO "drop-map" (D.dropMap 4) D.sourceUnfoldrM
190+ , benchIO "drop-scan" (D.dropScan 4) D.sourceUnfoldrM
191+ , benchIO "take-drop" (D.takeDrop 4) D.sourceUnfoldrM
192+ , benchIO "take-scan" (D.takeScan 4) D.sourceUnfoldrM
193+ , benchIO "take-map" (D.takeMap 4) D.sourceUnfoldrM
194+ , benchIO "filter-drop" (D.filterDrop 4) D.sourceUnfoldrM
195+ , benchIO "filter-take" (D.filterTake 4) D.sourceUnfoldrM
196+ , benchIO "filter-scan" (D.filterScan 4) D.sourceUnfoldrM
197+ , benchIO "filter-map" (D.filterMap 4) D.sourceUnfoldrM
198+ ]
199+#ifdef DEVBUILD
200+ -- XXX these consume too much stack space, need to fix or segregate in
201+ -- another benchmark.
202+ , bgroup "iterated"
203+ [ benchD "mapM" D.iterateMapM
204+ , benchD "scan(1/10)" D.iterateScan
205+ , benchD "filterEven" D.iterateFilterEven
206+ , benchD "takeAll" D.iterateTakeAll
207+ , benchD "dropOne" D.iterateDropOne
208+ , benchD "dropWhileFalse(1/10)" D.iterateDropWhileFalse
209+ , benchD "dropWhileTrue" D.iterateDropWhileTrue
210+ , benchD "iterateM" D.iterateM
211+
212+ ]
213+#endif
214+ ]
215+ , bgroup "list"
216+ [ bgroup "elimination"
217+ [ benchPure "last" (\xs -> [List.last xs]) (K.sourceUnfoldrList K.value)
218+ ]
219+ , bgroup "nested"
220+ [ benchPure "toNullAp" K.toNullApNestedList (K.sourceUnfoldrList K.value2)
221+ , benchPure "toNull" K.toNullNestedList (K.sourceUnfoldrList K.value2)
222+ , benchPure "toNull3" K.toNullNestedList3 (K.sourceUnfoldrList K.value3)
223+ , benchPure "filterAllIn" K.filterAllInNestedList (K.sourceUnfoldrList K.value2)
224+ , benchPure "filterAllOut" K.filterAllOutNestedList (K.sourceUnfoldrList K.value2)
225+ ]
226+ ]
227+ , bgroup "streamK"
228+ [ bgroup "generation"
229+ [ benchIO "unfoldr" K.toNull K.sourceUnfoldr
230+ , benchIO "unfoldrM" K.toNull K.sourceUnfoldrM
231+ -- , benchIO "fromEnum" K.toNull K.sourceFromEnum
232+
233+ , benchIO "fromFoldable" K.toNull K.sourceFromFoldable
234+ -- , benchIO "fromFoldableM" K.toNull K.sourceFromFoldableM
235+
236+ -- appends
237+ , benchIO "foldMapWith" K.toNull K.sourceFoldMapWith
238+ , benchIO "foldMapWithM" K.toNull K.sourceFoldMapWithM
239+ ]
240+ , bgroup "elimination"
241+ [ benchIO "toNull" K.toNull K.sourceUnfoldrM
242+ , benchIO "mapM_" K.mapM_ K.sourceUnfoldrM
243+ , benchIO "uncons" K.uncons K.sourceUnfoldrM
244+ , benchFold "init" K.init K.sourceUnfoldrM
245+#ifdef DEVBUILD
246+ -- XXX these consume too much stack space, need to fix or segregate in
247+ -- another benchmark.
248+ , benchFold "tail" K.tail K.sourceUnfoldrM
249+ , benchIO "nullTail" K.nullTail K.sourceUnfoldrM
250+ , benchIO "headTail" K.headTail K.sourceUnfoldrM
251+ , benchFold "toList" K.toList K.sourceUnfoldrM
252+#endif
253+ , benchFold "foldl'" K.foldl K.sourceUnfoldrM
254+ , benchFold "last" K.last K.sourceUnfoldrM
255+ ]
256+ , bgroup "nested"
257+ [ benchIO "toNullAp" K.toNullApNested (K.sourceUnfoldrMN K.value2)
258+ , benchIO "toNull" K.toNullNested (K.sourceUnfoldrMN K.value2)
259+ , benchIO "toNull3" K.toNullNested3 (K.sourceUnfoldrMN K.value3)
260+ , benchIO "filterAllIn" K.filterAllInNested (K.sourceUnfoldrMN K.value2)
261+ , benchIO "filterAllOut" K.filterAllOutNested (K.sourceUnfoldrMN K.value2)
262+ , benchIO "toNullApPure" K.toNullApNested (K.sourceUnfoldrN K.value2)
263+ , benchIO "toNullPure" K.toNullNested (K.sourceUnfoldrN K.value2)
264+ , benchIO "toNull3Pure" K.toNullNested3 (K.sourceUnfoldrN K.value3)
265+ , benchIO "filterAllInPure" K.filterAllInNested (K.sourceUnfoldrN K.value2)
266+ , benchIO "filterAllOutPure" K.filterAllOutNested (K.sourceUnfoldrN K.value2)
267+ ]
268+ , bgroup "transformation"
269+ [ benchIO "scan" (K.scan 1) K.sourceUnfoldrM
270+ , benchIO "map" (K.map 1) K.sourceUnfoldrM
271+ , benchIO "fmap" (K.fmap 1) K.sourceUnfoldrM
272+ , benchIO "mapM" (K.mapM 1) K.sourceUnfoldrM
273+ , benchIO "mapMSerial" (K.mapMSerial 1) K.sourceUnfoldrM
274+ -- , benchIOSrcK "concatMap" K.concatMap
275+ , benchIO "concatMapNxN" (K.concatMap 1) (K.sourceUnfoldrMN K.value2)
276+ , benchIO "concatMapPureNxN" (K.concatMap 1) (K.sourceUnfoldrN K.value2)
277+ , benchIO "concatMapRepl4xN" K.concatMapRepl4xN
278+ (K.sourceUnfoldrMN (K.value `div` 4))
279+ , benchIO "intersperse" (K.intersperse 1) (K.sourceUnfoldrMN K.value2)
280+ , benchIO "interspersePure" (K.intersperse 1) (K.sourceUnfoldrN K.value2)
281+#ifdef DEVBUILD
282+ -- XXX this consumes too much heap
283+ , benchIO "foldlS" (K.foldlS 1) K.sourceUnfoldrM
284+#endif
285+ ]
286+ , bgroup "transformationX4"
287+ [ benchIO "scan" (K.scan 4) K.sourceUnfoldrM
288+ , benchIO "map" (K.map 4) K.sourceUnfoldrM
289+ , benchIO "fmap" (K.fmap 4) K.sourceUnfoldrM
290+ , benchIO "mapM" (K.mapM 4) K.sourceUnfoldrM
291+ , benchIO "mapMSerial" (K.mapMSerial 4) K.sourceUnfoldrM
292+ -- , benchIO "concatMap" (K.concatMap 4) (K.sourceUnfoldrMN K.value16)
293+ , benchIO "intersperse" (K.intersperse 4) (K.sourceUnfoldrMN K.value16)
294+ ]
295+ , bgroup "filtering"
296+ [ benchIO "filter-even" (K.filterEven 1) K.sourceUnfoldrM
297+ , benchIO "filter-all-out" (K.filterAllOut 1) K.sourceUnfoldrM
298+ , benchIO "filter-all-in" (K.filterAllIn 1) K.sourceUnfoldrM
299+ , benchIO "take-all" (K.takeAll 1) K.sourceUnfoldrM
300+ , benchIO "takeWhile-true" (K.takeWhileTrue 1) K.sourceUnfoldrM
301+ , benchIO "drop-one" (K.dropOne 1) K.sourceUnfoldrM
302+ , benchIO "drop-all" (K.dropAll 1) K.sourceUnfoldrM
303+ , benchIO "dropWhile-true" (K.dropWhileTrue 1) K.sourceUnfoldrM
304+ , benchIO "dropWhile-false" (K.dropWhileFalse 1) K.sourceUnfoldrM
305+ ]
306+ , bgroup "filteringX4"
307+ [ benchIO "filter-even" (K.filterEven 4) K.sourceUnfoldrM
308+ , benchIO "filter-all-out" (K.filterAllOut 4) K.sourceUnfoldrM
309+ , benchIO "filter-all-in" (K.filterAllIn 4) K.sourceUnfoldrM
310+ , benchIO "take-all" (K.takeAll 4) K.sourceUnfoldrM
311+ , benchIO "takeWhile-true" (K.takeWhileTrue 4) K.sourceUnfoldrM
312+ , benchIO "drop-one" (K.dropOne 4) K.sourceUnfoldrM
313+ , benchIO "drop-all" (K.dropAll 4) K.sourceUnfoldrM
314+ , benchIO "dropWhile-true" (K.dropWhileTrue 4) K.sourceUnfoldrM
315+ , benchIO "dropWhile-false" (K.dropWhileFalse 4) K.sourceUnfoldrM
316+ ]
317+ , bgroup "zipping"
318+ [ benchIO "zip" K.zip K.sourceUnfoldrM
319+ ]
320+ , bgroup "mixed"
321+ [ benchIO "scan-map" (K.scanMap 1) K.sourceUnfoldrM
322+ , benchIO "drop-map" (K.dropMap 1) K.sourceUnfoldrM
323+ , benchIO "drop-scan" (K.dropScan 1) K.sourceUnfoldrM
324+ , benchIO "take-drop" (K.takeDrop 1) K.sourceUnfoldrM
325+ , benchIO "take-scan" (K.takeScan 1) K.sourceUnfoldrM
326+ , benchIO "take-map" (K.takeMap 1) K.sourceUnfoldrM
327+ , benchIO "filter-drop" (K.filterDrop 1) K.sourceUnfoldrM
328+ , benchIO "filter-take" (K.filterTake 1) K.sourceUnfoldrM
329+ , benchIO "filter-scan" (K.filterScan 1) K.sourceUnfoldrM
330+ , benchIO "filter-map" (K.filterMap 1) K.sourceUnfoldrM
331+ ]
332+ , bgroup "mixedX2"
333+ [ benchIO "scan-map" (K.scanMap 2) K.sourceUnfoldrM
334+ , benchIO "drop-map" (K.dropMap 2) K.sourceUnfoldrM
335+ , benchIO "drop-scan" (K.dropScan 2) K.sourceUnfoldrM
336+ , benchIO "take-drop" (K.takeDrop 2) K.sourceUnfoldrM
337+ , benchIO "take-scan" (K.takeScan 2) K.sourceUnfoldrM
338+ , benchIO "take-map" (K.takeMap 2) K.sourceUnfoldrM
339+ , benchIO "filter-drop" (K.filterDrop 2) K.sourceUnfoldrM
340+ , benchIO "filter-take" (K.filterTake 2) K.sourceUnfoldrM
341+ , benchIO "filter-scan" (K.filterScan 2) K.sourceUnfoldrM
342+ , benchIO "filter-map" (K.filterMap 2) K.sourceUnfoldrM
343+ ]
344+ , bgroup "mixedX4"
345+ [ benchIO "scan-map" (K.scanMap 4) K.sourceUnfoldrM
346+ , benchIO "drop-map" (K.dropMap 4) K.sourceUnfoldrM
347+ , benchIO "drop-scan" (K.dropScan 4) K.sourceUnfoldrM
348+ , benchIO "take-drop" (K.takeDrop 4) K.sourceUnfoldrM
349+ , benchIO "take-scan" (K.takeScan 4) K.sourceUnfoldrM
350+ , benchIO "take-map" (K.takeMap 4) K.sourceUnfoldrM
351+ , benchIO "filter-drop" (K.filterDrop 4) K.sourceUnfoldrM
352+ , benchIO "filter-take" (K.filterTake 4) K.sourceUnfoldrM
353+ , benchIO "filter-scan" (K.filterScan 4) K.sourceUnfoldrM
354+ , benchIO "filter-map" (K.filterMap 4) K.sourceUnfoldrM
355+ ]
356+#ifdef DEVBUILD
357+ -- XXX these consume too much stack space, need to fix or segregate in
358+ -- another benchmark.
359+ , bgroup "iterated"
360+ [ benchK "mapM" K.iterateMapM
361+ , benchK "scan(1/10)" K.iterateScan
362+ , benchK "filterEven" K.iterateFilterEven
363+ , benchK "takeAll" K.iterateTakeAll
364+ , benchK "dropOne" K.iterateDropOne
365+ , benchK "dropWhileFalse(1/10)" K.iterateDropWhileFalse
366+ , benchK "dropWhileTrue" K.iterateDropWhileTrue
367+ ]
368+#endif
369+ ]
370+ , bgroup "streamDK"
371+ [ bgroup "generation"
372+ [ benchIO "unfoldr" DK.toNull DK.sourceUnfoldr
373+ , benchIO "unfoldrM" DK.toNull DK.sourceUnfoldrM
374+ ]
375+ , bgroup "elimination"
376+ [ benchIO "toNull" DK.toNull DK.sourceUnfoldrM
377+ , benchIO "uncons" DK.uncons DK.sourceUnfoldrM
378+ ]
379+ ]
380+ ]
benchmark/Chart.hsnew file+467
@@ -0,0 +1,467 @@
1+{-# LANGUAGE TupleSections #-}
2+{-# LANGUAGE RecordWildCards #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+
5+module Main where
6+
7+import Control.Exception (handle, catch, SomeException, ErrorCall(..))
8+import Control.Monad.Trans.State
9+import Control.Monad.Trans.Maybe
10+import Data.Char (toLower)
11+import Data.Function (on, (&))
12+import Data.List
13+import Data.List.Split
14+import Data.Maybe (mapMaybe)
15+import Data.Ord (comparing)
16+import System.Environment (getArgs)
17+import Control.Monad.IO.Class (liftIO)
18+import Control.Monad (mzero)
19+
20+import BenchShow
21+
22+------------------------------------------------------------------------------
23+-- Command line parsing
24+------------------------------------------------------------------------------
25+
26+data BenchType
27+ = Linear
28+ | LinearAsync
29+ | LinearRate
30+ | Nested
31+ | NestedConcurrent
32+ | NestedUnfold
33+ | Base
34+ | FileIO
35+ | Array
36+ | ArrayCmp
37+ | UnpinnedArray
38+ | SmallArray
39+ | PrimArray
40+ | Concurrent
41+ | Parallel
42+ | Adaptive
43+ deriving Show
44+
45+data Options = Options
46+ { genGraphs :: Bool
47+ , groupDiff :: Bool
48+ , benchType :: BenchType
49+ } deriving Show
50+
51+defaultOptions = Options False False Linear
52+
53+setGenGraphs val = do
54+ (args, opts) <- get
55+ put (args, opts { genGraphs = val })
56+
57+setGroupDiff val = do
58+ (args, opts) <- get
59+ put (args, opts { groupDiff = val })
60+
61+setBenchType val = do
62+ (args, opts) <- get
63+ put (args, opts { benchType = val })
64+
65+-- Like the shell "shift" to shift the command line arguments
66+shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
67+shift = do
68+ s <- get
69+ case s of
70+ ([], _) -> return Nothing
71+ (x : xs, opts) -> put (xs, opts) >> return (Just x)
72+
73+parseBench :: StateT ([String], Options) (MaybeT IO) ()
74+parseBench = do
75+ x <- shift
76+ case x of
77+ Just "linear" -> setBenchType Linear
78+ Just "linear-async" -> setBenchType LinearAsync
79+ Just "linear-rate" -> setBenchType LinearRate
80+ Just "nested" -> setBenchType Nested
81+ Just "nested-concurrent" -> setBenchType NestedConcurrent
82+ Just "nested-unfold" -> setBenchType NestedUnfold
83+ Just "base" -> setBenchType Base
84+ Just "fileio" -> setBenchType FileIO
85+ Just "array-cmp" -> setBenchType ArrayCmp
86+ Just "array" -> setBenchType Array
87+ Just "unpinned-array" -> setBenchType UnpinnedArray
88+ Just "small-array" -> setBenchType SmallArray
89+ Just "prim-array" -> setBenchType PrimArray
90+ Just "concurrent" -> setBenchType Concurrent
91+ Just "parallel" -> setBenchType Parallel
92+ Just "adaptive" -> setBenchType Adaptive
93+ Just str -> do
94+ liftIO $ putStrLn $ "unrecognized benchmark type " <> str
95+ mzero
96+ Nothing -> do
97+ liftIO $ putStrLn "please provide a benchmark type "
98+ mzero
99+
100+-- totally imperative style option parsing
101+parseOptions :: IO (Maybe Options)
102+parseOptions = do
103+ args <- getArgs
104+ runMaybeT $ flip evalStateT (args, defaultOptions) $ do
105+ parseLoop
106+ fmap snd get
107+
108+ where
109+
110+ parseOpt opt =
111+ case opt of
112+ "--graphs" -> setGenGraphs True
113+ "--group-diff" -> setGroupDiff True
114+ "--benchmark" -> parseBench
115+ str -> do
116+ liftIO $ putStrLn $ "Unrecognized option " <> str
117+ mzero
118+
119+ parseLoop = do
120+ next <- shift
121+ case next of
122+ Just opt -> parseOpt opt >> parseLoop
123+ Nothing -> return ()
124+
125+ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
126+ putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
127+
128+------------------------------------------------------------------------------
129+-- Linear composition charts
130+------------------------------------------------------------------------------
131+
132+makeLinearGraphs :: Config -> String -> IO ()
133+makeLinearGraphs cfg@Config{..} inputFile = do
134+ ignoringErr $ graph inputFile "generation" $ cfg
135+ { title = (++) <$> title <*> Just " generation"
136+ , classifyBenchmark =
137+ fmap ("Streamly",) . stripPrefix "serially/generation/"
138+ }
139+
140+ ignoringErr $ graph inputFile "elimination" $ cfg
141+ { title = (++) <$> title <*> Just " Elimination"
142+ , classifyBenchmark =
143+ fmap ("Streamly",) . stripPrefix "serially/elimination/"
144+ }
145+
146+ ignoringErr $ graph inputFile "transformation-zip" $ cfg
147+ { title = (++) <$> title <*> Just " Transformation & Zip"
148+ , classifyBenchmark = \b ->
149+ if "serially/transformation/" `isPrefixOf` b
150+ || "serially/zipping" `isPrefixOf` b
151+ then Just ("Streamly", last $ splitOn "/" b)
152+ else Nothing
153+ }
154+
155+ ignoringErr $ graph inputFile "filtering" $ cfg
156+ { title = (++) <$> title <*> Just " Filtering"
157+ , classifyBenchmark =
158+ fmap ("Streamly",) . stripPrefix "serially/filtering/"
159+ }
160+
161+ ignoringErr $ graph inputFile "transformationX4" $ cfg
162+ { title = (++) <$> title <*> Just " Transformation x 4"
163+ , classifyBenchmark =
164+ fmap ("Streamly",) . stripPrefix "serially/transformationX4/"
165+ }
166+
167+ ignoringErr $ graph inputFile "filteringX4"
168+ $ cfg
169+ { title = (++) <$> title <*> Just " Filtering x 4"
170+ , classifyBenchmark =
171+ fmap ("Streamly",) . stripPrefix "serially/filteringX4/"
172+ }
173+
174+ ignoringErr $ graph inputFile "mixedX4"
175+ $ cfg
176+ { title = (++) <$> title <*> Just " Mixed x 4"
177+ , classifyBenchmark =
178+ fmap ("Streamly",) . stripPrefix "serially/mixedX4/"
179+ }
180+
181+ ignoringErr $ graph inputFile "iterated"
182+ $ cfg
183+ { title = Just "iterate 10,000 times over 10 elems"
184+ , classifyBenchmark =
185+ fmap ("Streamly",) . stripPrefix "serially/iterated/"
186+ }
187+
188+------------------------------------------------------------------------------
189+-- Nested composition charts
190+------------------------------------------------------------------------------
191+
192+makeNestedGraphs :: Config -> String -> IO ()
193+makeNestedGraphs cfg inputFile =
194+ ignoringErr $ graph inputFile "nested-all" $ cfg
195+ { presentation = Groups Absolute
196+ , classifyBenchmark = classifyNested
197+ , selectGroups = \gs ->
198+ groupBy ((==) `on` snd) gs
199+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
200+ & concat
201+ }
202+
203+ where
204+
205+ order = ["serially", "asyncly", "wAsyncly", "aheadly", "parallely"]
206+
207+ classifyNested b
208+ | "serially/" `isPrefixOf` b =
209+ ("serially",) <$> stripPrefix "serially/" b
210+ | "asyncly/" `isPrefixOf` b =
211+ ("asyncly",) <$> stripPrefix "asyncly/" b
212+ | "wAsyncly/" `isPrefixOf` b =
213+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
214+ | "aheadly/" `isPrefixOf` b =
215+ ("aheadly",) <$> stripPrefix "aheadly/" b
216+ | "parallely/" `isPrefixOf` b =
217+ ("parallely",) <$> stripPrefix "parallely/" b
218+ | otherwise = Nothing
219+
220+------------------------------------------------------------------------------
221+-- Charts for parallel streams
222+------------------------------------------------------------------------------
223+
224+makeLinearAsyncGraphs :: Config -> String -> IO ()
225+makeLinearAsyncGraphs cfg inputFile =
226+ ignoringErr $ graph inputFile "linear-async" cfg
227+ { presentation = Groups Absolute
228+ , classifyBenchmark = classifyAsync
229+ , selectGroups = \gs ->
230+ groupBy ((==) `on` snd) gs
231+ & fmap (\xs -> mapMaybe (\x -> (x,) <$> lookup x xs) order)
232+ & concat
233+ }
234+
235+ where
236+
237+ order = ["asyncly", "wAsyncly", "aheadly", "parallely"]
238+
239+ classifyAsync b
240+ | "asyncly/" `isPrefixOf` b =
241+ ("asyncly",) <$> stripPrefix "asyncly/" b
242+ | "wAsyncly/" `isPrefixOf` b =
243+ ("wAsyncly",) <$> stripPrefix "wAsyncly/" b
244+ | "aheadly/" `isPrefixOf` b =
245+ ("aheadly",) <$> stripPrefix "aheadly/" b
246+ | "parallely/" `isPrefixOf` b =
247+ ("parallely",) <$> stripPrefix "parallely/" b
248+ | otherwise = Nothing
249+
250+makeLinearRateGraphs :: Config -> String -> IO ()
251+makeLinearRateGraphs cfg inputFile = do
252+ putStrLn "Not implemented"
253+ return ()
254+
255+------------------------------------------------------------------------------
256+-- FileIO
257+------------------------------------------------------------------------------
258+
259+makeFileIOGraphs :: Config -> String -> IO ()
260+makeFileIOGraphs cfg@Config{..} inputFile =
261+ ignoringErr $ graph inputFile "fileIO" cfg
262+
263+------------------------------------------------------------------------------
264+-- Generic
265+------------------------------------------------------------------------------
266+
267+makeGraphs :: String -> Config -> String -> IO ()
268+makeGraphs name cfg@Config{..} inputFile =
269+ ignoringErr $ graph inputFile name cfg
270+
271+------------------------------------------------------------------------------
272+-- Arrays
273+------------------------------------------------------------------------------
274+
275+showArrayComparisons Options{..} cfg inp out =
276+ let cfg' = cfg { classifyBenchmark = classifyArray }
277+ in if genGraphs
278+ then ignoringErr $ graph inp "Arrays Comparison"
279+ cfg' { outputDir = Just out
280+ , presentation = Groups Absolute
281+ }
282+ else ignoringErr $ report inp Nothing cfg'
283+
284+ where
285+
286+ classifyArray b
287+ -- SmallArray uses a small number of elements therefore cannot be
288+ -- compared
289+ -- | "SmallArray/" `isPrefixOf` b = ("SmallArray",) <$> stripPrefix "SmallArray/" b
290+ | "Data.Prim.Array/" `isPrefixOf` b = ("Data.Prim.Array",) <$> stripPrefix "Data.Prim.Array/" b
291+ | "Data.Array/" `isPrefixOf` b = ("Data.Array",) <$> stripPrefix "Data.Array/" b
292+ | "array/" `isPrefixOf` b = ("array",) <$> stripPrefix "array/" b
293+ | otherwise = Nothing
294+
295+------------------------------------------------------------------------------
296+-- Reports/Charts for base streams
297+------------------------------------------------------------------------------
298+
299+showStreamDVsK Options{..} cfg inp out =
300+ let cfg' = cfg { classifyBenchmark = classifyBase }
301+ in if genGraphs
302+ then ignoringErr $ graph inp "streamD-vs-streamK"
303+ cfg' { outputDir = Just out
304+ , presentation = Groups Absolute
305+ }
306+ else ignoringErr $ report inp Nothing cfg'
307+
308+ where
309+
310+ classifyBase b
311+ | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
312+ | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
313+ | otherwise = Nothing
314+
315+showStreamD Options{..} cfg inp out =
316+ let cfg' = cfg { classifyBenchmark = classifyStreamD }
317+ in if genGraphs
318+ then ignoringErr $ graph inp "streamD"
319+ cfg' {outputDir = Just out}
320+ else ignoringErr $ report inp Nothing cfg'
321+
322+ where
323+
324+ classifyStreamD b
325+ | "streamD/" `isPrefixOf` b = ("streamD",) <$> stripPrefix "streamD/" b
326+ | otherwise = Nothing
327+
328+showStreamK Options{..} cfg inp out =
329+ let cfg' = cfg { classifyBenchmark = classifyStreamK }
330+ in if genGraphs
331+ then ignoringErr $ graph inp "streamK"
332+ cfg' {outputDir = Just out}
333+ else ignoringErr $ report inp Nothing cfg'
334+
335+ where
336+
337+ classifyStreamK b
338+ | "streamK/" `isPrefixOf` b = ("streamK",) <$> stripPrefix "streamK/" b
339+ | otherwise = Nothing
340+
341+------------------------------------------------------------------------------
342+-- text reports
343+------------------------------------------------------------------------------
344+
345+selectBench
346+ :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
347+ -> [String]
348+selectBench f =
349+ reverse
350+ $ fmap fst
351+ $ either
352+ (const $ either error (sortOn snd) $ f (ColumnIndex 0) (Just PercentDiff))
353+ (sortOn snd)
354+ $ f (ColumnIndex 1) (Just PercentDiff)
355+
356+benchShow Options{..} cfg func inp out =
357+ if genGraphs
358+ then func cfg {outputDir = Just out} inp
359+ else ignoringErr $ report inp Nothing cfg
360+
361+main :: IO ()
362+main = do
363+ let cfg = defaultConfig
364+ { presentation = Groups PercentDiff
365+ , selectBenchmarks = selectBench
366+ , selectFields = filter
367+ ( flip elem ["time" , "mean"
368+ , "maxrss", "cputime"
369+ ]
370+ . map toLower
371+ )
372+ }
373+ res <- parseOptions
374+
375+ case res of
376+ Nothing -> do
377+ putStrLn "cannot parse options"
378+ return ()
379+ Just opts@Options{..} ->
380+ case benchType of
381+ Linear -> benchShow opts cfg
382+ { title = Just "Linear" }
383+ makeLinearGraphs
384+ "charts/linear/results.csv"
385+ "charts/linear"
386+ LinearAsync -> benchShow opts cfg
387+ { title = Just "Linear Async" }
388+ makeLinearAsyncGraphs
389+ "charts/linear-async/results.csv"
390+ "charts/linear-async"
391+ LinearRate -> benchShow opts cfg
392+ { title = Just "Linear Rate" }
393+ makeLinearRateGraphs
394+ "charts/linear-rate/results.csv"
395+ "charts/linear-rate"
396+ Nested -> benchShow opts cfg
397+ { title = Just "Nested loops" }
398+ makeNestedGraphs
399+ "charts/nested/results.csv"
400+ "charts/nested"
401+ NestedConcurrent -> benchShow opts cfg
402+ { title = Just "Nested concurrent loops" }
403+ makeNestedGraphs
404+ "charts/nested-concurrent/results.csv"
405+ "charts/nested-concurrent"
406+ NestedUnfold -> benchShow opts cfg
407+ { title = Just "Nested unfold loops" }
408+ makeNestedGraphs
409+ "charts/nested-unfold/results.csv"
410+ "charts/nested-unfold"
411+ FileIO -> benchShow opts cfg
412+ { title = Just "File IO" }
413+ makeFileIOGraphs
414+ "charts/fileio/results.csv"
415+ "charts/fileio"
416+ Array -> benchShow opts cfg
417+ { title = Just "Array" }
418+ (makeGraphs "array")
419+ "charts/array/results.csv"
420+ "charts/array"
421+ UnpinnedArray -> benchShow opts cfg
422+ { title = Just "Unpinned Array" }
423+ (makeGraphs "unpinned-array")
424+ "charts/unpinned-array/results.csv"
425+ "charts/unpinned-array"
426+ SmallArray -> benchShow opts cfg
427+ { title = Just "Small Array" }
428+ (makeGraphs "small-array")
429+ "charts/small-array/results.csv"
430+ "charts/small-array"
431+ PrimArray -> benchShow opts cfg
432+ { title = Just "Prim Array" }
433+ (makeGraphs "prim-array")
434+ "charts/prim-array/results.csv"
435+ "charts/prim-array"
436+ ArrayCmp -> showArrayComparisons opts cfg
437+ { title = Just "Arrays Comparison" }
438+ "charts/array-cmp/results.csv"
439+ "charts/array-cmp"
440+ Concurrent -> benchShow opts cfg
441+ { title = Just "Concurrent Ops" }
442+ (makeGraphs "Concurrent")
443+ "charts/concurrent/results.csv"
444+ "charts/concurrent"
445+ Parallel -> benchShow opts cfg
446+ { title = Just "Parallel" }
447+ (makeGraphs "parallel")
448+ "charts/parallel/results.csv"
449+ "charts/parallel"
450+ Adaptive -> benchShow opts cfg
451+ { title = Just "Adaptive" }
452+ (makeGraphs "adaptive")
453+ "charts/adaptive/results.csv"
454+ "charts/adaptive"
455+ Base -> do
456+ let cfg' = cfg { title = Just "Base stream" }
457+ if groupDiff
458+ then showStreamDVsK opts cfg'
459+ "charts/base/results.csv"
460+ "charts/base"
461+ else do
462+ showStreamD opts cfg'
463+ "charts/base/results.csv"
464+ "charts/base"
465+ showStreamK opts cfg'
466+ "charts/base/results.csv"
467+ "charts/base"
benchmark/Common.hsnew file+95
@@ -0,0 +1,95 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+module Common (parseCLIOpts) where
9+
10+import Control.Exception (evaluate)
11+import Control.Monad (when)
12+import Data.List (scanl')
13+import Data.Maybe (catMaybes)
14+import System.Console.GetOpt
15+ (OptDescr(..), ArgDescr(..), ArgOrder(..), getOpt')
16+import System.Environment (getArgs, lookupEnv, setEnv)
17+import Text.Read (readMaybe)
18+
19+import Gauge
20+
21+-------------------------------------------------------------------------------
22+-- Parse custom CLI options
23+-------------------------------------------------------------------------------
24+
25+data BenchOpts = StreamSize Int deriving Show
26+
27+getStreamSize :: String -> Int
28+getStreamSize size =
29+ case (readMaybe size :: Maybe Int) of
30+ Just x -> x
31+ Nothing -> error "Stream size must be numeric"
32+
33+options :: [OptDescr BenchOpts]
34+options =
35+ [
36+ Option [] ["stream-size"] (ReqArg getSize "COUNT") "Stream element count"
37+ ]
38+
39+ where
40+
41+ getSize = StreamSize . getStreamSize
42+
43+deleteOptArgs
44+ :: (Maybe String, Maybe String) -- (prev, yielded)
45+ -> String
46+ -> (Maybe String, Maybe String)
47+deleteOptArgs (Nothing, _) opt =
48+ if opt == "--stream-size"
49+ then (Just opt, Nothing)
50+ else (Just opt, Just opt)
51+
52+deleteOptArgs (Just prev, _) opt =
53+ if opt == "--stream-size" || prev == "--stream-size"
54+ then (Just opt, Nothing)
55+ else (Just opt, Just opt)
56+
57+parseCLIOpts :: Int -> IO (Int, Config, [String])
58+parseCLIOpts defaultStreamSize = do
59+ args <- getArgs
60+
61+ -- Parse custom options
62+ let (opts, _, _, errs) = getOpt' Permute options args
63+ when (not $ null errs) $ error $ concat errs
64+ (streamSize, args') <-
65+ case opts of
66+ StreamSize x : _ -> do
67+ -- When using the gauge "--measure-with" option we need to make
68+ -- sure that we pass the stream size to child process forked by
69+ -- gauge. So we use this env var for that purpose.
70+ setEnv "STREAM_SIZE" (show x)
71+ -- Hack! remove the option and its argument from args
72+ -- getOpt should have a way to return the unconsumed args in
73+ -- correct order.
74+ newArgs <-
75+ evaluate
76+ $ catMaybes
77+ $ map snd
78+ $ scanl' deleteOptArgs (Nothing, Nothing) args
79+ return (x, newArgs)
80+ _ -> do
81+ r <- lookupEnv "STREAM_SIZE"
82+ case r of
83+ Just x -> do
84+ s <- evaluate $ getStreamSize x
85+ return (s, args)
86+ Nothing -> return (defaultStreamSize, args)
87+
88+ -- Parse gauge options
89+ let config = defaultConfig
90+ { timeLimit = Just 1
91+ , minDuration = 0
92+ , includeFirstIter = streamSize > defaultStreamSize
93+ }
94+ let (cfg, benches) = parseWith config args'
95+ streamSize `seq` return (streamSize, cfg, benches)
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs → benchmark/Concurrent.hsrenamed+24−32
@@ -1,21 +1,16 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# LANGUAGE CPP #-}
31{-# LANGUAGE RankNTypes #-}
42-- |
53-- Module : Main
6−-- Copyright : (c) 2018 Composewell Technologies
4+-- Copyright : (c) 2018 Harendra Kumar
75--
86-- License : BSD3
97-- Maintainer : streamly@composewell.com
108
119import Control.Concurrent
1210import Control.Monad (when, replicateM)
13−import Streamly.Prelude
14− ( IsStream, SerialT, serial, async, fromAsync, ahead, fromAhead, wAsync
15− , fromWAsync, parallel, fromParallel
16− )
1711
18−import Test.Tasty.Bench
12+import Gauge
13+import Streamly
1914import qualified Streamly.Prelude as S
2015
2116-------------------------------------------------------------------------------
@@ -33,9 +28,9 @@ append buflen tcount d t =
3328 let work = (\i -> when (d /= 0) (threadDelay d) >> return i)
3429 in S.drain
3530 $ t
36− $ S.maxBuffer buflen
37− $ S.maxThreads (-1)
38− $ S.fromFoldableM $ fmap work [1..tcount]
31+ $ maxBuffer buflen
32+ $ maxThreads (-1)
33+ $ S.fromFoldableM $ map work [1..tcount]
3934
4035-- | Run @threads@ concurrently, each producing streams of @elems@ elements
4136-- with a delay of @d@ microseconds between successive elements, and merge
@@ -51,35 +46,35 @@ concated
5146 -> (forall a. SerialT IO a -> SerialT IO a -> SerialT IO a)
5247 -> IO ()
5348concated buflen threads d elems t =
54− let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)
49+ let work = \i -> S.replicateM i
50+ ((when (d /= 0) (threadDelay d)) >> return i)
5551 in S.drain
56− $ S.adapt
57− $ S.maxThreads (-1)
58− $ S.maxBuffer buflen
52+ $ adapt
53+ $ maxThreads (-1)
54+ $ maxBuffer buflen
5955 $ S.concatMapWith t work
6056 $ S.replicate threads elems
6157
6258appendGroup :: Int -> Int -> Int -> [Benchmark]
63−appendGroup buflen threads usec =
64− [ -- bench "serial" $ nfIO $ append buflen threads delay fromSerial
65− bench "ahead" $ nfIO $ append buflen threads usec fromAhead
66− , bench "async" $ nfIO $ append buflen threads usec fromAsync
67− , bench "wAsync" $ nfIO $ append buflen threads usec fromWAsync
68− , bench "parallel" $ nfIO $ append buflen threads usec fromParallel
59+appendGroup buflen threads delay =
60+ [ -- bench "serial" $ nfIO $ append buflen threads delay serially
61+ bench "ahead" $ nfIO $ append buflen threads delay aheadly
62+ , bench "async" $ nfIO $ append buflen threads delay asyncly
63+ , bench "wAsync" $ nfIO $ append buflen threads delay wAsyncly
64+ , bench "parallel" $ nfIO $ append buflen threads delay parallely
6965 ]
7066
7167concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]
72−concatGroup buflen threads usec n =
73− [ bench "serial" $ nfIO $ concated buflen threads usec n serial
74− , bench "ahead" $ nfIO $ concated buflen threads usec n ahead
75− , bench "async" $ nfIO $ concated buflen threads usec n async
76− , bench "wAsync" $ nfIO $ concated buflen threads usec n wAsync
77− , bench "parallel" $ nfIO $ concated buflen threads usec n parallel
68+concatGroup buflen threads delay n =
69+ [ bench "serial" $ nfIO $ concated buflen threads delay n serial
70+ , bench "ahead" $ nfIO $ concated buflen threads delay n ahead
71+ , bench "async" $ nfIO $ concated buflen threads delay n async
72+ , bench "wAsync" $ nfIO $ concated buflen threads delay n wAsync
73+ , bench "parallel" $ nfIO $ concated buflen threads delay n parallel
7874 ]
7975
8076main :: IO ()
81−main =
82−#ifdef MIN_VERSION_gauge
77+main = do
8378 defaultMainWith (defaultConfig
8479 { timeLimit = Just 0
8580 , minSamples = Just 1
@@ -87,9 +82,6 @@ main =
8782 , includeFirstIter = True
8883 , quickMode = True
8984 })
90−#else
91− defaultMain
92−#endif
9385
9486 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
9587 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
benchmark/FileIO.hsnew file+340
@@ -0,0 +1,340 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2019 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+
10+import Control.DeepSeq (NFData)
11+import System.IO (openFile, IOMode(..), Handle, hClose)
12+import System.Process.Typed (shell, runProcess_)
13+
14+import Data.IORef
15+import Gauge
16+
17+import qualified Streamly.Benchmark.FileIO.Stream as BFS
18+import qualified Streamly.Benchmark.FileIO.Array as BFA
19+
20+-- Input and output file handles
21+data Handles = Handles Handle Handle
22+
23+scratchDir :: String
24+scratchDir = "benchmark/scratch/"
25+
26+outfile :: String
27+outfile = scratchDir ++ "out.txt"
28+
29+blockSize, blockCount :: Int
30+blockSize = 32768
31+blockCount = 3200
32+
33+fileSize :: Int
34+fileSize = blockSize * blockCount
35+
36+#ifdef DEVBUILD
37+-- This is a 500MB text file for text processing benchmarks. We cannot
38+-- have it in the repo, therefore we use it locally with DEVBUILD
39+-- conditional (enabled by "dev" cabal flag). Some tests that depend on
40+-- this file are available only in DEVBUILD mode.
41+infile :: String
42+infile = "benchmark/text-processing/gutenberg-500.txt"
43+
44+#else
45+infile :: String
46+infile = scratchDir ++ "in-100MB.txt"
47+#endif
48+
49+main :: IO ()
50+main = do
51+#ifndef DEVBUILD
52+ -- XXX will this work on windows/msys?
53+ let cmd = "mkdir -p " ++ scratchDir
54+ ++ "; test -e " ++ infile
55+ ++ " || { echo \"creating input file " ++ infile
56+ ++ "\" && dd if=/dev/random of=" ++ infile
57+ ++ " bs=" ++ show blockSize
58+ ++ " count=" ++ show blockCount
59+ ++ ";}"
60+
61+ runProcess_ (shell cmd)
62+#endif
63+ inHandle <- openFile infile ReadMode
64+ outHandle <- openFile outfile WriteMode
65+ href <- newIORef $ Handles inHandle outHandle
66+ devNull <- openFile "/dev/null" WriteMode
67+
68+ defaultMain
69+ [ bgroup "readArray"
70+ [ mkBench "last" href $ do
71+ Handles inh _ <- readIORef href
72+ BFA.last inh
73+ -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
74+ -- wc uses lseek to just determine the file size rather than reading
75+ -- and counting characters.
76+ , mkBench "length (bytecount)" href $ do
77+ Handles inh _ <- readIORef href
78+ BFA.countBytes inh
79+ , mkBench "linecount" href $ do
80+ Handles inh _ <- readIORef href
81+ BFA.countLines inh
82+ , mkBench "wordcount" href $ do
83+ Handles inh _ <- readIORef href
84+ BFA.countWords inh
85+ , mkBench "sum" href $ do
86+ Handles inh _ <- readIORef href
87+ BFA.sumBytes inh
88+ , mkBench "cat" href $ do
89+ Handles inh _ <- readIORef href
90+ BFA.cat devNull inh
91+ , mkBench "catBracket" href $ do
92+ Handles inh _ <- readIORef href
93+ BFA.catBracket devNull inh
94+ , mkBench "catBracketIO" href $ do
95+ Handles inh _ <- readIORef href
96+ BFA.catBracketIO devNull inh
97+ , mkBench "catBracketStream" href $ do
98+ Handles inh _ <- readIORef href
99+ BFA.catBracketStream devNull inh
100+ , mkBench "catBracketStreamIO" href $ do
101+ Handles inh _ <- readIORef href
102+ BFA.catBracketStreamIO devNull inh
103+ , mkBench "catOnException" href $ do
104+ Handles inh _ <- readIORef href
105+ BFA.catOnException devNull inh
106+ , mkBench "read-utf8" href $ do
107+ Handles inh _ <- readIORef href
108+ BFA.decodeUtf8Lenient inh
109+ ]
110+ , bgroup "readStream"
111+ [ mkBench "last" href $ do
112+ Handles inh _ <- readIORef href
113+ BFS.last inh
114+ , mkBench "length (bytecount)" href $ do
115+ Handles inh _ <- readIORef href
116+ BFS.countBytes inh
117+ , mkBench "linecount" href $ do
118+ Handles inh _ <- readIORef href
119+ BFS.countLines inh
120+ , mkBench "linecountU" href $ do
121+ Handles inh _ <- readIORef href
122+ BFS.countLinesU inh
123+ , mkBench "wordcount" href $ do
124+ Handles inh _ <- readIORef href
125+ BFS.countWords inh
126+ , mkBench "sum" href $ do
127+ Handles inh _ <- readIORef href
128+ BFS.sumBytes inh
129+ , mkBench "cat" href $ do
130+ Handles inh _ <- readIORef href
131+ BFS.cat devNull inh
132+ , mkBench "catStream" href $ do
133+ Handles inh _ <- readIORef href
134+ BFS.catStreamWrite devNull inh
135+#ifdef DEVBUILD
136+ , mkBench "catOnException" href $ do
137+ Handles inh _ <- readIORef href
138+ BFS.catOnException devNull inh
139+ , mkBench "catOnExceptionStream" href $ do
140+ Handles inh _ <- readIORef href
141+ BFS.catOnExceptionStream devNull inh
142+ , mkBench "catHandle" href $ do
143+ Handles inh _ <- readIORef href
144+ BFS.catHandle devNull inh
145+ , mkBench "catHandleStream" href $ do
146+ Handles inh _ <- readIORef href
147+ BFS.catHandleStream devNull inh
148+ , mkBench "catFinally" href $ do
149+ Handles inh _ <- readIORef href
150+ BFS.catFinally devNull inh
151+ , mkBench "catFinallyIO" href $ do
152+ Handles inh _ <- readIORef href
153+ BFS.catFinallyIO devNull inh
154+ , mkBench "catFinallyStream" href $ do
155+ Handles inh _ <- readIORef href
156+ BFS.catFinallyStream devNull inh
157+ , mkBench "catFinallyStreamIO" href $ do
158+ Handles inh _ <- readIORef href
159+ BFS.catFinallyStreamIO devNull inh
160+ , mkBench "catBracketStream" href $ do
161+ Handles inh _ <- readIORef href
162+ BFS.catBracketStream devNull inh
163+ , mkBench "catBracketStreamIO" href $ do
164+ Handles inh _ <- readIORef href
165+ BFS.catBracketStreamIO devNull inh
166+ , mkBench "catBracket" href $ do
167+ Handles inh _ <- readIORef href
168+ BFS.catBracket devNull inh
169+ , mkBench "catBracketIO" href $ do
170+ Handles inh _ <- readIORef href
171+ BFS.catBracketIO devNull inh
172+#endif
173+ , mkBench "read-word8" href $ do
174+ Handles inh _ <- readIORef href
175+ BFS.readWord8 inh
176+ , mkBench "read-latin1" href $ do
177+ Handles inh _ <- readIORef href
178+ BFS.decodeLatin1 inh
179+ , mkBench "read-utf8" href $ do
180+ Handles inh _ <- readIORef href
181+ BFS.decodeUtf8Lax inh
182+ ]
183+ , bgroup "copyArray"
184+ [ mkBench "copy" href $ do
185+ Handles inh outh <- readIORef href
186+ BFA.copy inh outh
187+ ]
188+#ifdef DEVBUILD
189+ -- This takes a little longer therefore put under the dev conditional
190+ , bgroup "copyStream"
191+ [ mkBench "fromToHandle" href $ do
192+ Handles inh outh <- readIORef href
193+ BFS.copy inh outh
194+ ]
195+ -- This needs an ascii file, as decode just errors out.
196+ , bgroup "decode-encode"
197+ [ mkBench "latin1" href $ do
198+ Handles inh outh <- readIORef href
199+ BFS.copyCodecChar8 inh outh
200+ , mkBench "utf8-arrays" href $ do
201+ Handles inh outh <- readIORef href
202+ BFA.copyCodecUtf8Lenient inh outh
203+ , mkBench "utf8" href $ do
204+ Handles inh outh <- readIORef href
205+ BFS.copyCodecUtf8Lenient inh outh
206+ ]
207+#endif
208+ , bgroup "grouping-chunks"
209+ [ mkBench "sumChunksOf (single chunk)" href $ do
210+ Handles inh _ <- readIORef href
211+ BFS.chunksOfSum fileSize inh
212+ , mkBench "sumChunksOf 1" href $ do
213+ Handles inh _ <- readIORef href
214+ BFS.chunksOfSum 1 inh
215+
216+ , mkBench "arraysOf 1" href $ do
217+ Handles inh _ <- readIORef href
218+ BFS.chunksOf 1 inh
219+ , mkBench "arraysOf 10" href $ do
220+ Handles inh _ <- readIORef href
221+ BFS.chunksOf 10 inh
222+ , mkBench "arraysOf 1000" href $ do
223+ Handles inh _ <- readIORef href
224+ BFS.chunksOf 1000 inh
225+ ]
226+#ifdef DEVBUILD
227+ , bgroup "group-ungroup-stream"
228+ [ mkBench "lines-unlines-[Char]" href $ do
229+ Handles inh outh <- readIORef href
230+ BFS.linesUnlinesCopy inh outh
231+ , mkBench "lines-unlines-Word8Array" href $ do
232+ Handles inh outh <- readIORef href
233+ BFS.linesUnlinesArrayWord8Copy inh outh
234+ , mkBench "lines-unlines-CharArray" href $ do
235+ Handles inh outh <- readIORef href
236+ BFS.linesUnlinesArrayCharCopy inh outh
237+ , mkBench "words-unwords-[Word8]" href $ do
238+ Handles inh outh <- readIORef href
239+ BFS.wordsUnwordsCopyWord8 inh outh
240+ , mkBench "words-unwords-[Char]" href $ do
241+ Handles inh outh <- readIORef href
242+ BFS.wordsUnwordsCopy inh outh
243+ , mkBench "words-unwords-CharArray" href $ do
244+ Handles inh outh <- readIORef href
245+ BFS.wordsUnwordsCharArrayCopy inh outh
246+ ]
247+
248+ , bgroup "group-ungroup-array-stream"
249+ [ mkBench "lines-unlines-Word8Array" href $ do
250+ Handles inh outh <- readIORef href
251+ BFA.linesUnlinesCopy inh outh
252+ , mkBench "words-unwords-Word8Array" href $ do
253+ Handles inh outh <- readIORef href
254+ BFA.wordsUnwordsCopy inh outh
255+ ]
256+
257+ , bgroup "splitting"
258+ [ bgroup "predicate"
259+ [ mkBench "splitOn \\n (line count)" href $ do
260+ Handles inh _ <- readIORef href
261+ BFS.splitOn inh
262+ , mkBench "splitOnSuffix \\n (line count)" href $ do
263+ Handles inh _ <- readIORef href
264+ BFS.splitOnSuffix inh
265+ , mkBench "wordsBy isSpace (word count)" href $ do
266+ Handles inh _ <- readIORef href
267+ BFS.wordsBy inh
268+ ]
269+
270+ , bgroup "empty-pattern"
271+ [ mkBench "splitOnSeq \"\"" href $ do
272+ Handles inh _ <- readIORef href
273+ BFS.splitOnSeq "" inh
274+ , mkBench "splitOnSuffixSeq \"\"" href $ do
275+ Handles inh _ <- readIORef href
276+ BFS.splitOnSuffixSeq "" inh
277+ ]
278+ , bgroup "short-pattern"
279+ [ mkBench "splitOnSeq \\n (line count)" href $ do
280+ Handles inh _ <- readIORef href
281+ BFS.splitOnSeq "\n" inh
282+ , mkBench "splitOnSuffixSeq \\n (line count)" href $ do
283+ Handles inh _ <- readIORef href
284+ BFS.splitOnSuffixSeq "\n" inh
285+ , mkBench "splitOnSeq a" href $ do
286+ Handles inh _ <- readIORef href
287+ BFS.splitOnSeq "a" inh
288+ , mkBench "splitOnSeq \\r\\n" href $ do
289+ Handles inh _ <- readIORef href
290+ BFS.splitOnSeq "\r\n" inh
291+ , mkBench "splitOnSuffixSeq \\r\\n)" href $ do
292+ Handles inh _ <- readIORef href
293+ BFS.splitOnSuffixSeq "\r\n" inh
294+ , mkBench "splitOnSeq aa" href $ do
295+ Handles inh _ <- readIORef href
296+ BFS.splitOnSeq "aa" inh
297+ , mkBench "splitOnSeq aaaa" href $ do
298+ Handles inh _ <- readIORef href
299+ BFS.splitOnSeq "aaaa" inh
300+ , mkBench "splitOnSeq abcdefgh" href $ do
301+ Handles inh _ <- readIORef href
302+ BFS.splitOnSeq "abcdefgh" inh
303+ , mkBench "splitOnSeqUtf8 abcdefgh" href $ do
304+ Handles inh _ <- readIORef href
305+ BFS.splitOnSeqUtf8 "abcdefgh" inh
306+ ]
307+ , bgroup "long-pattern"
308+ [ mkBench "splitOnSeq abcdefghi" href $ do
309+ Handles inh _ <- readIORef href
310+ BFS.splitOnSeq "abcdefghi" inh
311+ , mkBench "splitOnSeq catcatcatcatcat" href $ do
312+ Handles inh _ <- readIORef href
313+ BFS.splitOnSeq "catcatcatcatcat" inh
314+ , mkBench "splitOnSeq abc...xyz" href $ do
315+ Handles inh _ <- readIORef href
316+ BFS.splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
317+ , mkBench "splitOnSuffixSeq abc...xyz" href $ do
318+ Handles inh _ <- readIORef href
319+ BFS.splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
320+ , mkBench "splitOnSeqUtf8 abc...xyz" href $ do
321+ Handles inh _ <- readIORef href
322+ BFS.splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
323+ ]
324+ ]
325+#endif
326+ ]
327+
328+ where
329+
330+ mkBench :: NFData b => String -> IORef Handles -> IO b -> Benchmark
331+ mkBench name ref action =
332+ bench name $ perRunEnv (do
333+ (Handles inh outh) <- readIORef ref
334+ hClose inh
335+ hClose outh
336+ inHandle <- openFile infile ReadMode
337+ outHandle <- openFile outfile WriteMode
338+ writeIORef ref (Handles inHandle outHandle)
339+ )
340+ (\_ -> action)
benchmark/Linear.hsnew file+575
@@ -0,0 +1,575 @@
1+{-# LANGUAGE CPP #-}
2+#if __GLASGOW_HASKELL__ >= 800
3+{-# OPTIONS_GHC -Wno-orphans #-}
4+#endif
5+
6+-- |
7+-- Module : Main
8+-- Copyright : (c) 2018 Harendra Kumar
9+--
10+-- License : BSD3
11+-- Maintainer : streamly@composewell.com
12+
13+import Control.DeepSeq (NFData(..), deepseq)
14+import Control.Monad (when)
15+import Data.Functor.Identity (Identity, runIdentity)
16+import Data.Monoid (Last(..))
17+import System.Random (randomRIO)
18+
19+import Common (parseCLIOpts)
20+
21+import qualified GHC.Exts as GHC
22+import qualified Streamly.Benchmark.Prelude as Ops
23+
24+import Streamly
25+import qualified Streamly.Data.Fold as FL
26+import qualified Streamly.Memory.Array as A
27+import qualified Streamly.Prelude as S
28+import qualified Streamly.Internal.Data.Sink as Sink
29+
30+import Streamly.Internal.Data.Time.Units
31+import qualified Streamly.Internal.Memory.Array as IA
32+import qualified Streamly.Internal.Data.Fold as IFL
33+import qualified Streamly.Internal.Prelude as IP
34+import qualified Streamly.Internal.Data.Pipe as Pipe
35+
36+import Gauge
37+
38+-------------------------------------------------------------------------------
39+--
40+-------------------------------------------------------------------------------
41+
42+#if !MIN_VERSION_deepseq(1,4,3)
43+instance NFData Ordering where rnf = (`seq` ())
44+#endif
45+
46+-- We need a monadic bind here to make sure that the function f does not get
47+-- completely optimized out by the compiler in some cases.
48+
49+-- | Takes a fold method, and uses it with a default source.
50+{-# INLINE benchIOSink #-}
51+benchIOSink
52+ :: (IsStream t, NFData b)
53+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
54+benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source value
55+
56+{-# INLINE benchHoistSink #-}
57+benchHoistSink
58+ :: (IsStream t, NFData b)
59+ => Int -> String -> (t Identity Int -> IO b) -> Benchmark
60+benchHoistSink value name f =
61+ bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.sourceUnfoldr value
62+
63+-- XXX once we convert all the functions to use this we can rename this to
64+-- benchIOSink
65+{-# INLINE benchIOSink1 #-}
66+benchIOSink1 :: NFData b => String -> (Int -> IO b) -> Benchmark
67+benchIOSink1 name f = bench name $ nfIO $ randomRIO (1,1) >>= f
68+
69+-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
70+-- we can't use it as it requires MonadAsync constraint.
71+{-# INLINE benchIdentitySink #-}
72+benchIdentitySink
73+ :: (IsStream t, NFData b)
74+ => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
75+benchIdentitySink value name f = bench name $ nf (f . Ops.sourceUnfoldr value) 1
76+
77+-- | Takes a source, and uses it with a default drain/fold method.
78+{-# INLINE benchIOSrc #-}
79+benchIOSrc
80+ :: (t IO a -> SerialT IO a)
81+ -> String
82+ -> (Int -> t IO a)
83+ -> Benchmark
84+benchIOSrc t name f =
85+ bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
86+
87+{-# INLINE benchIOSrc1 #-}
88+benchIOSrc1 :: String -> (Int -> IO ()) -> Benchmark
89+benchIOSrc1 name f = bench name $ nfIO $ randomRIO (1,1) >>= f
90+
91+{-# INLINE benchPure #-}
92+benchPure :: NFData b => String -> (Int -> a) -> (a -> b) -> Benchmark
93+benchPure name src f = bench name $ nfIO $ randomRIO (1,1) >>= return . f . src
94+
95+{-# INLINE benchPureSink #-}
96+benchPureSink :: NFData b => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
97+benchPureSink value name f = benchPure name (Ops.sourceUnfoldr value) f
98+
99+-- XXX once we convert all the functions to use this we can rename this to
100+-- benchPureSink
101+{-# INLINE benchPureSink1 #-}
102+benchPureSink1 :: NFData b => String -> (Int -> Identity b) -> Benchmark
103+benchPureSink1 name f =
104+ bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
105+
106+{-# INLINE benchPureSinkIO #-}
107+benchPureSinkIO
108+ :: NFData b
109+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
110+benchPureSinkIO value name f =
111+ bench name $ nfIO $ randomRIO (1, 1) >>= f . Ops.sourceUnfoldr value
112+
113+{-# INLINE benchPureSrc #-}
114+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
115+benchPureSrc name src = benchPure name src (runIdentity . S.drain)
116+
117+mkString :: Int -> String
118+mkString value = "fromList [1" ++ concat (replicate value ",1") ++ "]"
119+
120+mkListString :: Int -> String
121+mkListString value = "[1" ++ concat (replicate value ",1") ++ "]"
122+
123+mkList :: Int -> [Int]
124+mkList value = [1..value]
125+
126+defaultStreamSize :: Int
127+defaultStreamSize = 100000
128+
129+main :: IO ()
130+main = do
131+ -- XXX Fix indentation
132+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
133+ let bufValue = min value defaultStreamSize
134+ when (bufValue /= value) $
135+ putStrLn $ "Limiting stream size to "
136+ ++ show defaultStreamSize
137+ ++ " for buffered operations"
138+
139+ bufValue `seq` value `seq` runMode (mode cfg) cfg benches
140+ [ bgroup "serially"
141+ [ bgroup "pure"
142+ [ benchPureSink value "id" id
143+ , benchPureSink1 "eqBy" (Ops.eqByPure value)
144+ , benchPureSink value "==" Ops.eqInstance
145+ , benchPureSink value "/=" Ops.eqInstanceNotEq
146+ , benchPureSink1 "cmpBy" (Ops.cmpByPure value)
147+ , benchPureSink value "<" Ops.ordInstance
148+ , benchPureSink value "min" Ops.ordInstanceMin
149+ , benchPureSrc "IsList.fromList" (Ops.sourceIsList value)
150+ -- length is used to check for foldr/build fusion
151+ , benchPureSink value "length . IsList.toList" (length . GHC.toList)
152+ , benchPureSrc "IsString.fromString" (Ops.sourceIsString value)
153+ , benchPureSink value "showsPrec pure streams" Ops.showInstance
154+ , benchPureSink value "foldl'" Ops.pureFoldl'
155+ ]
156+ , bgroup "foldable"
157+ [ -- Foldable instance
158+ -- type class operations
159+ bench "foldl'" $ nf (Ops.foldableFoldl' value) 1
160+ , bench "foldrElem" $ nf (Ops.foldableFoldrElem value) 1
161+ -- , bench "null" $ nf (Ops.foldableNull value) 1
162+ , bench "elem" $ nf (Ops.foldableElem value) 1
163+ , bench "length" $ nf (Ops.foldableLength value) 1
164+ , bench "sum" $ nf (Ops.foldableSum value) 1
165+ , bench "product" $ nf (Ops.foldableProduct value) 1
166+ , bench "minimum" $ nf (Ops.foldableMin value) 1
167+ , bench "maximum" $ nf (Ops.foldableMax value) 1
168+ , bench "length . toList" $
169+ nf (length . Ops.foldableToList value) 1
170+
171+ -- folds
172+ , bench "notElem" $ nf (Ops.foldableNotElem value) 1
173+ , bench "find" $ nf (Ops.foldableFind value) 1
174+ , bench "all" $ nf (Ops.foldableAll value) 1
175+ , bench "any" $ nf (Ops.foldableAny value) 1
176+ , bench "and" $ nf (Ops.foldableAnd value) 1
177+ , bench "or" $ nf (Ops.foldableOr value) 1
178+
179+ -- Note: minimumBy/maximumBy do not work in constant memory they are in
180+ -- the O(n) group of benchmarks down below in this file.
181+
182+ -- Applicative and Traversable operations
183+ -- TBD: traverse_
184+ , benchIOSink1 "mapM_" (Ops.foldableMapM_ value)
185+ -- TBD: for_
186+ -- TBD: forM_
187+ , benchIOSink1 "sequence_" (Ops.foldableSequence_ value)
188+ -- TBD: sequenceA_
189+ -- TBD: asum
190+ -- , benchIOSink1 "msum" (Ops.foldableMsum value)
191+ ]
192+ , bgroup "generation"
193+ [ -- Most basic, barely stream continuations running
194+ benchIOSrc serially "unfoldr" (Ops.sourceUnfoldr value)
195+ , benchIOSrc serially "unfoldrM" (Ops.sourceUnfoldrM value)
196+ , benchIOSrc serially "intFromTo" (Ops.sourceIntFromTo value)
197+ , benchIOSrc serially "intFromThenTo" (Ops.sourceIntFromThenTo value)
198+ , benchIOSrc serially "integerFromStep" (Ops.sourceIntegerFromStep value)
199+ , benchIOSrc serially "fracFromThenTo" (Ops.sourceFracFromThenTo value)
200+ , benchIOSrc serially "fracFromTo" (Ops.sourceFracFromTo value)
201+ , benchIOSrc serially "fromList" (Ops.sourceFromList value)
202+ , benchIOSrc serially "fromListM" (Ops.sourceFromListM value)
203+ -- These are essentially cons and consM
204+ , benchIOSrc serially "fromFoldable" (Ops.sourceFromFoldable value)
205+ , benchIOSrc serially "fromFoldableM" (Ops.sourceFromFoldableM value)
206+ , benchIOSrc serially "currentTime/0.00001s"
207+ $ Ops.currentTime value 0.00001
208+ ]
209+ , bgroup "elimination"
210+ [ bgroup "reduce"
211+ [ bgroup "IO"
212+ [
213+ benchIOSink value "foldl'" Ops.foldl'Reduce
214+ , benchIOSink value "foldl1'" Ops.foldl1'Reduce
215+ , benchIOSink value "foldlM'" Ops.foldlM'Reduce
216+ ]
217+ , bgroup "Identity"
218+ [
219+ benchIdentitySink value "foldl'" Ops.foldl'Reduce
220+ , benchIdentitySink value "foldl1'" Ops.foldl1'Reduce
221+ , benchIdentitySink value "foldlM'" Ops.foldlM'Reduce
222+ ]
223+ ]
224+
225+ , bgroup "build"
226+ [ bgroup "Identity"
227+ [ benchIdentitySink value "foldrM" Ops.foldrMBuild
228+ ]
229+ ]
230+ , benchIOSink value "uncons" Ops.uncons
231+ , benchIOSink value "toNull" $ Ops.toNull serially
232+ , benchIOSink value "mapM_" Ops.mapM_
233+
234+ , benchIOSink value "init" Ops.init
235+
236+ -- this is too low and causes all benchmarks reported in ns
237+ -- , benchIOSink value "head" Ops.head
238+ , benchIOSink value "last" Ops.last
239+ -- , benchIOSink value "lookup" Ops.lookup
240+ , benchIOSink value "find" (Ops.find value)
241+ , benchIOSink value "findIndex" (Ops.findIndex value)
242+ , benchIOSink value "elemIndex" (Ops.elemIndex value)
243+
244+ -- this is too low and causes all benchmarks reported in ns
245+ -- , benchIOSink value "null" Ops.null
246+ , benchIOSink value "elem" (Ops.elem value)
247+ , benchIOSink value "notElem" (Ops.notElem value)
248+ , benchIOSink value "all" (Ops.all value)
249+ , benchIOSink value "any" (Ops.any value)
250+ , benchIOSink value "and" (Ops.and value)
251+ , benchIOSink value "or" (Ops.or value)
252+
253+ , benchIOSink value "length" Ops.length
254+ , benchHoistSink value "length . generally" (Ops.length . IP.generally)
255+ , benchIOSink value "sum" Ops.sum
256+ , benchIOSink value "product" Ops.product
257+
258+ , benchIOSink value "maximumBy" Ops.maximumBy
259+ , benchIOSink value "maximum" Ops.maximum
260+ , benchIOSink value "minimumBy" Ops.minimumBy
261+ , benchIOSink value "minimum" Ops.minimum
262+
263+ ]
264+ , bgroup "folds"
265+ [ benchIOSink value "drain" (S.fold FL.drain)
266+ , benchIOSink value "drainN" (S.fold (IFL.drainN value))
267+ , benchIOSink value "drainWhileTrue" (S.fold (IFL.drainWhile $ (<=) (value + 1)))
268+ , benchIOSink value "drainWhileFalse" (S.fold (IFL.drainWhile $ (>=) (value + 1)))
269+ , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
270+ , benchIOSink value "last" (S.fold FL.last)
271+ , benchIOSink value "lastN.1" (S.fold (IA.lastN 1))
272+ , benchIOSink value "lastN.10" (S.fold (IA.lastN 10))
273+ , benchIOSink value "length" (S.fold FL.length)
274+ , benchIOSink value "sum" (S.fold FL.sum)
275+ , benchIOSink value "product" (S.fold FL.product)
276+ , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
277+ , benchIOSink value "maximum" (S.fold FL.maximum)
278+ , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
279+ , benchIOSink value "minimum" (S.fold FL.minimum)
280+ , benchIOSink value "mean" (\s -> S.fold FL.mean (S.map (fromIntegral :: Int -> Double) s))
281+ , benchIOSink value "variance" (\s -> S.fold FL.variance (S.map (fromIntegral :: Int -> Double) s))
282+ , benchIOSink value "stdDev" (\s -> S.fold FL.stdDev (S.map (fromIntegral :: Int -> Double) s))
283+
284+ , benchIOSink value "mconcat" (S.fold FL.mconcat . (S.map (Last . Just)))
285+ , benchIOSink value "foldMap" (S.fold (FL.foldMap (Last . Just)))
286+
287+ , benchIOSink value "index" (S.fold (FL.index (value + 1)))
288+ , benchIOSink value "head" (S.fold FL.head)
289+ , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
290+ , benchIOSink value "findIndex" (S.fold (FL.findIndex (== (value + 1))))
291+ , benchIOSink value "elemIndex" (S.fold (FL.elemIndex (value + 1)))
292+
293+ , benchIOSink value "null" (S.fold FL.null)
294+ , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
295+ , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
296+ , benchIOSink value "all" (S.fold (FL.all (<= (value + 1))))
297+ , benchIOSink value "any" (S.fold (FL.any (> (value + 1))))
298+ , benchIOSink value "and" (\s -> S.fold FL.and (S.map (<= (value + 1)) s))
299+ , benchIOSink value "or" (\s -> S.fold FL.or (S.map (> (value + 1)) s))
300+ ]
301+ , bgroup "fold-multi-stream"
302+ [ benchIOSink1 "eqBy" (Ops.eqBy value)
303+ , benchIOSink1 "cmpBy" (Ops.cmpBy value)
304+ , benchIOSink value "isPrefixOf" Ops.isPrefixOf
305+ , benchIOSink value "isSubsequenceOf" Ops.isSubsequenceOf
306+ , benchIOSink value "stripPrefix" Ops.stripPrefix
307+ ]
308+ , bgroup "folds-transforms"
309+ [ benchIOSink value "drain" (S.fold FL.drain)
310+ , benchIOSink value "lmap" (S.fold (IFL.lmap (+1) FL.drain))
311+ , benchIOSink value "pipe-mapM"
312+ (S.fold (IFL.transform (Pipe.mapM (\x -> return $ x + 1)) FL.drain))
313+ ]
314+ , bgroup "folds-compositions" -- Applicative
315+ [
316+ benchIOSink value "all,any" (S.fold ((,) <$> FL.all (<= (value + 1))
317+ <*> FL.any (> (value + 1))))
318+ , benchIOSink value "sum,length" (S.fold ((,) <$> FL.sum <*> FL.length))
319+ ]
320+ , bgroup "pipes"
321+ [ benchIOSink value "mapM" (Ops.transformMapM serially 1)
322+ , benchIOSink value "compose" (Ops.transformComposeMapM serially 1)
323+ , benchIOSink value "tee" (Ops.transformTeeMapM serially 1)
324+ , benchIOSink value "zip" (Ops.transformZipMapM serially 1)
325+ ]
326+ , bgroup "pipesX4"
327+ [ benchIOSink value "mapM" (Ops.transformMapM serially 4)
328+ , benchIOSink value "compose" (Ops.transformComposeMapM serially 4)
329+ , benchIOSink value "tee" (Ops.transformTeeMapM serially 4)
330+ , benchIOSink value "zip" (Ops.transformZipMapM serially 4)
331+ ]
332+ , bgroup "transformer"
333+ [ benchIOSrc serially "evalState" (Ops.evalStateT value)
334+ , benchIOSrc serially "withState" (Ops.withState value)
335+ ]
336+ , bgroup "transformation"
337+ [ benchIOSink value "scanl" (Ops.scan 1)
338+ , benchIOSink value "scanl1'" (Ops.scanl1' 1)
339+ , benchIOSink value "map" (Ops.map 1)
340+ , benchIOSink value "fmap" (Ops.fmap 1)
341+ , benchIOSink value "mapM" (Ops.mapM serially 1)
342+ , benchIOSink value "mapMaybe" (Ops.mapMaybe 1)
343+ , benchIOSink value "mapMaybeM" (Ops.mapMaybeM 1)
344+ , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
345+ Ops.sequence serially (Ops.sourceUnfoldrMAction value n)
346+ , benchIOSink value "findIndices" (Ops.findIndices value 1)
347+ , benchIOSink value "elemIndices" (Ops.elemIndices value 1)
348+ , benchIOSink value "foldrS" (Ops.foldrS 1)
349+ , benchIOSink value "foldrSMap" (Ops.foldrSMap 1)
350+ , benchIOSink value "foldrT" (Ops.foldrT 1)
351+ , benchIOSink value "foldrTMap" (Ops.foldrTMap 1)
352+ , benchIOSink value "tap" (Ops.tap 1)
353+ , benchIOSink value "tapRate 1 second" (Ops.tapRate 1)
354+ , benchIOSink value "pollCounts 1 second" (Ops.pollCounts 1)
355+ , benchIOSink value "tapAsync" (Ops.tapAsync 1)
356+ , benchIOSink value "tapAsyncS" (Ops.tapAsyncS 1)
357+ ]
358+ , bgroup "transformationX4"
359+ [ benchIOSink value "scan" (Ops.scan 4)
360+ , benchIOSink value "scanl1'" (Ops.scanl1' 4)
361+ , benchIOSink value "map" (Ops.map 4)
362+ , benchIOSink value "fmap" (Ops.fmap 4)
363+ , benchIOSink value "mapM" (Ops.mapM serially 4)
364+ , benchIOSink value "mapMaybe" (Ops.mapMaybe 4)
365+ , benchIOSink value "mapMaybeM" (Ops.mapMaybeM 4)
366+ -- , bench "sequence" $ nfIO $ randomRIO (1,1000) >>= \n ->
367+ -- Ops.sequence serially (Ops.sourceUnfoldrMAction n)
368+ , benchIOSink value "findIndices" (Ops.findIndices value 4)
369+ , benchIOSink value "elemIndices" (Ops.elemIndices value 4)
370+ ]
371+ , bgroup "filtering"
372+ [ benchIOSink value "filter-even" (Ops.filterEven 1)
373+ , benchIOSink value "filter-all-out" (Ops.filterAllOut value 1)
374+ , benchIOSink value "filter-all-in" (Ops.filterAllIn value 1)
375+
376+ , benchIOSink value "take-all" (Ops.takeAll value 1)
377+ , benchIOSink value "takeByTime-all"
378+ (Ops.takeByTime (NanoSecond64 maxBound) 1)
379+ , benchIOSink value "takeWhile-true" (Ops.takeWhileTrue value 1)
380+ --, benchIOSink value "takeWhileM-true" (Ops.takeWhileMTrue 1)
381+
382+ -- "drop-one" is dual to "last"
383+ , benchIOSink value "drop-one" (Ops.dropOne 1)
384+ , benchIOSink value "drop-all" (Ops.dropAll value 1)
385+ , benchIOSink value "dropByTime-all"
386+ (Ops.dropByTime (NanoSecond64 maxBound) 1)
387+ , benchIOSink value "dropWhile-true" (Ops.dropWhileTrue value 1)
388+ --, benchIOSink value "dropWhileM-true" (Ops.dropWhileMTrue 1)
389+ , benchIOSink value "dropWhile-false" (Ops.dropWhileFalse value 1)
390+
391+ , benchIOSink value "deleteBy" (Ops.deleteBy value 1)
392+ , benchIOSink value "intersperse" (Ops.intersperse value 1)
393+ , benchIOSink value "insertBy" (Ops.insertBy value 1)
394+ ]
395+ , bgroup "filteringX4"
396+ [ benchIOSink value "filter-even" (Ops.filterEven 4)
397+ , benchIOSink value "filter-all-out" (Ops.filterAllOut value 4)
398+ , benchIOSink value "filter-all-in" (Ops.filterAllIn value 4)
399+ , benchIOSink value "take-all" (Ops.takeAll value 4)
400+ , benchIOSink value "takeWhile-true" (Ops.takeWhileTrue value 4)
401+ --, benchIOSink value "takeWhileM-true" (Ops.takeWhileMTrue 4)
402+ , benchIOSink value "drop-one" (Ops.dropOne 4)
403+ , benchIOSink value "drop-all" (Ops.dropAll value 4)
404+ , benchIOSink value "dropWhile-true" (Ops.dropWhileTrue value 4)
405+ --, benchIOSink value "dropWhileM-true" (Ops.dropWhileMTrue 4)
406+ , benchIOSink value "dropWhile-false" (Ops.dropWhileFalse value 4)
407+ , benchIOSink value "deleteBy" (Ops.deleteBy value 4)
408+ , benchIOSink value "intersperse" (Ops.intersperse value 4)
409+ , benchIOSink value "insertBy" (Ops.insertBy value 4)
410+ ]
411+ , bgroup "joining"
412+ [ benchIOSrc1 "zip (2,x/2)" (Ops.zip (value `div` 2))
413+ , benchIOSrc1 "zipM (2,x/2)" (Ops.zipM (value `div` 2))
414+ , benchIOSrc1 "mergeBy (2,x/2)" (Ops.mergeBy (value `div` 2))
415+ , benchIOSrc1 "serial (2,x/2)" (Ops.serial2 (value `div` 2))
416+ , benchIOSrc1 "append (2,x/2)" (Ops.append2 (value `div` 2))
417+ , benchIOSrc1 "serial (2,2,x/4)" (Ops.serial4 (value `div` 4))
418+ , benchIOSrc1 "append (2,2,x/4)" (Ops.append4 (value `div` 4))
419+ , benchIOSrc1 "wSerial (2,x/2)" (Ops.wSerial2 value)
420+ , benchIOSrc1 "interleave (2,x/2)" (Ops.interleave2 value)
421+ , benchIOSrc1 "roundRobin (2,x/2)" (Ops.roundRobin2 value)
422+ ]
423+ , bgroup "concat-foldable"
424+ [ benchIOSrc serially "foldMapWith" (Ops.sourceFoldMapWith value)
425+ , benchIOSrc serially "foldMapWithM" (Ops.sourceFoldMapWithM value)
426+ , benchIOSrc serially "foldMapM" (Ops.sourceFoldMapM value)
427+ , benchIOSrc serially "foldWithConcatMapId" (Ops.sourceConcatMapId value)
428+ ]
429+ , bgroup "concat-serial"
430+ [ benchIOSrc1 "concatMapPure (2,x/2)" (Ops.concatMapPure 2 (value `div` 2))
431+ , benchIOSrc1 "concatMap (2,x/2)" (Ops.concatMap 2 (value `div` 2))
432+ , benchIOSrc1 "concatMap (x/2,2)" (Ops.concatMap (value `div` 2) 2)
433+ , benchIOSrc1 "concatMapRepl (x/4,4)" (Ops.concatMapRepl4xN value)
434+ , benchIOSrc1 "concatUnfoldRepl (x/4,4)" (Ops.concatUnfoldRepl4xN value)
435+
436+ , benchIOSrc1 "concatMapWithSerial (2,x/2)"
437+ (Ops.concatMapWithSerial 2 (value `div` 2))
438+ , benchIOSrc1 "concatMapWithSerial (x/2,2)"
439+ (Ops.concatMapWithSerial (value `div` 2) 2)
440+
441+ , benchIOSrc1 "concatMapWithAppend (2,x/2)"
442+ (Ops.concatMapWithAppend 2 (value `div` 2))
443+ ]
444+ , bgroup "concat-interleave"
445+ [ benchIOSrc1 "concatMapWithWSerial (2,x/2)"
446+ (Ops.concatMapWithWSerial 2 (value `div` 2))
447+ , benchIOSrc1 "concatMapWithWSerial (x/2,2)"
448+ (Ops.concatMapWithWSerial (value `div` 2) 2)
449+ ]
450+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
451+ -- library. If scan/fold followed by a map is efficient enough we may not
452+ -- need monolithic implementations of these.
453+ , bgroup "mixed"
454+ [ benchIOSink value "scanl-map" (Ops.scanMap 1)
455+ , benchIOSink value "foldl-map" Ops.foldl'ReduceMap
456+ , benchIOSink value "sum-product-fold" Ops.sumProductFold
457+ , benchIOSink value "sum-product-scan" Ops.sumProductScan
458+ ]
459+ , bgroup "mixedX4"
460+ [ benchIOSink value "scan-map" (Ops.scanMap 4)
461+ , benchIOSink value "drop-map" (Ops.dropMap 4)
462+ , benchIOSink value "drop-scan" (Ops.dropScan 4)
463+ , benchIOSink value "take-drop" (Ops.takeDrop value 4)
464+ , benchIOSink value "take-scan" (Ops.takeScan value 4)
465+ , benchIOSink value "take-map" (Ops.takeMap value 4)
466+ , benchIOSink value "filter-drop" (Ops.filterDrop value 4)
467+ , benchIOSink value "filter-take" (Ops.filterTake value 4)
468+ , benchIOSink value "filter-scan" (Ops.filterScan 4)
469+ , benchIOSink value "filter-scanl1" (Ops.filterScanl1 4)
470+ , benchIOSink value "filter-map" (Ops.filterMap value 4)
471+ ]
472+ ]
473+ , bgroup "wSerially"
474+ [ bgroup "transformation"
475+ [ benchIOSink value "fmap" $ Ops.fmap' wSerially 1
476+ ]
477+ ]
478+ , bgroup "zipSerially"
479+ [ bgroup "transformation"
480+ [ benchIOSink value "fmap" $ Ops.fmap' zipSerially 1
481+ ]
482+ ]
483+ -- Non-streaming operations. We keep these in a spearate group so that we
484+ -- can run these conveniently with smaller stream size.
485+ --
486+ -- These are also the operations that programmers should be aware of and
487+ -- should avoid using in a streaming application.
488+
489+ -- XXX stack dominant (upto 1M), segregate?
490+ , bgroup "iterated"
491+ [ benchIOSrc serially "mapM" Ops.iterateMapM
492+ , benchIOSrc serially "scan(1/100)" Ops.iterateScan
493+ , benchIOSrc serially "scanl1(1/100)" Ops.iterateScanl1
494+ , benchIOSrc serially "filterEven" Ops.iterateFilterEven
495+ , benchIOSrc serially "takeAll" (Ops.iterateTakeAll value)
496+ , benchIOSrc serially "dropOne" Ops.iterateDropOne
497+ , benchIOSrc serially "dropWhileFalse" (Ops.iterateDropWhileFalse value)
498+ , benchIOSrc serially "dropWhileTrue" (Ops.iterateDropWhileTrue value)
499+ ]
500+ , bgroup "buffered"
501+ [ -- Inherently non-streaming operations
502+
503+ -- Right folds for reducing are inherently non-streaming as the
504+ -- expression needs to be fully built before it can be reduced.
505+ -- XXX Stack dominant (up to 4MB), segregate?
506+ benchIOSink bufValue "foldrM/reduce/IO" Ops.foldrMReduce
507+ , benchIdentitySink bufValue "foldrM/reduce/Identity" Ops.foldrMReduce
508+
509+ -- Left folds for building a structure are inherently non-streaming as
510+ -- the structure cannot be lazily consumed until fully built.
511+ , benchIOSink bufValue "foldl'/build/IO" Ops.foldl'Build
512+ , benchIdentitySink bufValue "foldl'/build/Identity" Ops.foldl'Build
513+ , benchIOSink bufValue "foldlM'/build/IO" Ops.foldlM'Build
514+ , benchIdentitySink bufValue "foldlM'/build/Identity" Ops.foldlM'Build
515+
516+ -- accumulation due to strictness of IO monad
517+ -- XXX Stack dominant, segregate?
518+ , benchIOSink bufValue "foldrM/build/IO" Ops.foldrMBuild
519+ , benchPureSinkIO bufValue "traversable/mapM" Ops.traversableMapM
520+
521+ -- Converting the stream to a list or pure stream
522+ -- XXX Stack dominant, segregate?
523+ , benchIOSink bufValue "toList" Ops.toList
524+ , benchIOSink bufValue "toListRev" Ops.toListRev
525+
526+ , benchIOSink bufValue "toStream" (S.fold IP.toStream)
527+ , benchIOSink bufValue "toStreamRev" (S.fold IP.toStreamRev)
528+
529+ , benchIOSink bufValue "folds/toList" (S.fold FL.toList)
530+ , benchIOSink bufValue "folds/toListRevF" (S.fold IFL.toListRevF)
531+
532+ -- Converting the stream to an array
533+ , benchIOSink bufValue "folds/lastN.Max" (S.fold (IA.lastN (bufValue + 1)))
534+ , benchIOSink bufValue "folds/writeN" (S.fold (A.writeN bufValue))
535+
536+ -- Reversing/sorting a stream
537+ , benchIOSink bufValue "reverse" (Ops.reverse 1)
538+ , benchIOSink bufValue "reverse'" (Ops.reverse' 1)
539+
540+ -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
541+ -- foldl1 which does not work in constant memory for our implementation.
542+ -- It works in constant memory for lists but even for lists it takes 15x
543+ -- more time compared to our foldl' based implementation.
544+ , bench "minimumBy" $ nf (flip Ops.foldableMinBy 1) value
545+ , bench "maximumBy" $ nf (flip Ops.foldableMaxBy 1) value
546+ , bench "minimumByList" $ nf (flip Ops.foldableListMinBy 1) value
547+
548+ -- XXX can these be streaming? Can we have special read/show style type
549+ -- classes supporting streaming?
550+ , mkString bufValue `deepseq` (bench "readsPrec pure streams" $
551+ nf Ops.readInstance (mkString bufValue))
552+ , mkString bufValue `deepseq` (bench "readsPrec Haskell lists" $
553+ nf Ops.readInstanceList (mkListString bufValue))
554+ , mkList bufValue `deepseq` (bench "showPrec Haskell lists" $
555+ nf Ops.showInstanceList (mkList bufValue))
556+
557+ -- XXX streaming operations that can potentially be fixed
558+
559+ -- XXX These consume a lot of stack, fix or segregate
560+ , benchIOSink bufValue "tail" Ops.tail
561+ , benchIOSink bufValue "nullHeadTail" Ops.nullHeadTail
562+
563+ , benchIOSrc1 "concatUnfoldInterleaveRepl (x/4,4)"
564+ (Ops.concatUnfoldInterleaveRepl4xN bufValue)
565+ , benchIOSrc1 "concatUnfoldRoundrobinRepl (x/4,4)"
566+ (Ops.concatUnfoldRoundrobinRepl4xN bufValue)
567+ ]
568+ , bgroup "traversable"
569+ [ -- Traversable instance
570+ benchPureSinkIO bufValue "traverse" Ops.traversableTraverse
571+ , benchPureSinkIO bufValue "sequenceA" Ops.traversableSequenceA
572+ , benchPureSinkIO bufValue "mapM" Ops.traversableMapM
573+ , benchPureSinkIO bufValue "sequence" Ops.traversableSequence
574+ ]
575+ ]
benchmark/LinearAsync.hsnew file+147
@@ -0,0 +1,147 @@
1+{-# LANGUAGE CPP #-}
2+-- |
3+-- Module : Main
4+-- Copyright : (c) 2018 Harendra Kumar
5+--
6+-- License : BSD3
7+-- Maintainer : streamly@composewell.com
8+
9+import Control.DeepSeq (NFData)
10+-- import Data.Functor.Identity (Identity, runIdentity)
11+import System.Random (randomRIO)
12+
13+import Common (parseCLIOpts)
14+
15+import Streamly
16+import Gauge
17+
18+import qualified Streamly.Benchmark.Prelude as Ops
19+
20+-- We need a monadic bind here to make sure that the function f does not get
21+-- completely optimized out by the compiler in some cases.
22+--
23+-- | Takes a fold method, and uses it with a default source.
24+{-# INLINE benchIO #-}
25+benchIO :: (IsStream t, NFData b) => Int -> String -> (t IO Int -> IO b) -> Benchmark
26+benchIO value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source value
27+
28+-- | Takes a source, and uses it with a default drain/fold method.
29+{-# INLINE benchSrcIO #-}
30+benchSrcIO
31+ :: (t IO a -> SerialT IO a)
32+ -> String
33+ -> (Int -> t IO a)
34+ -> Benchmark
35+benchSrcIO t name f
36+ = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
37+
38+{-# INLINE benchMonadicSrcIO #-}
39+benchMonadicSrcIO :: String -> (Int -> IO ()) -> Benchmark
40+benchMonadicSrcIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
41+
42+{-
43+_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
44+_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
45+-}
46+
47+defaultStreamSize :: Int
48+defaultStreamSize = 100000
49+
50+main :: IO ()
51+main = do
52+ -- XXX Fix indentation
53+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
54+ let value2 = round $ sqrt $ (fromIntegral value :: Double)
55+ value2 `seq` value `seq` runMode (mode cfg) cfg benches
56+ [ bgroup "asyncly"
57+ [ benchSrcIO asyncly "unfoldr" (Ops.sourceUnfoldr value)
58+ , benchSrcIO asyncly "unfoldrM" (Ops.sourceUnfoldrM value)
59+ , benchSrcIO asyncly "fromFoldable" (Ops.sourceFromFoldable value)
60+ , benchSrcIO asyncly "fromFoldableM" (Ops.sourceFromFoldableM value)
61+ , benchSrcIO asyncly "foldMapWith" (Ops.sourceFoldMapWith value)
62+ , benchSrcIO asyncly "foldMapWithM" (Ops.sourceFoldMapWithM value)
63+ , benchSrcIO asyncly "foldMapM" (Ops.sourceFoldMapM value)
64+ , benchIO value "map" $ Ops.map' asyncly 1
65+ , benchIO value "fmap" $ Ops.fmap' asyncly 1
66+ , benchIO value "mapM" $ Ops.mapM asyncly 1
67+ , benchSrcIO asyncly "unfoldrM maxThreads 1"
68+ (maxThreads 1 . Ops.sourceUnfoldrM value)
69+ , benchSrcIO asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
70+ (maxBuffer 1 . Ops.sourceUnfoldrMN (value `div` 10))
71+ , benchMonadicSrcIO "concatMapWith (2,x/2)"
72+ (Ops.concatStreamsWith async 2 (value `div` 2))
73+ , benchMonadicSrcIO "concatMapWith (sqrt x,sqrt x)"
74+ (Ops.concatStreamsWith async value2 value2)
75+ , benchMonadicSrcIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
76+ (Ops.concatStreamsWith async (value2 * 2) (value2 `div` 2))
77+ ]
78+ , bgroup "wAsyncly"
79+ [ benchSrcIO wAsyncly "unfoldr" (Ops.sourceUnfoldr value)
80+ , benchSrcIO wAsyncly "unfoldrM" (Ops.sourceUnfoldrM value)
81+ , benchSrcIO wAsyncly "fromFoldable" (Ops.sourceFromFoldable value)
82+ , benchSrcIO wAsyncly "fromFoldableM" (Ops.sourceFromFoldableM value)
83+ , benchSrcIO wAsyncly "foldMapWith" (Ops.sourceFoldMapWith value)
84+ , benchSrcIO wAsyncly "foldMapWithM" (Ops.sourceFoldMapWithM value)
85+ , benchSrcIO wAsyncly "foldMapM" (Ops.sourceFoldMapM value)
86+ , benchIO value "map" $ Ops.map' wAsyncly 1
87+ , benchIO value "fmap" $ Ops.fmap' wAsyncly 1
88+ , benchIO value "mapM" $ Ops.mapM wAsyncly 1
89+ , benchSrcIO wAsyncly "unfoldrM maxThreads 1"
90+ (maxThreads 1 . Ops.sourceUnfoldrM value)
91+ , benchSrcIO wAsyncly "unfoldrM maxBuffer 1 (x/10 ops)"
92+ (maxBuffer 1 . Ops.sourceUnfoldrMN (value `div` 10))
93+ -- When we merge streams using wAsync the size of the queue increases
94+ -- slowly because of the binary composition adding just one more item
95+ -- to the work queue only after every scheduling pass through the
96+ -- work queue.
97+ --
98+ -- We should see the memory consumption increasing slowly if these
99+ -- benchmarks are left to run on infinite number of streams of infinite
100+ -- sizes.
101+ , benchMonadicSrcIO "concatMapWith (2,x/2)"
102+ (Ops.concatStreamsWith wAsync 2 (value `div` 2))
103+ , benchMonadicSrcIO "concatMapWith (sqrt x,sqrt x)"
104+ (Ops.concatStreamsWith wAsync value2 value2)
105+ , benchMonadicSrcIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
106+ (Ops.concatStreamsWith wAsync (value2 * 2) (value2 `div` 2))
107+ ]
108+ -- unfoldr and fromFoldable are always serial and therefore the same for
109+ -- all stream types.
110+ , bgroup "aheadly"
111+ [ benchSrcIO aheadly "unfoldr" (Ops.sourceUnfoldr value)
112+ , benchSrcIO aheadly "unfoldrM" (Ops.sourceUnfoldrM value)
113+ , benchSrcIO aheadly "fromFoldableM" (Ops.sourceFromFoldableM value)
114+ , benchSrcIO aheadly "foldMapWith" (Ops.sourceFoldMapWith value)
115+ , benchSrcIO aheadly "foldMapWithM" (Ops.sourceFoldMapWithM value)
116+ , benchSrcIO aheadly "foldMapM" (Ops.sourceFoldMapM value)
117+ , benchIO value "map" $ Ops.map' aheadly 1
118+ , benchIO value "fmap" $ Ops.fmap' aheadly 1
119+ , benchIO value "mapM" $ Ops.mapM aheadly 1
120+ , benchSrcIO aheadly "unfoldrM maxThreads 1"
121+ (maxThreads 1 . Ops.sourceUnfoldrM value)
122+ , benchSrcIO aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
123+ (maxBuffer 1 . Ops.sourceUnfoldrMN (value `div` 10))
124+ , benchSrcIO aheadly "fromFoldable" (Ops.sourceFromFoldable value)
125+ , benchMonadicSrcIO "concatMapWith (2,x/2)"
126+ (Ops.concatStreamsWith ahead 2 (value `div` 2))
127+ , benchMonadicSrcIO "concatMapWith (sqrt x,sqrt x)"
128+ (Ops.concatStreamsWith ahead value2 value2)
129+ , benchMonadicSrcIO "concatMapWith (sqrt x * 2,sqrt x / 2)"
130+ (Ops.concatStreamsWith ahead (value2 * 2) (value2 `div` 2))
131+ ]
132+ , bgroup "zip"
133+ [ benchSrcIO serially "zipAsync (2,x/2)" (Ops.zipAsync (value `div` 2))
134+ , benchSrcIO serially "zipAsyncM (2,x/2)"
135+ (Ops.zipAsyncM (value `div` 2))
136+ , benchSrcIO serially "zipAsyncAp (2,x/2)"
137+ (Ops.zipAsyncAp (value `div` 2))
138+ , benchIO value "fmap zipAsyncly" $ Ops.fmap' zipAsyncly 1
139+ , benchSrcIO serially "mergeAsyncBy (2,x/2)"
140+ (Ops.mergeAsyncBy (value `div` 2))
141+ , benchSrcIO serially "mergeAsyncByM (2,x/2)"
142+ (Ops.mergeAsyncByM (value `div` 2))
143+ -- Parallel stages in a pipeline
144+ , benchIO value "parAppMap" Ops.parAppMap
145+ , benchIO value "parAppSum" Ops.parAppSum
146+ ]
147+ ]
benchmark/LinearRate.hsnew file+68
@@ -0,0 +1,68 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+-- Rate benchmarks are kept separate because they need more running time to
9+-- provide stable results.
10+
11+-- import Data.Functor.Identity (Identity, runIdentity)
12+import System.Random (randomRIO)
13+
14+import Common (parseCLIOpts)
15+
16+import Streamly
17+import Gauge
18+
19+import qualified Streamly.Benchmark.Prelude as Ops
20+
21+-- | Takes a source, and uses it with a default drain/fold method.
22+{-# INLINE benchSrcIO #-}
23+benchSrcIO
24+ :: (t IO Int -> SerialT IO Int)
25+ -> String
26+ -> (Int -> t IO Int)
27+ -> Benchmark
28+benchSrcIO t name f
29+ = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
30+
31+{-
32+_benchId :: NFData b => String -> (Ops.Stream m Int -> Identity b) -> Benchmark
33+_benchId name f = bench name $ nf (runIdentity . f) (Ops.source 10)
34+-}
35+
36+defaultStreamSize :: Int
37+defaultStreamSize = 100000
38+
39+main :: IO ()
40+main = do
41+ -- XXX Fix indentation
42+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
43+ value `seq` runMode (mode cfg) cfg benches
44+ -- XXX arbitrarily large rate should be the same as rate Nothing
45+ [ bgroup "avgrate"
46+ [ bgroup "asyncly"
47+ [ -- benchIO "unfoldr" $ Ops.toNull asyncly
48+ benchSrcIO asyncly "unfoldrM" (Ops.sourceUnfoldrM value)
49+ , benchSrcIO asyncly "unfoldrM/Nothing"
50+ (rate Nothing . Ops.sourceUnfoldrM value)
51+ , benchSrcIO asyncly "unfoldrM/1,000,000"
52+ (avgRate 1000000 . Ops.sourceUnfoldrM value)
53+ , benchSrcIO asyncly "unfoldrM/3,000,000"
54+ (avgRate 3000000 . Ops.sourceUnfoldrM value)
55+ , benchSrcIO asyncly "unfoldrM/10,000,000/maxThreads1"
56+ (maxThreads 1 . avgRate 10000000 . Ops.sourceUnfoldrM value)
57+ , benchSrcIO asyncly "unfoldrM/10,000,000"
58+ (avgRate 10000000 . Ops.sourceUnfoldrM value)
59+ , benchSrcIO asyncly "unfoldrM/20,000,000"
60+ (avgRate 20000000 . Ops.sourceUnfoldrM value)
61+ ]
62+ , bgroup "aheadly"
63+ [
64+ benchSrcIO aheadly "unfoldrM/1,000,000"
65+ (avgRate 1000000 . Ops.sourceUnfoldrM value)
66+ ]
67+ ]
68+ ]
benchmark/NanoBenchmarks.hs+23−28
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-------------------------------------------------------------------------------
42-- Investigate specific benchmarks more closely in isolation, possibly looking
53-- at GHC generated code for optimizing specific problematic cases.
@@ -8,27 +6,30 @@
86{-# LANGUAGE FlexibleContexts #-}
97{-# LANGUAGE ScopedTypeVariables #-}
108
11−import Data.Char (ord)
12−import Streamly.Internal.Data.Stream (Stream)
13−import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
9+import Streamly (SerialT)
10+import Streamly.Internal.Data.SVar (MonadAsync)
1411
15−import qualified Streamly.Data.Array as A
12+import qualified Streamly.Memory.Array as A
13+import qualified Streamly.FileSystem.Handle as FH
1614import qualified Streamly.Internal.FileSystem.Handle as IFH
1715import qualified Streamly.Data.Fold as FL
18−import qualified Streamly.Internal.Data.Stream as S
19−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
16+import qualified Streamly.Internal.Prelude as Internal
17+import qualified Streamly.Prelude as S
18+import qualified Streamly.Internal.Data.Stream.StreamK as K
2019
21−import Test.Tasty.Bench
20+import Data.Char (ord)
21+import Gauge
22+import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
2223import System.Random
2324
2425maxValue :: Int
2526maxValue = 100000
2627
27−drain :: Monad m => S.Stream m a -> m ()
28−drain = S.fold FL.drain
28+-- type Stream = K.Stream
29+type Stream = SerialT
2930
3031{-# INLINE sourceUnfoldrM #-}
31−sourceUnfoldrM :: Monad m => Stream m Int
32+sourceUnfoldrM :: MonadAsync m => Stream m Int
3233sourceUnfoldrM = S.unfoldrM step 0
3334 where
3435 step cnt =
@@ -37,7 +38,7 @@ sourceUnfoldrM = S.unfoldrM step 0
3738 else return (Just (cnt, cnt + 1))
3839
3940{-# INLINE sourceUnfoldrMN #-}
40−sourceUnfoldrMN :: Monad m => Int -> Stream m Int
41+sourceUnfoldrMN :: MonadAsync m => Int -> Stream m Int
4142sourceUnfoldrMN n = S.unfoldrM step n
4243 where
4344 step cnt =
@@ -66,7 +67,7 @@ takeAllDropOne = S.drop 1 . S.take maxValue
6667
6768{-# INLINE takeDrop #-}
6869takeDrop :: Monad m => Stream m Int -> m ()
69−takeDrop = drain .
70+takeDrop = S.drain .
7071 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
7172
7273-------------------------------------------------------------------------------
@@ -81,7 +82,7 @@ dropWhileFalse = S.dropWhile (> maxValue)
8182
8283{-# INLINE dropWhileFalseX4 #-}
8384dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
84−dropWhileFalseX4 = drain
85+dropWhileFalseX4 = S.drain
8586 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
8687
8788-------------------------------------------------------------------------------
@@ -90,7 +91,7 @@ dropWhileFalseX4 = drain
9091
9192{-# INLINE iterateSource #-}
9293iterateSource
93− :: Monad m
94+ :: MonadAsync m
9495 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
9596iterateSource g i n = f i (sourceUnfoldrMN n)
9697 where
@@ -102,26 +103,20 @@ iterateSource g i n = f i (sourceUnfoldrMN n)
102103main :: IO ()
103104main = do
104105 defaultMain [bench "unfoldr" $ nfIO $
105− randomRIO (1,1) >>= \n -> drain (sourceUnfoldr n)]
106+ randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]
106107 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
107108 defaultMain [bench "dropWhileFalseX4" $
108109 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
109110 defaultMain [bench "iterate-mapM" $
110− nfIO $ drain $ iterateSource (S.mapM return) 100000 10]
111+ nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]
111112
112113 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
113114 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
114− S.fold FL.length
115− (Internal.splitOnSeq
116− (A.fromList
117− $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"
118− )
119− FL.drain
120− $ IFH.read inText
121− )
122− >>= print
115+ (S.length $ Internal.splitOnSeq (A.fromList $ map (fromIntegral . ord)
116+ "abcdefghijklmnopqrstuvwxyz") FL.drain
117+ $ IFH.toBytes inText) >>= print
123118 ]
124119 where
125120
126121 mkBenchText name h action =
127− env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)
122+ bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)
benchmark/Nested.hsnew file+61
@@ -0,0 +1,61 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Control.DeepSeq (NFData)
9+import Data.Functor.Identity (Identity, runIdentity)
10+import System.Random (randomRIO)
11+
12+import Common (parseCLIOpts)
13+
14+import Streamly
15+import Gauge
16+
17+import qualified NestedOps as Ops
18+
19+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
20+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
21+
22+_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark
23+_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f
24+
25+defaultStreamSize :: Int
26+defaultStreamSize = 100000
27+
28+main :: IO ()
29+main = do
30+ -- XXX Fix indentation
31+ (linearCount, cfg, benches) <- parseCLIOpts defaultStreamSize
32+ linearCount `seq` runMode (mode cfg) cfg benches
33+ [ bgroup "serially"
34+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount serially
35+ , benchIO "toNull" $ Ops.toNull linearCount serially
36+ , benchIO "toNull3" $ Ops.toNull3 linearCount serially
37+ -- , benchIO "toList" $ Ops.toList linearCount serially
38+ -- XXX takes too much stack space
39+ , benchIO "toListSome" $ Ops.toListSome linearCount serially
40+ , benchIO "filterAllOut" $ Ops.filterAllOut linearCount serially
41+ , benchIO "filterAllIn" $ Ops.filterAllIn linearCount serially
42+ , benchIO "filterSome" $ Ops.filterSome linearCount serially
43+ , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount serially
44+ ]
45+
46+ , bgroup "wSerially"
47+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount wSerially
48+ , benchIO "toNull" $ Ops.toNull linearCount wSerially
49+ , benchIO "toNull3" $ Ops.toNull3 linearCount wSerially
50+ -- , benchIO "toList" $ Ops.toList linearCount wSerially
51+ , benchIO "toListSome" $ Ops.toListSome linearCount wSerially
52+ , benchIO "filterAllOut" $ Ops.filterAllOut linearCount wSerially
53+ , benchIO "filterAllIn" $ Ops.filterAllIn linearCount wSerially
54+ , benchIO "filterSome" $ Ops.filterSome linearCount wSerially
55+ , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount wSerially
56+ ]
57+
58+ , bgroup "zipSerially"
59+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount zipSerially
60+ ]
61+ ]
benchmark/NestedConcurrent.hsnew file+84
@@ -0,0 +1,84 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Control.DeepSeq (NFData)
9+import Control.Monad (when)
10+import Data.Functor.Identity (Identity, runIdentity)
11+import System.Random (randomRIO)
12+
13+import Common (parseCLIOpts)
14+
15+import Streamly
16+import Gauge
17+
18+import qualified NestedOps as Ops
19+
20+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
21+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
22+
23+_benchId :: (NFData b) => String -> (Int -> Identity b) -> Benchmark
24+_benchId name f = bench name $ nf (\g -> runIdentity (g 1)) f
25+
26+defaultStreamSize :: Int
27+defaultStreamSize = 100000
28+
29+main :: IO ()
30+main = do
31+ -- XXX Fix indentation
32+ (linearCount, cfg, benches) <- parseCLIOpts defaultStreamSize
33+ let finiteCount = min linearCount defaultStreamSize
34+ when (finiteCount /= linearCount) $
35+ putStrLn $ "Limiting stream size to "
36+ ++ show defaultStreamSize
37+ ++ " for finite stream operations only"
38+
39+ finiteCount `seq` linearCount `seq` runMode (mode cfg) cfg benches
40+ [
41+ bgroup "aheadly"
42+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount aheadly
43+ , benchIO "toNull" $ Ops.toNull linearCount aheadly
44+ , benchIO "toNull3" $ Ops.toNull3 linearCount aheadly
45+ -- , benchIO "toList" $ Ops.toList linearCount aheadly
46+ -- XXX consumes too much stack space
47+ , benchIO "toListSome" $ Ops.toListSome linearCount aheadly
48+ , benchIO "filterAllOut" $ Ops.filterAllOut linearCount aheadly
49+ , benchIO "filterAllIn" $ Ops.filterAllIn linearCount aheadly
50+ , benchIO "filterSome" $ Ops.filterSome linearCount aheadly
51+ , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount aheadly
52+ ]
53+
54+ , bgroup "asyncly"
55+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount asyncly
56+ , benchIO "toNull" $ Ops.toNull linearCount asyncly
57+ , benchIO "toNull3" $ Ops.toNull3 linearCount asyncly
58+ -- , benchIO "toList" $ Ops.toList linearCount asyncly
59+ , benchIO "toListSome" $ Ops.toListSome linearCount asyncly
60+ , benchIO "filterAllOut" $ Ops.filterAllOut linearCount asyncly
61+ , benchIO "filterAllIn" $ Ops.filterAllIn linearCount asyncly
62+ , benchIO "filterSome" $ Ops.filterSome linearCount asyncly
63+ , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount asyncly
64+ ]
65+
66+ , bgroup "zipAsyncly"
67+ [ benchIO "toNullAp" $ Ops.toNullAp linearCount zipAsyncly
68+ ]
69+
70+ -- Operations that are not scalable to infinite streams
71+ , bgroup "finite"
72+ [ bgroup "wAsyncly"
73+ [ benchIO "toNullAp" $ Ops.toNullAp finiteCount wAsyncly
74+ , benchIO "toNull" $ Ops.toNull finiteCount wAsyncly
75+ , benchIO "toNull3" $ Ops.toNull3 finiteCount wAsyncly
76+ -- , benchIO "toList" $ Ops.toList finiteCount wAsyncly
77+ , benchIO "toListSome" $ Ops.toListSome finiteCount wAsyncly
78+ , benchIO "filterAllOut" $ Ops.filterAllOut finiteCount wAsyncly
79+ -- , benchIO "filterAllIn" $ Ops.filterAllIn finiteCount wAsyncly
80+ , benchIO "filterSome" $ Ops.filterSome finiteCount wAsyncly
81+ , benchIO "breakAfterSome" $ Ops.breakAfterSome finiteCount wAsyncly
82+ ]
83+ ]
84+ ]
benchmark/NestedOps.hsnew file+174
@@ -0,0 +1,174 @@
1+-- |
2+-- Module : BenchmarkOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : MIT
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+
12+module NestedOps where
13+
14+import Control.Exception (try)
15+import GHC.Exception (ErrorCall)
16+
17+import qualified Streamly as S hiding (runStream)
18+import qualified Streamly.Prelude as S
19+
20+-------------------------------------------------------------------------------
21+-- Stream generation and elimination
22+-------------------------------------------------------------------------------
23+
24+type Stream m a = S.SerialT m a
25+
26+{-# INLINE source #-}
27+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
28+source = sourceUnfoldrM
29+
30+-- Change this to "sourceUnfoldrM value n" for consistency
31+{-# INLINE sourceUnfoldrM #-}
32+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
33+sourceUnfoldrM n value = S.serially $ S.unfoldrM step n
34+ where
35+ step cnt =
36+ if cnt > n + value
37+ then return Nothing
38+ else return (Just (cnt, cnt + 1))
39+
40+{-# INLINE sourceUnfoldr #-}
41+sourceUnfoldr :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
42+sourceUnfoldr start n = S.unfoldr step start
43+ where
44+ step cnt =
45+ if cnt > start + n
46+ then Nothing
47+ else Just (cnt, cnt + 1)
48+
49+{-# INLINE runStream #-}
50+runStream :: Monad m => Stream m a -> m ()
51+runStream = S.drain
52+
53+{-# INLINE runToList #-}
54+runToList :: Monad m => Stream m a -> m [a]
55+runToList = S.toList
56+
57+-------------------------------------------------------------------------------
58+-- Benchmark ops
59+-------------------------------------------------------------------------------
60+
61+{-# INLINE toNullAp #-}
62+toNullAp
63+ :: (S.IsStream t, S.MonadAsync m, Applicative (t m))
64+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
65+toNullAp linearCount t start = runStream . t $
66+ (+) <$> source start nestedCount2 <*> source start nestedCount2
67+ where
68+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
69+
70+{-# INLINE toNull #-}
71+toNull
72+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
73+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
74+toNull linearCount t start = runStream . t $ do
75+ x <- source start nestedCount2
76+ y <- source start nestedCount2
77+ return $ x + y
78+ where
79+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
80+
81+{-# INLINE toNull3 #-}
82+toNull3
83+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
84+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
85+toNull3 linearCount t start = runStream . t $ do
86+ x <- source start nestedCount3
87+ y <- source start nestedCount3
88+ z <- source start nestedCount3
89+ return $ x + y + z
90+ where
91+ nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
92+
93+{-# INLINE toList #-}
94+toList
95+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
96+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
97+toList linearCount t start = runToList . t $ do
98+ x <- source start nestedCount2
99+ y <- source start nestedCount2
100+ return $ x + y
101+ where
102+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
103+
104+-- Taking a specified number of elements is very expensive in logict so we have
105+-- a test to measure the same.
106+{-# INLINE toListSome #-}
107+toListSome
108+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
109+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m [Int]
110+toListSome linearCount t start =
111+ runToList . t $ S.take 10000 $ do
112+ x <- source start nestedCount2
113+ y <- source start nestedCount2
114+ return $ x + y
115+ where
116+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
117+
118+{-# INLINE filterAllOut #-}
119+filterAllOut
120+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
121+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
122+filterAllOut linearCount t start = runStream . t $ do
123+ x <- source start nestedCount2
124+ y <- source start nestedCount2
125+ let s = x + y
126+ if s < 0
127+ then return s
128+ else S.nil
129+ where
130+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
131+
132+{-# INLINE filterAllIn #-}
133+filterAllIn
134+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
135+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
136+filterAllIn linearCount t start = runStream . t $ do
137+ x <- source start nestedCount2
138+ y <- source start nestedCount2
139+ let s = x + y
140+ if s > 0
141+ then return s
142+ else S.nil
143+ where
144+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
145+
146+{-# INLINE filterSome #-}
147+filterSome
148+ :: (S.IsStream t, S.MonadAsync m, Monad (t m))
149+ => Int -> (t m Int -> S.SerialT m Int) -> Int -> m ()
150+filterSome linearCount t start = runStream . t $ do
151+ x <- source start nestedCount2
152+ y <- source start nestedCount2
153+ let s = x + y
154+ if s > 1100000
155+ then return s
156+ else S.nil
157+ where
158+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
159+
160+{-# INLINE breakAfterSome #-}
161+breakAfterSome
162+ :: (S.IsStream t, Monad (t IO))
163+ => Int -> (t IO Int -> S.SerialT IO Int) -> Int -> IO ()
164+breakAfterSome linearCount t start = do
165+ (_ :: Either ErrorCall ()) <- try $ runStream . t $ do
166+ x <- source start nestedCount2
167+ y <- source start nestedCount2
168+ let s = x + y
169+ if s > 1100000
170+ then error "break"
171+ else return s
172+ return ()
173+ where
174+ nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
benchmark/NestedUnfold.hsnew file+38
@@ -0,0 +1,38 @@
1+-- |
2+-- Module : NestedUnfold
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+import Control.DeepSeq (NFData)
9+import System.Random (randomRIO)
10+
11+import Common (parseCLIOpts)
12+
13+import qualified NestedUnfoldOps as Ops
14+
15+import Gauge
16+
17+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
18+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
19+
20+defaultStreamSize :: Int
21+defaultStreamSize = 100000
22+
23+main :: IO ()
24+main = do
25+ (linearCount, cfg, benches) <- parseCLIOpts defaultStreamSize
26+ linearCount `seq` runMode (mode cfg) cfg benches
27+ [ bgroup "unfold"
28+ [ benchIO "toNull" $ Ops.toNull linearCount
29+ , benchIO "toNull3" $ Ops.toNull3 linearCount
30+ , benchIO "concat" $ Ops.concat linearCount
31+ -- , benchIO "toList" $ Ops.toList
32+ , benchIO "toListSome" $ Ops.toListSome linearCount
33+ , benchIO "filterAllOut" $ Ops.filterAllOut linearCount
34+ , benchIO "filterAllIn" $ Ops.filterAllIn linearCount
35+ , benchIO "filterSome" $ Ops.filterSome linearCount
36+ , benchIO "breakAfterSome" $ Ops.breakAfterSome linearCount
37+ ]
38+ ]
benchmark/NestedUnfoldOps.hsnew file+126
@@ -0,0 +1,126 @@
1+-- |
2+-- Module : NestedUnfoldOps
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+module NestedUnfoldOps where
9+
10+import Control.Monad.IO.Class (MonadIO (..))
11+import Streamly.Internal.Data.Unfold (Unfold)
12+
13+import qualified Streamly.Internal.Data.Unfold as UF
14+import qualified Streamly.Internal.Data.Fold as FL
15+
16+-- n * (n + 1) / 2 == linearCount
17+concatCount :: Int -> Int
18+concatCount linearCount =
19+ round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
20+
21+-- double nested loop
22+nestedCount2 :: Int -> Int
23+nestedCount2 linearCount = round (fromIntegral linearCount**(1/2::Double))
24+
25+-- triple nested loop
26+nestedCount3 :: Int -> Int
27+nestedCount3 linearCount = round (fromIntegral linearCount**(1/3::Double))
28+
29+-------------------------------------------------------------------------------
30+-- Stream generation and elimination
31+-------------------------------------------------------------------------------
32+
33+-- generate numbers up to the argument value
34+{-# INLINE source #-}
35+source :: Monad m => Int -> Unfold m Int Int
36+source n = UF.enumerateFromToIntegral n
37+
38+-------------------------------------------------------------------------------
39+-- Benchmark ops
40+-------------------------------------------------------------------------------
41+
42+{-# INLINE toNull #-}
43+toNull :: MonadIO m => Int -> Int -> m ()
44+toNull linearCount start = do
45+ let end = start + nestedCount2 linearCount
46+ UF.fold
47+ (UF.map (\(x, y) -> x + y)
48+ $ UF.outerProduct (source end) (source end))
49+ FL.drain (start, start)
50+
51+{-# INLINE toNull3 #-}
52+toNull3 :: MonadIO m => Int -> Int -> m ()
53+toNull3 linearCount start = do
54+ let end = start + nestedCount3 linearCount
55+ UF.fold
56+ (UF.map (\(x, y) -> x + y)
57+ $ UF.outerProduct (source end)
58+ ((UF.map (\(x, y) -> x + y)
59+ $ UF.outerProduct (source end) (source end))))
60+ FL.drain (start, (start, start))
61+
62+{-# INLINE concat #-}
63+concat :: MonadIO m => Int -> Int -> m ()
64+concat linearCount start = do
65+ let end = start + concatCount linearCount
66+ UF.fold
67+ (UF.concat (source end) (source end))
68+ FL.drain start
69+
70+{-# INLINE toList #-}
71+toList :: MonadIO m => Int -> Int -> m [Int]
72+toList linearCount start = do
73+ let end = start + nestedCount2 linearCount
74+ UF.fold
75+ (UF.map (\(x, y) -> x + y)
76+ $ UF.outerProduct (source end) (source end))
77+ FL.toList (start, start)
78+
79+{-# INLINE toListSome #-}
80+toListSome :: MonadIO m => Int -> Int -> m [Int]
81+toListSome linearCount start = do
82+ let end = start + nestedCount2 linearCount
83+ UF.fold
84+ (UF.take 1000 $ (UF.map (\(x, y) -> x + y)
85+ $ UF.outerProduct (source end) (source end)))
86+ FL.toList (start, start)
87+
88+{-# INLINE filterAllOut #-}
89+filterAllOut :: MonadIO m => Int -> Int -> m ()
90+filterAllOut linearCount start = do
91+ let end = start + nestedCount2 linearCount
92+ UF.fold
93+ (UF.filter (< 0)
94+ $ UF.map (\(x, y) -> x + y)
95+ $ UF.outerProduct (source end) (source end))
96+ FL.drain (start, start)
97+
98+{-# INLINE filterAllIn #-}
99+filterAllIn :: MonadIO m => Int -> Int -> m ()
100+filterAllIn linearCount start = do
101+ let end = start + nestedCount2 linearCount
102+ UF.fold
103+ (UF.filter (> 0)
104+ $ UF.map (\(x, y) -> x + y)
105+ $ UF.outerProduct (source end) (source end))
106+ FL.drain (start, start)
107+
108+{-# INLINE filterSome #-}
109+filterSome :: MonadIO m => Int -> Int -> m ()
110+filterSome linearCount start = do
111+ let end = start + nestedCount2 linearCount
112+ UF.fold
113+ (UF.filter (> 1100000)
114+ $ UF.map (\(x, y) -> x + y)
115+ $ UF.outerProduct (source end) (source end))
116+ FL.drain (start, start)
117+
118+{-# INLINE breakAfterSome #-}
119+breakAfterSome :: MonadIO m => Int -> Int -> m ()
120+breakAfterSome linearCount start = do
121+ let end = start + nestedCount2 linearCount
122+ UF.fold
123+ (UF.takeWhile (<= 1100000)
124+ $ UF.map (\(x, y) -> x + y)
125+ $ UF.outerProduct (source end) (source end))
126+ FL.drain (start, start)
benchmark/Parallel.hsnew file+93
@@ -0,0 +1,93 @@
1+{-# LANGUAGE CPP #-}
2+-- |
3+-- Module : Main
4+-- Copyright : (c) 2018 Harendra Kumar
5+--
6+-- License : BSD3
7+-- Maintainer : streamly@composewell.com
8+
9+import Control.DeepSeq (NFData)
10+-- import Data.Functor.Identity (Identity, runIdentity)
11+import System.Random (randomRIO)
12+
13+import Common (parseCLIOpts)
14+
15+import Streamly
16+import Gauge
17+
18+import qualified Streamly.Benchmark.Prelude as Ops
19+import qualified NestedOps as Nested
20+
21+{-# INLINE benchIONested #-}
22+benchIONested :: (NFData b) => String -> (Int -> IO b) -> Benchmark
23+benchIONested name f = bench name $ nfIO $ randomRIO (1,1) >>= f
24+
25+-- We need a monadic bind here to make sure that the function f does not get
26+-- completely optimized out by the compiler in some cases.
27+--
28+-- | Takes a fold method, and uses it with a default source.
29+{-# INLINE benchIO #-}
30+benchIO :: (IsStream t, NFData b) => Int -> String -> (t IO Int -> IO b) -> Benchmark
31+benchIO value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . Ops.source value
32+
33+-- | Takes a source, and uses it with a default drain/fold method.
34+{-# INLINE benchSrcIO #-}
35+benchSrcIO
36+ :: (t IO Int -> SerialT IO Int)
37+ -> String
38+ -> (Int -> t IO Int)
39+ -> Benchmark
40+benchSrcIO t name f
41+ = bench name $ nfIO $ randomRIO (1,1) >>= Ops.toNull t . f
42+
43+defaultStreamSize :: Int
44+defaultStreamSize = 100000
45+
46+linear :: Int -> Int -> [Benchmark]
47+linear value value2 =
48+ [ -- unfoldr is pure and works serially irrespective of the stream type
49+ benchSrcIO parallely "unfoldr" (Ops.sourceUnfoldr value)
50+ , benchSrcIO parallely "unfoldrM" (Ops.sourceUnfoldrM value)
51+ , benchSrcIO parallely "fromFoldable" (Ops.sourceFromFoldable value)
52+ , benchSrcIO parallely "fromFoldableM" (Ops.sourceFromFoldableM value)
53+ , benchSrcIO parallely "foldMapWith" (Ops.sourceFoldMapWith value)
54+ , benchSrcIO parallely "foldMapWithM" (Ops.sourceFoldMapWithM value)
55+ , benchSrcIO parallely "foldMapM" (Ops.sourceFoldMapM value)
56+ -- map/fmap are pure and therefore no concurrency would be added on top
57+ -- of what the source stream (i.e. unfoldrM) provides.
58+ , benchIO value "map" $ Ops.map' parallely 1
59+ , benchIO value "fmap" $ Ops.fmap' parallely 1
60+ , benchIO value "mapM" $ Ops.mapM parallely 1
61+ , benchIONested "concatMapWith (2,x/2)"
62+ (Ops.concatStreamsWith parallel 2 (value `div` 2))
63+ , benchIONested "concatMapWith (sqrt x,sqrt x)"
64+ (Ops.concatStreamsWith parallel value2 value2)
65+ , benchIONested "concatMapWith (sqrt x * 2,sqrt x / 2)"
66+ (Ops.concatStreamsWith parallel (value2 * 2) (value2 `div` 2))
67+ ]
68+
69+nested :: Int -> [Benchmark]
70+nested value =
71+ [ benchIONested "toNullAp" $ Nested.toNullAp value parallely
72+ , benchIONested "toNull" $ Nested.toNull value parallely
73+ , benchIONested "toNull3" $ Nested.toNull3 value parallely
74+ -- , benchIO "toList" $ Ops.toList value parallely
75+ -- XXX fix thread blocked indefinitely in MVar
76+ -- , benchIO "toListSome" $ Ops.toListSome value parallely
77+ , benchIONested "filterAllOut" $ Nested.filterAllOut value parallely
78+ , benchIONested "filterAllIn" $ Nested.filterAllIn value parallely
79+ , benchIONested "filterSome" $ Nested.filterSome value parallely
80+ , benchIONested "breakAfterSome" $ Nested.breakAfterSome value parallely
81+ ]
82+
83+main :: IO ()
84+main = do
85+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
86+ let value2 = round $ sqrt $ (fromIntegral value :: Double)
87+ value2 `seq` value `seq`
88+ runMode (mode cfg) cfg benches $
89+ [ bgroup "parallelly"
90+ [ bgroup "linear" $ linear value value2
91+ , bgroup "nested" $ nested value
92+ ]
93+ ]
benchmark/README.mdmode 120000 → 100644+102−1
@@ -1 +0,0 @@
1−../docs/Developer/Benchmarks.md
@@ -0,0 +1,102 @@
1+## Running Benchmarks
2+
3+`bench.sh` script at the root of the repo is the top level driver for running
4+benchmarks. It runs the requested benchmarks and then creates a report from the
5+results using the `bench-show` package. Try `bench.sh --help` for available
6+options to run it.
7+
8+## Quick start
9+
10+Run these commands from the root of the repo.
11+
12+To run the default benchmarks:
13+
14+```
15+$ ./bench.sh
16+```
17+
18+To run all benchmarks:
19+
20+```
21+$ ./bench.sh --benchmarks all
22+```
23+
24+To run `linear` and `linear-async` benchmarks:
25+
26+```
27+$ ./bench.sh --benchmarks "linear linear-async"
28+```
29+
30+To run only the base benchmark and only the benchmarks prefixed with
31+`StreamD` in that (anything after a `--` is passed to gauge):
32+
33+```
34+$ ./bench.sh --benchmarks base -- StreamD
35+```
36+
37+## Comparing benchmarks
38+
39+To compare two sets of results, first run the benchmarks at the baseline
40+commit:
41+
42+```
43+$ ./bench.sh
44+```
45+
46+And then run with the `--append` option at the commit that you want to compare
47+with the baseline. It will show the comparison with the baseline:
48+
49+```
50+$ ./bench.sh --append
51+```
52+
53+Append just adds the next set of results in the same results file. You can keep
54+appending more results and all of them will be compared with the baseline.
55+
56+You can use `--compare` to compare the previous commit with the head commit:
57+
58+```
59+$ ./bench.sh --compare
60+```
61+
62+To compare the head commit with some other base commit:
63+
64+```
65+$ ./bench.sh --compare --base d918833
66+```
67+
68+To compare two arbitrary commits:
69+
70+```
71+$ ./bench.sh --compare --base d918833 --candidate 38aa5f2
72+```
73+
74+Note that the above may not always work because the script and the benchmarks
75+themselves might have changed across the commits. The `--append` method is more
76+reliable to compare.
77+
78+## Available Benchmarks
79+
80+The benchmark names that you can use when running `bench.sh`:
81+
82+* `base`: a benchmark that measures the raw operations of the basic streams
83+ `StreamD` and `StreamK`.
84+
85+* `linear`: measures the non-monadic operations of serial streams
86+* `linear-async`: measures the non-monadic operations of concurrent streams
87+* `linear-rate`: measures the rate limiting operations
88+* `nested`: measures the monadic operations of all streams
89+* `all`: runs all of the above benchmarks
90+
91+## Reporting without measuring
92+
93+You can use the `--no-measure` option to report the already measured results in
94+the benchmarks results file. A results file may collect an arbitrary number of
95+results by running with `--append` multiple times. Each benchmark has its own
96+results file, for example the `linear` benchmark has the results file at
97+`charts/linear/results.csv`.
98+
99+You can also manually edit the file to remove a set of results if you like or
100+to append results from previously saved results or from some other results
101+file. After editing you can run `bench.sh` with the `--no-measure` option to
102+see the reports corresponding to the results.
benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/StreamDKOps.hsrenamed+16−48
@@ -1,8 +1,6 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
4−-- Module : Streamly.Benchmark.Data.Stream.StreamDK
5−-- Copyright : (c) 2018 Composewell Technologies
2+-- Module : StreamDKOps
3+-- Copyright : (c) 2018 Harendra Kumar
64--
75-- License : BSD3
86-- Maintainer : streamly@composewell.com
@@ -10,30 +8,26 @@
108{-# LANGUAGE FlexibleContexts #-}
119{-# LANGUAGE ScopedTypeVariables #-}
1210
13−module Main (main) where
11+module StreamDKOps where
1412
1513-- import Control.Monad (when)
1614-- import Data.Maybe (isJust)
17−import Prelude hiding ()
18−-- import qualified Prelude as P
15+import Prelude
16+ (Monad, Int, (+), (.), return, undefined, Maybe(..), round, (/),
17+ (**), (>))
18+import qualified Prelude as P
1919-- import qualified Data.List as List
2020
21−import qualified Streamly.Internal.Data.StreamK.Alt as S
22−-- import qualified Streamly.Internal.Data.Stream.Common as SP
21+import qualified Streamly.Internal.Data.Stream.StreamDK as S
22+-- import qualified Streamly.Internal.Data.Stream.Prelude as SP
2323-- import qualified Streamly.Internal.Data.SVar as S
2424
25−import Streamly.Benchmark.Common
26−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
27−
28−value :: Int
25+value, value2, value3, value16, maxValue :: Int
2926value = 100000
30−{-
31−value2, value3, value16, maxValue :: Int
3227value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
3328value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
3429value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
3530maxValue = value
36−-}
3731
3832-------------------------------------------------------------------------------
3933-- Benchmark ops
@@ -54,7 +48,6 @@ sourceUnfoldr n = S.unfoldr step n
5448 then Nothing
5549 else Just (cnt, cnt + 1)
5650
57−{-
5851{-# INLINE sourceUnfoldrN #-}
5952sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int
6053sourceUnfoldrN m n = S.unfoldr step n
@@ -63,7 +56,6 @@ sourceUnfoldrN m n = S.unfoldr step n
6356 if cnt > n + m
6457 then Nothing
6558 else Just (cnt, cnt + 1)
66−-}
6759
6860{-# INLINE sourceUnfoldrM #-}
6961sourceUnfoldrM :: Monad m => Int -> Stream m Int
@@ -74,7 +66,6 @@ sourceUnfoldrM n = S.unfoldrM step n
7466 then return Nothing
7567 else return (Just (cnt, cnt + 1))
7668
77−{-
7869{-# INLINE sourceUnfoldrMN #-}
7970sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int
8071sourceUnfoldrMN m n = S.unfoldrM step n
@@ -83,7 +74,6 @@ sourceUnfoldrMN m n = S.unfoldrM step n
8374 if cnt > n + m
8475 then return Nothing
8576 else return (Just (cnt, cnt + 1))
86−-}
8777
8878{-
8979{-# INLINE sourceFromEnum #-}
@@ -106,13 +96,17 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
10696{-
10797{-# INLINE sourceFoldMapWith #-}
10898sourceFoldMapWith :: Int -> Stream m Int
109−sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]
99+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
110100
111101{-# INLINE sourceFoldMapWithM #-}
112102sourceFoldMapWithM :: Monad m => Int -> Stream m Int
113−sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]
103+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
114104-}
115105
106+{-# INLINE source #-}
107+source :: Monad m => Int -> Stream m Int
108+source = sourceUnfoldrM
109+
116110-------------------------------------------------------------------------------
117111-- Elimination
118112-------------------------------------------------------------------------------
@@ -183,7 +177,6 @@ last = S.last
183177-- Transformation
184178-------------------------------------------------------------------------------
185179
186−{-
187180{-# INLINE transform #-}
188181transform :: Monad m => Stream m a -> m ()
189182transform = runStream
@@ -199,7 +192,6 @@ composeN n f =
199192 3 -> transform . f . f . f
200193 4 -> transform . f . f . f . f
201194 _ -> undefined
202−-}
203195
204196{-
205197{-# INLINE scan #-}
@@ -429,27 +421,3 @@ filterAllInNestedList str = do
429421 then return s
430422 else []
431423-}
432−
433−-------------------------------------------------------------------------------
434−-- Benchmarks
435−-------------------------------------------------------------------------------
436−
437−moduleName :: String
438−moduleName = "Data.Stream.StreamDK"
439−
440−o_1_space :: [Benchmark]
441−o_1_space =
442− [ bgroup (o_1_space_prefix moduleName)
443− [ bgroup "generation"
444− [ benchFold "unfoldr" toNull sourceUnfoldr
445− , benchFold "unfoldrM" toNull sourceUnfoldrM
446− ]
447− , bgroup "elimination"
448− [ benchFold "toNull" toNull sourceUnfoldrM
449− , benchFold "uncons" uncons sourceUnfoldrM
450− ]
451− ]
452− ]
453−
454−main :: IO ()
455−main = defaultMain [o_1_space]
benchmark/StreamDOps.hsnew file+357
@@ -0,0 +1,357 @@
1+-- |
2+-- Module : StreamDOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+
11+module StreamDOps where
12+
13+import Control.Monad (when)
14+import Data.Maybe (isJust)
15+import Prelude
16+ (Monad, Int, (+), ($), (.), return, (>), even, (<=), div,
17+ subtract, undefined, Maybe(..), not, (>>=),
18+ maxBound, fmap, odd, (==), flip, (<$>), (<*>), round, (/), (**), (<))
19+import qualified Prelude as P
20+
21+import qualified Streamly.Internal.Data.Stream.StreamD as S
22+import qualified Streamly.Internal.Data.Unfold as UF
23+
24+-- We try to keep the total number of iterations same irrespective of nesting
25+-- of the loops so that the overhead is easy to compare.
26+value, value2, value3, value16, maxValue :: Int
27+value = 100000
28+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31+maxValue = value
32+
33+-------------------------------------------------------------------------------
34+-- Stream generation and elimination
35+-------------------------------------------------------------------------------
36+
37+type Stream m a = S.Stream m a
38+
39+{-# INLINE sourceUnfoldr #-}
40+sourceUnfoldr :: Monad m => Int -> Stream m Int
41+sourceUnfoldr n = S.unfoldr step n
42+ where
43+ step cnt =
44+ if cnt > n + value
45+ then Nothing
46+ else Just (cnt, cnt + 1)
47+
48+{-# INLINE sourceUnfoldrN #-}
49+sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int
50+sourceUnfoldrN m n = S.unfoldr step n
51+ where
52+ step cnt =
53+ if cnt > n + m
54+ then Nothing
55+ else Just (cnt, cnt + 1)
56+
57+{-# INLINE sourceUnfoldrMN #-}
58+sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int
59+sourceUnfoldrMN m n = S.unfoldrM step n
60+ where
61+ step cnt =
62+ if cnt > n + m
63+ then return Nothing
64+ else return (Just (cnt, cnt + 1))
65+
66+{-# INLINE sourceUnfoldrM #-}
67+sourceUnfoldrM :: Monad m => Int -> Stream m Int
68+sourceUnfoldrM n = S.unfoldrM step n
69+ where
70+ step cnt =
71+ if cnt > n + value
72+ then return Nothing
73+ else return (Just (cnt, cnt + 1))
74+
75+{-# INLINE sourceIntFromTo #-}
76+sourceIntFromTo :: Monad m => Int -> Stream m Int
77+sourceIntFromTo n = S.enumerateFromToIntegral n (n + value)
78+
79+{-# INLINE sourceFromList #-}
80+sourceFromList :: Monad m => Int -> Stream m Int
81+sourceFromList n = S.fromList [n..n+value]
82+
83+{-# INLINE source #-}
84+source :: Monad m => Int -> Stream m Int
85+source = sourceUnfoldrM
86+
87+-------------------------------------------------------------------------------
88+-- Elimination
89+-------------------------------------------------------------------------------
90+
91+{-# INLINE runStream #-}
92+runStream :: Monad m => Stream m a -> m ()
93+runStream = S.drain
94+
95+{-# INLINE mapM_ #-}
96+mapM_ :: Monad m => Stream m a -> m ()
97+mapM_ = S.mapM_ (\_ -> return ())
98+
99+{-# INLINE toNull #-}
100+toNull :: Monad m => Stream m Int -> m ()
101+toNull = runStream
102+
103+{-# INLINE uncons #-}
104+{-# INLINE nullTail #-}
105+{-# INLINE headTail #-}
106+uncons, nullTail, headTail
107+ :: Monad m
108+ => Stream m Int -> m ()
109+
110+uncons s = do
111+ r <- S.uncons s
112+ case r of
113+ Nothing -> return ()
114+ Just (_, t) -> uncons t
115+
116+{-# INLINE tail #-}
117+tail :: Monad m => Stream m a -> m ()
118+tail s = S.tail s >>= P.mapM_ tail
119+
120+nullTail s = do
121+ r <- S.null s
122+ when (not r) $ S.tail s >>= P.mapM_ nullTail
123+
124+headTail s = do
125+ h <- S.head s
126+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
127+
128+{-# INLINE toList #-}
129+toList :: Monad m => Stream m Int -> m [Int]
130+toList = S.toList
131+
132+{-# INLINE foldl #-}
133+foldl :: Monad m => Stream m Int -> m Int
134+foldl = S.foldl' (+) 0
135+
136+{-# INLINE last #-}
137+last :: Monad m => Stream m Int -> m (Maybe Int)
138+last = S.last
139+
140+-------------------------------------------------------------------------------
141+-- Transformation
142+-------------------------------------------------------------------------------
143+
144+{-# INLINE transform #-}
145+transform :: Monad m => Stream m a -> m ()
146+transform = runStream
147+
148+{-# INLINE composeN #-}
149+composeN
150+ :: Monad m
151+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
152+composeN n f =
153+ case n of
154+ 1 -> transform . f
155+ 2 -> transform . f . f
156+ 3 -> transform . f . f . f
157+ 4 -> transform . f . f . f . f
158+ _ -> undefined
159+
160+{-# INLINE scan #-}
161+{-# INLINE map #-}
162+{-# INLINE fmap #-}
163+{-# INLINE mapM #-}
164+{-# INLINE mapMaybe #-}
165+{-# INLINE mapMaybeM #-}
166+{-# INLINE filterEven #-}
167+{-# INLINE filterAllOut #-}
168+{-# INLINE filterAllIn #-}
169+{-# INLINE takeOne #-}
170+{-# INLINE takeAll #-}
171+{-# INLINE takeWhileTrue #-}
172+{-# INLINE takeWhileMTrue #-}
173+{-# INLINE dropOne #-}
174+{-# INLINE dropAll #-}
175+{-# INLINE dropWhileTrue #-}
176+{-# INLINE dropWhileMTrue #-}
177+{-# INLINE dropWhileFalse #-}
178+{-# INLINE foldrS #-}
179+{-# INLINE foldlS #-}
180+{-# INLINE concatMap #-}
181+{-# INLINE intersperse #-}
182+scan, map, fmap, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,
183+ filterAllIn, takeOne, takeAll, takeWhileTrue, takeWhileMTrue, dropOne,
184+ dropAll, dropWhileTrue, dropWhileMTrue, dropWhileFalse, foldrS, foldlS,
185+ concatMap, intersperse
186+ :: Monad m
187+ => Int -> Stream m Int -> m ()
188+
189+scan n = composeN n $ S.scanl' (+) 0
190+fmap n = composeN n $ Prelude.fmap (+1)
191+map n = composeN n $ S.map (+1)
192+mapM n = composeN n $ S.mapM return
193+mapMaybe n = composeN n $ S.mapMaybe
194+ (\x -> if Prelude.odd x then Nothing else Just x)
195+mapMaybeM n = composeN n $ S.mapMaybeM
196+ (\x -> if Prelude.odd x then return Nothing else return $ Just x)
197+filterEven n = composeN n $ S.filter even
198+filterAllOut n = composeN n $ S.filter (> maxValue)
199+filterAllIn n = composeN n $ S.filter (<= maxValue)
200+takeOne n = composeN n $ S.take 1
201+takeAll n = composeN n $ S.take maxValue
202+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
203+takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
204+dropOne n = composeN n $ S.drop 1
205+dropAll n = composeN n $ S.drop maxValue
206+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
207+dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
208+dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
209+foldrS n = composeN n $ S.foldrS S.cons S.nil
210+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
211+concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
212+intersperse n = composeN n $ S.intersperse maxValue
213+
214+-------------------------------------------------------------------------------
215+-- Iteration
216+-------------------------------------------------------------------------------
217+
218+iterStreamLen, maxIters :: Int
219+iterStreamLen = 10
220+maxIters = 10000
221+
222+{-# INLINE iterateSource #-}
223+iterateSource
224+ :: Monad m
225+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
226+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
227+ where
228+ f (0 :: Int) m = g m
229+ f x m = g (f (x P.- 1) m)
230+
231+{-# INLINE iterateMapM #-}
232+{-# INLINE iterateScan #-}
233+{-# INLINE iterateFilterEven #-}
234+{-# INLINE iterateTakeAll #-}
235+{-# INLINE iterateDropOne #-}
236+{-# INLINE iterateDropWhileFalse #-}
237+{-# INLINE iterateDropWhileTrue #-}
238+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
239+ iterateDropWhileFalse, iterateDropWhileTrue
240+ :: Monad m
241+ => Int -> Stream m Int
242+
243+-- this is quadratic
244+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
245+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
246+ (maxIters `div` 10)
247+
248+iterateMapM = iterateSource (S.mapM return) maxIters
249+iterateFilterEven = iterateSource (S.filter even) maxIters
250+iterateTakeAll = iterateSource (S.take maxValue) maxIters
251+iterateDropOne = iterateSource (S.drop 1) maxIters
252+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
253+
254+{-# INLINE iterateM #-}
255+iterateM :: Monad m => Int -> Stream m Int
256+iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))
257+
258+-------------------------------------------------------------------------------
259+-- Zipping and concat
260+-------------------------------------------------------------------------------
261+
262+{-# INLINE eqBy #-}
263+eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
264+eqBy src = S.eqBy (==) src src
265+
266+{-# INLINE cmpBy #-}
267+cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
268+cmpBy src = S.cmpBy P.compare src src
269+
270+{-# INLINE zip #-}
271+zip :: Monad m => Stream m Int -> m ()
272+zip src = transform $ S.zipWith (,) src src
273+
274+{-# INLINE concatMapRepl4xN #-}
275+concatMapRepl4xN :: Monad m => Stream m Int -> m ()
276+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
277+
278+{-# INLINE concatMapURepl4xN #-}
279+concatMapURepl4xN :: Monad m => Stream m Int -> m ()
280+concatMapURepl4xN src = transform $ S.concatMapU (UF.replicateM 4) src
281+
282+-------------------------------------------------------------------------------
283+-- Mixed Composition
284+-------------------------------------------------------------------------------
285+
286+{-# INLINE scanMap #-}
287+{-# INLINE dropMap #-}
288+{-# INLINE dropScan #-}
289+{-# INLINE takeDrop #-}
290+{-# INLINE takeScan #-}
291+{-# INLINE takeMap #-}
292+{-# INLINE filterDrop #-}
293+{-# INLINE filterTake #-}
294+{-# INLINE filterScan #-}
295+{-# INLINE filterMap #-}
296+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
297+ filterTake, filterScan, filterMap
298+ :: Monad m => Int -> Stream m Int -> m ()
299+
300+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
301+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
302+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
303+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
304+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
305+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
306+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
307+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
308+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
309+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
310+
311+-------------------------------------------------------------------------------
312+-- Nested Composition
313+-------------------------------------------------------------------------------
314+
315+{-# INLINE toNullApNested #-}
316+toNullApNested :: Monad m => Stream m Int -> m ()
317+toNullApNested s = runStream $ do
318+ (+) <$> s <*> s
319+
320+{-# INLINE toNullNested #-}
321+toNullNested :: Monad m => Stream m Int -> m ()
322+toNullNested s = runStream $ do
323+ x <- s
324+ y <- s
325+ return $ x + y
326+
327+{-# INLINE toNullNested3 #-}
328+toNullNested3 :: Monad m => Stream m Int -> m ()
329+toNullNested3 s = runStream $ do
330+ x <- s
331+ y <- s
332+ z <- s
333+ return $ x + y + z
334+
335+{-# INLINE filterAllOutNested #-}
336+filterAllOutNested
337+ :: Monad m
338+ => Stream m Int -> m ()
339+filterAllOutNested str = runStream $ do
340+ x <- str
341+ y <- str
342+ let s = x + y
343+ if s < 0
344+ then return s
345+ else S.nil
346+
347+{-# INLINE filterAllInNested #-}
348+filterAllInNested
349+ :: Monad m
350+ => Stream m Int -> m ()
351+filterAllInNested str = runStream $ do
352+ x <- str
353+ y <- str
354+ let s = x + y
355+ if s > 0
356+ then return s
357+ else S.nil
benchmark/StreamKOps.hsnew file+410
@@ -0,0 +1,410 @@
1+-- |
2+-- Module : StreamKOps
3+-- Copyright : (c) 2018 Harendra Kumar
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+
11+module StreamKOps where
12+
13+import Control.Monad (when)
14+import Data.Maybe (isJust)
15+import Prelude
16+ (Monad, Int, (+), ($), (.), return, even, (>), (<=), div,
17+ subtract, undefined, Maybe(..), not, (>>=),
18+ maxBound, flip, (<$>), (<*>), round, (/), (**), (<))
19+import qualified Prelude as P
20+import qualified Data.List as List
21+
22+import qualified Streamly.Internal.Data.Stream.StreamK as S
23+import qualified Streamly.Internal.Data.Stream.Prelude as SP
24+import qualified Streamly.Internal.Data.SVar as S
25+
26+value, value2, value3, value16, maxValue :: Int
27+value = 100000
28+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
29+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
30+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
31+maxValue = value
32+
33+-------------------------------------------------------------------------------
34+-- Benchmark ops
35+-------------------------------------------------------------------------------
36+
37+{-# INLINE toNull #-}
38+{-# INLINE uncons #-}
39+{-# INLINE nullTail #-}
40+{-# INLINE headTail #-}
41+{-# INLINE zip #-}
42+toNull, uncons, nullTail, headTail, zip
43+ :: Monad m
44+ => Stream m Int -> m ()
45+
46+{-# INLINE toList #-}
47+toList :: Monad m => Stream m Int -> m [Int]
48+{-# INLINE foldl #-}
49+foldl :: Monad m => Stream m Int -> m Int
50+{-# INLINE last #-}
51+last :: Monad m => Stream m Int -> m (Maybe Int)
52+
53+-------------------------------------------------------------------------------
54+-- Stream generation and elimination
55+-------------------------------------------------------------------------------
56+
57+type Stream m a = S.Stream m a
58+
59+{-# INLINE sourceUnfoldr #-}
60+sourceUnfoldr :: Int -> Stream m Int
61+sourceUnfoldr n = S.unfoldr step n
62+ where
63+ step cnt =
64+ if cnt > n + value
65+ then Nothing
66+ else Just (cnt, cnt + 1)
67+
68+{-# INLINE sourceUnfoldrN #-}
69+sourceUnfoldrN :: Int -> Int -> Stream m Int
70+sourceUnfoldrN m n = S.unfoldr step n
71+ where
72+ step cnt =
73+ if cnt > n + m
74+ then Nothing
75+ else Just (cnt, cnt + 1)
76+
77+{-# INLINE sourceUnfoldrM #-}
78+sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
79+sourceUnfoldrM n = S.unfoldrM step n
80+ where
81+ step cnt =
82+ if cnt > n + value
83+ then return Nothing
84+ else return (Just (cnt, cnt + 1))
85+
86+{-# INLINE sourceUnfoldrMN #-}
87+sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
88+sourceUnfoldrMN m n = S.unfoldrM step n
89+ where
90+ step cnt =
91+ if cnt > n + m
92+ then return Nothing
93+ else return (Just (cnt, cnt + 1))
94+
95+{-
96+{-# INLINE sourceFromEnum #-}
97+sourceFromEnum :: Monad m => Int -> Stream m Int
98+sourceFromEnum n = S.enumFromStepN n 1 value
99+-}
100+
101+{-# INLINE sourceFromFoldable #-}
102+sourceFromFoldable :: Int -> Stream m Int
103+sourceFromFoldable n = S.fromFoldable [n..n+value]
104+
105+{-
106+{-# INLINE sourceFromFoldableM #-}
107+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
108+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
109+-}
110+
111+{-# INLINE sourceFoldMapWith #-}
112+sourceFoldMapWith :: Int -> Stream m Int
113+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
114+
115+{-# INLINE sourceFoldMapWithM #-}
116+sourceFoldMapWithM :: Monad m => Int -> Stream m Int
117+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
118+
119+{-# INLINE source #-}
120+source :: S.MonadAsync m => Int -> Stream m Int
121+source = sourceUnfoldrM
122+
123+-------------------------------------------------------------------------------
124+-- Elimination
125+-------------------------------------------------------------------------------
126+
127+{-# INLINE runStream #-}
128+runStream :: Monad m => Stream m a -> m ()
129+runStream = S.drain
130+-- runStream = S.mapM_ (\_ -> return ())
131+
132+{-# INLINE mapM_ #-}
133+mapM_ :: Monad m => Stream m a -> m ()
134+mapM_ = S.mapM_ (\_ -> return ())
135+
136+toNull = runStream
137+uncons s = do
138+ r <- S.uncons s
139+ case r of
140+ Nothing -> return ()
141+ Just (_, t) -> uncons t
142+
143+{-# INLINE init #-}
144+init :: (Monad m, S.IsStream t) => t m a -> m ()
145+init s = do
146+ t <- S.init s
147+ P.mapM_ S.drain t
148+
149+{-# INLINE tail #-}
150+tail :: (Monad m, S.IsStream t) => t m a -> m ()
151+tail s = S.tail s >>= P.mapM_ tail
152+
153+nullTail s = do
154+ r <- S.null s
155+ when (not r) $ S.tail s >>= P.mapM_ nullTail
156+
157+headTail s = do
158+ h <- S.head s
159+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
160+
161+toList = S.toList
162+foldl = S.foldl' (+) 0
163+last = S.last
164+
165+-------------------------------------------------------------------------------
166+-- Transformation
167+-------------------------------------------------------------------------------
168+
169+{-# INLINE transform #-}
170+transform :: Monad m => Stream m a -> m ()
171+transform = runStream
172+
173+{-# INLINE composeN #-}
174+composeN
175+ :: Monad m
176+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
177+composeN n f =
178+ case n of
179+ 1 -> transform . f
180+ 2 -> transform . f . f
181+ 3 -> transform . f . f . f
182+ 4 -> transform . f . f . f . f
183+ _ -> undefined
184+
185+{-# INLINE scan #-}
186+{-# INLINE map #-}
187+{-# INLINE fmap #-}
188+{-# INLINE filterEven #-}
189+{-# INLINE filterAllOut #-}
190+{-# INLINE filterAllIn #-}
191+{-# INLINE takeOne #-}
192+{-# INLINE takeAll #-}
193+{-# INLINE takeWhileTrue #-}
194+{-# INLINE dropOne #-}
195+{-# INLINE dropAll #-}
196+{-# INLINE dropWhileTrue #-}
197+{-# INLINE dropWhileFalse #-}
198+{-# INLINE foldlS #-}
199+{-# INLINE concatMap #-}
200+scan, map, fmap, filterEven, filterAllOut,
201+ filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
202+ dropWhileTrue, dropWhileFalse, foldlS, concatMap
203+ :: Monad m
204+ => Int -> Stream m Int -> m ()
205+
206+{-# INLINE mapM #-}
207+{-# INLINE mapMSerial #-}
208+{-# INLINE intersperse #-}
209+mapM, mapMSerial, intersperse
210+ :: S.MonadAsync m => Int -> Stream m Int -> m ()
211+
212+scan n = composeN n $ S.scanl' (+) 0
213+map n = composeN n $ P.fmap (+1)
214+fmap n = composeN n $ P.fmap (+1)
215+mapM n = composeN n $ S.mapM return
216+mapMSerial n = composeN n $ S.mapMSerial return
217+filterEven n = composeN n $ S.filter even
218+filterAllOut n = composeN n $ S.filter (> maxValue)
219+filterAllIn n = composeN n $ S.filter (<= maxValue)
220+takeOne n = composeN n $ S.take 1
221+takeAll n = composeN n $ S.take maxValue
222+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
223+dropOne n = composeN n $ S.drop 1
224+dropAll n = composeN n $ S.drop maxValue
225+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
226+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
227+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
228+-- We use a (sqrt n) element stream as source and then concat the same stream
229+-- for each element to produce an n element stream.
230+concatMap n = composeN n $ (\s -> S.concatMap (\_ -> s) s)
231+intersperse n = composeN n $ S.intersperse maxValue
232+
233+-------------------------------------------------------------------------------
234+-- Iteration
235+-------------------------------------------------------------------------------
236+
237+iterStreamLen, maxIters :: Int
238+iterStreamLen = 10
239+maxIters = 10000
240+
241+{-# INLINE iterateSource #-}
242+iterateSource
243+ :: S.MonadAsync m
244+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
245+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
246+ where
247+ f (0 :: Int) m = g m
248+ f x m = g (f (x P.- 1) m)
249+
250+{-# INLINE iterateMapM #-}
251+{-# INLINE iterateScan #-}
252+{-# INLINE iterateFilterEven #-}
253+{-# INLINE iterateTakeAll #-}
254+{-# INLINE iterateDropOne #-}
255+{-# INLINE iterateDropWhileFalse #-}
256+{-# INLINE iterateDropWhileTrue #-}
257+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
258+ iterateDropWhileFalse, iterateDropWhileTrue
259+ :: S.MonadAsync m
260+ => Int -> Stream m Int
261+
262+-- this is quadratic
263+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
264+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
265+ (maxIters `div` 10)
266+
267+iterateMapM = iterateSource (S.mapM return) maxIters
268+iterateFilterEven = iterateSource (S.filter even) maxIters
269+iterateTakeAll = iterateSource (S.take maxValue) maxIters
270+iterateDropOne = iterateSource (S.drop 1) maxIters
271+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
272+
273+-------------------------------------------------------------------------------
274+-- Zipping and concat
275+-------------------------------------------------------------------------------
276+
277+zip src = transform $ S.zipWith (,) src src
278+
279+{-# INLINE concatMapRepl4xN #-}
280+concatMapRepl4xN :: Monad m => Stream m Int -> m ()
281+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)
282+
283+-------------------------------------------------------------------------------
284+-- Mixed Composition
285+-------------------------------------------------------------------------------
286+
287+{-# INLINE scanMap #-}
288+{-# INLINE dropMap #-}
289+{-# INLINE dropScan #-}
290+{-# INLINE takeDrop #-}
291+{-# INLINE takeScan #-}
292+{-# INLINE takeMap #-}
293+{-# INLINE filterDrop #-}
294+{-# INLINE filterTake #-}
295+{-# INLINE filterScan #-}
296+{-# INLINE filterMap #-}
297+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
298+ filterTake, filterScan, filterMap
299+ :: Monad m => Int -> Stream m Int -> m ()
300+
301+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
302+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
303+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
304+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
305+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
306+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
307+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
308+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
309+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
310+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
311+
312+-------------------------------------------------------------------------------
313+-- Nested Composition
314+-------------------------------------------------------------------------------
315+
316+{-# INLINE toNullApNested #-}
317+toNullApNested :: Monad m => Stream m Int -> m ()
318+toNullApNested s = runStream $ do
319+ (+) <$> s <*> s
320+
321+{-# INLINE toNullNested #-}
322+toNullNested :: Monad m => Stream m Int -> m ()
323+toNullNested s = runStream $ do
324+ x <- s
325+ y <- s
326+ return $ x + y
327+
328+{-# INLINE toNullNested3 #-}
329+toNullNested3 :: Monad m => Stream m Int -> m ()
330+toNullNested3 s = runStream $ do
331+ x <- s
332+ y <- s
333+ z <- s
334+ return $ x + y + z
335+
336+{-# INLINE filterAllOutNested #-}
337+filterAllOutNested
338+ :: Monad m
339+ => Stream m Int -> m ()
340+filterAllOutNested str = runStream $ do
341+ x <- str
342+ y <- str
343+ let s = x + y
344+ if s < 0
345+ then return s
346+ else S.nil
347+
348+{-# INLINE filterAllInNested #-}
349+filterAllInNested
350+ :: Monad m
351+ => Stream m Int -> m ()
352+filterAllInNested str = runStream $ do
353+ x <- str
354+ y <- str
355+ let s = x + y
356+ if s > 0
357+ then return s
358+ else S.nil
359+
360+-------------------------------------------------------------------------------
361+-- Nested Composition Pure lists
362+-------------------------------------------------------------------------------
363+
364+{-# INLINE sourceUnfoldrList #-}
365+sourceUnfoldrList :: Int -> Int -> [Int]
366+sourceUnfoldrList maxval n = List.unfoldr step n
367+ where
368+ step cnt =
369+ if cnt > n + maxval
370+ then Nothing
371+ else Just (cnt, cnt + 1)
372+
373+{-# INLINE toNullApNestedList #-}
374+toNullApNestedList :: [Int] -> [Int]
375+toNullApNestedList s = (+) <$> s <*> s
376+
377+{-# INLINE toNullNestedList #-}
378+toNullNestedList :: [Int] -> [Int]
379+toNullNestedList s = do
380+ x <- s
381+ y <- s
382+ return $ x + y
383+
384+{-# INLINE toNullNestedList3 #-}
385+toNullNestedList3 :: [Int] -> [Int]
386+toNullNestedList3 s = do
387+ x <- s
388+ y <- s
389+ z <- s
390+ return $ x + y + z
391+
392+{-# INLINE filterAllOutNestedList #-}
393+filterAllOutNestedList :: [Int] -> [Int]
394+filterAllOutNestedList str = do
395+ x <- str
396+ y <- str
397+ let s = x + y
398+ if s < 0
399+ then return s
400+ else []
401+
402+{-# INLINE filterAllInNestedList #-}
403+filterAllInNestedList :: [Int] -> [Int]
404+filterAllInNestedList str = do
405+ x <- str
406+ y <- str
407+ let s = x + y
408+ if s > 0
409+ then return s
410+ else []
benchmark/Streamly/Benchmark/Data/Array.hs+71−115
@@ -1,140 +1,96 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
39
410{-# LANGUAGE CPP #-}
511
6−#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
12+module Main (main) where
713
8−import Control.DeepSeq (deepseq)
14+import Control.DeepSeq (NFData(..), deepseq)
15+import System.Random (randomRIO)
916
10−import qualified Streamly.Internal.Data.Array as IA
11−import qualified GHC.Exts as GHC
12−
13−-- import qualified Streamly.Data.Array as A
17+import qualified Streamly.Benchmark.Data.ArrayOps as Ops
1418import qualified Streamly.Internal.Data.Array as A
19+import qualified Streamly.Prelude as S
1520
16−type Stream = A.Array
17−
18−#include "Streamly/Benchmark/Data/Array/Common.hs"
19−
20−instance NFData (A.Array a) where
21− {-# INLINE rnf #-}
22− rnf _ = ()
21+import Gauge
2322
2423-------------------------------------------------------------------------------
25−-- Benchmark helpers
24+--
2625-------------------------------------------------------------------------------
2726
28−-- Drain a source that generates a pure array
29−{-# INLINE benchPureSrc #-}
30−benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
31−benchPureSrc name src = benchPure name src id
27+{-# INLINE benchIO #-}
28+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
29+benchIO name src f = bench name $ nfIO $
30+ randomRIO (1,1) >>= src >>= return . f
3231
3332-- Drain a source that generates an array in the IO monad
3433{-# INLINE benchIOSrc #-}
35−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
34+benchIOSrc :: (NFData a)
35+ => String -> (Int -> IO (Ops.Stream a)) -> Benchmark
3636benchIOSrc name src = benchIO name src id
3737
38−-------------------------------------------------------------------------------
39−-- Bench Ops
40−-------------------------------------------------------------------------------
41−
42−{-# INLINE sourceIntFromToFromList #-}
43−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
44−sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
45−
46−{-# INLINE readInstance #-}
47−readInstance :: P.String -> Stream Int
48−readInstance str =
49− let r = P.reads str
50− in case r of
51− [(x,"")] -> x
52− _ -> P.error "readInstance: no parse"
38+{-# INLINE benchPureSink #-}
39+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark
40+benchPureSink name f = benchIO name Ops.sourceIntFromTo f
5341
54−#ifdef DEVBUILD
55−{-
56−{-# INLINE foldableFoldl' #-}
57−foldableFoldl' :: Stream Int -> Int
58−foldableFoldl' = F.foldl' (+) 0
59−
60−{-# INLINE foldableSum #-}
61−foldableSum :: Stream Int -> Int
62−foldableSum = P.sum
63−-}
64−#endif
65−
66−{-# INLINE sourceIsList #-}
67−sourceIsList :: Int -> Int -> Stream Int
68−sourceIsList value n = GHC.fromList [n..n+value]
42+{-# INLINE benchIO' #-}
43+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
44+benchIO' name src f = bench name $ nfIO $
45+ randomRIO (1,1) >>= src >>= f
6946
70−{-# INLINE sourceIsString #-}
71−sourceIsString :: Int -> Int -> Stream P.Char
72−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
73−
74−{-# INLINE sourceIntFromToFromStream #-}
75−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
76−sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
77−
78−-------------------------------------------------------------------------------
79−-- Bench groups
80−-------------------------------------------------------------------------------
47+{-# INLINE benchIOSink #-}
48+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark
49+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f
8150
82−o_1_space_generation :: Int -> [Benchmark]
83−o_1_space_generation value =
84− [ bgroup
85− "generation"
86− [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
87− , let testStr = "fromList " ++ mkListString value
88− in testStr `deepseq` bench "read" (nf readInstance testStr)
89− , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)
90− , benchPureSrc
91− "writeN . IsString.fromString"
92− (sourceIsString value)
51+mkString :: String
52+mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"
9353
54+main :: IO ()
55+main =
56+ defaultMain
57+ [ bgroup "Data.Array"
58+ [ bgroup "generation"
59+ [ benchIOSrc "writeN . intFromTo" Ops.sourceIntFromTo
60+ , benchIOSrc "write . intFromTo" Ops.sourceIntFromToFromStream
61+ , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList
62+ , benchIOSrc "writeN . unfoldr" Ops.sourceUnfoldr
63+ , benchIOSrc "writeN . fromList" Ops.sourceFromList
64+ -- , benchPureSrc "writeN . IsList.fromList" Ops.sourceIsList
65+ -- , benchPureSrc "writeN . IsString.fromString" Ops.sourceIsString
66+ , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)
67+ , benchPureSink "show" Ops.showInstance
9468 ]
95− ]
96−
97−o_1_space_elimination :: Int -> [Benchmark]
98−o_1_space_elimination value =
99− [ bgroup "elimination"
100− [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
101− , benchFold "writeLastN.1"
102− (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
103− , benchFold "writeLastN.10"
104− (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
69+ , bgroup "elimination"
70+ [ benchPureSink "id" id
71+ , benchPureSink "==" Ops.eqInstance
72+ , benchPureSink "/=" Ops.eqInstanceNotEq
73+ , benchPureSink "<" Ops.ordInstance
74+ , benchPureSink "min" Ops.ordInstanceMin
75+ -- length is used to check for foldr/build fusion
76+ -- , benchPureSink "length . IsList.toList" (length . GHC.toList)
77+ , benchIOSink "foldl'" Ops.pureFoldl'
78+ , benchIOSink "read" (S.drain . S.unfold A.read)
79+ , benchIOSink "toStreamRev" (S.drain . A.toStreamRev)
10580#ifdef DEVBUILD
106−{-
107− benchPureSink value "foldable/foldl'" foldableFoldl'
108− , benchPureSink value "foldable/sum" foldableSum
109−-}
81+ , benchPureSink "foldable/foldl'" Ops.foldableFoldl'
82+ , benchPureSink "foldable/sum" Ops.foldableSum
11083#endif
11184 ]
112− ]
113−
114−o_n_heap_serial :: Int -> [Benchmark]
115−o_n_heap_serial value =
116− [ bgroup "elimination"
117− [
118− -- Converting the stream to an array
119− benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
120− (P.sourceUnfoldrM value)
121− ]
85+ , bgroup "transformation"
86+ [ benchIOSink "scanl'" (Ops.scanl' 1)
87+ , benchIOSink "scanl1'" (Ops.scanl1' 1)
88+ , benchIOSink "map" (Ops.map 1)
89+ ]
90+ , bgroup "transformationX4"
91+ [ benchIOSink "scanl'" (Ops.scanl' 4)
92+ , benchIOSink "scanl1'" (Ops.scanl1' 4)
93+ , benchIOSink "map" (Ops.map 4)
94+ ]
95+ ]
12296 ]
123−
124−moduleName :: String
125−moduleName = "Data.Array"
126−
127−defStreamSize :: Int
128−defStreamSize = defaultStreamSize
129−
130−main :: IO ()
131−main = runWithCLIOpts defStreamSize allBenchmarks
132−
133− where
134−
135− allBenchmarks size =
136− [ bgroup (o_1_space_prefix moduleName) $
137− o_1_space_generation size ++ o_1_space_elimination size
138− , bgroup (o_n_space_prefix moduleName) $
139− o_n_heap_serial size
140− ] ++ commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/Common.hsdeleted−185
@@ -1,185 +0,0 @@
1−-------------------------------------------------------------------------------
2−-- Benchmark helpers
3−-------------------------------------------------------------------------------
4−
5−{-# INLINE benchIO #-}
6−benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
7−benchIO name src f = bench name $ nfIO $
8− (randomRIO (1,1) >>= src) <&> f
9−
10−{-# INLINE benchPureSink #-}
11−benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
12−benchPureSink value name = benchIO name (sourceIntFromTo value)
13−
14−{-# INLINE benchIO' #-}
15−benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
16−benchIO' name src f = bench name $ nfIO $
17− randomRIO (1,1) >>= src >>= f
18−
19−{-# INLINE benchIOSink #-}
20−benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
21−benchIOSink value name = benchIO' name (sourceIntFromTo value)
22−
23−-------------------------------------------------------------------------------
24−-- Bench Ops
25−-------------------------------------------------------------------------------
26−
27−{-# INLINE sourceUnfoldr #-}
28−sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
29−sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n
30− where
31− step cnt =
32− if cnt > n + value
33− then Nothing
34− else Just (cnt, cnt + 1)
35−
36−{-# INLINE sourceIntFromTo #-}
37−sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
38−sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
39−
40−{-# INLINE sourceFromList #-}
41−sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
42−sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]
43−
44−-------------------------------------------------------------------------------
45−-- Transformation
46−-------------------------------------------------------------------------------
47−
48−{-# INLINE composeN #-}
49−composeN :: P.Monad m
50− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
51−composeN n f x =
52− case n of
53− 1 -> f x
54− 2 -> f x P.>>= f
55− 3 -> f x P.>>= f P.>>= f
56− 4 -> f x P.>>= f P.>>= f P.>>= f
57− _ -> undefined
58−
59−{-# INLINE scanl' #-}
60−{-# INLINE scanl1' #-}
61−{-# INLINE map #-}
62−
63−scanl' , scanl1', map
64− :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
65−
66−
67−{-# INLINE onArray #-}
68−onArray
69− :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
70− -> Stream Int
71− -> m (Stream Int)
72−onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.reader arr
73−
74−scanl' value n = composeN n $ onArray value $ S.scan (Fold.foldl' (+) 0)
75−scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
76−map value n = composeN n $ onArray value $ fmap (+1)
77−-- map n = composeN n $ A.map (+1)
78−
79−{-# INLINE eqInstance #-}
80−eqInstance :: Stream Int -> Bool
81−eqInstance src = src == src
82−
83−{-# INLINE eqInstanceNotEq #-}
84−eqInstanceNotEq :: Stream Int -> Bool
85−eqInstanceNotEq src = src P./= src
86−
87−{-# INLINE ordInstance #-}
88−ordInstance :: Stream Int -> Bool
89−ordInstance src = src P.< src
90−
91−{-# INLINE ordInstanceMin #-}
92−ordInstanceMin :: Stream Int -> Stream Int
93−ordInstanceMin src = P.min src src
94−
95−{-# INLINE showInstance #-}
96−showInstance :: Stream Int -> P.String
97−showInstance = P.show
98−
99−{-# INLINE pureFoldl' #-}
100−pureFoldl' :: MonadIO m => Stream Int -> m Int
101−pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader
102−
103−-------------------------------------------------------------------------------
104−-- Elimination
105−-------------------------------------------------------------------------------
106−
107−{-# INLINE unfoldReadDrain #-}
108−unfoldReadDrain :: MonadIO m => Stream Int -> m ()
109−unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader
110−
111−{-# INLINE toStreamRevDrain #-}
112−toStreamRevDrain :: MonadIO m => Stream Int -> m ()
113−toStreamRevDrain = S.fold Fold.drain . A.readRev
114−
115−-------------------------------------------------------------------------------
116−-- Bench groups
117−-------------------------------------------------------------------------------
118−
119−common_o_1_space_generation :: Int -> [Benchmark]
120−common_o_1_space_generation value =
121− [ bgroup
122− "generation"
123− [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
124− , benchIOSrc
125− "fromList . intFromTo"
126− (sourceIntFromToFromList value)
127− , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
128− , benchIOSrc "writeN . fromList" (sourceFromList value)
129− , benchPureSink value "show" showInstance
130− ]
131− ]
132−
133−common_o_1_space_elimination :: Int -> [Benchmark]
134−common_o_1_space_elimination value =
135− [ bgroup "elimination"
136− [ benchPureSink value "id" id
137− , benchPureSink value "==" eqInstance
138− , benchPureSink value "/=" eqInstanceNotEq
139− , benchPureSink value "<" ordInstance
140− , benchPureSink value "min" ordInstanceMin
141− , benchIOSink value "foldl'" pureFoldl'
142− , benchIOSink value "read" unfoldReadDrain
143− , benchIOSink value "toStreamRev" toStreamRevDrain
144− ]
145− ]
146−
147−common_o_n_heap_serial :: Int -> [Benchmark]
148−common_o_n_heap_serial value =
149− [ bgroup "elimination"
150− [
151− -- Converting the stream to an array
152− benchFold "writeN" (S.fold (A.writeN value))
153− (P.sourceUnfoldrM value)
154− ]
155− ]
156−
157−common_o_1_space_transformation :: Int -> [Benchmark]
158−common_o_1_space_transformation value =
159− [ bgroup "transformation"
160− [ benchIOSink value "scanl'" (scanl' value 1)
161− , benchIOSink value "scanl1'" (scanl1' value 1)
162− , benchIOSink value "map" (map value 1)
163− ]
164− ]
165−
166−common_o_1_space_transformationX4 :: Int -> [Benchmark]
167−common_o_1_space_transformationX4 value =
168− [ bgroup "transformationX4"
169− [ benchIOSink value "scanl'" (scanl' value 4)
170− , benchIOSink value "scanl1'" (scanl1' value 4)
171− , benchIOSink value "map" (map value 4)
172− ]
173− ]
174−
175−commonBenchmarks :: Int -> [Benchmark]
176−commonBenchmarks size =
177− [ bgroup (o_1_space_prefix moduleName) $ concat
178− [ common_o_1_space_generation size
179− , common_o_1_space_elimination size
180− , common_o_1_space_transformation size
181− , common_o_1_space_transformationX4 size
182− ]
183− , bgroup (o_n_space_prefix moduleName) $
184− common_o_n_heap_serial size
185− ]
benchmark/Streamly/Benchmark/Data/Array/CommonImports.hsdeleted−16
@@ -1,16 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−
3−import Control.DeepSeq (NFData(..))
4−import Control.Monad.IO.Class (MonadIO)
5−import Data.Functor ((<&>))
6−import System.Random (randomRIO)
7−
8−import qualified Streamly.Data.Fold as Fold
9−import qualified Streamly.Data.Stream as S
10−import qualified Streamly.Internal.Data.Stream as Stream
11−
12−import Test.Tasty.Bench
13−import Streamly.Benchmark.Common hiding (benchPureSrc)
14−import qualified Stream.Common as P
15−
16−import Prelude as P hiding (map)
benchmark/Streamly/Benchmark/Data/Array/Generic.hsdeleted−119
@@ -1,119 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4−{-# LANGUAGE CPP #-}
5−
6−#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
7−
8−import Control.DeepSeq (deepseq)
9−
10−import qualified Streamly.Internal.Data.Array.Generic as IA
11−import qualified Streamly.Internal.Data.Array.Generic as A
12−
13−type Stream = A.Array
14−
15−#include "Streamly/Benchmark/Data/Array/Common.hs"
16−
17−instance NFData a => NFData (A.Array a) where
18− {-# INLINE rnf #-}
19− rnf = A.foldl' (\_ x -> rnf x) ()
20−
21−-------------------------------------------------------------------------------
22−-- Benchmark helpers
23−-------------------------------------------------------------------------------
24−
25−-- Drain a source that generates an array in the IO monad
26−{-# INLINE benchIOSrc #-}
27−benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark
28−benchIOSrc name src = benchIO name src id
29−
30−-------------------------------------------------------------------------------
31−-- Bench Ops
32−-------------------------------------------------------------------------------
33−
34−{-# INLINE sourceIntFromToFromList #-}
35−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
36−sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
37−
38−{-# INLINE readInstance #-}
39−readInstance :: P.String -> Stream Int
40−readInstance str =
41− let r = P.reads str
42− in case r of
43− [(x,"")] -> x
44− _ -> P.error "readInstance: no parse"
45−
46−#ifdef DEVBUILD
47−{-
48−{-# INLINE foldableFoldl' #-}
49−foldableFoldl' :: Stream Int -> Int
50−foldableFoldl' = F.foldl' (+) 0
51−
52−{-# INLINE foldableSum #-}
53−foldableSum :: Stream Int -> Int
54−foldableSum = P.sum
55−-}
56−#endif
57−
58−{-# INLINE sourceIntFromToFromStream #-}
59−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
60−sourceIntFromToFromStream value n =
61− S.fold A.write $ S.enumerateFromTo n (n + value)
62−
63−-------------------------------------------------------------------------------
64−-- Bench groups
65−-------------------------------------------------------------------------------
66−
67−o_1_space_generation :: Int -> [Benchmark]
68−o_1_space_generation value =
69− [ bgroup
70− "generation"
71− [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
72− , let testStr = "fromList " ++ mkListString value
73− in testStr `deepseq` bench "read" (nf readInstance testStr)
74− ]
75− ]
76−
77−o_1_space_elimination :: Int -> [Benchmark]
78−o_1_space_elimination value =
79− [ bgroup "elimination"
80− [ benchFold "writeLastN.1"
81− (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
82− , benchFold "writeLastN.10"
83− (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
84−#ifdef DEVBUILD
85−{-
86− benchPureSink value "foldable/foldl'" foldableFoldl'
87− , benchPureSink value "foldable/sum" foldableSum
88−-}
89−#endif
90− ]
91− ]
92−
93−o_n_heap_serial :: Int -> [Benchmark]
94−o_n_heap_serial value =
95− [ bgroup "elimination"
96− [
97− -- Converting the stream to an array
98− benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
99− (P.sourceUnfoldrM value)
100− ]
101− ]
102−
103−moduleName :: String
104−moduleName = "Data.Array.Generic"
105−
106−defStreamSize :: Int
107−defStreamSize = defaultStreamSize
108−
109−main :: IO ()
110−main = runWithCLIOpts defStreamSize allBenchmarks
111−
112− where
113−
114− allBenchmarks size =
115− [ bgroup (o_1_space_prefix moduleName) $
116− o_1_space_generation size ++ o_1_space_elimination size
117− , bgroup (o_n_space_prefix moduleName) $
118− o_n_heap_serial size
119− ] ++ commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/SmallArray.hsdeleted−95
@@ -1,95 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−{-# LANGUAGE CPP #-}
4−
5−#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
6−
7−import Control.DeepSeq (deepseq)
8−
9−import qualified Streamly.Internal.Data.SmallArray as A
10−type Stream = A.SmallArray
11−
12−#include "Streamly/Benchmark/Data/Array/Common.hs"
13−
14−-------------------------------------------------------------------------------
15−-- Benchmark helpers
16−-------------------------------------------------------------------------------
17−
18−-- Drain a source that generates an array in the IO monad
19−{-# INLINE benchIOSrc #-}
20−benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark
21−benchIOSrc name src = benchIO name src id
22−
23−-------------------------------------------------------------------------------
24−-- Bench Ops
25−-------------------------------------------------------------------------------
26−
27−{-# INLINE sourceIntFromToFromList #-}
28−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
29−sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
30−
31−{-# INLINE readInstance #-}
32−readInstance :: P.String -> Stream Int
33−readInstance str =
34− let r = P.reads str
35− in case r of
36− [(x,"")] -> x
37− _ -> P.error "readInstance: no parse"
38−
39−#ifdef DEVBUILD
40−{-
41−{-# INLINE foldableFoldl' #-}
42−foldableFoldl' :: Stream Int -> Int
43−foldableFoldl' = F.foldl' (+) 0
44−
45−{-# INLINE foldableSum #-}
46−foldableSum :: Stream Int -> Int
47−foldableSum = P.sum
48−-}
49−#endif
50−
51−-------------------------------------------------------------------------------
52−-- Bench groups
53−-------------------------------------------------------------------------------
54−
55−o_1_space_generation :: Int -> [Benchmark]
56−o_1_space_generation value =
57− [ bgroup
58− "generation"
59− [ let testStr =
60− "fromListN " ++
61− show (value + 1) ++
62− "[1" ++ concat (replicate value ",1") ++ "]"
63− in testStr `deepseq` bench "read" (nf readInstance testStr)
64− ]
65− ]
66−
67−{-
68−o_1_space_elimination :: Int -> [Benchmark]
69−o_1_space_elimination value =
70− [ bgroup "elimination"
71− [
72−#ifdef DEVBUILD
73−{-
74− benchPureSink value "foldable/foldl'" foldableFoldl'
75− , benchPureSink value "foldable/sum" foldableSum
76−-}
77−#endif
78− ]
79− ]
80−-}
81−
82−moduleName :: String
83−moduleName = "Data.SmallArray"
84−
85−defStreamSize :: Int
86−defStreamSize = 128
87−
88−main :: IO ()
89−main = runWithCLIOpts defStreamSize allBenchmarks
90−
91− where
92−
93− allBenchmarks size =
94− bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
95− : commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/Stream.hsdeleted−309
@@ -1,309 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−-- |
4−-- Module : Streamly.Benchmark.Data.ParserD
5−-- Copyright : (c) 2020 Composewell Technologies
6−--
7−-- License : BSD-3-Clause
8−-- Maintainer : streamly@composewell.com
9−
10−{-# LANGUAGE CPP #-}
11−{-# LANGUAGE FlexibleContexts #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−module Main
24− (
25− main
26− ) where
27−
28−import Control.DeepSeq (NFData(..))
29−import Control.Monad (void, when)
30−import Control.Monad.Catch (MonadCatch)
31−import Data.Functor.Identity (runIdentity)
32−import Data.Maybe (isJust)
33−import Data.Word (Word8)
34−import Streamly.Internal.Data.Stream (Stream)
35−import Streamly.Internal.Data.StreamK (StreamK)
36−import System.IO (Handle)
37−import System.Random (randomRIO)
38−import Prelude hiding ()
39−
40−import qualified Streamly.Data.Stream as Stream
41−import qualified Streamly.Internal.Data.Array as Array
42−import qualified Streamly.Internal.Data.Array.Stream as ArrayStream
43−import qualified Streamly.Internal.Data.Fold as Fold
44−import qualified Streamly.Internal.Data.Parser as Parser
45−import qualified Streamly.Internal.Data.Stream as Stream
46−import qualified Streamly.Internal.Data.StreamK as StreamK
47−import qualified Streamly.Internal.FileSystem.Handle as Handle
48−import qualified Streamly.Internal.Unicode.Stream as Unicode
49−
50−import Test.Tasty.Bench hiding (env)
51−import Streamly.Benchmark.Common
52−import Streamly.Benchmark.Common.Handle
53−import Control.Monad.IO.Class (MonadIO)
54−
55−#ifdef INSPECTION
56−import Streamly.Internal.Data.MutByteArray (Unbox)
57−import Streamly.Internal.Data.Stream (Step(..))
58−import Test.Inspection
59−#endif
60−
61−-------------------------------------------------------------------------------
62−-- Utilities
63−-------------------------------------------------------------------------------
64−
65−-- XXX these can be moved to the common module
66−
67−{-# INLINE sourceUnfoldrM #-}
68−sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
69−sourceUnfoldrM value n = Stream.unfoldrM step n
70− where
71− step cnt =
72− if cnt > n + value
73− then return Nothing
74− else return (Just (cnt, cnt + 1))
75−
76−{-# INLINE benchIO #-}
77−benchIO
78− :: NFData b
79− => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
80−benchIO name src sink =
81− bench name $ nfIO $ randomRIO (1,1) >>= sink . src
82−
83−-------------------------------------------------------------------------------
84−-- read chunked using toChunks
85−-------------------------------------------------------------------------------
86−
87−-- | Get the last byte from a file bytestream.
88−toChunksLast :: Handle -> IO (Maybe Word8)
89−toChunksLast inh = do
90− let s = Handle.readChunks inh
91− larr <- Stream.last s
92− return $ case larr of
93− Nothing -> Nothing
94− Just arr -> Array.getIndex (Array.length arr - 1) arr
95−
96−#ifdef INSPECTION
97−inspect $ hasNoTypeClasses 'toChunksLast
98−inspect $ 'toChunksLast `hasNoType` ''Step
99−#endif
100−
101−-- | Count the number of bytes in a file.
102−toChunksSumLengths :: Handle -> IO Int
103−toChunksSumLengths inh =
104− let s = Handle.readChunks inh
105− in Stream.fold Fold.sum (Stream.map Array.length s)
106−
107−#ifdef INSPECTION
108−inspect $ hasNoTypeClasses 'toChunksSumLengths
109−inspect $ 'toChunksSumLengths `hasNoType` ''Step
110−#endif
111−
112−-- | Sum the bytes in a file.
113−toChunksCountBytes :: Handle -> IO Word8
114−toChunksCountBytes inh = do
115− let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
116− let s = Handle.readChunks inh
117− Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118−
119−#ifdef INSPECTION
120−inspect $ hasNoTypeClasses 'toChunksCountBytes
121−inspect $ 'toChunksCountBytes `hasNoType` ''Step
122−#endif
123−
124−toChunksDecodeUtf8Arrays :: Handle -> IO ()
125−toChunksDecodeUtf8Arrays =
126− Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
127−
128−#ifdef INSPECTION
129−inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
130−-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
131−#endif
132−
133−-------------------------------------------------------------------------------
134−-- Splitting
135−-------------------------------------------------------------------------------
136−
137−-- | Count the number of lines in a file.
138−toChunksSplitOnSuffix :: Handle -> IO Int
139−toChunksSplitOnSuffix =
140− Stream.fold Fold.length
141− . ArrayStream.splitOnSuffix 10
142− . Handle.readChunks
143−
144−#ifdef INSPECTION
145−inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
146−inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
147−#endif
148−
149−-- XXX use a word splitting combinator instead of splitOn and test it.
150−-- | Count the number of words in a file.
151−toChunksSplitOn :: Handle -> IO Int
152−toChunksSplitOn =
153− Stream.fold Fold.length
154− . ArrayStream.splitOn 32
155− . Handle.readChunks
156−
157−#ifdef INSPECTION
158−inspect $ hasNoTypeClasses 'toChunksSplitOn
159−inspect $ 'toChunksSplitOn `hasNoType` ''Step
160−#endif
161−
162−o_1_space_read_chunked :: BenchEnv -> [Benchmark]
163−o_1_space_read_chunked env =
164− -- read using toChunks instead of read
165− [ bgroup "reduce/toChunks"
166− [ mkBench "Stream.last" env $ \inH _ ->
167− toChunksLast inH
168− -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
169− -- wc uses lseek to just determine the file size rather than reading
170− -- and counting characters.
171− , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
172− toChunksSumLengths inH
173− , mkBench "splitOnSuffix" env $ \inH _ ->
174− toChunksSplitOnSuffix inH
175− , mkBench "splitOn" env $ \inH _ ->
176− toChunksSplitOn inH
177− , mkBench "countBytes" env $ \inH _ ->
178− toChunksCountBytes inH
179− , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
180− toChunksDecodeUtf8Arrays inH
181− ]
182− ]
183−
184−-------------------------------------------------------------------------------
185−-- copy with group/ungroup transformations
186−-------------------------------------------------------------------------------
187−
188−-- | Lines and unlines
189−{-# NOINLINE copyChunksSplitInterposeSuffix #-}
190−copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
191−copyChunksSplitInterposeSuffix inh outh =
192− Stream.fold (Handle.write outh)
193− $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
194− $ Handle.readChunks inh
195−
196−#ifdef INSPECTION
197−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
198−inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
199−#endif
200−
201−-- | Words and unwords
202−{-# NOINLINE copyChunksSplitInterpose #-}
203−copyChunksSplitInterpose :: Handle -> Handle -> IO ()
204−copyChunksSplitInterpose inh outh =
205− Stream.fold (Handle.write outh)
206− -- XXX this is not correct word splitting combinator
207− $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
208− $ Handle.readChunks inh
209−
210−#ifdef INSPECTION
211−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
212−inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
213−#endif
214−
215−o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
216−o_1_space_copy_toChunks_group_ungroup env =
217− [ bgroup "copy/toChunks/group-ungroup"
218− [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
219− copyChunksSplitInterposeSuffix inh outh
220− , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
221− copyChunksSplitInterpose inh outh
222− ]
223− ]
224−
225−-------------------------------------------------------------------------------
226−-- Parsers
227−-------------------------------------------------------------------------------
228−
229−{-# INLINE drainWhile #-}
230−drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
231−drainWhile p = Parser.takeWhile p Fold.drain
232−
233−-------------------------------------------------------------------------------
234−-- Folds and parsers
235−-------------------------------------------------------------------------------
236−
237−{-# INLINE fold #-}
238−fold :: Stream IO (Array.Array Int) -> IO ()
239−fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s
240−
241−{-# INLINE parse #-}
242−parse :: Int -> Stream IO (Array.Array Int) -> IO ()
243−parse value s =
244− void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s
245−
246−{-# INLINE foldBreak #-}
247−foldBreak :: StreamK IO (Array.Array Int) -> IO ()
248−foldBreak s = do
249− (r, s1) <- ArrayStream.foldBreak Fold.one s
250− when (isJust r) $ foldBreak s1
251−
252−{-# INLINE parseBreak #-}
253−parseBreak :: StreamK IO (Array.Array Int) -> IO ()
254−parseBreak s = do
255− r <- ArrayStream.parseBreak Parser.one s
256− case r of
257− (Left _, _) -> return ()
258− (Right _, s1) -> parseBreak s1
259−
260−o_1_space_serial_array ::
261− Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
262−o_1_space_serial_array bound arraysSmall arraysBig =
263− [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
264− , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265− , benchIO
266− "foldBreak (recursive, small arrays)"
267− (\_ -> Stream.fromList arraysSmall)
268− (foldBreak . StreamK.fromStream)
269− , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
270− $ parse bound
271− , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
272− $ parse bound
273− , benchIO
274− "parseBreak (recursive, small arrays)"
275− (\_ -> Stream.fromList arraysSmall)
276− (parseBreak . StreamK.fromStream)
277− ]
278−
279−-------------------------------------------------------------------------------
280−-- Driver
281−-------------------------------------------------------------------------------
282−
283−moduleName :: String
284−moduleName = "Data.Array.Stream"
285−
286−main :: IO ()
287−main = do
288− env <- mkHandleBenchEnv
289− runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
290−
291− where
292−
293− alloc value =
294− if value <= 0
295− then return (undefined, undefined)
296− else
297− do
298− small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
299− big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0
300− return (small, big)
301−
302− allBenchmarks env arrays value =
303− let (arraysSmall, arraysBig) = arrays
304− in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
305− [ o_1_space_read_chunked env
306− , o_1_space_serial_array value arraysSmall arraysBig
307− , o_1_space_copy_toChunks_group_ungroup env
308− ]
309− ]
benchmark/Streamly/Benchmark/Data/ArrayOps.hsnew file+148
@@ -0,0 +1,148 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ArrayOps
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE DeriveAnyClass #-}
12+{-# LANGUAGE DeriveGeneric #-}
13+{-# LANGUAGE FlexibleContexts #-}
14+{-# LANGUAGE ScopedTypeVariables #-}
15+
16+module Streamly.Benchmark.Data.ArrayOps where
17+
18+import Control.Monad.IO.Class (MonadIO)
19+import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20+import qualified Prelude as P
21+#ifdef DEVBUILD
22+import qualified Data.Foldable as F
23+#endif
24+
25+import qualified Streamly as S hiding (foldMapWith, runStream)
26+import qualified Streamly.Internal.Data.Array as A
27+import qualified Streamly.Prelude as S
28+
29+value :: Int
30+value = 100000
31+
32+-------------------------------------------------------------------------------
33+-- Benchmark ops
34+-------------------------------------------------------------------------------
35+
36+-------------------------------------------------------------------------------
37+-- Stream generation and elimination
38+-------------------------------------------------------------------------------
39+
40+type Stream = A.Array
41+
42+{-# INLINE sourceUnfoldr #-}
43+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
44+sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
45+ where
46+ step cnt =
47+ if cnt > n + value
48+ then Nothing
49+ else (Just (cnt, cnt + 1))
50+
51+{-# INLINE sourceIntFromTo #-}
52+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
53+sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
54+
55+{-# INLINE sourceIntFromToFromStream #-}
56+sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
57+sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
58+
59+{-# INLINE sourceIntFromToFromList #-}
60+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
61+sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
62+
63+{-# INLINE sourceFromList #-}
64+sourceFromList :: MonadIO m => Int -> m (Stream Int)
65+sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
66+{-
67+{-# INLINE sourceIsList #-}
68+sourceIsList :: Int -> Stream Int
69+sourceIsList n = GHC.fromList [n..n+value]
70+
71+{-# INLINE sourceIsString #-}
72+sourceIsString :: Int -> Stream P.Char
73+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
74+-}
75+-------------------------------------------------------------------------------
76+-- Transformation
77+-------------------------------------------------------------------------------
78+
79+{-# INLINE composeN #-}
80+composeN :: P.Monad m
81+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
82+composeN n f x =
83+ case n of
84+ 1 -> f x
85+ 2 -> f x P.>>= f
86+ 3 -> f x P.>>= f P.>>= f
87+ 4 -> f x P.>>= f P.>>= f P.>>= f
88+ _ -> undefined
89+
90+{-# INLINE scanl' #-}
91+{-# INLINE scanl1' #-}
92+{-# INLINE map #-}
93+
94+scanl', scanl1', map
95+ :: MonadIO m => Int -> Stream Int -> m (Stream Int)
96+
97+{-# INLINE onArray #-}
98+onArray
99+ :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
100+ -> Stream Int
101+ -> m (Stream Int)
102+onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
103+
104+scanl' n = composeN n $ onArray $ S.scanl' (+) 0
105+scanl1' n = composeN n $ onArray $ S.scanl1' (+)
106+map n = composeN n $ onArray $ S.map (+1)
107+
108+{-# INLINE eqInstance #-}
109+eqInstance :: Stream Int -> Bool
110+eqInstance src = src == src
111+
112+{-# INLINE eqInstanceNotEq #-}
113+eqInstanceNotEq :: Stream Int -> Bool
114+eqInstanceNotEq src = src P./= src
115+
116+{-# INLINE ordInstance #-}
117+ordInstance :: Stream Int -> Bool
118+ordInstance src = src P.< src
119+
120+{-# INLINE ordInstanceMin #-}
121+ordInstanceMin :: Stream Int -> Stream Int
122+ordInstanceMin src = P.min src src
123+
124+{-# INLINE showInstance #-}
125+showInstance :: Stream Int -> P.String
126+showInstance src = P.show src
127+
128+{-# INLINE readInstance #-}
129+readInstance :: P.String -> Stream Int
130+readInstance str =
131+ let r = P.reads str
132+ in case r of
133+ [(x,"")] -> x
134+ _ -> P.error "readInstance: no parse"
135+
136+{-# INLINE pureFoldl' #-}
137+pureFoldl' :: MonadIO m => Stream Int -> m Int
138+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
139+
140+#ifdef DEVBUILD
141+{-# INLINE foldableFoldl' #-}
142+foldableFoldl' :: Stream Int -> Int
143+foldableFoldl' = F.foldl' (+) 0
144+
145+{-# INLINE foldableSum #-}
146+foldableSum :: Stream Int -> Int
147+foldableSum = P.sum
148+#endif
benchmark/Streamly/Benchmark/Data/Fold.hsdeleted−541
@@ -1,541 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Fold
3−-- Copyright : (c) 2018 Composewell
4−--
5−-- License : MIT
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
10−{-# LANGUAGE RankNTypes #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
12−{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−
15−#undef FUSION_CHECK
16−#ifdef FUSION_CHECK
17−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
18−#endif
19−
20−module Main (main) where
21−
22−import Control.DeepSeq (NFData(..))
23−import Control.Monad (when)
24−import Control.Monad.IO.Class (MonadIO(..))
25−import Data.Functor.Identity (Identity(..))
26−import Data.Map.Strict (Map)
27−import Data.Hashable (Hashable)
28−import Data.HashMap.Strict (HashMap)
29−import Data.IntMap.Strict (IntMap)
30−import Data.Monoid (Last(..), Sum(..))
31−import System.Random (randomRIO)
32−
33−import Streamly.Internal.Data.Stream (Stream)
34−import Streamly.Internal.Data.Fold (Fold(..))
35−import Streamly.Internal.Data.IsMap.HashMap ()
36−import Streamly.Internal.Data.MutArray (MutArray)
37−
38−import qualified Streamly.Internal.Data.Fold as FL
39−import qualified Streamly.Data.Fold.Prelude as Fold
40−import qualified Streamly.Internal.Data.Unfold as Unfold
41−import qualified Streamly.Internal.Data.Pipe as Pipe
42−import qualified Streamly.Internal.Data.Stream as Stream
43−
44−import Test.Tasty.Bench
45−import Streamly.Benchmark.Common
46−import Prelude hiding (all, any, take, unzip, sequence_, filter)
47−
48−-- We need a monadic bind here to make sure that the function f does not get
49−-- completely optimized out by the compiler in some cases.
50−
51−{-# INLINE sourceUnfoldrM #-}
52−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
53−sourceUnfoldrM value n = Stream.unfoldrM step n
54− where
55− step cnt =
56− if cnt > n + value
57− then return Nothing
58− else return (Just (cnt, cnt + 1))
59−
60−{-# INLINE source #-}
61−source :: Monad m => Int -> Int -> Stream m Int
62−source = sourceUnfoldrM
63−
64−-- | Takes a fold method, and uses it with a default source.
65−{-# INLINE benchIOSink #-}
66−benchIOSink
67− :: NFData b
68− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
69−benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
70−
71−-------------------------------------------------------------------------------
72−-- Folds
73−-------------------------------------------------------------------------------
74−
75−{-# INLINE any #-}
76−any :: (Monad m, Ord a) => a -> Stream m a -> m Bool
77−any value = Stream.fold (FL.any (> value))
78−
79−{-# INLINE all #-}
80−all :: (Monad m, Ord a) => a -> Stream m a -> m Bool
81−all value = Stream.fold (FL.all (<= value))
82−
83−{-# INLINE take #-}
84−take :: Monad m => Int -> Stream m a -> m ()
85−take value = Stream.fold (FL.take value FL.drain)
86−
87−{-# INLINE sequence_ #-}
88−sequence_ :: Monad m => Int -> Fold m a ()
89−sequence_ value =
90− foldr f (FL.fromPure ()) (Prelude.replicate value (FL.take 1 FL.drain))
91−
92− where
93−
94− {-# INLINE f #-}
95− f m k = FL.concatMap (const k) m
96−
97−-------------------------------------------------------------------------------
98−-- Filter
99−-------------------------------------------------------------------------------
100−
101−{-# INLINE filter #-}
102−filter :: Monad m => Int -> Stream m Int -> m ()
103−filter _ = Stream.fold (FL.filter even FL.drain)
104−
105−{-# INLINE scanMaybe #-}
106−scanMaybe :: Monad m => Int -> Stream m Int -> m ()
107−scanMaybe _ = Stream.fold (FL.scanMaybe (FL.filtering even) FL.drain)
108−
109−{-# INLINE scanMaybe2 #-}
110−scanMaybe2 :: Monad m => Int -> Stream m Int -> m ()
111−scanMaybe2 _ =
112− Stream.fold
113− $ FL.scanMaybe (FL.filtering even)
114− $ FL.scanMaybe (FL.filtering odd) FL.drain
115−
116−-------------------------------------------------------------------------------
117−-- Splitting by serial application
118−-------------------------------------------------------------------------------
119−
120−{-# INLINE takeEndBy_ #-}
121−takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()
122−takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)
123−
124−{-# INLINE many #-}
125−many :: Monad m => Stream m Int -> m ()
126−many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)
127−
128−{-# INLINE splitAllAny #-}
129−splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool)
130−splitAllAny value =
131− Stream.fold
132− (FL.splitWith (,)
133− (FL.all (<= (value `div` 2)))
134− (FL.any (> value))
135− )
136−
137−{-# INLINE split_ #-}
138−split_ :: Monad m => Int -> Stream m Int -> m Bool
139−split_ value =
140− Stream.fold
141− (FL.split_
142− (FL.all (<= (value `div` 2)))
143− (FL.any (> value))
144− )
145−
146−{-# INLINE shortest #-}
147−shortest :: Monad m => Stream m Int -> m (Either Int Int)
148−shortest = Stream.fold (FL.shortest FL.sum FL.length)
149−
150−{-# INLINE longest #-}
151−longest :: Monad m => Stream m Int -> m (Either Int Int)
152−longest = Stream.fold (FL.longest FL.sum FL.length)
153−
154−{-# INLINE foldBreak #-}
155−foldBreak :: Monad m => Stream m Int -> m ()
156−foldBreak s = do
157− (r, s1) <- Stream.foldBreak (FL.take 1 FL.length) s
158− when (r /= 0) $ foldBreak s1
159−
160−-------------------------------------------------------------------------------
161−-- Distributing by parallel application
162−-------------------------------------------------------------------------------
163−
164−{-# INLINE teeSumLength #-}
165−teeSumLength :: Monad m => Stream m Int -> m (Int, Int)
166−teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)
167−
168−{-# INLINE teeAllAny #-}
169−teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)
170−teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
171−
172− where
173−
174− all_ = FL.all (<= value)
175− any_ = FL.any (> value)
176−
177−{-# INLINE teeWithFst #-}
178−teeWithFst :: Monad m => Stream m Int -> m (Int, Int)
179−teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)
180−
181−{-# INLINE teeWithMin #-}
182−teeWithMin :: Monad m => Stream m Int -> m (Int, Int)
183−teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)
184−
185−{-# INLINE distribute #-}
186−distribute :: Monad m => Stream m Int -> m [Int]
187−distribute = Stream.fold (FL.distribute [FL.sum, FL.length])
188−
189−-------------------------------------------------------------------------------
190−-- Partitioning
191−-------------------------------------------------------------------------------
192−
193−{-# INLINE oddEven #-}
194−oddEven :: Int -> Either Int Int
195−oddEven x = if odd x then Left x else Right x
196−
197−{-# INLINE partition #-}
198−partition :: Monad m => Stream m Int -> m (Int, Int)
199−partition = Stream.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
200−
201−{-# INLINE partitionByFstM #-}
202−partitionByFstM :: Monad m => Stream m Int -> m (Int, Int)
203−partitionByFstM =
204− Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
205−
206−{-# INLINE partitionByMinM #-}
207−partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)
208−partitionByMinM =
209− Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
210−
211−{-# INLINE demuxToMap #-}
212−demuxToMap :: (Monad m, Ord k) =>
213− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
214−demuxToMap f g = Stream.fold (FL.demuxToContainer f g)
215−
216−{-# INLINE demuxToIntMap #-}
217−demuxToIntMap :: Monad m =>
218− (a -> Int) -> (a -> m (Fold m a b)) -> Stream m a -> m (IntMap b)
219−demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g)
220−
221−{-# INLINE demuxToHashMap #-}
222−demuxToHashMap :: (Monad m, Hashable k) =>
223− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
224−demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g)
225−
226−{-# INLINE demuxToMapIO #-}
227−demuxToMapIO :: (MonadIO m, Ord k) =>
228− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
229−demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
230−
231−{-# INLINE demuxToHashMapIO #-}
232−demuxToHashMapIO :: (MonadIO m, Hashable k) =>
233− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
234−demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
235−
236−{-# INLINE toMap #-}
237−toMap ::
238− (Monad m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
239−toMap f = Stream.fold (FL.toContainer f FL.sum)
240−
241−{-# INLINE toIntMap #-}
242−toIntMap ::
243− (Monad m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
244−toIntMap f = Stream.fold (FL.toContainer f FL.sum)
245−
246−{-# INLINE toMapIO #-}
247−toMapIO ::
248− (MonadIO m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
249−toMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
250−
251−{-# INLINE toIntMapIO #-}
252−toIntMapIO ::
253− (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
254−toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
255−
256−{-# INLINE toHashMapIO #-}
257−toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) =>
258− (a -> k) -> Stream m a -> m (HashMap k a)
259−toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum)
260−
261−-------------------------------------------------------------------------------
262−-- unzip
263−-------------------------------------------------------------------------------
264−
265−{-# INLINE unzip #-}
266−unzip :: Monad m => Stream m Int -> m (Int, Int)
267−unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
268−
269−{-# INLINE unzipWithFstM #-}
270−unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
271−unzipWithFstM = do
272− let f a = return (a + 1, a)
273− Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
274−
275−{-# INLINE unzipWithMinM #-}
276−unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
277−unzipWithMinM = do
278− let f a = return (a + 1, a)
279− Stream.fold (FL.unzipWithMinM f FL.sum FL.length)
280−
281−-------------------------------------------------------------------------------
282−-- Nested
283−-------------------------------------------------------------------------------
284−
285−{-# INLINE unfoldMany #-}
286−unfoldMany :: Int -> Benchmarkable
287−unfoldMany val =
288− nfIO
289− $ Stream.fold (FL.unfoldMany Unfold.replicateM FL.drain)
290− $ Stream.fromPure (val, randomRIO (1, 1 :: Int))
291−
292−-------------------------------------------------------------------------------
293−-- Benchmarks
294−-------------------------------------------------------------------------------
295−
296−moduleName :: String
297−moduleName = "Data.Fold"
298−
299−instance NFData (MutArray a) where
300− {-# INLINE rnf #-}
301− rnf _ = ()
302−
303−instance NFData a => NFData (Stream Identity a) where
304− {-# INLINE rnf #-}
305− rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs
306−
307−o_1_space_serial_elimination :: Int -> [Benchmark]
308−o_1_space_serial_elimination value =
309− [ bgroup "elimination"
310− [ benchIOSink value "drain" (Stream.fold FL.drain)
311− , benchIOSink value "drainBy" (Stream.fold (FL.drainBy return))
312− , benchIOSink value "drainN" (Stream.fold (FL.drainN value))
313− , benchIOSink value "last" (Stream.fold FL.last)
314− , benchIOSink value "length" (Stream.fold FL.length)
315− , benchIOSink value "top" (Stream.fold $ FL.top 10)
316− , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)
317− , benchIOSink value "sum" (Stream.fold FL.sum)
318− , benchIOSink value "sum (foldMap)" (Stream.fold (FL.foldMap Sum))
319− , benchIOSink value "product" (Stream.fold FL.product)
320− , benchIOSink value "maximumBy" (Stream.fold (FL.maximumBy compare))
321− , benchIOSink value "maximum" (Stream.fold FL.maximum)
322− , benchIOSink value "minimumBy" (Stream.fold (FL.minimumBy compare))
323− , benchIOSink value "minimum" (Stream.fold FL.minimum)
324− , benchIOSink
325− value
326− "mean"
327− (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))
328− , benchIOSink
329− value
330− "variance"
331− (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))
332− , benchIOSink
333− value
334− "stdDev"
335− (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))
336− , benchIOSink
337− value
338− "mconcat"
339− (Stream.fold FL.mconcat . fmap (Last . Just))
340− , benchIOSink
341− value
342− "foldMap"
343− (Stream.fold (FL.foldMap (Last . Just)))
344− , benchIOSink
345− value
346− "foldMapM"
347− (Stream.fold (FL.foldMapM (return . Last . Just)))
348− , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))
349− , benchIOSink value "head" (Stream.fold FL.head)
350− , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))
351− , benchIOSink
352− value
353− "lookup"
354− (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
355− , benchIOSink
356− value
357− "findIndex"
358− (Stream.fold (FL.findIndex (== (value + 1))))
359− , benchIOSink
360− value
361− "elemIndex"
362− (Stream.fold (FL.elemIndex (value + 1)))
363− , benchIOSink value "null" (Stream.fold FL.null)
364− , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))
365− , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))
366− , benchIOSink value "all" $ all value
367− , benchIOSink value "any" $ any value
368− , benchIOSink value "take" $ take value
369− , benchIOSink value "takeEndBy_" $ takeEndBy_ value
370− , benchIOSink value "and" (Stream.fold FL.and . fmap (<= (value + 1)))
371− , benchIOSink value "or" (Stream.fold FL.or . fmap (> (value + 1)))
372− ]
373− ]
374−
375−o_1_space_serial_transformation :: Int -> [Benchmark]
376−o_1_space_serial_transformation value =
377− [ bgroup "transformation"
378− [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))
379− , let f x = if even x then Just x else Nothing
380− fld = FL.mapMaybe f FL.drain
381− in benchIOSink value "mapMaybe" (Stream.fold fld)
382− , benchIOSink
383− value
384− "rsequence"
385− (Stream.fold (FL.rmapM id (return <$> FL.drain)))
386− , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))
387− , benchIOSink
388− value
389− "pipe-mapM"
390− (Stream.fold
391− (FL.transform
392− (Pipe.mapM (\x -> return $ x + 1))
393− FL.drain))
394− , benchIOSink
395− value
396− "fold-scan"
397− (Stream.fold $ FL.scan FL.sum FL.drain)
398− , benchIOSink
399− value
400− "fold-scanMany"
401− (Stream.fold $ FL.scanMany (FL.take 2 FL.drain) FL.drain)
402− , benchIOSink
403− value
404− "fold-postscan"
405− (Stream.fold $ FL.postscan FL.sum FL.drain)
406− ]
407− ]
408−
409−o_1_space_serial_composition :: Int -> [Benchmark]
410−o_1_space_serial_composition value =
411− [ bgroup
412− "composition"
413− [ benchIOSink value "filter even" $ filter value
414− , benchIOSink value "scanMaybe even" $ scanMaybe value
415− , benchIOSink value "scanMaybe even, odd" $ scanMaybe2 value
416− , benchIOSink value "foldBreak (recursive)" foldBreak
417− , benchIOSink value "splitWith (all, any)" $ splitAllAny value
418− , benchIOSink value "split_ (all, any)" $ split_ value
419− , benchIOSink value "tee (all, any)" $ teeAllAny value
420− , benchIOSink value "many drain (take 1)" many
421− , bench "unfoldMany" $ unfoldMany value
422− , benchIOSink value "shortest (sum, length)" shortest
423− , benchIOSink value "longest (sum, length)" longest
424− , benchIOSink value "tee (sum, length)" teeSumLength
425− , benchIOSink value "teeWithFst (sum, length)" teeWithFst
426− , benchIOSink value "teeWithMin (sum, length)" teeWithMin
427− , benchIOSink value "distribute [sum, length]" distribute
428− , benchIOSink value "partition (sum, length)" partition
429− , benchIOSink value "partitionByFstM (sum, length)" partitionByFstM
430− , benchIOSink value "partitionByMinM (sum, length)" partitionByMinM
431− , benchIOSink value "unzip (sum, length)" unzip
432− , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
433− , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
434− ]
435− ]
436−
437−o_n_space_serial :: Int -> [Benchmark]
438−o_n_space_serial value =
439− [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))
440− ]
441−
442−o_n_heap_serial :: Int -> [Benchmark]
443−o_n_heap_serial value =
444− [ bgroup "elimination"
445− -- Left folds for building a structure are inherently non-streaming
446− -- as the structure cannot be lazily consumed until fully built.
447− [
448− benchIOSink value "toList" (Stream.fold FL.toList)
449− , benchIOSink value "toListRev" (Stream.fold FL.toListRev)
450− , benchIOSink value "toStream"
451− (Stream.fold FL.toStream
452− :: Stream IO a -> IO (Stream Identity a))
453− , benchIOSink value "toStreamRev"
454− (Stream.fold FL.toStreamRev
455− :: Stream IO a -> IO (Stream Identity a))
456− , benchIOSink value "nub" (Stream.fold FL.nub)
457− ]
458− , bgroup "key-value"
459− [
460− benchIOSink value "demuxToMap (64 buckets) [sum, length]"
461− $ demuxToMap (getKey 64) (getFold . getKey 64)
462− , benchIOSink value "demuxToIntMap (64 buckets) [sum, length]"
463− $ demuxToIntMap (getKey 64) (getFold . getKey 64)
464− , benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"
465− $ demuxToHashMap (getKey 64) (getFold . getKey 64)
466− , benchIOSink value "demuxToMapIO (64 buckets) [sum, length]"
467− $ demuxToMapIO (getKey 64) (getFold . getKey 64)
468− , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"
469− $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)
470−
471− -- classify: immutable
472− , benchIOSink value "toMap (64 buckets) sum"
473− $ toMap (getKey 64)
474− , benchIOSink value "toIntMap (64 buckets) sum"
475− $ toIntMap (getKey 64)
476−
477− -- classify: mutable cells
478− , benchIOSink value "toMapIO (single bucket) sum"
479− $ toMapIO (getKey 1)
480− , benchIOSink value "toMapIO (64 buckets) sum"
481− $ toMapIO (getKey 64)
482− , benchIOSink value "toMapIO (max buckets) sum"
483− $ toMapIO (getKey value)
484− , benchIOSink value "toIntMapIO (64 buckets) sum"
485− $ toIntMapIO (getKey 64)
486− , benchIOSink value "toHashMapIO (single bucket) sum"
487− $ toHashMapIO (getKey 1)
488− , benchIOSink value "toHashMapIO (64 buckets) sum"
489− $ toHashMapIO (getKey 64)
490− , benchIOSink value "toHashMapIO (max buckets) sum"
491− $ toHashMapIO (getKey value)
492− ]
493− ]
494−
495− where
496−
497− getKey buckets = (`mod` buckets)
498−
499− getFold k =
500− return $ case k of
501− 0 -> FL.sum
502− 1 -> FL.length
503− _ -> FL.length
504−
505−-------------------------------------------------------------------------------
506−-- Driver
507−-------------------------------------------------------------------------------
508−
509−main :: IO ()
510−main = do
511−#ifndef FUSION_CHECK
512− runWithCLIOpts defaultStreamSize allBenchmarks
513−
514− where
515−
516− allBenchmarks value =
517− [ bgroup (o_1_space_prefix moduleName) $ concat
518− [ o_1_space_serial_elimination value
519− , o_1_space_serial_transformation value
520− , o_1_space_serial_composition value
521− ]
522− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
523− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
524− ]
525−#else
526− -- Enable FUSION_CHECK macro at the beginning of the file
527− -- Enable one benchmark below, and run the benchmark
528− -- Check the .dump-simpl output
529− let value = 100000
530− let input = source value 1
531− let getKey buckets = (`mod` buckets)
532− let getFold k =
533− return $ case k of
534− 0 -> FL.sum
535− 1 -> FL.length
536− _ -> FL.length
537−
538− -- demuxToMap (getKey 64) (getFold . getKey 64) input
539− toIntMapIO (getKey 64) input
540− return ()
541−#endif
benchmark/Streamly/Benchmark/Data/Fold/Window.hsdeleted−191
@@ -1,191 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−module Main (main) where
4−
5−import Control.DeepSeq (NFData)
6−import Streamly.Data.Fold (Fold)
7−import Streamly.Internal.Data.Stream (Stream)
8−import System.Random (randomRIO)
9−
10−import qualified Streamly.Data.Fold as Fold
11−import qualified Streamly.Internal.Data.Fold as Window
12−import qualified Streamly.Internal.Data.Ring as Ring
13−import qualified Streamly.Internal.Data.Stream as Stream
14−
15−import Streamly.Benchmark.Common
16−import Test.Tasty.Bench
17−
18−{-# INLINE source #-}
19−source :: (Monad m, Num a, Stream.Enumerable a) =>
20− Int -> a -> Stream m a
21−source len from =
22− Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)
23−
24−{-# INLINE sourceDescending #-}
25−sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>
26− Int -> a -> Stream m a
27−sourceDescending len from =
28− Stream.enumerateFromThenTo
29− (from + fromIntegral len)
30− (from + fromIntegral (len - 1))
31− from
32−
33−{-# INLINE sourceDescendingInt #-}
34−sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int
35−sourceDescendingInt = sourceDescending
36−
37−{-# INLINE benchWith #-}
38−benchWith :: (Num a, NFData b) =>
39− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
40−benchWith src len name f =
41− bench name
42− $ nfIO
43− $ randomRIO (1, 1 :: Int) >>= Stream.fold f . src len . fromIntegral
44−
45−{-# INLINE benchWithFold #-}
46−benchWithFold :: NFData a => Int -> String -> Fold IO Double a -> Benchmark
47−benchWithFold = benchWith source
48−
49−{-# INLINE benchWithFoldInt #-}
50−benchWithFoldInt :: Int -> String -> Fold IO Int Int -> Benchmark
51−benchWithFoldInt = benchWith source
52−
53−{-# INLINE benchScanWith #-}
54−benchScanWith :: Num a =>
55− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
56−benchScanWith src len name f =
57− bench name
58− $ nfIO
59− $ randomRIO (1, 1 :: Int)
60− >>= Stream.fold Fold.drain
61− . Stream.postscan f
62− . src len
63− . fromIntegral
64−
65−{-# INLINE benchWithPostscan #-}
66−benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark
67−benchWithPostscan = benchScanWith source
68−
69−o_1_space_folds :: Int -> [Benchmark]
70−o_1_space_folds numElements =
71− [ bgroup "fold"
72− [ benchWithFold numElements "minimum (window size 100)"
73− (Window.windowMinimum 100)
74− , benchWithFold numElements "minimum (window size 1000)"
75− (Window.windowMinimum 1000)
76− , benchWith sourceDescendingInt numElements
77− "minimum descending (window size 1000)"
78− (Window.windowMinimum 1000)
79−
80− , benchWithFold numElements "maximum (window size 100)"
81− (Window.windowMaximum 100)
82− , benchWithFold numElements "maximum (window size 1000)"
83− (Window.windowMaximum 1000)
84− , benchWith sourceDescendingInt numElements
85− "maximum descending (window size 1000)"
86− (Window.windowMaximum 1000)
87−
88− , benchWithFold numElements "range (window size 100)"
89− (Window.windowRange 100)
90− , benchWithFold numElements "range (window size 1000)"
91− (Window.windowRange 1000)
92− , benchWith sourceDescendingInt numElements
93− "range descending (window size 1000)"
94− (Window.windowRange 1000)
95−
96− , benchWithFoldInt numElements "sumInt (window size 100)"
97− (Ring.slidingWindow 100 Window.windowSumInt)
98− , benchWithFoldInt numElements "sum for Int (window size 100)"
99− (Ring.slidingWindow 100 Window.windowSum)
100− , benchWithFold numElements "sum (window size 100)"
101− (Ring.slidingWindow 100 Window.windowSum)
102− , benchWithFold numElements "sum (window size 1000)"
103− (Ring.slidingWindow 1000 Window.windowSum)
104− , benchWithFold numElements "sum (entire stream)"
105− (Window.cumulative Window.windowSum)
106− , benchWithFold numElements "sum (Data.Fold)"
107− Fold.sum
108−
109− , benchWithFold numElements "mean (window size 100)"
110− (Ring.slidingWindow 100 Window.windowMean)
111− , benchWithFold numElements "mean (window size 1000)"
112− (Ring.slidingWindow 1000 Window.windowMean)
113− , benchWithFold numElements "mean (entire stream)"
114− (Window.cumulative Window.windowMean)
115− , benchWithFold numElements "mean (Data.Fold)"
116− Fold.mean
117−
118− , benchWithFold numElements "powerSum 2 (window size 100)"
119− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
120− , benchWithFold numElements "powerSum 2 (entire stream)"
121− (Window.cumulative (Window.windowPowerSum 2))
122−
123− ]
124− ]
125−
126−o_1_space_scans :: Int -> [Benchmark]
127−o_1_space_scans numElements =
128− [ bgroup "scan"
129− [ benchWithPostscan numElements "minimum (window size 10)"
130− (Window.windowMinimum 10)
131− -- Below window size 30 the linear search based impl performs better
132− -- than the dequeue based implementation.
133− , benchWithPostscan numElements "minimum (window size 30)"
134− (Window.windowMinimum 30)
135− , benchWithPostscan numElements "minimum (window size 1000)"
136− (Window.windowMinimum 1000)
137− , benchScanWith sourceDescendingInt numElements
138− "minimum descending (window size 1000)"
139− (Window.windowMinimum 1000)
140−
141− , benchWithPostscan numElements "maximum (window size 10)"
142− (Window.windowMaximum 10)
143− , benchWithPostscan numElements "maximum (window size 30)"
144− (Window.windowMaximum 30)
145− , benchWithPostscan numElements "maximum (window size 1000)"
146− (Window.windowMaximum 1000)
147− , benchScanWith sourceDescendingInt numElements
148− "maximum descending (window size 1000)"
149− (Window.windowMaximum 1000)
150−
151− , benchWithPostscan numElements "range (window size 10)"
152− (Window.windowRange 10)
153− , benchWithPostscan numElements "range (window size 30)"
154− (Window.windowRange 30)
155− , benchWithPostscan numElements "range (window size 1000)"
156− (Window.windowRange 1000)
157− , benchScanWith sourceDescendingInt numElements
158− "range descending (window size 1000)"
159− (Window.windowRange 1000)
160−
161− , benchWithPostscan numElements "sum (window size 100)"
162− (Ring.slidingWindow 100 Window.windowSum)
163− , benchWithPostscan numElements "sum (window size 1000)"
164− (Ring.slidingWindow 1000 Window.windowSum)
165−
166− , benchWithPostscan numElements "mean (window size 100)"
167− (Ring.slidingWindow 100 Window.windowMean)
168− , benchWithPostscan numElements "mean (window size 1000)"
169− (Ring.slidingWindow 1000 Window.windowMean)
170−
171− , benchWithPostscan numElements "powerSum 2 (window size 100)"
172− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
173− , benchWithPostscan numElements "powerSum 2 (window size 1000)"
174− (Ring.slidingWindow 1000 (Window.windowPowerSum 2))
175− ]
176− ]
177−
178−moduleName :: String
179−moduleName = "Data.Fold.Window"
180−
181−main :: IO ()
182−main = runWithCLIOpts defaultStreamSize allBenchmarks
183−
184− where
185−
186− allBenchmarks value =
187− [ bgroup (o_1_space_prefix moduleName) $ concat
188− [ o_1_space_folds value
189− , o_1_space_scans value
190− ]
191− ]
benchmark/Streamly/Benchmark/Data/MutArray.hsdeleted−300
@@ -1,300 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4−-- |
5−-- Module : Streamly.Benchmark.Data.Array.Unboxed.Mut
6−-- Copyright : (c) 2021 Composewell Technologies
7−-- License : BSD-3-Clause
8−-- Maintainer : streamly@composewell.com
9−
10−{-# LANGUAGE CPP #-}
11−{-# LANGUAGE FlexibleContexts #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad.IO.Class (MonadIO)
25−import Data.Functor ((<&>))
26−import System.Random (randomRIO)
27−import Prelude
28− ( IO
29− , Int
30− , Integral(..)
31− , Maybe(..)
32− , Monad(..)
33− , Num(..)
34− , Ord(..)
35− , String
36− , ($)
37− , (.)
38− , (||)
39− , concat
40− , const
41− , fmap
42− , id
43− , undefined
44− )
45−import Streamly.Internal.Data.MutArray (MutArray)
46−
47−import qualified Streamly.Internal.Data.Array as Array
48−import qualified Streamly.Internal.Data.MutArray as MArray
49−import qualified Streamly.Internal.Data.Fold as Fold
50−import qualified Streamly.Internal.Data.Stream as Stream
51−
52−import Test.Tasty.Bench
53−import Streamly.Benchmark.Common hiding (benchPureSrc)
54−
55−type Stream = MutArray
56−
57−instance NFData (MutArray a) where
58− {-# INLINE rnf #-}
59− rnf _ = ()
60−
61−-------------------------------------------------------------------------------
62−-- Benchmark helpers
63−-------------------------------------------------------------------------------
64−
65−{-# INLINE benchIO #-}
66−benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
67−benchIO name src f = bench name $ nfIO $
68− (randomRIO (1,1) >>= src) <&> f
69−
70−{-# INLINE benchPureSink #-}
71−benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
72−benchPureSink value name = benchIO name (sourceIntFromTo value)
73−
74−{-# INLINE benchIO' #-}
75−benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
76−benchIO' name src f = bench name $ nfIO $
77− randomRIO (1,1) >>= src >>= f
78−
79−{-# INLINE benchIOSink #-}
80−benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
81−benchIOSink value name = benchIO' name (sourceIntFromTo value)
82−
83−-- Drain a source that generates an array in the IO monad
84−{-# INLINE benchIOSrc #-}
85−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
86−benchIOSrc name src = benchIO name src id
87−
88−drain :: Monad m => Stream.Stream m a -> m ()
89−drain = Stream.fold Fold.drain
90−
91−-------------------------------------------------------------------------------
92−-- Bench Ops
93−-------------------------------------------------------------------------------
94−
95−{-# INLINE sourceUnfoldr #-}
96−sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
97−sourceUnfoldr value n =
98− Stream.fold (MArray.writeN value) $ Stream.unfoldr step n
99−
100− where
101−
102− step cnt =
103− if cnt > n + value
104− then Nothing
105− else Just (cnt, cnt + 1)
106−
107−{-# INLINE sourceIntFromTo #-}
108−sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
109−sourceIntFromTo value n =
110− Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)
111−
112−{-# INLINE sourceFromList #-}
113−sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
114−sourceFromList value n =
115− Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]
116−
117−{-# INLINE sourceIntFromToFromList #-}
118−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
119−sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]
120−
121−{-# INLINE sourceIntFromToFromStream #-}
122−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
123−sourceIntFromToFromStream value n =
124− Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)
125−
126−{-# INLINE sourceUnfoldrM #-}
127−sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int
128−sourceUnfoldrM value n = Stream.unfoldrM step n
129− where
130− step cnt =
131− if cnt > n + value
132− then return Nothing
133− else return (Just (cnt, cnt + 1))
134−
135−-------------------------------------------------------------------------------
136−-- Transformation
137−-------------------------------------------------------------------------------
138−
139−{-# INLINE composeN #-}
140−composeN :: Monad m
141− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
142−composeN n f x =
143− case n of
144− 1 -> f x
145− 2 -> f x >>= f
146− 3 -> f x >>= f >>= f
147− 4 -> f x >>= f >>= f >>= f
148− _ -> undefined
149−
150−{-# INLINE scanl' #-}
151−scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
152−scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)
153−
154−{-# INLINE scanl1' #-}
155−scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
156−scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
157−
158−{-# INLINE map #-}
159−map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
160−map value n = composeN n $ onArray value $ fmap (+ 1)
161−
162−{-# INLINE onArray #-}
163−onArray
164− :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
165− -> Stream Int
166− -> m (Stream Int)
167−onArray value f arr =
168− Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr
169−
170−-------------------------------------------------------------------------------
171−-- Elimination
172−-------------------------------------------------------------------------------
173−
174−{-# INLINE unfoldReadDrain #-}
175−unfoldReadDrain :: MonadIO m => Stream Int -> m ()
176−unfoldReadDrain = drain . Stream.unfold MArray.reader
177−
178−{-# INLINE unfoldReadRevDrain #-}
179−unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()
180−unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev
181−
182−{-# INLINE toStreamDRevDrain #-}
183−toStreamDRevDrain :: MonadIO m => Stream Int -> m ()
184−toStreamDRevDrain = drain . MArray.readRev
185−
186−{-# INLINE toStreamDDrain #-}
187−toStreamDDrain :: MonadIO m => Stream Int -> m ()
188−toStreamDDrain = drain . MArray.read
189−
190−{-# INLINE unfoldFold #-}
191−unfoldFold :: MonadIO m => Stream Int -> m Int
192−unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader
193−
194−-------------------------------------------------------------------------------
195−-- Bench groups
196−-------------------------------------------------------------------------------
197−
198−o_1_space_generation :: Int -> [Benchmark]
199−o_1_space_generation value =
200− [ bgroup
201− "generation"
202− [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
203− , benchIOSrc
204− "fromList . intFromTo"
205− (sourceIntFromToFromList value)
206− , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
207− , benchIOSrc "writeN . fromList" (sourceFromList value)
208− , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
209− ]
210− ]
211−
212−o_1_space_elimination :: Int -> [Benchmark]
213−o_1_space_elimination value =
214− [ bgroup "elimination"
215− [ benchPureSink value "id" id
216− , benchIOSink value "foldl'" unfoldFold
217− , benchIOSink value "read" unfoldReadDrain
218− , benchIOSink value "readRev" unfoldReadRevDrain
219− , benchIOSink value "toStream" toStreamDDrain
220− , benchIOSink value "toStreamRev" toStreamDRevDrain
221− ]
222− ]
223−
224−o_n_heap_serial :: Int -> [Benchmark]
225−o_n_heap_serial value =
226− [ bgroup "elimination"
227− [
228− -- Converting the stream to an array
229− benchFold "writeN" (Stream.fold (MArray.writeN value))
230− (sourceUnfoldrM value)
231− ]
232− ]
233−
234−o_1_space_transformation :: Int -> [Benchmark]
235−o_1_space_transformation value =
236− [ bgroup "transformation"
237− [ benchIOSink value "scanl'" (scanl' value 1)
238− , benchIOSink value "scanl1'" (scanl1' value 1)
239− , benchIOSink value "map" (map value 1)
240− ]
241− ]
242−
243−o_1_space_transformationX4 :: Int -> [Benchmark]
244−o_1_space_transformationX4 value =
245− [ bgroup "transformationX4"
246− [ benchIOSink value "scanl'" (scanl' value 4)
247− , benchIOSink value "scanl1'" (scanl1' value 4)
248− , benchIOSink value "map" (map value 4)
249− ]
250− ]
251−
252−o_1_space_serial_marray ::
253− Int -> (MutArray Int, Array.Array Int) -> [Benchmark]
254−o_1_space_serial_marray value ~(array, indices) =
255− [ benchIO' "partitionBy (< 0)" (const (return array))
256− $ MArray.partitionBy (< 0)
257− , benchIO' "partitionBy (> 0)" (const (return array))
258− $ MArray.partitionBy (> 0)
259− , benchIO' "partitionBy (< value/2)" (const (return array))
260− $ MArray.partitionBy (< (value `div` 2))
261− , benchIO' "partitionBy (> value/2)" (const (return array))
262− $ MArray.partitionBy (> (value `div` 2))
263− , benchIO' "strip (< value/2 || > value/2)" (const (return array))
264− $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
265− , benchIO' "strip (> 0)" (const (return array))
266− $ MArray.strip (> 0)
267− , benchIO' "modifyIndices (+ 1)" (const (return indices))
268− $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))
269− . Stream.unfold Array.reader
270− ]
271−
272−-------------------------------------------------------------------------------
273−-- Driver
274−-------------------------------------------------------------------------------
275−
276−moduleName :: String
277−moduleName = "Data.MutArray"
278−
279−main :: IO ()
280−main = do
281− runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
282−
283− where
284−
285− alloc value = do
286− marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
287− indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
288− return (marr, indices)
289−
290− allBenchmarks array value =
291− [ bgroup (o_1_space_prefix moduleName)
292− $ concat
293− [ o_1_space_serial_marray value array
294− , o_1_space_generation value
295− , o_1_space_elimination value
296− , o_1_space_transformation value
297− , o_1_space_transformationX4 value
298− ]
299− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
300− ]
benchmark/Streamly/Benchmark/Data/Parser.hsdeleted−887
@@ -1,887 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−#undef FUSION_CHECK
4−#ifdef FUSION_CHECK
5−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
6−#endif
7−
8−-- |
9−-- Module : Streamly.Benchmark.Data.Parser
10−-- Copyright : (c) 2020 Composewell Technologies
11−--
12−-- License : BSD-3-Clause
13−-- Maintainer : streamly@composewell.com
14−
15−{-# LANGUAGE CPP #-}
16−{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# OPTIONS_GHC -Wno-orphans #-}
19−
20−module Main
21− (
22− main
23− ) where
24−
25−import Control.Applicative ((<|>))
26−import Control.DeepSeq (NFData(..))
27−import Data.Function ((&))
28−import Data.Functor (($>))
29−import Data.Monoid (Sum(..))
30−import GHC.Magic (inline)
31−import GHC.Magic (noinline)
32−import System.IO (Handle)
33−import System.Random (randomRIO)
34−import Streamly.Internal.Data.Fold (Fold(..))
35−import Streamly.Internal.Data.Parser
36− (ParseError(..), Parser(..), Initial(..), Step(..))
37−import Streamly.Internal.Data.Stream (Stream)
38−import Prelude hiding
39− (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span)
40−
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
43−import qualified Data.Traversable as TR
44−import qualified Streamly.FileSystem.Handle as Handle
45−import qualified Streamly.Internal.Data.Array as Array
46−import qualified Streamly.Internal.Data.Fold as Fold
47−import qualified Streamly.Internal.Data.Parser as PR
48−import qualified Streamly.Data.Stream as Stream
49−import qualified Streamly.Internal.Data.Producer as Producer
50−import qualified Streamly.Internal.Data.Stream as Stream
51−
52−import Test.Tasty.Bench hiding (env)
53−import Streamly.Benchmark.Common
54−import Streamly.Benchmark.Common.Handle
55−
56−-------------------------------------------------------------------------------
57−-- Utilities
58−-------------------------------------------------------------------------------
59−
60−-- XXX these can be moved to the common module
61−
62−{-# INLINE sourceUnfoldrM #-}
63−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
64−sourceUnfoldrM value n = Stream.unfoldrM step n
65− where
66− step cnt =
67− if cnt > n + value
68− then return Nothing
69− else return (Just (cnt, cnt + 1))
70−
71−-- | Generates something like this: { { \{ \{ } }. The stream consists of
72−-- three parts, the first part is contains a sequence of `{`. The second part
73−-- contains a sequence pf escaped values `\{`. The third part contains a
74−-- sequence of `}`.
75−{-# INLINE sourceEscapedFrames #-}
76−sourceEscapedFrames ::
77− Monad m
78− => Int
79− -> Int
80− -> Stream m Char
81−sourceEscapedFrames value n = Stream.unfoldrM step n
82− where
83−
84− bs = '\\'
85− cbOpen = '{'
86− cbClose = '}'
87− value1 = value `div` 4
88−
89− step cnt
90− | cnt > 4 * value1 = return Nothing
91− | cnt <= value1 = return $ Just (cbOpen, cnt + 1)
92− | cnt > 3 * value1 = return $ Just (cbClose, cnt + 1)
93− | otherwise =
94− return
95− $ Just
96− $ if (cnt - value1) `mod` 2 == 1
97− then (bs, cnt + 1)
98− else (cbOpen, cnt + 1)
99−
100−{-# INLINE benchIOSrc #-}
101−benchIOSrc
102− :: NFData b
103− => (Int -> Int -> Stream IO a)
104− -> Int
105− -> String
106− -> (Stream IO a -> IO b)
107− -> Benchmark
108−benchIOSrc src value name f =
109− bench name $ nfIO $ randomRIO (1,1) >>= f . src value
110−
111−-- | Takes a fold method, and uses it with a default source.
112−{-# INLINE benchIOSink #-}
113−benchIOSink
114− :: NFData b
115− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
116−benchIOSink value name f =
117− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
118−
119−-------------------------------------------------------------------------------
120−-- Parsers
121−-------------------------------------------------------------------------------
122−
123−{-# INLINE takeBetween #-}
124−takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())
125−takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)
126−
127−{-# INLINE takeEQ #-}
128−takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())
129−takeEQ value = Stream.parse (PR.takeEQ value Fold.drain)
130−
131−{-# INLINE takeGE #-}
132−takeGE :: Monad m => Int -> Stream m a -> m (Either ParseError ())
133−takeGE value = Stream.parse (PR.takeGE value Fold.drain)
134−
135−{-# INLINE dropWhile #-}
136−dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
137−dropWhile value = Stream.parse (PR.dropWhile (<= value))
138−
139−{-# INLINE takeStartBy #-}
140−takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
141−takeStartBy value stream = do
142− let stream2 = value `Stream.cons` stream
143− Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2
144−
145−takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ())
146−takeFramedByEsc_ _ = Stream.parse parser
147−
148− where
149−
150− isEsc = (== '\\')
151− isBegin = (== '{')
152− isEnd = (== '}')
153−
154− parser = PR.takeFramedByEsc_ isEsc isBegin isEnd Fold.drain
155−
156−{-# INLINE listEqBy #-}
157−listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])
158−listEqBy len = Stream.parse (PR.listEqBy (==) [1 .. len])
159−
160−{-# INLINE streamEqBy #-}
161−streamEqBy :: Int -> Stream IO Int -> IO (Either ParseError ())
162−streamEqBy len = Stream.parse (PR.streamEqBy (==) (Stream.enumerateFromTo 1 len))
163−
164−{-# INLINE takeWhile #-}
165−takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
166−takeWhile value = Stream.parse (PR.takeWhile (<= value) Fold.drain)
167−
168−takeWhileP :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
169−takeWhileP value =
170− Stream.parse (PR.takeWhileP (<= value) (PR.takeWhile (<= value - 1) Fold.drain))
171−
172−{-# INLINE takeP #-}
173−takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())
174−takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))
175−
176−{-# INLINE groupBy #-}
177−groupBy :: Monad m => Stream m Int -> m (Either ParseError ())
178−groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)
179−
180−{-# INLINE groupByRolling #-}
181−groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())
182−groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)
183−
184−{-# INLINE wordBy #-}
185−wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
186−wordBy value = Stream.parse (PR.wordBy (>= value) Fold.drain)
187−
188−{-# INLINE sepByWords #-}
189−sepByWords :: Monad m => Stream m Int -> m (Either ParseError ())
190−sepByWords = Stream.parse (wrds even Fold.drain)
191− where
192− wrds p = PR.sepBy (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
193−
194−{-# INLINE sepByAllWords #-}
195−sepByAllWords :: Monad m => Stream m Int -> m (Either ParseError ())
196−sepByAllWords = Stream.parse (wrds even Fold.drain)
197− where
198− wrds p = PR.sepByAll (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
199−
200−-- Returning a list to compare with the sepBy1 in ParserK
201−{-# INLINE sepBy1 #-}
202−sepBy1 :: Monad m => Stream m Int -> m (Either ParseError [Int])
203−sepBy1 xs = do
204− Stream.parse (PR.sepBy1 (PR.satisfy odd) (PR.satisfy even) Fold.toList) xs
205−
206−{-# INLINE sepByWords1 #-}
207−sepByWords1 :: Monad m => Stream m Int -> m (Either ParseError ())
208−sepByWords1 = Stream.parse (wrds even Fold.drain)
209− where
210− wrds p = PR.sepBy1 (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
211−
212−{-# INLINE deintercalate #-}
213−deintercalate :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
214−deintercalate _ = Stream.parse (partition even)
215−
216− where
217−
218− partition p =
219− PR.deintercalate
220− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
221−
222−{-# INLINE deintercalate1 #-}
223−deintercalate1 :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
224−deintercalate1 _ = Stream.parse (partition even)
225−
226− where
227−
228− partition p =
229− PR.deintercalate1
230− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
231−
232−{-# INLINE deintercalateAll #-}
233−deintercalateAll :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
234−deintercalateAll _ = Stream.parse (partition even)
235−
236− where
237−
238− partition p =
239− PR.deintercalateAll
240− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
241−
242−{-# INLINE manyWordByEven #-}
243−manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())
244−manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)
245−
246−{-# INLINE many #-}
247−many :: Monad m => Stream m Int -> m (Either ParseError Int)
248−many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
249−
250−{-# INLINE manyAlt #-}
251−manyAlt :: Monad m => Stream m Int -> m Int
252−manyAlt xs = do
253− x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
254− return $ Prelude.length x
255−
256−{-# INLINE some #-}
257−some :: Monad m => Stream m Int -> m (Either ParseError Int)
258−some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
259−
260−{-# INLINE someAlt #-}
261−someAlt :: Monad m => Stream m Int -> m Int
262−someAlt xs = do
263− x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
264− return $ Prelude.length x
265−
266−{-# INLINE manyTill #-}
267−manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
268−manyTill value =
269− Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)
270−
271−{-# INLINE splitAp2 #-}
272−splitAp2 :: Monad m
273− => Int -> Stream m Int -> m (Either ParseError ((), ()))
274−splitAp2 value =
275− Stream.parse
276− ((,)
277− <$> PR.dropWhile (<= (value `div` 2))
278− <*> PR.dropWhile (<= value)
279− )
280−
281−{-# INLINE splitAp4 #-}
282−splitAp4 :: Monad m
283− => Int -> Stream m Int -> m (Either ParseError ())
284−splitAp4 value =
285− Stream.parse
286− ( (\() () () () -> ())
287− <$> PR.dropWhile (<= (value * 1 `div` 4))
288− <*> PR.dropWhile (<= (value * 2 `div` 4))
289− <*> PR.dropWhile (<= (value * 3 `div` 4))
290− <*> PR.dropWhile (<= value)
291− )
292−
293−{-# INLINE splitAp8 #-}
294−splitAp8 :: Monad m
295− => Int -> Stream m Int -> m (Either ParseError ())
296−splitAp8 value =
297− Stream.parse
298− ( (\() () () () () () () () -> ())
299− <$> PR.dropWhile (<= (value * 1 `div` 8))
300− <*> PR.dropWhile (<= (value * 2 `div` 8))
301− <*> PR.dropWhile (<= (value * 3 `div` 8))
302− <*> PR.dropWhile (<= (value * 4 `div` 8))
303− <*> PR.dropWhile (<= (value * 5 `div` 8))
304− <*> PR.dropWhile (<= (value * 6 `div` 8))
305− <*> PR.dropWhile (<= (value * 7 `div` 8))
306− <*> PR.dropWhile (<= value)
307− )
308−
309−{-# INLINE splitApBefore #-}
310−splitApBefore :: Monad m
311− => Int -> Stream m Int -> m (Either ParseError ())
312−splitApBefore value =
313− Stream.parse
314− ( PR.dropWhile (<= (value `div` 2))
315− *> PR.dropWhile (<= value)
316− )
317−
318−{-# INLINE splitApAfter #-}
319−splitApAfter :: Monad m
320− => Int -> Stream m Int -> m (Either ParseError ())
321−splitApAfter value =
322− Stream.parse
323− ( PR.dropWhile (<= (value `div` 2))
324− <* PR.dropWhile (<= value)
325− )
326−
327−{-# INLINE splitWith2 #-}
328−splitWith2 :: Monad m
329− => Int -> Stream m Int -> m (Either ParseError ((), ()))
330−splitWith2 value =
331− Stream.parse
332− (PR.splitWith (,)
333− (PR.dropWhile (<= (value `div` 2)))
334− (PR.dropWhile (<= value))
335− )
336−
337−{-# INLINE split_ #-}
338−split_ :: Monad m
339− => Int -> Stream m Int -> m (Either ParseError ())
340−split_ value =
341− Stream.parse
342− (PR.split_
343− (PR.dropWhile (<= (value `div` 2)))
344− (PR.dropWhile (<= value))
345− )
346−
347−-- XXX dropWhile with applicative does not fuse
348−-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
349−{-# INLINE takeWhileFail #-}
350−takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
351−takeWhileFail predicate (Fold fstep finitial _ ffinal) =
352− Parser step initial extract
353−
354− where
355−
356− initial = do
357− res <- finitial
358− return $ case res of
359− Fold.Partial s -> IPartial s
360− Fold.Done b -> IDone b
361−
362− step s a =
363− if predicate a
364− then do
365− fres <- fstep s a
366− return
367− $ case fres of
368− Fold.Partial s1 -> Partial 0 s1
369− Fold.Done b -> Done 0 b
370− else return $ Error "fail"
371−
372− extract s = fmap (Done 0) (ffinal s)
373−
374−{-# INLINE alt2 #-}
375−alt2 :: Monad m
376− => Int -> Stream m Int -> m (Either ParseError ())
377−alt2 value =
378− Stream.parse
379− (PR.alt
380− (takeWhileFail (<= (value `div` 2)) Fold.drain)
381− (PR.dropWhile (<= value))
382− )
383−
384−{-# INLINE alt4 #-}
385−alt4 :: Monad m
386− => Int -> Stream m Int -> m (Either ParseError ())
387−alt4 value =
388− Stream.parse
389− ( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain
390− <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain
391− <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain
392− <|> PR.dropWhile (<= value)
393− )
394−
395−{-# INLINE alt8 #-}
396−alt8 :: Monad m
397− => Int -> Stream m Int -> m (Either ParseError ())
398−alt8 value =
399− Stream.parse
400− ( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain
401− <|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain
402− <|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain
403− <|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain
404− <|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain
405− <|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain
406− <|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain
407− <|> PR.dropWhile (<= value)
408− )
409−
410−{-# INLINE alt16 #-}
411−alt16 :: Monad m
412− => Int -> Stream m Int -> m (Either ParseError ())
413−alt16 value =
414− Stream.parse
415− ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
416− <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
417− <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
418− <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
419− <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
420− <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
421− <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
422− <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
423− <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
424− <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
425− <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
426− <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
427− <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
428− <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
429− <|> PR.dropWhile (<= value)
430− )
431−
432−{-# INLINE altSmall #-}
433−altSmall :: Monad m
434− => Int -> Stream m Int -> m ()
435−altSmall value =
436− Stream.fold Fold.drain .
437− Stream.parseMany
438− (PR.alt
439− (PR.satisfy (>= value) *> PR.die "alt")
440− (PR.satisfy (<= value))
441− )
442−
443−{-# INLINE monad #-}
444−monad :: Monad m
445− => Int -> Stream m Int -> m (Either ParseError ())
446−monad value =
447− Stream.parse
448− $ do
449− PR.dropWhile (<= (value `div` 2))
450− PR.dropWhile (<= value)
451−
452−{-# INLINE monad4 #-}
453−monad4 :: Monad m
454− => Int -> Stream m Int -> m (Either ParseError ())
455−monad4 value =
456− Stream.parse $ do
457− PR.dropWhile (<= (value `div` 4))
458− PR.dropWhile (<= (value `div` 2))
459− PR.dropWhile (<= (value * 3 `div` 4))
460− PR.dropWhile (<= value)
461−
462−{-# INLINE monad8 #-}
463−monad8 :: Monad m
464− => Int -> Stream m Int -> m (Either ParseError ())
465−monad8 value =
466− Stream.parse $ do
467− PR.dropWhile (<= (value * 1 `div` 8))
468− PR.dropWhile (<= (value * 2 `div` 8))
469− PR.dropWhile (<= (value * 3 `div` 8))
470− PR.dropWhile (<= (value * 4 `div` 8))
471− PR.dropWhile (<= (value * 5 `div` 8))
472− PR.dropWhile (<= (value * 6 `div` 8))
473− PR.dropWhile (<= (value * 7 `div` 8))
474− PR.dropWhile (<= value)
475−
476−{-# INLINE monad16 #-}
477−monad16 :: Monad m
478− => Int -> Stream m Int -> m (Either ParseError ())
479−monad16 value =
480− Stream.parse $ do
481− PR.dropWhile (<= (value * 1 `div` 16))
482− PR.dropWhile (<= (value * 2 `div` 16))
483− PR.dropWhile (<= (value * 3 `div` 16))
484− PR.dropWhile (<= (value * 4 `div` 16))
485− PR.dropWhile (<= (value * 5 `div` 16))
486− PR.dropWhile (<= (value * 6 `div` 16))
487− PR.dropWhile (<= (value * 7 `div` 16))
488− PR.dropWhile (<= (value * 8 `div` 16))
489− PR.dropWhile (<= (value * 9 `div` 16))
490− PR.dropWhile (<= (value * 10 `div` 16))
491− PR.dropWhile (<= (value * 11 `div` 16))
492− PR.dropWhile (<= (value * 12 `div` 16))
493− PR.dropWhile (<= (value * 13 `div` 16))
494− PR.dropWhile (<= (value * 14 `div` 16))
495− PR.dropWhile (<= (value * 15 `div` 16))
496− PR.dropWhile (<= value)
497−
498−{-# INLINE takeEndBy_ #-}
499−takeEndBy_ :: Monad m
500− => Int -> Stream m Int -> m (Either ParseError ())
501−takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))
502−
503−{-
504−{-# INLINE teeAllAny #-}
505−teeAllAny :: Monad m
506− => Int -> Stream m Int -> m ((), ())
507−teeAllAny value =
508− Stream.parse
509− (PR.teeWith (,)
510− (PR.dropWhile (<= value))
511− (PR.dropWhile (<= value))
512− )
513−
514−{-# INLINE teeFstAllAny #-}
515−teeFstAllAny :: Monad m
516− => Int -> Stream m Int -> m ((), ())
517−teeFstAllAny value =
518− Stream.parse
519− (PR.teeWithFst (,)
520− (PR.dropWhile (<= value))
521− (PR.dropWhile (<= value))
522− )
523−
524−{-# INLINE shortestAllAny #-}
525−shortestAllAny :: Monad m
526− => Int -> Stream m Int -> m (Either ParseError ())
527−shortestAllAny value =
528− Stream.parse
529− (PR.shortest
530− (PR.dropWhile (<= value))
531− (PR.dropWhile (<= value))
532− )
533−
534−{-# INLINE longestAllAny #-}
535−longestAllAny :: Monad m
536− => Int -> Stream m Int -> m (Either ParseError ())
537−longestAllAny value =
538− Stream.parse
539− (PR.longest
540− (PR.dropWhile (<= value))
541− (PR.dropWhile (<= value))
542− )
543−-}
544−
545−-------------------------------------------------------------------------------
546−-- Spanning
547−-------------------------------------------------------------------------------
548−
549−{-# INLINE span #-}
550−span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
551−span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)
552−
553−{-# INLINE spanBy #-}
554−spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
555−spanBy value =
556− Stream.parse (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)
557−
558−{-# INLINE spanByRolling #-}
559−spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
560−spanByRolling value =
561− Stream.parse (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)
562−
563−parseManyChunksOfSum :: Int -> Handle -> IO Int
564−parseManyChunksOfSum n inh =
565− Stream.fold Fold.length
566− $ Stream.parseMany
567− (PR.fromFold $ Fold.take n Fold.sum)
568− (Stream.unfold Handle.reader inh)
569−
570−-------------------------------------------------------------------------------
571−-- Parsers in which -fspec-constr-recursive=16 is problematic
572−-------------------------------------------------------------------------------
573−
574−-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
575−-- We need to fix GHC so that we can have better control over that option or do
576−-- not have to rely on it.
577−--
578−{-# INLINE lookAhead #-}
579−lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
580−lookAhead value =
581− Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
582−
583−-- XXX The timing of this increased 3x after the stepify extract changes.
584−{-# INLINE sequenceA_ #-}
585−sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
586−sequenceA_ value =
587− Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
588−
589−-- quadratic complexity
590−{-# INLINE sequenceA #-}
591−sequenceA :: Monad m => Int -> Stream m Int -> m Int
592−sequenceA value xs = do
593− x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
594− return $ length x
595−
596−-- quadratic complexity
597−{-# INLINE sequence #-}
598−sequence :: Monad m => Int -> Stream m Int -> m Int
599−sequence value xs = do
600− x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
601− return $ length x
602−
603−{-# INLINE sequence_ #-}
604−sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
605−sequence_ value xs =
606− Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs
607−
608− where
609−
610− {-# INLINE f #-}
611− f m k = m >>= (\_ -> k)
612−
613−-- choice using the "Alternative" instance with direct style parser type has
614−-- quadratic performance complexity.
615−--
616−{-# INLINE choiceAsum #-}
617−choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
618−choiceAsum value =
619− Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
620− AP.<|> PR.satisfy (> 0))
621−
622−{-
623−{-# INLINE choice #-}
624−choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
625−choice value =
626− Stream.parse
627− (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
628−-}
629−
630−-------------------------------------------------------------------------------
631−-- Parsing with unfolds
632−-------------------------------------------------------------------------------
633−
634−{-# INLINE parseManyUnfoldArrays #-}
635−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
636−parseManyUnfoldArrays count arrays = do
637− let src = Producer.source (Just (Producer.OuterLoop arrays))
638− let parser = PR.fromFold (Fold.take count Fold.drain)
639− let readSrc =
640− Producer.producer
641− $ Producer.concat Producer.fromList Array.producer
642− let streamParser =
643− Producer.simplify (Producer.parseMany parser readSrc)
644− Stream.fold Fold.drain $ Stream.unfold streamParser src
645−
646−-------------------------------------------------------------------------------
647−-- Stream transformation
648−-------------------------------------------------------------------------------
649−
650−{-# INLINE parseMany #-}
651−parseMany :: Monad m => Int -> Stream m Int -> m ()
652−parseMany n =
653− Stream.fold Fold.drain
654− . fmap getSum
655− . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)
656− . fmap Sum
657−
658−{-# INLINE parseManyGroupBy #-}
659−parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()
660−parseManyGroupBy cmp =
661− Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)
662−
663−{-# INLINE parseManyGroupsRolling #-}
664−parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()
665−parseManyGroupsRolling b =
666− Stream.fold Fold.drain
667− . Stream.parseMany (PR.groupByRolling (\_ _ -> b) Fold.drain)
668−
669−{-# INLINE parseManyGroupsRollingEither #-}
670−parseManyGroupsRollingEither :: Monad m =>
671− (Int -> Int -> Bool) -> Int -> m ()
672−parseManyGroupsRollingEither cmp value = do
673− sourceUnfoldrM value 1
674− & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)
675− & Stream.fold Fold.drain
676−
677−{-# INLINE parseManyGroupsRollingEitherAlt #-}
678−parseManyGroupsRollingEitherAlt :: Monad m =>
679− (Int -> Int -> Bool) -> Int -> m ()
680−parseManyGroupsRollingEitherAlt cmp value = do
681− sourceUnfoldrM value 1
682− -- Make the input unsorted.
683− & fmap (\x -> if even x then x + 2 else x)
684− & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)
685− & Stream.fold Fold.drain
686−
687−{-# INLINE parseIterate #-}
688−parseIterate :: Monad m => Int -> Stream m Int -> m ()
689−parseIterate n =
690− Stream.fold Fold.drain
691− . fmap getSum
692− . Stream.catRights
693− . Stream.parseIterate
694− (PR.fromFold . Fold.take n . Fold.sconcat)
695− (Sum 0)
696− . fmap Sum
697−
698−{-# INLINE concatSequence #-}
699−concatSequence :: Monad m => Stream m Int -> m (Either ParseError ())
700−concatSequence =
701− Stream.parse $ PR.sequence (Stream.repeat PR.one) Fold.drain
702−
703−-------------------------------------------------------------------------------
704−-- Benchmarks
705−-------------------------------------------------------------------------------
706−
707−moduleName :: String
708−moduleName = "Data.Parser"
709−
710−instance NFData ParseError where
711− {-# INLINE rnf #-}
712− rnf (ParseError x) = rnf x
713−
714−o_1_space_serial :: Int -> [Benchmark]
715−o_1_space_serial value =
716− [ benchIOSink value "takeBetween" $ takeBetween value
717− , benchIOSink value "takeWhile" $ takeWhile value
718− , benchIOSink value "takeWhileP" $ takeWhileP value
719− , benchIOSink value "takeP" $ takeP value
720− , benchIOSink value "dropWhile" $ dropWhile value
721− , benchIOSink value "takeStartBy" $ takeStartBy value
722− , benchIOSink value "takeEndBy_" $ takeEndBy_ value
723− , benchIOSink value "groupBy" $ groupBy
724− , benchIOSink value "groupByRolling" $ groupByRolling
725− , benchIOSink value "wordBy" $ wordBy value
726− , benchIOSink value "sepBy (words)" sepByWords
727− , benchIOSink value "sepByAll (words)" sepByAllWords
728− , benchIOSink value "sepBy1 (words)" sepByWords1
729− , benchIOSink value "deintercalate" $ deintercalate value
730− , benchIOSink value "deintercalate1" $ deintercalate1 value
731− , benchIOSink value "deintercalateAll" $ deintercalateAll value
732− -- Applicative and Monad
733− , benchIOSink value "splitAp2" $ splitAp2 value
734− , benchIOSink value "splitAp4" $ splitAp4 value
735− , benchIOSink value "splitAp8" $ splitAp8 value
736− , benchIOSink value "splitApBefore" $ splitApBefore value
737− , benchIOSink value "splitApAfter" $ splitApAfter value
738− , benchIOSink value "splitWith2" $ splitWith2 value
739− , benchIOSink value "span" $ span value
740− , benchIOSink value "spanBy" $ spanBy value
741− , benchIOSink value "spanByRolling" $ spanByRolling value
742− , benchIOSink value "monad2" $ monad value
743− , benchIOSink value "monad4" $ monad4 value
744− , benchIOSink value "monad8" $ monad8 value
745− -- Alternative
746− , benchIOSink value "alt2parseMany" $ altSmall value
747− , benchIOSink value "alt2" $ alt2 value
748− , benchIOSink value "alt4" $ alt4 value
749− , benchIOSink value "alt8" $ alt8 value
750− , benchIOSink value "alt16" $ alt16 value
751− , benchIOSink value "many" many
752− , benchIOSink value "many (wordBy even)" $ manyWordByEven
753− , benchIOSink value "some" some
754− , benchIOSink value "manyTill" $ manyTill value
755− , benchIOSink value "parseMany" $ parseMany value
756− , benchIOSink value "parseMany (take 1)" (parseMany 1)
757− , benchIOSink value "parseMany (take all)" (parseMany value)
758− , benchIOSink value "parseMany (groupBy (<))" (parseManyGroupBy (<))
759− , benchIOSink value "parseMany (groupBy (==))" (parseManyGroupBy (==))
760− , benchIOSink value "parseMany groupRollingBy (bound groups)"
761− $ parseManyGroupsRolling False
762− , benchIOSink value "parseMany groupRollingBy (1 group)"
763− $ parseManyGroupsRolling True
764− , bench "parseMany groupRollingByEither (Left)"
765− $ nfIO $ parseManyGroupsRollingEitherLeft
766− , bench "parseMany groupRollingByEither (Right)"
767− $ nfIO $ parseManyGroupsRollingEitherRight
768− , bench "parseMany groupRollingByEither (Alternating)"
769− $ nfIO $ parseManyGroupsRollingEitherAlt1
770− , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
771− , benchIOSink value "parseIterate (take all)" (parseIterate value)
772− , benchIOSink value "concatSequence" concatSequence
773− {-
774− , benchIOSink value "tee" $ teeAllAny value
775− , benchIOSink value "teeFst" $ teeFstAllAny value
776− , benchIOSink value "shortest" $ shortestAllAny value
777− , benchIOSink value "longest" $ longestAllAny value
778− -}
779− , benchIOSink value "streamEqBy" (streamEqBy value)
780− ]
781−
782− where
783−
784− {-# NOINLINE parseManyGroupsRollingEitherLeft #-}
785− parseManyGroupsRollingEitherLeft = parseManyGroupsRollingEither (<) value
786−
787− {-# NOINLINE parseManyGroupsRollingEitherRight #-}
788− parseManyGroupsRollingEitherRight = parseManyGroupsRollingEither (>) value
789−
790− {-# NOINLINE parseManyGroupsRollingEitherAlt1 #-}
791− parseManyGroupsRollingEitherAlt1 =
792− parseManyGroupsRollingEitherAlt (>) value
793−
794−o_1_space_filesystem :: BenchEnv -> [Benchmark]
795−o_1_space_filesystem env =
796− [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env
797− $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
798− , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env
799− $ \inh _ -> inline parseManyChunksOfSum 1 inh
800− ]
801−
802−o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]
803−o_1_space_serial_unfold bound arrays =
804− [ bench "parseMany/Unfold/1000 arrays/take all"
805− $ nfIO $ parseManyUnfoldArrays bound arrays
806− , bench "parseMany/Unfold/1000 arrays/take 1"
807− $ nfIO $ parseManyUnfoldArrays 1 arrays
808− ]
809−
810−o_n_heap_serial :: Int -> [Benchmark]
811−o_n_heap_serial value =
812− [
813− benchIOSink value "takeEQ" $ takeEQ value
814− , benchIOSink value "takeGE" $ takeGE value
815−
816− -- lookahead benchmark holds the entire input till end
817− , benchIOSink value "lookAhead" $ lookAhead value
818−
819− -- o-n-heap because of backtracking
820− , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
821− $ takeFramedByEsc_ value
822−
823− -- non-linear time complexity (parserD)
824− , benchIOSink value "split_" $ split_ value
825− -- XXX Takes lot of space when run on a long stream, why?
826− , benchIOSink value "monad16" $ monad16 value
827−
828− -- These show non-linear time complexity.
829− -- They accumulate the results in a list.
830− , benchIOSink value "sepBy1" sepBy1
831− , benchIOSink value "manyAlt" manyAlt
832− , benchIOSink value "someAlt" someAlt
833− , benchIOSink value "listEqBy" (listEqBy value)
834− ]
835−
836−-- accumulate results in a list in IO
837−o_n_space_serial :: Int -> [Benchmark]
838−o_n_space_serial value =
839− [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
840− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
841− , benchIOSink value "sequence/100" $ sequence (value `div` 100)
842− , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
843− , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
844− -- , benchIOSink value "choice/100" $ choice (value `div` 100)
845− ]
846−
847−-------------------------------------------------------------------------------
848−-- Driver
849−-------------------------------------------------------------------------------
850−
851−main :: IO ()
852−main = do
853−#ifndef FUSION_CHECK
854− env <- mkHandleBenchEnv
855− runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
856−
857− where
858−
859− alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
860−
861− allBenchmarks env arrays value =
862− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
863− , bgroup
864− (o_1_space_prefix moduleName ++ "/filesystem")
865− (o_1_space_filesystem env)
866− , bgroup (o_1_space_prefix moduleName)
867− (o_1_space_serial_unfold value arrays)
868− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
869− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
870− ]
871−#else
872− -- Enable FUSION_CHECK macro at the beginning of the file
873− -- Enable one benchmark below, and run the benchmark
874− -- Check the .dump-simpl output
875− let value = 100000
876− -- let input = sourceUnfoldrM value 1
877− -- manyTill value input
878− -- deintercalate value input
879− -- deintercalate1 value input
880− -- deintercalateAll value input
881− -- sepByWords input
882− -- sepByAllWords input
883− -- sepBy1 input
884− -- sepByWords1 input
885− takeFramedByEsc_ value (sourceEscapedFrames value 1)
886− return ()
887−#endif
benchmark/Streamly/Benchmark/Data/ParserK.hsdeleted−437
@@ -1,437 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.ParserK
3−-- Copyright : (c) 2020 Composewell Technologies
4−--
5−-- License : BSD-3-Clause
6−-- Maintainer : streamly@composewell.com
7−
8−-- BENCH_CHUNKED -> adaptC
9−-- BENCH_CHUNKED_GENERIC -> adaptCG
10−-- BENCH_SINGULAR -> adapt
11−
12−{-# LANGUAGE CPP #-}
13−{-# LANGUAGE FlexibleContexts #-}
14−{-# OPTIONS_GHC -Wno-orphans #-}
15−
16−module Main
17− (
18− main
19− ) where
20−
21−import Control.Applicative ((<|>))
22−import Control.DeepSeq (NFData(..))
23−import Control.Monad.IO.Class (MonadIO)
24−import Data.Foldable (asum)
25−#ifdef BENCH_CHUNKED
26−import Streamly.Data.Array (Array, Unbox)
27−#endif
28−#ifdef BENCH_CHUNKED_GENERIC
29−import Streamly.Data.Array.Generic (Array)
30−import qualified Streamly.Internal.Data.Array.Generic as GenArr (chunksOf)
31−#endif
32−import Streamly.Internal.Data.Fold (Fold(..))
33−import Streamly.Data.StreamK (StreamK)
34−import Streamly.Internal.Data.Parser
35− (ParseError(..), Parser(..), Initial(..), Step(..))
36−import Streamly.Internal.Data.Stream (Stream)
37−import System.Random (randomRIO)
38−import Prelude hiding
39− (any, all, take, sequence, sequence_, sequenceA, takeWhile)
40−
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
43−import qualified Data.Traversable as TR
44−import qualified Streamly.Data.Stream as Stream
45−import qualified Streamly.Data.Fold as FL
46−import qualified Streamly.Internal.Data.Fold as Fold
47−import qualified Streamly.Data.Parser as PRD
48−import qualified Streamly.Internal.Data.ParserK as PR
49−import qualified Streamly.Internal.Data.StreamK as StreamK
50−
51−import Test.Tasty.Bench
52−import Streamly.Benchmark.Common
53−
54−-------------------------------------------------------------------------------
55−-- CPP Helpers
56−-------------------------------------------------------------------------------
57−
58−#ifdef BENCH_CHUNKED
59−
60−#define PARSE_OP StreamK.parseChunks
61−#define FROM_PARSER adaptC
62−#define INPUT (Array a)
63−#define PARSE_ELEM (Array Int)
64−#define CONSTRAINT_IO (MonadIO m, Unbox a)
65−#define CONSTRAINT (Monad m, Unbox a)
66−#define MODULE_NAME "Data.ParserK.Chunked"
67−
68−#endif
69−
70−#ifdef BENCH_CHUNKED_GENERIC
71−
72−#define PARSE_OP StreamK.parseChunksGeneric
73−#define FROM_PARSER adaptCG
74−#define INPUT (Array a)
75−#define PARSE_ELEM (Array Int)
76−#define CONSTRAINT_IO (MonadIO m)
77−#define CONSTRAINT (Monad m)
78−#define MODULE_NAME "Data.ParserK.Chunked.Generic"
79−
80−#endif
81−
82−#ifdef BENCH_SINGULAR
83−
84−#define PARSE_OP StreamK.parse
85−#define FROM_PARSER adapt
86−#define INPUT a
87−#define PARSE_ELEM Int
88−#define CONSTRAINT_IO (MonadIO m)
89−#define CONSTRAINT (Monad m)
90−#define MODULE_NAME "Data.ParserK"
91−
92−#endif
93−
94−-------------------------------------------------------------------------------
95−-- Utilities
96−-------------------------------------------------------------------------------
97−
98−-- XXX these can be moved to the common module
99−
100−{-# INLINE sourceUnfoldrM #-}
101−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
102−sourceUnfoldrM value n = Stream.unfoldrM step n
103− where
104− step cnt =
105− if cnt > n + value
106− then return Nothing
107− else return (Just (cnt, cnt + 1))
108−
109−-- | Takes a fold method, and uses it with a default source.
110−{-# INLINE benchIOSink #-}
111−benchIOSink
112− :: NFData b
113− => Int -> String -> (StreamK IO PARSE_ELEM -> IO b) -> Benchmark
114−benchIOSink value name f =
115− bench name $ nfIO $ randomRIO (1,1)
116− >>= f
117− . StreamK.fromStream
118−#ifdef BENCH_CHUNKED
119− . Stream.chunksOf 4000
120−#endif
121−#ifdef BENCH_CHUNKED_GENERIC
122− . GenArr.chunksOf 4000
123−#endif
124− . sourceUnfoldrM value
125−
126−-------------------------------------------------------------------------------
127−-- Parsers
128−-------------------------------------------------------------------------------
129−
130−{-# INLINE one #-}
131−one :: MonadIO m =>
132− Int -> StreamK m PARSE_ELEM -> m (Either ParseError (Maybe Int))
133−one value = PARSE_OP p
134−
135− where
136−
137− p = do
138− m <- PR.FROM_PARSER (PRD.fromFold FL.one)
139− case m of
140− Just i -> if i >= value then pure m else p
141− Nothing -> pure Nothing
142−
143−{-# INLINE satisfy #-}
144−satisfy :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m a
145−satisfy = PR.FROM_PARSER . PRD.satisfy
146−
147−{-# INLINE takeWhile #-}
148−takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()
149−takeWhile p = PR.FROM_PARSER $ PRD.takeWhile p FL.drain
150−
151−{-# INLINE takeWhileK #-}
152−takeWhileK :: MonadIO m =>
153− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
154−takeWhileK value = PARSE_OP (takeWhile (<= value))
155−
156−{-# INLINE splitAp2 #-}
157−splitAp2 :: MonadIO m
158− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ((), ()))
159−splitAp2 value =
160− PARSE_OP
161− ((,)
162− <$> takeWhile (<= (value `div` 2))
163− <*> takeWhile (<= value)
164− )
165−
166−{-# INLINE splitAp8 #-}
167−splitAp8 :: MonadIO m
168− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
169−splitAp8 value =
170− PARSE_OP
171− ( (\() () () () () () () () -> ())
172− <$> takeWhile (<= ( value `div` 8))
173− <*> takeWhile (<= ((value * 2) `div` 8))
174− <*> takeWhile (<= ((value * 3) `div` 8))
175− <*> takeWhile (<= ((value * 4) `div` 8))
176− <*> takeWhile (<= ((value * 5) `div` 8))
177− <*> takeWhile (<= ((value * 6) `div` 8))
178− <*> takeWhile (<= ((value * 7) `div` 8))
179− <*> takeWhile (<= value)
180− )
181−
182−{-# INLINE sequenceA #-}
183−sequenceA :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int
184−sequenceA value xs = do
185− let parser = satisfy (> 0)
186− list = Prelude.replicate value parser
187− x <- PARSE_OP (TR.sequenceA list) xs
188− return $ Prelude.length x
189−
190−{-# INLINE sequenceA_ #-}
191−sequenceA_ :: MonadIO m =>
192− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
193−sequenceA_ value xs = do
194− let parser = satisfy (> 0)
195− list = Prelude.replicate value parser
196− PARSE_OP (F.sequenceA_ list) xs
197−
198−{-# INLINE sequence #-}
199−sequence :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int
200−sequence value xs = do
201− let parser = satisfy (> 0)
202− list = Prelude.replicate value parser
203− x <- PARSE_OP (TR.sequence list) xs
204− return $ Prelude.length x
205−
206−{-# INLINE sequence_ #-}
207−sequence_ :: MonadIO m =>
208− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
209−sequence_ value =
210− let parser = satisfy (> 0)
211− list = Prelude.replicate value parser
212− in PARSE_OP (F.sequence_ list)
213−
214−{-# INLINE takeWhileFailD #-}
215−takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
216−takeWhileFailD predicate (Fold fstep finitial _ ffinal) =
217− Parser step initial extract
218−
219− where
220−
221− initial = do
222− res <- finitial
223− return $ case res of
224− Fold.Partial s -> IPartial s
225− Fold.Done b -> IDone b
226−
227− step s a =
228− if predicate a
229− then do
230− fres <- fstep s a
231− return
232− $ case fres of
233− Fold.Partial s1 -> Partial 0 s1
234− Fold.Done b -> Done 0 b
235− else return $ Error "fail"
236−
237− extract s = fmap (Done 0) (ffinal s)
238−
239−{-# INLINE takeWhileFail #-}
240−takeWhileFail :: CONSTRAINT =>
241− (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b
242−takeWhileFail p f = PR.FROM_PARSER (takeWhileFailD p f)
243−
244−{-# INLINE alt2 #-}
245−alt2 :: MonadIO m
246− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
247−alt2 value =
248− PARSE_OP
249− ( takeWhileFail (<= (value `div` 2)) Fold.drain
250− <|> takeWhile (<= value)
251− )
252−
253−{-# INLINE alt8 #-}
254−alt8 :: MonadIO m
255− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
256−alt8 value =
257− PARSE_OP
258− ( takeWhileFail (<= ( value `div` 8)) Fold.drain
259− <|> takeWhileFail (<= ((value * 2) `div` 8)) Fold.drain
260− <|> takeWhileFail (<= ((value * 3) `div` 8)) Fold.drain
261− <|> takeWhileFail (<= ((value * 4) `div` 8)) Fold.drain
262− <|> takeWhileFail (<= ((value * 5) `div` 8)) Fold.drain
263− <|> takeWhileFail (<= ((value * 6) `div` 8)) Fold.drain
264− <|> takeWhileFail (<= ((value * 7) `div` 8)) Fold.drain
265− <|> takeWhile (<= value)
266− )
267−
268−{-# INLINE alt16 #-}
269−alt16 :: MonadIO m
270− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
271−alt16 value =
272− PARSE_OP
273− ( takeWhileFail (<= ( value `div` 16)) Fold.drain
274− <|> takeWhileFail (<= ((value * 2) `div` 16)) Fold.drain
275− <|> takeWhileFail (<= ((value * 3) `div` 16)) Fold.drain
276− <|> takeWhileFail (<= ((value * 4) `div` 16)) Fold.drain
277− <|> takeWhileFail (<= ((value * 5) `div` 16)) Fold.drain
278− <|> takeWhileFail (<= ((value * 6) `div` 16)) Fold.drain
279− <|> takeWhileFail (<= ((value * 7) `div` 16)) Fold.drain
280− <|> takeWhileFail (<= ((value * 8) `div` 16)) Fold.drain
281− <|> takeWhileFail (<= ((value * 9) `div` 16)) Fold.drain
282− <|> takeWhileFail (<= ((value * 10) `div` 16)) Fold.drain
283− <|> takeWhileFail (<= ((value * 11) `div` 16)) Fold.drain
284− <|> takeWhileFail (<= ((value * 12) `div` 16)) Fold.drain
285− <|> takeWhileFail (<= ((value * 13) `div` 16)) Fold.drain
286− <|> takeWhileFail (<= ((value * 14) `div` 16)) Fold.drain
287− <|> takeWhileFail (<= ((value * 15) `div` 16)) Fold.drain
288− <|> takeWhile (<= value)
289− )
290−
291−{-# INLINE manyAlt #-}
292−manyAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int
293−manyAlt xs = do
294− x <- PARSE_OP (AP.many (satisfy (> 0))) xs
295− return $ Prelude.length x
296−
297−{-# INLINE someAlt #-}
298−someAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int
299−someAlt xs = do
300− x <- PARSE_OP (AP.some (satisfy (> 0))) xs
301− return $ Prelude.length x
302−
303−{-# INLINE choice #-}
304−choice :: MonadIO m =>
305− Int -> StreamK m PARSE_ELEM -> m (Either ParseError Int)
306−choice value =
307− PARSE_OP (asum (replicate value (satisfy (< 0)))
308− AP.<|> satisfy (> 0))
309−
310−{-# INLINE monad2 #-}
311−monad2 :: MonadIO m
312− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
313−monad2 value =
314− PARSE_OP $ do
315− takeWhile (<= (value `div` 2))
316− takeWhile (<= value)
317−
318−{-# INLINE monad4 #-}
319−monad4 :: MonadIO m
320− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
321−monad4 value =
322− PARSE_OP $ do
323− takeWhile (<= ( value `div` 4))
324− takeWhile (<= ((value * 2) `div` 4))
325− takeWhile (<= ((value * 3) `div` 4))
326− takeWhile (<= value)
327−
328−{-# INLINE monad8 #-}
329−monad8 :: MonadIO m
330− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
331−monad8 value =
332− PARSE_OP $ do
333− takeWhile (<= ( value `div` 8))
334− takeWhile (<= ((value * 2) `div` 8))
335− takeWhile (<= ((value * 3) `div` 8))
336− takeWhile (<= ((value * 4) `div` 8))
337− takeWhile (<= ((value * 5) `div` 8))
338− takeWhile (<= ((value * 6) `div` 8))
339− takeWhile (<= ((value * 7) `div` 8))
340− takeWhile (<= value)
341−
342−{-# INLINE monad16 #-}
343−monad16 :: MonadIO m
344− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
345−monad16 value =
346− PARSE_OP $ do
347− takeWhile (<= ( value `div` 16))
348− takeWhile (<= ((value * 2) `div` 16))
349− takeWhile (<= ((value * 3) `div` 16))
350− takeWhile (<= ((value * 4) `div` 16))
351− takeWhile (<= ((value * 5) `div` 16))
352− takeWhile (<= ((value * 6) `div` 16))
353− takeWhile (<= ((value * 7) `div` 16))
354− takeWhile (<= ((value * 8) `div` 16))
355− takeWhile (<= ((value * 9) `div` 16))
356− takeWhile (<= ((value * 10) `div` 16))
357− takeWhile (<= ((value * 11) `div` 16))
358− takeWhile (<= ((value * 12) `div` 16))
359− takeWhile (<= ((value * 13) `div` 16))
360− takeWhile (<= ((value * 14) `div` 16))
361− takeWhile (<= ((value * 15) `div` 16))
362− takeWhile (<= value)
363−
364−-------------------------------------------------------------------------------
365−-- Benchmarks
366−-------------------------------------------------------------------------------
367−
368−moduleName :: String
369−moduleName = MODULE_NAME
370−
371−instance NFData ParseError where
372− {-# INLINE rnf #-}
373− rnf (ParseError x) = rnf x
374−
375−o_1_space_serial :: Int -> [Benchmark]
376−o_1_space_serial value =
377− [ benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)
378− , benchIOSink value "takeWhile" $ takeWhileK value
379− , benchIOSink value "splitAp2" $ splitAp2 value
380− , benchIOSink value "splitAp8" $ splitAp8 value
381− , benchIOSink value "alt2" $ alt2 value
382− , benchIOSink value "alt8" $ alt8 value
383− , benchIOSink value "alt16" $ alt16 value
384− , benchIOSink value "monad2" $ monad2 value
385− , benchIOSink value "monad4" $ monad4 value
386− , benchIOSink value "monad8" $ monad8 value
387− , benchIOSink value "monad16" $ monad16 value
388− ]
389−
390−{-# INLINE sepBy1 #-}
391−sepBy1 :: MonadIO m => StreamK m PARSE_ELEM -> m Int
392−sepBy1 xs = do
393− x <- PARSE_OP (parser (satisfy odd) (satisfy even)) xs
394− return $ Prelude.length x
395−
396− where
397−
398− parser p sep = do
399− x <- p
400− fmap (x :) $ AP.many (sep >> p)
401−
402−-- O(n) heap beacuse of accumulation of the list in strict IO monad?
403−o_n_heap_serial :: Int -> [Benchmark]
404−o_n_heap_serial value =
405− [
406− -- accumulates the results in a list
407− -- XXX why should this take O(n) heap, it discards the results?
408− benchIOSink value "sequence_" $ sequence_ value
409− , benchIOSink value "sequenceA_" $ sequenceA_ value
410− , benchIOSink value "sequence" $ sequence value
411− , benchIOSink value "sequenceA" $ sequenceA value
412− , benchIOSink value "manyAlt" manyAlt
413− , benchIOSink value "sepBy1" sepBy1
414− , benchIOSink value "someAlt" someAlt
415− , benchIOSink value "choice" $ choice value
416− ]
417−
418−-- O(n) heap beacuse of accumulation of the list in strict IO monad?
419−o_1_space_recursive :: Int -> [Benchmark]
420−o_1_space_recursive value =
421− [ benchIOSink value "one (recursive)" $ one value
422− ]
423−
424−-------------------------------------------------------------------------------
425−-- Driver
426−-------------------------------------------------------------------------------
427−
428−main :: IO ()
429−main = runWithCLIOpts defaultStreamSize allBenchmarks
430−
431− where
432−
433− allBenchmarks value =
434− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
435− , bgroup (o_1_space_prefix moduleName) (o_1_space_recursive value)
436− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
437− ]
benchmark/Streamly/Benchmark/Data/Prim/Array.hsnew file+100
@@ -0,0 +1,100 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+
12+module Main (main) where
13+
14+import Control.DeepSeq (NFData(..))
15+import System.Random (randomRIO)
16+
17+import qualified Streamly.Benchmark.Data.Prim.ArrayOps as Ops
18+import qualified Streamly.Internal.Data.Prim.Array as A
19+import qualified Streamly.Prelude as S
20+
21+import Gauge
22+
23+-------------------------------------------------------------------------------
24+--
25+-------------------------------------------------------------------------------
26+
27+{-# INLINE benchIO #-}
28+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
29+benchIO name src f = bench name $ nfIO $
30+ randomRIO (1,1) >>= src >>= return . f
31+
32+-- Drain a source that generates an array in the IO monad
33+{-# INLINE benchIOSrc #-}
34+benchIOSrc :: A.Prim a => String -> (Int -> IO (Ops.Stream a)) -> Benchmark
35+benchIOSrc name src = benchIO name src id
36+
37+{-# INLINE benchPureSink #-}
38+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark
39+benchPureSink name f = benchIO name Ops.sourceIntFromTo f
40+
41+{-# INLINE benchIO' #-}
42+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
43+benchIO' name src f = bench name $ nfIO $
44+ randomRIO (1,1) >>= src >>= f
45+
46+{-# INLINE benchIOSink #-}
47+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark
48+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f
49+
50+{-
51+mkString :: String
52+mkString = "[1" ++ concat (replicate Ops.value ",1") ++ "]"
53+-}
54+
55+main :: IO ()
56+main =
57+ defaultMain
58+ [ bgroup "Data.Prim.Array"
59+ [ bgroup "generation"
60+ [ benchIOSrc "writeN . intFromTo" Ops.sourceIntFromTo
61+ , benchIOSrc "write . intFromTo" Ops.sourceIntFromToFromStream
62+ , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList
63+ , benchIOSrc "writeN . unfoldr" Ops.sourceUnfoldr
64+ , benchIOSrc "writeN . fromList" Ops.sourceFromList
65+ -- , benchPureSrc "writeN . IsList.fromList" Ops.sourceIsList
66+ -- , benchPureSrc "writeN . IsString.fromString" Ops.sourceIsString
67+ -- , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)
68+ , benchPureSink "show" Ops.showInstance
69+ ]
70+ , bgroup "elimination"
71+ [ benchPureSink "id" id
72+ , benchPureSink "==" Ops.eqInstance
73+ , benchPureSink "/=" Ops.eqInstanceNotEq
74+ , benchPureSink "<" Ops.ordInstance
75+ , benchPureSink "min" Ops.ordInstanceMin
76+ -- length is used to check for foldr/build fusion
77+ -- , benchPureSink "length . IsList.toList" (length . GHC.toList)
78+ , benchIOSink "foldl'" Ops.pureFoldl'
79+ , benchIOSink "read" (S.drain . S.unfold A.read)
80+ , benchIOSink "toStreamRev" (S.drain . A.toStreamRev)
81+#if 0
82+ -- PrimArray does not have a Foldable instance because it requires a
83+ -- Prim constraint. Though it should be possible to make an instance in
84+ -- the same way as we do in Memory.Array.
85+ , benchPureSink "foldable/foldl'" Ops.foldableFoldl'
86+ , benchPureSink "foldable/sum" Ops.foldableSum
87+#endif
88+ ]
89+ , bgroup "transformation"
90+ [ benchIOSink "scanl'" (Ops.scanl' 1)
91+ , benchIOSink "scanl1'" (Ops.scanl1' 1)
92+ , benchIOSink "map" (Ops.map 1)
93+ ]
94+ , bgroup "transformationX4"
95+ [ benchIOSink "scanl'" (Ops.scanl' 4)
96+ , benchIOSink "scanl1'" (Ops.scanl1' 4)
97+ , benchIOSink "map" (Ops.map 4)
98+ ]
99+ ]
100+ ]
benchmark/Streamly/Benchmark/Data/Prim/ArrayOps.hsnew file+153
@@ -0,0 +1,153 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Prim.ArrayOps
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE DeriveAnyClass #-}
12+{-# LANGUAGE DeriveGeneric #-}
13+{-# LANGUAGE FlexibleContexts #-}
14+{-# LANGUAGE ScopedTypeVariables #-}
15+
16+module Streamly.Benchmark.Data.Prim.ArrayOps where
17+
18+import Control.Monad.IO.Class (MonadIO)
19+import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20+import qualified Prelude as P
21+#ifdef DEVBUILD
22+-- import qualified Data.Foldable as F
23+#endif
24+
25+import qualified Streamly as S hiding (foldMapWith, runStream)
26+import qualified Streamly.Internal.Data.Prim.Array as A
27+import qualified Streamly.Prelude as S
28+
29+value :: Int
30+value = 100000
31+
32+-------------------------------------------------------------------------------
33+-- Benchmark ops
34+-------------------------------------------------------------------------------
35+
36+-------------------------------------------------------------------------------
37+-- Stream generation and elimination
38+-------------------------------------------------------------------------------
39+
40+type Stream = A.PrimArray
41+
42+{-# INLINE sourceUnfoldr #-}
43+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
44+sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
45+ where
46+ step cnt =
47+ if cnt > n + value
48+ then Nothing
49+ else (Just (cnt, cnt + 1))
50+
51+{-# INLINE sourceIntFromTo #-}
52+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
53+sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
54+
55+{-# INLINE sourceIntFromToFromStream #-}
56+sourceIntFromToFromStream :: MonadIO m => Int -> m (Stream Int)
57+sourceIntFromToFromStream n = S.fold A.write $ S.enumerateFromTo n (n + value)
58+
59+{-# INLINE sourceIntFromToFromList #-}
60+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
61+sourceIntFromToFromList n = P.return $ A.fromList $ [n..n + value]
62+
63+{-# INLINE sourceFromList #-}
64+sourceFromList :: MonadIO m => Int -> m (Stream Int)
65+sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
66+{-
67+{-# INLINE sourceIsList #-}
68+sourceIsList :: Int -> Stream Int
69+sourceIsList n = GHC.fromList [n..n+value]
70+
71+{-# INLINE sourceIsString #-}
72+sourceIsString :: Int -> Stream P.Char
73+sourceIsString n = GHC.fromString (P.replicate (n + value) 'a')
74+-}
75+-------------------------------------------------------------------------------
76+-- Transformation
77+-------------------------------------------------------------------------------
78+
79+{-# INLINE composeN #-}
80+composeN :: P.Monad m
81+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
82+composeN n f x =
83+ case n of
84+ 1 -> f x
85+ 2 -> f x P.>>= f
86+ 3 -> f x P.>>= f P.>>= f
87+ 4 -> f x P.>>= f P.>>= f P.>>= f
88+ _ -> undefined
89+
90+{-# INLINE scanl' #-}
91+{-# INLINE scanl1' #-}
92+{-# INLINE map #-}
93+
94+scanl', scanl1', map
95+ :: MonadIO m => Int -> Stream Int -> m (Stream Int)
96+
97+{-# INLINE onArray #-}
98+onArray
99+ :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
100+ -> Stream Int
101+ -> m (Stream Int)
102+onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
103+
104+scanl' n = composeN n $ onArray $ S.scanl' (+) 0
105+scanl1' n = composeN n $ onArray $ S.scanl1' (+)
106+map n = composeN n $ onArray $ S.map (+1)
107+
108+{-# INLINE eqInstance #-}
109+eqInstance :: Stream Int -> Bool
110+eqInstance src = src == src
111+
112+{-# INLINE eqInstanceNotEq #-}
113+eqInstanceNotEq :: Stream Int -> Bool
114+eqInstanceNotEq src = src P./= src
115+
116+{-# INLINE ordInstance #-}
117+ordInstance :: Stream Int -> Bool
118+ordInstance src = src P.< src
119+
120+{-# INLINE ordInstanceMin #-}
121+ordInstanceMin :: Stream Int -> Stream Int
122+ordInstanceMin src = P.min src src
123+
124+{-# INLINE showInstance #-}
125+showInstance :: Stream Int -> P.String
126+showInstance src = P.show src
127+
128+{-
129+{-# INLINE readInstance #-}
130+readInstance :: P.String -> Stream Int
131+readInstance str =
132+ let r = P.reads str
133+ in case r of
134+ [(x,"")] -> x
135+ _ -> P.error "readInstance: no parse"
136+-}
137+
138+{-# INLINE pureFoldl' #-}
139+pureFoldl' :: MonadIO m => Stream Int -> m Int
140+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
141+
142+#if 0
143+-- PrimArray does not have a Foldable instance because it reuqires a Prim
144+-- constraint. Though it should be possible to make an instance in the same way
145+-- as we do in Memory.Array.
146+{-# INLINE foldableFoldl' #-}
147+foldableFoldl' :: Stream Int -> Int
148+foldableFoldl' = F.foldl' (+) 0
149+
150+{-# INLINE foldableSum #-}
151+foldableSum :: Stream Int -> Int
152+foldableSum = P.sum
153+#endif
benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hsdeleted−69
@@ -1,69 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Ring.Unboxed
3−-- Copyright : (c) 2022 Composewell
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE RankNTypes #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−
11−module Main (main) where
12−
13−import Control.Monad (void)
14−import GHC.Ptr (Ptr(..))
15−import qualified Streamly.Internal.Data.Array as Array
16−import qualified Streamly.Internal.Data.Ring as Ring
17−import qualified Data.Foldable as P
18−
19−import Test.Tasty.Bench
20−import Streamly.Benchmark.Common
21−
22−import Prelude as P
23−
24−-------------------------------------------------------------------------------
25−-- Benchmark ops
26−-------------------------------------------------------------------------------
27−
28−unsafeEqArrayN :: (Int, Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool
29−unsafeEqArrayN (value, arr, (ring, rh)) = Ring.unsafeEqArrayN ring rh arr value
30−
31−unsafeEqArray :: (Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool
32−unsafeEqArray (arr, (ring, rh)) = Ring.unsafeEqArray ring rh arr
33−
34−-------------------------------------------------------------------------------
35−-- Benchmark groups
36−-------------------------------------------------------------------------------
37−
38−o_1_space_serial ::
39− Int -> Array.Array Int -> (Ring.Ring Int, Ptr Int) -> [Benchmark]
40−o_1_space_serial value arr (ring, rh) =
41− [ bench "unsafeEqArrayN" $ nf unsafeEqArrayN (value, arr, (ring, rh))
42− , bench "unsafeEqArray" $ nf unsafeEqArray (arr, (ring, rh))
43− ]
44−
45−-------------------------------------------------------------------------------
46−-- Main
47−-------------------------------------------------------------------------------
48−
49−moduleName :: String
50−moduleName = "Data.Ring.Unboxed"
51−
52−main :: IO ()
53−main = do
54− runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
55−
56− where
57−
58− alloc value = do
59− let input = [1 .. value] :: [Int]
60− let arr = Array.fromList input
61− (ring, rh) <- Ring.new value
62− void $ P.foldlM (Ring.unsafeInsert ring) rh input
63− return (arr, (ring, rh))
64−
65− allBenchmarks (arr, (ring, rh)) value =
66− [ bgroup
67− (o_1_space_prefix moduleName)
68− (o_1_space_serial value arr (ring, rh))
69− ]
benchmark/Streamly/Benchmark/Data/Serialize.hsdeleted−591
@@ -1,591 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−{- HLINT ignore -}
3−
4−#undef FUSION_CHECK
5−#ifdef FUSION_CHECK
6−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
7−#endif
8−
9−-- |
10−-- Module : Streamly.Benchmark.Data.Serialize
11−-- Copyright : (c) 2023 Composewell
12−-- License : BSD-3-Clause
13−-- Maintainer : streamly@composewell.com
14−
15−module Main (main) where
16−
17−-------------------------------------------------------------------------------
18−-- Imports
19−-------------------------------------------------------------------------------
20−
21−import Control.DeepSeq (NFData(..), deepseq)
22−import Control.Monad (when, void)
23−import GHC.Generics (Generic)
24−import System.Random (randomRIO)
25−#ifndef USE_UNBOX
26−import Test.QuickCheck (Arbitrary, arbitrary)
27−#endif
28−
29−import Streamly.Internal.Data.MutByteArray
30−import qualified Streamly.Internal.Data.MutByteArray as MBA
31−#ifdef USE_UNBOX
32−import Data.Proxy (Proxy(..))
33−#else
34−import Control.DeepSeq (force)
35−import Test.QuickCheck (oneof, generate)
36−#endif
37−
38−import Test.Tasty.Bench
39−import Streamly.Benchmark.Common
40−
41−#ifndef USE_UNBOX
42−import Streamly.Benchmark.Data.Serialize.RecCompatible
43−import Streamly.Benchmark.Data.Serialize.RecNonCompatible
44−#endif
45−
46−#ifdef USE_UNBOX
47−#define SERIALIZE_CLASS Unbox
48−#define DERIVE_CLASS(typ) $(deriveUnbox [d|instance Unbox typ|])
49−#define SERIALIZE_OP pokeAt
50−#define DESERIALIZE_OP peekAt
51−#else
52−#define SERIALIZE_CLASS Serialize
53−#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])
54−#define SERIALIZE_OP serializeAt
55−#define DESERIALIZE_OP deserializeAt
56−#endif
57−
58−-------------------------------------------------------------------------------
59−-- Types
60−-------------------------------------------------------------------------------
61−
62−data Unit = Unit
63− deriving (Generic, Show, Eq)
64−
65−#ifndef USE_TH
66−instance SERIALIZE_CLASS Unit
67−#else
68−DERIVE_CLASS(Unit)
69−#endif
70−
71−instance NFData Unit where
72− {-# INLINE rnf #-}
73− rnf _ = ()
74−
75−data Sum2
76− = Sum21
77− | Sum22
78− deriving (Generic, Show, Eq)
79−
80−#ifndef USE_TH
81−instance SERIALIZE_CLASS Sum2
82−#else
83−DERIVE_CLASS(Sum2)
84−#endif
85−
86−instance NFData Sum2 where
87− {-# INLINE rnf #-}
88− rnf _ = ()
89−
90−data Sum25
91− = Sum251
92− | Sum252
93− | Sum253
94− | Sum254
95− | Sum255
96− | Sum256
97− | Sum257
98− | Sum258
99− | Sum259
100− | Sum2510
101− | Sum2511
102− | Sum2512
103− | Sum2513
104− | Sum2514
105− | Sum2515
106− | Sum2516
107− | Sum2517
108− | Sum2518
109− | Sum2519
110− | Sum2520
111− | Sum2521
112− | Sum2522
113− | Sum2523
114− | Sum2524
115− | Sum2525
116− deriving (Generic, Show, Eq)
117−
118−#ifndef USE_TH
119−instance SERIALIZE_CLASS Sum25
120−#else
121−DERIVE_CLASS(Sum25)
122−#endif
123−
124−instance NFData Sum25 where
125− {-# INLINE rnf #-}
126− rnf _ = ()
127−
128−data Product25
129− = Product25
130− Int
131− Int
132− Int
133− Int
134− Int
135− Int
136− Int
137− Int
138− Int
139− Int
140− Int
141− Int
142− Int
143− Int
144− Int
145− Int
146− Int
147− Int
148− Int
149− Int
150− Int
151− Int
152− Int
153− Int
154− Int
155− deriving (Generic, Show)
156−
157−#ifndef USE_TH
158−instance SERIALIZE_CLASS Product25
159−#else
160−DERIVE_CLASS(Product25)
161−#endif
162−
163−instance NFData Product25 where
164− {-# INLINE rnf #-}
165− rnf
166− (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)
167− = a1
168− `seq` a2
169− `seq` a3
170− `seq` a4
171− `seq` a5
172− `seq` a6
173− `seq` a7
174− `seq` a8
175− `seq` a9
176− `seq` a10
177− `seq` a11
178− `seq` a12
179− `seq` a13
180− `seq` a14
181− `seq` a15
182− `seq` a16
183− `seq` a17
184− `seq` a18
185− `seq` a19
186− `seq` a20
187− `seq` a21
188− `seq` a22
189− `seq` a23
190− `seq` a24
191− `seq` a25
192− `seq` ()
193−
194−-- XXX derived Eq instance is not inlined
195−instance Eq Product25 where
196− {-# INLINE (==) #-}
197− (==)
198− (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)
199− (Product25 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25)
200− = a1 == b1
201− && a2 == b2
202− && a3 == b3
203− && a4 == b4
204− && a5 == b5
205− && a6 == b6
206− && a7 == b7
207− && a8 == b8
208− && a9 == b9
209− && a10 == b10
210− && a11 == b11
211− && a12 == b12
212− && a13 == b13
213− && a14 == b14
214− && a15 == b15
215− && a16 == b16
216− && a17 == b17
217− && a18 == b18
218− && a19 == b19
219− && a20 == b20
220− && a21 == b21
221− && a22 == b22
222− && a23 == b23
223− && a24 == b24
224− && a25 == b25
225−
226−-------------------------------------------------------------------------------
227−-- Simple non-recursive ADT
228−-------------------------------------------------------------------------------
229−
230−{-
231−data CustomDT1
232− = CDT1C1
233− | CDT1C2 Int
234− | CDT1C3 Int Int
235− deriving (Generic, Show, Eq)
236−
237−#ifndef USE_TH
238−instance SERIALIZE_CLASS CustomDT1
239−#else
240−DERIVE_CLASS(CustomDT1)
241−#endif
242−
243−instance NFData CustomDT1 where
244− {-# INLINE rnf #-}
245− rnf CDT1C1 = ()
246− rnf (CDT1C2 i) = i `seq` ()
247− rnf (CDT1C3 i1 i2) = i1 `seq` i2 `seq` ()
248−-}
249−
250−-------------------------------------------------------------------------------
251−-- Recursive ADT
252−-------------------------------------------------------------------------------
253−
254−#ifndef USE_UNBOX
255−data BinTree a
256− = Tree (BinTree a) (BinTree a)
257− | Leaf a
258− deriving (Show, Read, Eq, Generic)
259−
260−#ifndef USE_TH
261−instance Serialize (BinTree a)
262−#else
263−$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
264−#endif
265−
266−instance NFData a => NFData (BinTree a) where
267− {-# INLINE rnf #-}
268− rnf (Leaf a) = rnf a `seq` ()
269− rnf (Tree l r) = rnf l `seq` rnf r
270−
271−-- XXX This may not terminate, or could become really large.
272−instance Arbitrary a => Arbitrary (BinTree a) where
273− arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
274−
275−mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
276−mkBinTree = go (generate arbitrary)
277−
278− where
279−
280− go r 0 = Leaf <$> r
281− go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
282−
283−#endif
284−
285−-------------------------------------------------------------------------------
286−-- Size helpers
287−-------------------------------------------------------------------------------
288−
289−{-# INLINE getSize #-}
290−getSize :: forall a. SERIALIZE_CLASS a => a -> Int
291−#ifdef USE_UNBOX
292−getSize _ = sizeOf (Proxy :: Proxy a)
293−#else
294−getSize = addSizeTo 0
295−#endif
296−
297−-------------------------------------------------------------------------------
298−-- Common helpers
299−-------------------------------------------------------------------------------
300−
301−{- HLINT ignore "Eta reduce" -}
302−-- Parts of "f" that are dependent on val will not be optimized out.
303−{-# INLINE loop #-}
304−loop :: Int -> (a -> IO b) -> a -> IO ()
305−loop count f val = go count val
306− where
307−
308− go n x = when (n > 0) $ f x >> go (n-1) x
309−
310−-- The first arg of "f" is the environment which is not threaded around in the
311−-- loop.
312−{-# INLINE loopWith #-}
313−loopWith :: Int -> (e -> a -> IO b) -> e -> a -> IO ()
314−loopWith count f e val = go count val
315− where
316−
317− go n x = when (n > 0) $ f e x >> go (n-1) x
318−
319−benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
320−benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
321−
322−-------------------------------------------------------------------------------
323−-- Serialization Helpers
324−-------------------------------------------------------------------------------
325−
326−{-
327−{-# INLINE pokeWithSize #-}
328−pokeWithSize :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()
329−pokeWithSize arr val = do
330− let n = getSize val
331− n `seq` SERIALIZE_OP 0 arr val >> return ()
332−
333−{-# INLINE pokeTimesWithSize #-}
334−pokeTimesWithSize :: SERIALIZE_CLASS a => a -> Int -> IO ()
335−pokeTimesWithSize val times = do
336− let n = getSize val
337− arr <- MBA.new n
338− loopWith times pokeWithSize arr val
339−-}
340−
341−{-# INLINE poke #-}
342−poke :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()
343−poke arr val = void (SERIALIZE_OP 0 arr val)
344−
345−{-# INLINE pokeTimes #-}
346−pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
347−pokeTimes val times = do
348− let n = getSize val
349− arr <- MBA.new n
350− loopWith times poke arr val
351−
352−{-# INLINE encode #-}
353−encode :: SERIALIZE_CLASS a => a -> IO ()
354−encode val = do
355− let n = getSize val
356− arr <- MBA.new n
357− void (SERIALIZE_OP 0 arr val)
358−
359−{-# INLINE encodeTimes #-}
360−encodeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
361−encodeTimes val times = loop times encode val
362−
363−{-# INLINE peek #-}
364−peek :: forall a. (NFData a, SERIALIZE_CLASS a) =>
365− (a, Int) -> MutByteArray -> IO ()
366−#ifdef USE_UNBOX
367−peek (_val, _) arr = do
368− (val1 :: a) <- DESERIALIZE_OP 0 arr
369−#else
370−peek (_val, n) arr = do
371− (_, val1 :: a) <- DESERIALIZE_OP 0 arr n
372−#endif
373− -- If the datatype is not deeply strict or deepseq is not used then use
374− -- Equality.
375− -- Ensure that we are actually constructing the type and using it. This
376− -- is important, otherwise the structure is created and discarded, the
377− -- cost of creation of the structure is not accounted. Otherwise we may
378− -- just read the values and discard them. The comparison adds to the
379− -- cost though. We could use deepseq but then we need to write
380− -- instances of NFData and ensure that they are correct and perform
381− -- well. Equality check also ensures correctness.
382− {-
383− if (val1 /= val)
384− then error "peek: no match"
385− else return ()
386− -}
387− val1 `deepseq` return ()
388−
389−{-# INLINE peekTimes #-}
390−peekTimes :: (NFData a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()
391−peekTimes n val times = do
392− arr <- MBA.new n
393− _ <- SERIALIZE_OP 0 arr val
394− loopWith times peek (val, n) arr
395−
396−{-# INLINE trip #-}
397−trip :: forall a. (NFData a, SERIALIZE_CLASS a) => a -> IO ()
398−trip val = do
399− let n = getSize val
400− arr <- MBA.new n
401− _ <- SERIALIZE_OP 0 arr val
402−#ifdef USE_UNBOX
403− (val1 :: a) <- DESERIALIZE_OP 0 arr
404−#else
405− (_, val1 :: a) <- DESERIALIZE_OP 0 arr n
406−#endif
407− -- Do not remove this or use deepseq, see the comments in peek.
408− {-
409− if (val1 /= val)
410− then error "roundtrip: no match"
411− else return ()
412− -}
413− -- Note: deepseq is not needed if the datatype is strict
414− val1 `deepseq` return ()
415−
416−{-# INLINE roundtrip #-}
417−roundtrip :: (NFData a, SERIALIZE_CLASS a) => a -> Int -> IO ()
418−roundtrip val times = loop times trip val
419−
420−-------------------------------------------------------------------------------
421−-- Benchmarks
422−-------------------------------------------------------------------------------
423−
424−{-# INLINE benchConst #-}
425−benchConst ::
426− String
427− -> (forall a. (NFData a, SERIALIZE_CLASS a) =>
428− Int -> a -> Int -> IO ())
429− -> Int
430− -> Benchmark
431−benchConst gname f times =
432− bgroup gname
433− [ let !n = getSize Unit
434− in benchSink "Unit" times (f n Unit)
435− {-
436− , let !n = getSize CDT1C1
437− in benchSink "C1" times (f n CDT1C1)
438− , let val = CDT1C2 5
439− !n = getSize val
440− in benchSink "C2" (times `div` 2) (f n val)
441− , let val = CDT1C3 5 2
442− !n = getSize val
443− in benchSink "C3" (times `div` 3) (f n val)
444− -}
445− , let !n = getSize Sum21
446− in benchSink "Sum2" times (f n Sum21)
447− , let !n = getSize Sum2525
448− in benchSink "Sum25" times (f n Sum2525)
449− , let val = Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
450− !n = getSize val
451− in benchSink "Product25" (times `div` 26) (f n val)
452− ]
453−
454−#ifndef USE_UNBOX
455−{-# INLINE benchVar #-}
456−benchVar ::
457− String
458− -> (forall a. (NFData a, SERIALIZE_CLASS a) =>
459− Int -> a -> Int -> IO ())
460− -> BinTree Int
461− -> [Int]
462− -> Int
463− -> Benchmark
464−benchVar gname f tInt lInt times =
465− bgroup gname
466− [ let !n = getSize tInt
467− in benchSink "bintree-int" times (f n tInt)
468− , let !n = getSize lInt
469− in benchSink "list-int" times (f n lInt)
470− ]
471−
472−{-
473−{-# INLINE benchGeneric #-}
474−benchGeneric
475− :: (NFData b, Serialize b)
476− => String
477− -> String
478− -> (forall a. (NFData a, Serialize a) =>
479− Int -> a -> Int -> IO ())
480− -> b
481− -> Int
482− -> Benchmark
483−benchGeneric gname valId f val times =
484− bgroup gname
485− [ let !n = getSize val
486− in benchSink valId times (f n val)
487− ]
488−-}
489−
490−{-# INLINE benchLargeRec #-}
491−benchLargeRec ::
492− String
493− -> (forall a. (NFData a, Serialize a) =>
494− Int -> a -> Int -> IO ())
495− -> RecNonCompatible
496− -> RecCompatible
497− -> Int
498− -> Benchmark
499−benchLargeRec gname f recL recR times =
500− bgroup gname
501− [ let !n = getSize recL
502− in benchSink "RecNonCompatible" times (f n recL)
503− , let !n = getSize recR
504− in benchSink "RecCompatible" times (f n recR)
505− ]
506−#endif
507−
508−-- Times is scaled by the number of constructors to normalize
509−#ifdef USE_UNBOX
510−allBenchmarks :: Int -> [Benchmark]
511−allBenchmarks times =
512−#else
513−allBenchmarks ::
514− BinTree Int -> [Int] -> RecNonCompatible -> RecCompatible -> Int -> [Benchmark]
515−allBenchmarks tInt lInt recL recR times =
516−#endif
517− [ bgroup "sizeOf"
518− [
519−#ifndef USE_UNBOX
520− bench "bintree-int" $ nf getSize tInt
521− , bench "list-int" $ nf getSize lInt
522−#endif
523− ]
524− , benchConst "poke" (const pokeTimes) times
525− -- , benchConst "pokeWithSize" (const pokeTimesWithSize) times
526− , benchConst "encode" (const encodeTimes) times
527− , benchConst "peek" peekTimes times
528− , benchConst "roundtrip" (const roundtrip) times
529−#ifndef USE_UNBOX
530− , benchVar "poke" (const pokeTimes) tInt lInt 1
531− -- , benchVar "pokeWithSize" (const pokeTimesWithSize) tInt lInt 1
532− , benchVar "encode" (const encodeTimes) tInt lInt 1
533− , benchVar "peek" peekTimes tInt lInt 1
534− , benchVar "roundtrip" (const roundtrip) tInt lInt 1
535− , benchLargeRec "poke" (const pokeTimes) recL recR times
536− , benchLargeRec "encode" (const encodeTimes) recL recR times
537− , benchLargeRec "peek" peekTimes recL recR times
538− , benchLargeRec "roundtrip" (const roundtrip) recL recR times
539−#endif
540− ]
541−
542−-------------------------------------------------------------------------------
543−-- Driver
544−-------------------------------------------------------------------------------
545−
546−main :: IO ()
547−main = do
548−#ifndef USE_UNBOX
549− -- Approximately 100000 constructors
550− -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal
551− -- nodes 1 level = log_2 (100001/3) + 1 = 16
552− !(tInt :: BinTree Int) <- force <$> mkBinTree 16
553−
554− let !recL = valRecNonCompatible
555− let !recR = valRecCompatible
556−
557− -- Approximately 100000 constructors, assuming two constructors (Cons, Int)
558− -- per element.
559− let lInt = [1..50000 :: Int]
560− let !len = length lInt -- evaluate the list
561−#endif
562−#ifndef FUSION_CHECK
563−#ifdef USE_UNBOX
564− runWithCLIOpts defaultStreamSize allBenchmarks
565−#else
566− len
567− `seq` runWithCLIOpts
568− defaultStreamSize
569− (allBenchmarks tInt lInt recL recR)
570−#endif
571−#else
572− -- Enable FUSION_CHECK macro at the beginning of the file
573− -- Enable one benchmark below, and run the benchmark
574− -- Check the .dump-simpl output
575− let value = 100000
576− -- print $ getSize (CDT1C3 4 2)
577− -- print $ getSize tInt
578− -- print $ getSize lInt
579−
580− -- pokeTimes tInt 1
581−
582− -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value
583− -- peekTimes (Sum2525) value
584− -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value
585− -- peekTimes tInt 1
586− let !n = getSize lInt
587− peekTimes n lInt 1
588−
589− -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value
590− return ()
591−#endif
benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.RecCompatible
4− ( RecCompatible(..)
5− , valRecCompatible
6− ) where
7−
8−--------------------------------------------------------------------------------
9−-- Imports
10−--------------------------------------------------------------------------------
11−
12−import Streamly.Internal.Data.MutByteArray (Serialize)
13−import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
14−
15−import qualified Streamly.Internal.Data.MutByteArray as Serialize
16−
17−--------------------------------------------------------------------------------
18−-- Code
19−--------------------------------------------------------------------------------
20−
21−$(genLargeRecord "RecCompatible" 50)
22−$(Serialize.deriveSerializeWith
23− (Serialize.encodeRecordFields True)
24− [d|instance Serialize RecCompatible|])
benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.RecNonCompatible
4− ( RecNonCompatible(..)
5− , valRecNonCompatible
6− ) where
7−
8−--------------------------------------------------------------------------------
9−-- Imports
10−--------------------------------------------------------------------------------
11−
12−import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
13−
14−import qualified Streamly.Internal.Data.MutByteArray as Serialize
15−
16−--------------------------------------------------------------------------------
17−-- Code
18−--------------------------------------------------------------------------------
19−
20−$(genLargeRecord "RecNonCompatible" 50)
21−$(Serialize.deriveSerialize [d|instance Serialize.Serialize RecNonCompatible|])
benchmark/Streamly/Benchmark/Data/Serialize/TH.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where
4−
5−--------------------------------------------------------------------------------
6−-- Imports
7−--------------------------------------------------------------------------------
8−
9−import Language.Haskell.TH
10−
11−import Streamly.Internal.Data.MutByteArray (makeI)
12−import Control.DeepSeq (NFData(..))
13−
14−--------------------------------------------------------------------------------
15−-- Large Record
16−--------------------------------------------------------------------------------
17−
18−genLargeRecord :: String -> Int -> Q [Dec]
19−genLargeRecord tyName numFields =
20− sequence
21− [ dataD
22− (pure [])
23− (mkName tyName)
24− []
25− Nothing
26− [mkCon tyName]
27− [derivClause Nothing [conT ''Eq, conT ''Show]]
28− , mkValueSigDec
29− , mkValueDec
30− , nfDataInstance tyName
31− ]
32−
33− where
34−
35− fieldTypeChoices = [conT ''()]
36− chooseCycle i xs = xs !! (i `mod` length xs)
37− nfDataInstance nm =
38− instanceD
39− (pure [])
40− (appT (conT ''NFData) (conT (mkName nm)))
41− [ funD
42− 'rnf
43− [ clause
44− [ conP
45− (mkName nm)
46− (varP . makeI <$> [0 .. (numFields - 1)])
47− ]
48− (normalB
49− (foldl
50− (\b a -> [|rnf $(b) `seq` rnf $(a)|])
51− [|()|]
52− (varE . makeI <$> [0 .. (numFields - 1)])))
53− []
54− ]
55− ]
56− valueName = mkName $ "val" ++ tyName
57− mkValueSigDec = sigD valueName [t|$(conT (mkName tyName))|]
58− mkValueDec =
59− funD
60− valueName
61− [ clause
62− []
63− (normalB
64− (foldl
65− (\b a -> [|$(b) $(a)|])
66− (conE (mkName tyName))
67− (conE '() <$ [0 .. (numFields - 1)])))
68− []
69− ]
70− mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])
71− mkField i =
72− varBangType
73− (mkName ("field" ++ show i))
74− (bangType
75− (bang noSourceUnpackedness noSourceStrictness)
76− (chooseCycle i fieldTypeChoices))
benchmark/Streamly/Benchmark/Data/SmallArray.hsnew file+95
@@ -0,0 +1,95 @@
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+
12+module Main (main) where
13+
14+import Control.DeepSeq (NFData(..), deepseq)
15+import System.Random (randomRIO)
16+
17+import qualified Streamly.Benchmark.Data.SmallArrayOps as Ops
18+import qualified Streamly.Internal.Data.SmallArray as A
19+import qualified Streamly.Prelude as S
20+
21+import Gauge
22+
23+-------------------------------------------------------------------------------
24+--
25+-------------------------------------------------------------------------------
26+
27+{-# INLINE benchIO #-}
28+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
29+benchIO name src f = bench name $ nfIO $
30+ randomRIO (1,1) >>= src >>= return . f
31+
32+-- Drain a source that generates an array in the IO monad
33+{-# INLINE benchIOSrc #-}
34+benchIOSrc :: (NFData a)
35+ => String -> (Int -> IO (Ops.Stream a)) -> Benchmark
36+benchIOSrc name src = benchIO name src id
37+
38+{-# INLINE benchPureSink #-}
39+benchPureSink :: NFData b => String -> (Ops.Stream Int -> b) -> Benchmark
40+benchPureSink name f = benchIO name Ops.sourceIntFromTo f
41+
42+{-# INLINE benchIO' #-}
43+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
44+benchIO' name src f = bench name $ nfIO $
45+ randomRIO (1,1) >>= src >>= f
46+
47+{-# INLINE benchIOSink #-}
48+benchIOSink :: NFData b => String -> (Ops.Stream Int -> IO b) -> Benchmark
49+benchIOSink name f = benchIO' name Ops.sourceIntFromTo f
50+
51+mkString :: String
52+mkString =
53+ "fromListN " ++
54+ show (Ops.value + 1) ++ " [1" ++ concat (replicate Ops.value ",1") ++ "]"
55+
56+main :: IO ()
57+main =
58+ defaultMain
59+ [ bgroup "SmallArray"
60+ [ bgroup "generation"
61+ [ benchIOSrc "writeN . intFromTo" Ops.sourceIntFromTo
62+ , benchIOSrc "fromList . intFromTo" Ops.sourceIntFromToFromList
63+ , benchIOSrc "writeN . unfoldr" Ops.sourceUnfoldr
64+ , benchIOSrc "writeN . fromList" Ops.sourceFromList
65+ , mkString `deepseq` (bench "read" $ nf Ops.readInstance mkString)
66+ , benchPureSink "show" Ops.showInstance
67+ ]
68+ , bgroup "elimination"
69+ [ benchPureSink "id" id
70+ , benchPureSink "==" Ops.eqInstance
71+ , benchPureSink "/=" Ops.eqInstanceNotEq
72+ , benchPureSink "<" Ops.ordInstance
73+ , benchPureSink "min" Ops.ordInstanceMin
74+ -- length is used to check for foldr/build fusion
75+ -- , benchPureSink "length . IsList.toList" (length . GHC.toList)
76+ , benchIOSink "foldl'" Ops.pureFoldl'
77+ , benchIOSink "read" (S.drain . S.unfold A.read)
78+ , benchIOSink "toStreamRev" (S.drain . A.toStreamRev)
79+#ifdef DEVBUILD
80+ , benchPureSink "foldable/foldl'" Ops.foldableFoldl'
81+ , benchPureSink "foldable/sum" Ops.foldableSum
82+#endif
83+ ]
84+ , bgroup "transformation"
85+ [ benchIOSink "scanl'" (Ops.scanl' 1)
86+ , benchIOSink "scanl1'" (Ops.scanl1' 1)
87+ , benchIOSink "map" (Ops.map 1)
88+ ]
89+ , bgroup "transformationX4"
90+ [ benchIOSink "scanl'" (Ops.scanl' 4)
91+ , benchIOSink "scanl1'" (Ops.scanl1' 4)
92+ , benchIOSink "map" (Ops.map 4)
93+ ]
94+ ]
95+ ]
benchmark/Streamly/Benchmark/Data/SmallArrayOps.hsnew file+136
@@ -0,0 +1,136 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.SmallArrayOps
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE DeriveAnyClass #-}
12+{-# LANGUAGE DeriveGeneric #-}
13+{-# LANGUAGE FlexibleContexts #-}
14+{-# LANGUAGE ScopedTypeVariables #-}
15+
16+module Streamly.Benchmark.Data.SmallArrayOps where
17+
18+import Control.Monad.IO.Class (MonadIO)
19+import Prelude (Int, Bool, (+), ($), (==), (>), (.), Maybe(..), undefined)
20+import qualified Prelude as P
21+#ifdef DEVBUILD
22+import qualified Data.Foldable as F
23+#endif
24+
25+import qualified Streamly as S hiding (foldMapWith, runStream)
26+import qualified Streamly.Internal.Data.SmallArray as A
27+import qualified Streamly.Prelude as S
28+
29+value :: Int
30+value = 128
31+
32+-------------------------------------------------------------------------------
33+-- Benchmark ops
34+-------------------------------------------------------------------------------
35+
36+-------------------------------------------------------------------------------
37+-- Stream generation and elimination
38+-------------------------------------------------------------------------------
39+
40+type Stream = A.SmallArray
41+
42+{-# INLINE sourceUnfoldr #-}
43+sourceUnfoldr :: MonadIO m => Int -> m (Stream Int)
44+sourceUnfoldr n = S.fold (A.writeN value) $ S.unfoldr step n
45+ where
46+ step cnt =
47+ if cnt > n + value
48+ then Nothing
49+ else (Just (cnt, cnt + 1))
50+
51+{-# INLINE sourceIntFromTo #-}
52+sourceIntFromTo :: MonadIO m => Int -> m (Stream Int)
53+sourceIntFromTo n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
54+
55+{-# INLINE sourceIntFromToFromList #-}
56+sourceIntFromToFromList :: MonadIO m => Int -> m (Stream Int)
57+sourceIntFromToFromList n = P.return $ (A.fromListN value) $ [n..n + value]
58+
59+{-# INLINE sourceFromList #-}
60+sourceFromList :: MonadIO m => Int -> m (Stream Int)
61+sourceFromList n = S.fold (A.writeN value) $ S.fromList [n..n+value]
62+
63+-------------------------------------------------------------------------------
64+-- Transformation
65+-------------------------------------------------------------------------------
66+
67+{-# INLINE composeN #-}
68+composeN :: P.Monad m
69+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
70+composeN n f x =
71+ case n of
72+ 1 -> f x
73+ 2 -> f x P.>>= f
74+ 3 -> f x P.>>= f P.>>= f
75+ 4 -> f x P.>>= f P.>>= f P.>>= f
76+ _ -> undefined
77+
78+{-# INLINE scanl' #-}
79+{-# INLINE scanl1' #-}
80+{-# INLINE map #-}
81+
82+scanl', scanl1', map
83+ :: MonadIO m => Int -> Stream Int -> m (Stream Int)
84+
85+{-# INLINE onArray #-}
86+onArray
87+ :: MonadIO m => (S.SerialT m Int -> S.SerialT m Int)
88+ -> Stream Int
89+ -> m (Stream Int)
90+onArray f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
91+
92+scanl' n = composeN n $ onArray $ S.scanl' (+) 0
93+scanl1' n = composeN n $ onArray $ S.scanl1' (+)
94+map n = composeN n $ onArray $ S.map (+1)
95+
96+{-# INLINE eqInstance #-}
97+eqInstance :: Stream Int -> Bool
98+eqInstance src = src == src
99+
100+{-# INLINE eqInstanceNotEq #-}
101+eqInstanceNotEq :: Stream Int -> Bool
102+eqInstanceNotEq src = src P./= src
103+
104+{-# INLINE ordInstance #-}
105+ordInstance :: Stream Int -> Bool
106+ordInstance src = src P.< src
107+
108+{-# INLINE ordInstanceMin #-}
109+ordInstanceMin :: Stream Int -> Stream Int
110+ordInstanceMin src = P.min src src
111+
112+{-# INLINE showInstance #-}
113+showInstance :: Stream Int -> P.String
114+showInstance src = P.show src
115+
116+{-# INLINE readInstance #-}
117+readInstance :: P.String -> Stream Int
118+readInstance str =
119+ let r = P.reads str
120+ in case r of
121+ [(x,"")] -> x
122+ _ -> P.error "readInstance: no parse"
123+
124+{-# INLINE pureFoldl' #-}
125+pureFoldl' :: MonadIO m => Stream Int -> m Int
126+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
127+
128+#ifdef DEVBUILD
129+{-# INLINE foldableFoldl' #-}
130+foldableFoldl' :: Stream Int -> Int
131+foldableFoldl' = F.foldl' (+) 0
132+
133+{-# INLINE foldableSum #-}
134+foldableSum :: Stream Int -> Int
135+foldableSum = P.sum
136+#endif
benchmark/Streamly/Benchmark/Data/Stream.hsdeleted−114
@@ -1,114 +0,0 @@
1−-- |
2−-- Module : Data.Stream
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE RankNTypes #-}
11−
12−#undef FUSION_CHECK
13−#ifdef FUSION_CHECK
14−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
15−#endif
16−
17−module Main (main) where
18−
19−import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
20−
21−import qualified Stream.Eliminate as Elimination
22−#ifndef USE_STREAMLY_CORE
23−import qualified Stream.Exceptions as Exceptions
24−#endif
25−import qualified Stream.Expand as NestedStream
26−import qualified Stream.Generate as Generation
27−import qualified Stream.Lift as Lift
28−import qualified Stream.Reduce as NestedFold
29−#ifdef USE_PRELUDE
30−import qualified Stream.Split as Split
31−#endif
32−import qualified Stream.Transform as Transformation
33−
34−import Streamly.Benchmark.Common
35−
36−#ifdef FUSION_CHECK
37−import Data.Function ((&))
38−import Streamly.Data.Stream (Stream)
39−import qualified Streamly.Internal.Data.Stream as Stream
40−import qualified Streamly.Internal.Data.Fold as Fold
41−import qualified Data.Foldable as Foldable
42−import Stream.Common
43−#endif
44−
45−moduleName :: String
46−#ifdef USE_STREAMK
47−moduleName = "Data.Stream.StreamDK"
48−#else
49−moduleName = "Data.Stream"
50−#endif
51−
52−-------------------------------------------------------------------------------
53−-- Main
54−-------------------------------------------------------------------------------
55−
56−-- In addition to gauge options, the number of elements in the stream can be
57−-- passed using the --stream-size option.
58−--
59−main :: IO ()
60−main = do
61−#ifndef FUSION_CHECK
62− env <- mkHandleBenchEnv
63− runWithCLIOpts defaultStreamSize (allBenchmarks env)
64−
65− where
66−
67− allBenchmarks env size = Prelude.concat
68− [ Generation.benchmarks moduleName size
69− , Elimination.benchmarks moduleName size
70−#ifndef USE_STREAMLY_CORE
71− , Exceptions.benchmarks moduleName env size
72−#endif
73−#ifdef USE_PRELUDE
74− , Split.benchmarks moduleName env
75−#endif
76− , Transformation.benchmarks moduleName size
77− , NestedFold.benchmarks moduleName size
78− , Lift.benchmarks moduleName size
79− , NestedStream.benchmarks moduleName size
80− ]
81−#else
82− -- Enable FUSION_CHECK macro at the beginning of the file
83− -- Enable one benchmark below, and run the benchmark
84− -- Check the .dump-simpl output
85− let value = 100000
86− let input = sourceUnfoldrM value 1
87−
88− -- Stream.foldr (:) [] input >>= print . Prelude.length
89− -- Stream.fold (Fold.foldr' (:) []) input >>= print . Prelude.length
90−
91− -- Stream.toList input >>= print . Prelude.length
92− -- Stream.fold Fold.toList input >>= print . Prelude.length
93−
94− -- We can automatically assert that these generate identical core
95−
96− -- Stream.drain input >>= print
97− -- Stream.fold Fold.drain input >>= print
98−
99− -- Stream.last input >>= print
100− -- Stream.fold Fold.latest input >>= print
101−
102− -- Stream.length input >>= print
103− -- Stream.fold Fold.length input >>= print
104−
105− -- Stream.maximum input >>= print
106− -- Stream.fold Fold.maximum input >>= print
107−
108− -- Stream.head input >>= print
109− -- Stream.fold Fold.one input >>= print
110−
111− -- composeN 4 (Stream.scanl' (+) 0) input
112− composeN 4 (Stream.scan (Fold.foldl' (+) 0)) input
113− return ()
114−#endif
benchmark/Streamly/Benchmark/Data/Stream/Common.hsdeleted−518
@@ -1,518 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−
6−-- |
7−-- Module : Stream.Common
8−-- Copyright : (c) 2018 Composewell Technologies
9−-- License : BSD-3-Clause
10−-- Maintainer : streamly@composewell.com
11−
12−#ifdef USE_PRELUDE
13−{-# OPTIONS_GHC -Wno-deprecations #-}
14−#endif
15−
16−module Stream.Common
17− ( MonadAsync
18−
19− , fromStream
20− , toStream
21−
22− -- Generation
23− , fromListM
24− , fromFoldableM
25−
26− , append
27− , append2
28−
29− -- Elimination
30− , drain
31− , foldl'
32− , scanl'
33−
34− -- Benchmark stream generation
35− , sourceUnfoldr
36− , sourceUnfoldrM
37− , sourceUnfoldrAction
38− , sourceConcatMapId
39− , sourceFromFoldable
40−
41− -- Benchmark stream elimination
42− , benchIOSink
43− , benchIOSrc
44− , benchIO
45−
46− -- Benchmarking functions
47−#ifdef USE_STREAMK
48− , concatStreamsWith
49− , mergeMapWith
50−#endif
51− , apDiscardFst
52− , apDiscardSnd
53− , apLiftA2
54− , toNullAp
55− , monadThen
56− , toNullM
57− , toNullM3
58− , filterAllOutM
59− , filterAllInM
60− , filterSome
61− , breakAfterSome
62− , toListM
63− , toListSome
64− , composeN
65− , mapN
66− , mapM
67− , transformMapM
68− , transformComposeMapM
69− , transformTeeMapM
70− , transformZipMapM
71− )
72−where
73−
74−#if !MIN_VERSION_base(4,18,0)
75−import Control.Applicative (liftA2)
76−#endif
77−import Control.DeepSeq (NFData)
78−import Control.Exception (try)
79−import GHC.Exception (ErrorCall)
80−import System.Random (randomRIO)
81−
82−import qualified Streamly.Internal.Data.Fold as Fold
83−import qualified Streamly.Internal.Data.Pipe as Pipe
84−
85−#ifdef USE_PRELUDE
86−import Streamly.Prelude (foldl', scanl')
87−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
88−import qualified Streamly.Prelude as Stream
89−import qualified Streamly.Prelude as StreamK
90−import Streamly.Benchmark.Prelude
91− ( composeN, sourceConcatMapId, benchIOSink
92− , concatStreamsWith
93− )
94−#else
95−import Streamly.Internal.Data.Stream (Stream)
96−import qualified Streamly.Internal.Data.Stream as D
97−#ifdef USE_STREAMK
98−import Streamly.Internal.Data.StreamK (StreamK)
99−import qualified Streamly.Internal.Data.Stream as Stream
100−import qualified Streamly.Internal.Data.StreamK as StreamK
101−#else
102−import qualified Streamly.Internal.Data.Stream as Stream
103−import qualified Streamly.Internal.Data.Stream as StreamK
104−#endif
105−#endif
106−
107−import Test.Tasty.Bench
108−import Prelude hiding (Foldable(..), mapM, replicate)
109−
110−#ifdef USE_STREAMK
111−toStream :: Applicative m => StreamK m a -> Stream m a
112−toStream = StreamK.toStream
113−
114−fromStream :: Monad m => Stream m a -> StreamK m a
115−fromStream = StreamK.fromStream
116−#else
117−fromStream :: a -> a
118−fromStream = id
119−
120−toStream :: a -> a
121−toStream = id
122−#endif
123−
124−#ifdef USE_PRELUDE
125−type Stream = Stream.SerialT
126−type MonadAsync m = Stream.MonadAsync m
127−mkCross = id
128−unCross = id
129−#else
130−type MonadAsync = Monad
131−
132−#ifdef USE_STREAMK
133−mkCross :: StreamK m a -> StreamK.CrossStreamK m a
134−mkCross = StreamK.mkCross
135−
136−unCross :: StreamK.CrossStreamK m a -> StreamK m a
137−unCross = StreamK.unCross
138−#else
139−mkCross :: Stream m a -> Stream.CrossStream m a
140−mkCross = Stream.mkCross
141−
142−unCross :: Stream.CrossStream m a -> Stream m a
143−unCross = Stream.unCross
144−#endif
145−#endif
146−
147−#ifdef USE_PRELUDE
148−{-# INLINE append #-}
149−append :: Monad m => Stream m a -> Stream m a -> Stream m a
150−append = Stream.serial
151−#else
152−#ifdef USE_STREAMK
153−append :: StreamK m a -> StreamK m a -> StreamK m a
154−append = StreamK.append
155−#else
156−append :: Monad m => Stream m a -> Stream m a -> Stream m a
157−append = Stream.append
158−#endif
159−#endif
160−
161−{-# INLINE append2 #-}
162−append2 :: Monad m => Stream m a -> Stream m a -> Stream m a
163−#ifdef USE_PRELUDE
164−append2 = Stream.append
165−#else
166−append2 = D.append
167−#endif
168−
169−{-# INLINE drain #-}
170−drain :: Monad m => Stream m a -> m ()
171−{-# INLINE toList #-}
172−toList :: Monad m => Stream m a -> m [a]
173−#ifdef USE_PRELUDE
174−drain = Stream.drain
175−toList = Stream.toList
176−#else
177−drain = Stream.fold Fold.drain
178−toList = Stream.fold Fold.toList
179−#endif
180−
181−{-# INLINE fromListM #-}
182−fromListM :: MonadAsync m => [m a] -> Stream m a
183−#ifdef USE_PRELUDE
184−fromListM = Stream.fromListM
185−#else
186−fromListM = Stream.sequence . Stream.fromList
187−#endif
188−
189−{-# INLINE fromFoldableM #-}
190−fromFoldableM :: MonadAsync m => [m a] -> Stream m a
191−#ifdef USE_PRELUDE
192−fromFoldableM = Stream.fromFoldableM
193−#else
194−fromFoldableM = Stream.sequence . toStream . StreamK.fromFoldable
195−#endif
196−
197−{-# INLINE sourceUnfoldrM #-}
198−sourceUnfoldrM :: MonadAsync m => Int -> Int -> Stream m Int
199−sourceUnfoldrM count start = Stream.unfoldrM step start
200−
201− where
202−
203− step cnt =
204− if cnt > start + count
205− then return Nothing
206− else return (Just (cnt, cnt + 1))
207−
208−{-# INLINE sourceUnfoldr #-}
209−sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
210−sourceUnfoldr count start = Stream.unfoldr step start
211−
212− where
213−
214− step cnt =
215− if cnt > start + count
216− then Nothing
217− else Just (cnt, cnt + 1)
218−
219−{-# INLINE sourceUnfoldrAction #-}
220−sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
221−sourceUnfoldrAction value n = Stream.unfoldr step n
222−
223− where
224−
225− step cnt =
226− if cnt > n + value
227− then Nothing
228− else Just (return cnt, cnt + 1)
229−
230−{-# INLINE sourceFromFoldable #-}
231−sourceFromFoldable :: Monad m => Int -> Int -> Stream m Int
232−sourceFromFoldable value n = toStream $ StreamK.fromFoldable [n..n+value]
233−
234−#ifndef USE_PRELUDE
235−{-# INLINE benchIOSink #-}
236−benchIOSink
237− :: (NFData b)
238− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
239−benchIOSink value name f =
240− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
241−#endif
242−
243−-- | Takes a source, and uses it with a default drain/fold method.
244−{-# INLINE benchIOSrc #-}
245−benchIOSrc
246− :: String
247− -> (Int -> Stream IO a)
248− -> Benchmark
249−benchIOSrc name f =
250− bench name $ nfIO $ randomRIO (1,1) >>= drain . f
251−
252−{-# NOINLINE benchIO #-}
253−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
254−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
255−
256−#ifndef USE_PRELUDE
257−#ifdef USE_STREAMK
258−{-# INLINE concatStreamsWith #-}
259−concatStreamsWith
260− :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)
261− -> Int
262− -> Int
263− -> Int
264− -> IO ()
265−concatStreamsWith op outer inner n =
266− drain $ toStream $ StreamK.concatMapWith op
267− (fromStream . sourceUnfoldrM inner)
268− (fromStream $ sourceUnfoldrM outer n)
269−
270−{-# INLINE mergeMapWith #-}
271−mergeMapWith
272− :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)
273− -> Int
274− -> Int
275− -> Int
276− -> IO ()
277−mergeMapWith op outer inner n =
278− drain $ toStream $ StreamK.mergeMapWith op
279− (fromStream . sourceUnfoldrM inner)
280− (fromStream $ sourceUnfoldrM outer n)
281−#endif
282−
283−{-# INLINE sourceConcatMapId #-}
284−sourceConcatMapId :: (Monad m)
285− => Int -> Int -> Stream m (Stream m Int)
286−sourceConcatMapId value n =
287− Stream.fromList $ fmap (D.fromEffect . return) [n..n+value]
288−#endif
289−
290−{-# INLINE apDiscardFst #-}
291−apDiscardFst :: MonadAsync m =>
292− Int -> Int -> m ()
293−apDiscardFst linearCount start = drain $ toStream $ unCross $
294− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
295− *> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
296−
297− where
298−
299− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
300−
301−{-# INLINE apDiscardSnd #-}
302−apDiscardSnd :: MonadAsync m => Int -> Int -> m ()
303−apDiscardSnd linearCount start = drain $ toStream $ unCross $
304− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
305− <* mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
306−
307− where
308−
309− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
310−
311−{-# INLINE apLiftA2 #-}
312−apLiftA2 :: MonadAsync m => Int -> Int -> m ()
313−apLiftA2 linearCount start = drain $ toStream $ unCross $
314− liftA2 (+) (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))
315− (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))
316−
317− where
318−
319− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
320−
321−{-# INLINE toNullAp #-}
322−toNullAp :: MonadAsync m => Int -> Int -> m ()
323−toNullAp linearCount start = drain $ toStream $ unCross $
324− (+) <$> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
325− <*> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
326−
327− where
328−
329− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
330−
331−{-# INLINE monadThen #-}
332−monadThen :: MonadAsync m => Int -> Int -> m ()
333−monadThen linearCount start = drain $ toStream $ unCross $ do
334− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) >>
335− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
336−
337− where
338−
339− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
340−
341−{-# INLINE toNullM #-}
342−toNullM :: MonadAsync m => Int -> Int -> m ()
343−toNullM linearCount start = drain $ toStream $ unCross $ do
344− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
345− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
346− return $ x + y
347−
348− where
349−
350− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
351−
352−{-# INLINE toNullM3 #-}
353−toNullM3 :: MonadAsync m => Int -> Int -> m ()
354−toNullM3 linearCount start = drain $ toStream $ unCross $ do
355− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
356− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
357− z <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
358− return $ x + y + z
359− where
360− nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
361−
362−{-# INLINE filterAllOutM #-}
363−filterAllOutM :: MonadAsync m => Int -> Int -> m ()
364−filterAllOutM linearCount start = drain $ toStream $ unCross $ do
365− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
366− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
367− let s = x + y
368− if s < 0
369− then return s
370− else mkCross StreamK.nil
371− where
372− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
373−
374−{-# INLINE filterAllInM #-}
375−filterAllInM :: MonadAsync m => Int -> Int -> m ()
376−filterAllInM linearCount start = drain $ toStream $ unCross $ do
377− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
378− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
379− let s = x + y
380− if s > 0
381− then return s
382− else mkCross StreamK.nil
383− where
384− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
385−
386−{-# INLINE filterSome #-}
387−filterSome :: MonadAsync m => Int -> Int -> m ()
388−filterSome linearCount start = drain $ toStream $ unCross $ do
389− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
390− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
391− let s = x + y
392− if s > 1100000
393− then return s
394− else mkCross StreamK.nil
395− where
396− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
397−
398−{-# INLINE breakAfterSome #-}
399−breakAfterSome :: Int -> Int -> IO ()
400−breakAfterSome linearCount start = do
401− (_ :: Either ErrorCall ()) <- try $ drain $ toStream $ unCross $ do
402− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
403− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
404− let s = x + y
405− if s > 1100000
406− then error "break"
407− else return s
408− return ()
409− where
410− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
411−
412−{-# INLINE toListM #-}
413−toListM :: MonadAsync m => Int -> Int -> m [Int]
414−toListM linearCount start = toList $ toStream $ unCross $ do
415− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
416− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
417− return $ x + y
418− where
419− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
420−
421−-- Taking a specified number of elements is very expensive in logict so we have
422−-- a test to measure the same.
423−{-# INLINE toListSome #-}
424−toListSome :: MonadAsync m => Int -> Int -> m [Int]
425−toListSome linearCount start =
426− toList $ Stream.take 10000 $ toStream $ unCross $ do
427− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
428− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
429− return $ x + y
430− where
431− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
432−
433−#ifndef USE_PRELUDE
434−{-# INLINE composeN #-}
435−composeN ::
436− (Monad m)
437− => Int
438− -> (Stream m Int -> Stream m Int)
439− -> Stream m Int
440− -> m ()
441−composeN n f =
442− case n of
443− 1 -> drain . f
444− 2 -> drain . f . f
445− 3 -> drain . f . f . f
446− 4 -> drain . f . f . f . f
447− _ -> undefined
448−#endif
449−
450−{-# INLINE mapN #-}
451−mapN ::
452− Monad m
453− => Int
454− -> Stream m Int
455− -> m ()
456−mapN n = composeN n $ fmap (+ 1)
457−
458−{-# INLINE mapM #-}
459−mapM ::
460− MonadAsync m
461− => Int
462− -> Stream m Int
463− -> m ()
464−mapM n = composeN n $ Stream.mapM return
465−
466−#ifndef USE_PRELUDE
467−foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b
468−foldl' f z = Stream.fold (Fold.foldl' f z)
469−
470−scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b
471−scanl' f z = Stream.scan (Fold.foldl' f z)
472−#endif
473−
474−{-# INLINE transformMapM #-}
475−transformMapM ::
476− (Monad m)
477− => Int
478− -> Stream m Int
479− -> m ()
480−transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)
481−
482−{-# INLINE transformComposeMapM #-}
483−transformComposeMapM ::
484− (Monad m)
485− => Int
486− -> Stream m Int
487− -> m ()
488−transformComposeMapM n =
489− composeN n $
490− Stream.transform
491− (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
492− Pipe.mapM (\x -> return (x + 2)))
493−
494−{-# INLINE transformTeeMapM #-}
495−transformTeeMapM ::
496− (Monad m)
497− => Int
498− -> Stream m Int
499− -> m ()
500−transformTeeMapM n =
501− composeN n $
502− Stream.transform
503− (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
504− Pipe.mapM (\x -> return (x + 2)))
505−
506−{-# INLINE transformZipMapM #-}
507−transformZipMapM ::
508− (Monad m)
509− => Int
510− -> Stream m Int
511− -> m ()
512−transformZipMapM n =
513− composeN n $
514− Stream.transform
515− (Pipe.zipWith
516− (+)
517− (Pipe.mapM (\x -> return (x + 1)))
518− (Pipe.mapM (\x -> return (x + 2))))
benchmark/Streamly/Benchmark/Data/Stream/Concurrent.hsdeleted−20
@@ -1,20 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−moduleName :: String
13−moduleName = "Data.Stream.Concurrent"
14−
15−-------------------------------------------------------------------------------
16−-- Main
17−-------------------------------------------------------------------------------
18−
19−main :: IO ()
20−main = runWithCLIOpts defaultStreamSize (allBenchmarks moduleName False id)
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hsdeleted−208
@@ -1,208 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−module Stream.ConcurrentCommon
10− ( allBenchmarks
11− )
12−where
13−
14−import Stream.Common
15− (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)
16−import Streamly.Data.Stream (Stream)
17−import Streamly.Internal.Data.Stream.Prelude (MonadAsync, Config)
18−
19−import qualified Data.List as List
20−import qualified Streamly.Data.Fold as Fold
21−import qualified Streamly.Data.Stream as Stream
22−import qualified Streamly.Internal.Data.Stream.Prelude as Async
23−
24−import Test.Tasty.Bench
25−import Prelude hiding (mapM)
26−import Streamly.Benchmark.Common
27−
28−-- XXX Write inspection tests to make sure no dictionaries are being passed
29−-- around to find specialization issues. Could be really bad for perf.
30−
31−-------------------------------------------------------------------------------
32−-- Mapping
33−-------------------------------------------------------------------------------
34−
35−{-# INLINE mapM #-}
36−mapM ::
37− MonadAsync m
38− => (Config -> Config)
39− -> Int
40− -> Stream m Int
41− -> m ()
42−mapM f n = composeN n $ Async.parMapM f return
43−
44−o_1_space_mapping :: Int -> (Config -> Config) -> [Benchmark]
45−o_1_space_mapping value f =
46− [ bgroup "mapping"
47− [ benchIOSink value "mapM" $ mapM f 1
48− ]
49− ]
50−
51−-------------------------------------------------------------------------------
52−-- Size conserving transformations (reordering, buffering, etc.)
53−-------------------------------------------------------------------------------
54−
55−o_n_heap_buffering :: Int -> (Config -> Config) -> [Benchmark]
56−o_n_heap_buffering value f =
57− [ bgroup "buffered"
58− [ benchIOSink value "mkAsync"
59− (Stream.fold Fold.drain . Async.parEval f)
60− ]
61− ]
62−
63−-------------------------------------------------------------------------------
64−-- Joining
65−-------------------------------------------------------------------------------
66−
67−{-# INLINE async2 #-}
68−async2 :: (Config -> Config) -> Int -> Int -> IO ()
69−async2 f count n =
70− Stream.fold Fold.drain
71− $ Async.parTwo f
72− (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
73−
74−{-# INLINE concatAsync2 #-}
75−concatAsync2 :: (Config -> Config) -> Int -> Int -> IO ()
76−concatAsync2 f count n =
77− Stream.fold Fold.drain
78− $ Async.parConcat f
79− $ Stream.fromList
80− [sourceUnfoldrM count n, sourceUnfoldrM count (n + 1)]
81−
82−o_1_space_joining :: Int -> (Config -> Config) -> [Benchmark]
83−o_1_space_joining value f =
84− [ bgroup "joining"
85− [ benchIOSrc1 "async (2 of n/2)" (async2 f (value `div` 2))
86− , benchIOSrc1 "concat async (2 of n/2)" (concatAsync2 f (value `div` 2))
87− ]
88− ]
89−
90−-------------------------------------------------------------------------------
91−-- Concat
92−-------------------------------------------------------------------------------
93−
94−{-# INLINE sourceFoldMapWith #-}
95−sourceFoldMapWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
96−sourceFoldMapWith f value n =
97− Async.parConcatMap f Stream.fromPure $ Stream.fromList [n..n+value]
98−
99−{-# INLINE sourceFoldMapWithStream #-}
100−sourceFoldMapWithStream :: (Config -> Config) -> Int -> Int -> Stream IO Int
101−sourceFoldMapWithStream f value n =
102− Async.parConcatMap f Stream.fromPure
103− $ Stream.enumerateFromTo n (n + value)
104−
105−{-# INLINE concatFoldableWith #-}
106−concatFoldableWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
107−concatFoldableWith f value n =
108− let step x =
109− if x <= n + value
110− then Just (Stream.fromPure x, x + 1)
111− else Nothing
112− list = List.unfoldr step n
113− in Async.parConcat f (Stream.fromList list)
114−
115−o_1_space_concatFoldable :: Int -> (Config -> Config) -> [Benchmark]
116−o_1_space_concatFoldable value f =
117− [ bgroup "concat-foldable"
118− [ benchIOSrc "foldMapWith (<>) (List)"
119− (sourceFoldMapWith f value)
120− , benchIOSrc "foldMapWith (<>) (Stream)"
121− (sourceFoldMapWithStream f value)
122− , benchIOSrc "S.concatFoldableWith (<>) (List)"
123− (concatFoldableWith f value)
124− ]
125− ]
126−
127−{-# INLINE concatMapStreamsWith #-}
128−concatMapStreamsWith
129− :: (Config -> Config)
130− -> Int
131− -> Int
132− -> Int
133− -> IO ()
134−concatMapStreamsWith f outer inner n =
135− Stream.fold Fold.drain
136− $ Async.parConcatMap f (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
137−
138−{-# INLINE concatFmapStreamsWith #-}
139−concatFmapStreamsWith
140− :: (Config -> Config)
141− -> Int
142− -> Int
143− -> Int
144− -> IO ()
145−concatFmapStreamsWith f outer inner n =
146− Stream.fold Fold.drain
147− $ Async.parConcat f
148− $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
149−
150−o_1_space_concatMap :: Int -> (Config -> Config) -> [Benchmark]
151−o_1_space_concatMap value f =
152− value2 `seq`
153− [ bgroup "concat"
154− [ benchIO "parConcatMap (n of 1)"
155− (concatMapStreamsWith f value 1)
156− , benchIO "parConcatMap (sqrt x of sqrt x)"
157− (concatMapStreamsWith f value2 value2)
158− , benchIO "parConcatMap (1 of n)"
159− (concatMapStreamsWith f 1 value)
160− , benchIO "concat . fmap (n of 1)"
161− (concatFmapStreamsWith f value 1)
162− ]
163− ]
164−
165− where
166−
167− value2 = round $ sqrt (fromIntegral value :: Double)
168−
169−-------------------------------------------------------------------------------
170−-- Monadic outer product
171−-------------------------------------------------------------------------------
172−
173−{-# INLINE toNullAp #-}
174−toNullAp :: (Config -> Config) -> Int -> Int -> IO ()
175−toNullAp f linearCount start =
176− Stream.fold Fold.drain
177− $ Async.parApply f
178− (fmap (+) (sourceUnfoldrM nestedCount2 start))
179− (sourceUnfoldrM nestedCount2 start)
180−
181− where
182−
183− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
184−
185−o_1_space_outerProduct :: Int -> (Config -> Config) -> [Benchmark]
186−o_1_space_outerProduct value f =
187− [ bgroup "monad-outer-product"
188− [ benchIO "toNullAp" $ toNullAp f value
189− ]
190− ]
191−
192−-------------------------------------------------------------------------------
193−-- Benchmark sets
194−-------------------------------------------------------------------------------
195−
196−allBenchmarks :: String -> Bool -> (Config -> Config) -> Int -> [Benchmark]
197−allBenchmarks moduleName wide modifier value =
198− [ bgroup (o_1_space_prefix moduleName) $ concat
199− [ o_1_space_mapping value modifier
200− , o_1_space_concatFoldable value modifier
201− , o_1_space_concatMap value modifier
202− , o_1_space_joining value modifier
203− ] ++ if wide then [] else o_1_space_outerProduct value modifier
204− , bgroup (o_n_heap_prefix moduleName) $ concat
205− [ if wide then o_1_space_outerProduct value modifier else []
206− , o_n_heap_buffering value modifier
207− ]
208− ]
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentEager"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName True (Async.eager True))
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2022 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentInterleaved"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName True (Async.interleaved True))
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentOrdered"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName False (Async.ordered True))
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hsdeleted−748
@@ -1,748 +0,0 @@
1−-- |
2−-- Module : Stream.Eliminate
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE RankNTypes #-}
12−
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−#ifdef __HADDOCK_VERSION__
19−#undef INSPECTION
20−#endif
21−
22−#ifdef INSPECTION
23−{-# LANGUAGE TemplateHaskell #-}
24−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25−#endif
26−
27−module Stream.Eliminate (benchmarks) where
28−
29−import Control.DeepSeq (NFData(..))
30−import Data.Functor.Identity (Identity, runIdentity)
31−import System.Random (randomRIO)
32−
33−import qualified Data.Foldable as F
34−import qualified GHC.Exts as GHC
35−import qualified Streamly.Internal.Data.Fold as Fold
36−
37−#ifdef INSPECTION
38−import GHC.Types (SPEC(..))
39−import Test.Inspection
40−import qualified Streamly.Internal.Data.Stream as D
41−#endif
42−
43−#ifdef USE_PRELUDE
44−import Streamly.Prelude (fromSerial)
45−import Streamly.Benchmark.Prelude
46−import qualified Streamly.Internal.Data.Stream.IsStream as S
47−import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
48−#else
49−import Stream.Common
50−import Streamly.Internal.Data.Stream (Stream)
51−import qualified Streamly.Internal.Data.Stream as S
52−#ifdef USE_STREAMK
53−import Streamly.Internal.Data.StreamK (StreamK)
54−import qualified Streamly.Data.StreamK as StreamK
55−#else
56−import qualified Streamly.Internal.Data.Stream as StreamK
57−#endif
58−#endif
59−
60−import Test.Tasty.Bench
61−import Streamly.Benchmark.Common
62−import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
63− lookup, repeat, minimum, maximum, product, last, mapM_, init)
64−import qualified Prelude
65−
66−#ifdef USE_PRELUDE
67−type Stream = S.SerialT
68−fromStream = id
69−
70−{-# INLINE repeat #-}
71−repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
72−repeat count = S.take count . S.repeat
73−#endif
74−
75−-------------------------------------------------------------------------------
76−-- Elimination
77−-------------------------------------------------------------------------------
78−
79−-------------------------------------------------------------------------------
80−-- Foldable Instance
81−-------------------------------------------------------------------------------
82−
83−{-# INLINE foldableFoldl' #-}
84−foldableFoldl' :: Int -> Int -> Int
85−foldableFoldl' value n =
86− F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int)
87−
88−{-# INLINE foldableFoldrElem #-}
89−foldableFoldrElem :: Int -> Int -> Bool
90−foldableFoldrElem value n =
91− F.foldr (\x xs -> x == value || xs)
92− False
93− (sourceUnfoldr value n :: Stream Identity Int)
94−
95−{-# INLINE foldableSum #-}
96−foldableSum :: Int -> Int -> Int
97−foldableSum value n =
98− Prelude.sum (sourceUnfoldr value n :: Stream Identity Int)
99−
100−{-# INLINE foldableProduct #-}
101−foldableProduct :: Int -> Int -> Int
102−foldableProduct value n =
103− Prelude.product (sourceUnfoldr value n :: Stream Identity Int)
104−
105−{-# INLINE _foldableNull #-}
106−_foldableNull :: Int -> Int -> Bool
107−_foldableNull value n =
108− Prelude.null (sourceUnfoldr value n :: Stream Identity Int)
109−
110−{-# INLINE foldableElem #-}
111−foldableElem :: Int -> Int -> Bool
112−foldableElem value n =
113− value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int)
114−
115−{-# INLINE foldableNotElem #-}
116−foldableNotElem :: Int -> Int -> Bool
117−foldableNotElem value n =
118− value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int)
119−
120−{-# INLINE foldableFind #-}
121−foldableFind :: Int -> Int -> Maybe Int
122−foldableFind value n =
123− F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
124−
125−{-# INLINE foldableAll #-}
126−foldableAll :: Int -> Int -> Bool
127−foldableAll value n =
128− Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
129−
130−{-# INLINE foldableAny #-}
131−foldableAny :: Int -> Int -> Bool
132−foldableAny value n =
133− Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
134−
135−{- HLINT ignore "Use all"-}
136−{-# INLINE foldableAnd #-}
137−foldableAnd :: Int -> Int -> Bool
138−foldableAnd value n =
139− Prelude.and $ fmap
140− (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
141−
142−{- HLINT ignore "Use any"-}
143−{-# INLINE foldableOr #-}
144−foldableOr :: Int -> Int -> Bool
145−foldableOr value n =
146− Prelude.or $ fmap
147− (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
148−
149−{-# INLINE foldableLength #-}
150−foldableLength :: Int -> Int -> Int
151−foldableLength value n =
152− Prelude.length (sourceUnfoldr value n :: Stream Identity Int)
153−
154−{-# INLINE foldableMin #-}
155−foldableMin :: Int -> Int -> Int
156−foldableMin value n =
157− Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int)
158−
159−{-# INLINE ordInstanceMin #-}
160−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
161−ordInstanceMin src = min src src
162−
163−{-# INLINE foldableMax #-}
164−foldableMax :: Int -> Int -> Int
165−foldableMax value n =
166− Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int)
167−
168−{-# INLINE foldableMinBy #-}
169−foldableMinBy :: Int -> Int -> Int
170−foldableMinBy value n =
171− F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int)
172−
173−{-# INLINE foldableListMinBy #-}
174−foldableListMinBy :: Int -> Int -> Int
175−foldableListMinBy value n = F.minimumBy compare [1..value+n]
176−
177−{-# INLINE foldableMaxBy #-}
178−foldableMaxBy :: Int -> Int -> Int
179−foldableMaxBy value n =
180− F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int)
181−
182−{-# INLINE foldableToList #-}
183−foldableToList :: Int -> Int -> [Int]
184−foldableToList value n =
185− F.toList (sourceUnfoldr value n :: Stream Identity Int)
186−
187−{-# INLINE foldableMapM_ #-}
188−foldableMapM_ :: Monad m => Int -> Int -> m ()
189−foldableMapM_ value n =
190− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int)
191−
192−{-# INLINE foldableSequence_ #-}
193−foldableSequence_ :: Int -> Int -> IO ()
194−foldableSequence_ value n =
195− F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int))
196−
197−{-# INLINE _foldableMsum #-}
198−_foldableMsum :: Int -> Int -> IO Int
199−_foldableMsum value n =
200− F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int))
201−
202−{-# INLINE showInstance #-}
203−showInstance :: Stream Identity Int -> String
204−showInstance = show
205−
206−o_1_space_elimination_foldable :: Int -> [Benchmark]
207−o_1_space_elimination_foldable value =
208− [ bgroup "foldable"
209− -- Foldable instance
210− [ bench "foldl'" $ nf (foldableFoldl' value) 1
211− , bench "foldrElem" $ nf (foldableFoldrElem value) 1
212− -- , bench "null" $ nf (_foldableNull value) 1
213− , bench "elem" $ nf (foldableElem value) 1
214− , bench "length" $ nf (foldableLength value) 1
215− , bench "sum" $ nf (foldableSum value) 1
216− , bench "product" $ nf (foldableProduct value) 1
217− , bench "minimum" $ nf (foldableMin value) 1
218− , benchPureSink value "min (ord)" ordInstanceMin
219− , bench "maximum" $ nf (foldableMax value) 1
220− , bench "minimumBy" $ nf (`foldableMinBy` 1) value
221− , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
222− , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
223− , bench "length . toList"
224− $ nf (Prelude.length . foldableToList value) 1
225− , bench "notElem" $ nf (foldableNotElem value) 1
226− , bench "find" $ nf (foldableFind value) 1
227− , bench "all" $ nf (foldableAll value) 1
228− , bench "any" $ nf (foldableAny value) 1
229− , bench "and" $ nf (foldableAnd value) 1
230− , bench "or" $ nf (foldableOr value) 1
231−
232− -- Applicative and Traversable operations
233− -- TBD: traverse_
234− , benchIOSink1 "mapM_" (foldableMapM_ value)
235− -- TBD: for_
236− -- TBD: forM_
237− , benchIOSink1 "sequence_" (foldableSequence_ value)
238− -- TBD: sequenceA_
239− -- TBD: asum
240− -- XXX needs to be fixed, results are in ns
241− -- , benchIOSink1 "msum" (foldableMsum value)
242− ]
243− ]
244−
245−-------------------------------------------------------------------------------
246−-- Stream folds
247−-------------------------------------------------------------------------------
248−
249−#ifndef USE_PRELUDE
250−instance NFData a => NFData (Stream Identity a) where
251− {-# INLINE rnf #-}
252− rnf xs = runIdentity $ S.fold (Fold.foldl' (\_ x -> rnf x) ()) xs
253−#endif
254−
255−{-# INLINE benchPureSink #-}
256−benchPureSink :: NFData b
257− => Int -> String -> (Stream Identity Int -> b) -> Benchmark
258−benchPureSink value name = benchPure name (sourceUnfoldr value)
259−
260−{-# INLINE benchHoistSink #-}
261−benchHoistSink
262− :: (NFData b)
263− => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
264−benchHoistSink value name f =
265− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
266−
267−-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but
268−-- we can't use it as it requires MonadAsync constraint.
269−{-# INLINE benchIdentitySink #-}
270−benchIdentitySink
271− :: (NFData b)
272− => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark
273−benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
274−
275−-------------------------------------------------------------------------------
276−-- Reductions
277−-------------------------------------------------------------------------------
278−
279−{-# INLINE uncons #-}
280−#ifdef USE_STREAMK
281−uncons :: Monad m => StreamK m Int -> m ()
282−#else
283−uncons :: Monad m => Stream m Int -> m ()
284−#endif
285−uncons s = do
286− r <- StreamK.uncons s
287− case r of
288− Nothing -> return ()
289− Just (_, t) -> uncons t
290−
291−#ifdef USE_PRELUDE
292−{-# INLINE init #-}
293−init :: Monad m => Stream m a -> m ()
294−init s = S.init s >>= Prelude.mapM_ S.drain
295−
296−{-# INLINE mapM_ #-}
297−mapM_ :: Monad m => Stream m Int -> m ()
298−mapM_ = S.mapM_ (\_ -> return ())
299−#endif
300−
301−{-# INLINE foldrMElem #-}
302−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
303−foldrMElem e =
304− S.foldrM
305− (\x xs ->
306− if x == e
307− then return True
308− else xs)
309− (return False)
310−
311−#ifdef USE_STREAMK
312−{-# INLINE foldrToStream #-}
313−foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int)
314−foldrToStream = S.foldr StreamK.cons StreamK.nil
315−#else
316−-- {-# INLINE foldrToStream #-}
317−-- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int)
318−-- foldrToStream = S.foldr S.cons S.nil
319−#endif
320−
321−{-# INLINE foldrMBuild #-}
322−foldrMBuild :: Monad m => Stream m Int -> m [Int]
323−foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
324−
325−#ifdef USE_PRELUDE
326−{-# INLINE foldl'Reduce #-}
327−foldl'Reduce :: Monad m => Stream m Int -> m Int
328−foldl'Reduce = S.foldl' (+) 0
329−
330−{-# INLINE foldl1'Reduce #-}
331−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
332−foldl1'Reduce = S.foldl1' (+)
333−
334−{-# INLINE foldlM'Reduce #-}
335−foldlM'Reduce :: Monad m => Stream m Int -> m Int
336−foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
337−
338−{-# INLINE last #-}
339−last :: Monad m => Stream m Int -> m (Maybe Int)
340−last = S.last
341−
342−{-# INLINE _head #-}
343−_head :: Monad m => Stream m Int -> m (Maybe Int)
344−_head = S.head
345−
346−{-# INLINE elem #-}
347−elem :: Monad m => Int -> Stream m Int -> m Bool
348−elem value = S.elem (value + 1)
349−
350−{-# INLINE notElem #-}
351−notElem :: Monad m => Int -> Stream m Int -> m Bool
352−notElem value = S.notElem (value + 1)
353−
354−{-# INLINE length #-}
355−length :: Monad m => Stream m Int -> m Int
356−length = S.length
357−
358−{-# INLINE all #-}
359−all :: Monad m => Int -> Stream m Int -> m Bool
360−all value = S.all (<= (value + 1))
361−
362−{-# INLINE any #-}
363−any :: Monad m => Int -> Stream m Int -> m Bool
364−any value = S.any (> (value + 1))
365−
366−{-# INLINE and #-}
367−and :: Monad m => Int -> Stream m Int -> m Bool
368−and value = S.and . S.map (<= (value + 1))
369−
370−{-# INLINE or #-}
371−or :: Monad m => Int -> Stream m Int -> m Bool
372−or value = S.or . S.map (> (value + 1))
373−
374−{-# INLINE find #-}
375−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
376−find value = S.find (== (value + 1))
377−
378−{-# INLINE findM #-}
379−findM :: Monad m => Int -> Stream m Int -> m (Maybe Int)
380−findM value = S.findM (\z -> return $ z == (value + 1))
381−
382−{-# INLINE findIndex #-}
383−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
384−findIndex value = S.findIndex (== (value + 1))
385−
386−{-# INLINE elemIndex #-}
387−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
388−elemIndex value = S.elemIndex (value + 1)
389−
390−{-# INLINE maximum #-}
391−maximum :: Monad m => Stream m Int -> m (Maybe Int)
392−maximum = S.maximum
393−
394−{-# INLINE minimum #-}
395−minimum :: Monad m => Stream m Int -> m (Maybe Int)
396−minimum = S.minimum
397−
398−{-# INLINE sum #-}
399−sum :: Monad m => Stream m Int -> m Int
400−sum = S.sum
401−
402−{-# INLINE product #-}
403−product :: Monad m => Stream m Int -> m Int
404−product = S.product
405−
406−{-# INLINE minimumBy #-}
407−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
408−minimumBy = S.minimumBy compare
409−
410−{-# INLINE maximumBy #-}
411−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
412−maximumBy = S.maximumBy compare
413−
414−{-# INLINE the #-}
415−the :: Monad m => Stream m Int -> m (Maybe Int)
416−the = S.the
417−
418−{-# INLINE drainN #-}
419−drainN :: Monad m => Int -> Stream m Int -> m ()
420−drainN = S.drainN
421−
422−{-# INLINE drainWhile #-}
423−drainWhile :: Monad m => Stream m Int -> m ()
424−drainWhile = S.drainWhile (const True)
425−
426−{-# INLINE (!!) #-}
427−(!!) :: Monad m => Int -> Stream m Int -> m (Maybe Int)
428−(!!) = flip (S.!!)
429−
430−{-# INLINE lookup #-}
431−lookup :: Monad m => Int -> Stream m Int -> m (Maybe Int)
432−lookup val = S.lookup val . S.map (\x -> (x, x))
433−#endif
434−
435−o_1_space_elimination_folds :: Int -> [Benchmark]
436−o_1_space_elimination_folds value =
437− [ bgroup "elimination"
438− -- Basic folds
439− [
440−#ifdef USE_PRELUDE
441− bgroup "reduce"
442− [ bgroup
443− "IO"
444− [ benchIOSink value "foldl'" foldl'Reduce
445− , benchIOSink value "foldl1'" foldl1'Reduce
446− , benchIOSink value "foldlM'" foldlM'Reduce
447− ]
448−
449− , bgroup
450− "Identity"
451− [ benchIdentitySink value "foldl'" foldl'Reduce
452− , benchIdentitySink value "foldl1'" foldl1'Reduce
453− , benchIdentitySink value "foldlM'" foldlM'Reduce
454− ]
455− ] ,
456−#endif
457− bgroup "build"
458− [ bgroup "IO"
459− [ benchIOSink value "foldrMElem" (foldrMElem value)
460− ]
461− , bgroup "Identity"
462− [ benchIdentitySink value "foldrMElem" (foldrMElem value)
463−#ifdef USE_STREAMK
464− , benchIdentitySink value "foldrToStreamLength"
465− (S.fold Fold.length . toStream . runIdentity . foldrToStream)
466− {-
467− , benchIdentitySink 16 "foldrToStreamLength (16)"
468− (S.fold Fold.length . toStream . runIdentity . foldrToStream)
469− -}
470−#else
471− {-
472− , benchIdentitySink 16 "foldrToStreamLength (16)"
473− (S.fold Fold.length . runIdentity . foldrToStream)
474− -}
475−#endif
476− {-
477− , benchPureSink 16 "foldrMToListLength (16)"
478− (Prelude.length . runIdentity . foldrMBuild)
479− -}
480− , benchPureSink value "foldrMToListLength"
481− (Prelude.length . runIdentity . foldrMBuild)
482− ]
483− ]
484−
485− -- deconstruction
486− , benchIOSink value "uncons" (uncons . fromStream)
487−#ifndef USE_PRELUDE
488− , benchHoistSink value "length . generalizeInner"
489− (S.fold Fold.length . S.generalizeInner)
490−#endif
491−#ifdef USE_PRELUDE
492− , benchIOSink value "init" init
493−
494− -- draining
495− , benchIOSink value "drain" $ toNull fromSerial
496− , benchIOSink value "drainN" $ drainN value
497− , benchIOSink value "drainWhile" drainWhile
498− , benchPureSink value "drain (pure)" id
499− , benchIOSink value "mapM_" mapM_
500−
501− -- this is too fast, causes all benchmarks reported in ns
502− -- , benchIOSink value "head" head
503− , benchIOSink value "last" last
504− , benchIOSink value "length" length
505− , benchIOSink value "sum" sum
506− , benchIOSink value "product" product
507− , benchIOSink value "maximumBy" maximumBy
508− , benchIOSink value "maximum" maximum
509− , benchIOSink value "minimumBy" minimumBy
510− , benchIOSink value "minimum" minimum
511−
512− , bench "the" $ nfIO $ randomRIO (1,1) >>= the . repeat value
513− , benchIOSink value "find" (find value)
514− , benchIOSink value "findM" (findM value)
515− -- , benchIOSink value "lookupFirst" (lookup 1)
516− , benchIOSink value "lookupNever" (lookup (value + 1))
517− , benchIOSink value "(!!)" (value !!)
518− , benchIOSink value "findIndex" (findIndex value)
519− , benchIOSink value "elemIndex" (elemIndex value)
520− -- this is too fast, causes all benchmarks reported in ns
521− -- , benchIOSink value "null" S.null
522− , benchIOSink value "elem" (elem value)
523− , benchIOSink value "notElem" (notElem value)
524− , benchIOSink value "all" (all value)
525− , benchIOSink value "any" (any value)
526− , benchIOSink value "and" (and value)
527− , benchIOSink value "or" (or value)
528−#endif
529−
530− -- length is used to check for foldr/build fusion
531− , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
532− ]
533− ]
534−
535−-------------------------------------------------------------------------------
536−-- Buffered Transformations by fold
537−-------------------------------------------------------------------------------
538−
539−#ifdef USE_PRELUDE
540−{-# INLINE foldl'Build #-}
541−foldl'Build :: Monad m => Stream m Int -> m [Int]
542−foldl'Build = S.foldl' (flip (:)) []
543−
544−{-# INLINE foldlM'Build #-}
545−foldlM'Build :: Monad m => Stream m Int -> m [Int]
546−foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
547−
548−o_n_heap_elimination_foldl :: Int -> [Benchmark]
549−o_n_heap_elimination_foldl value =
550− [ bgroup "foldl"
551− -- Left folds for building a structure are inherently non-streaming
552− -- as the structure cannot be lazily consumed until fully built.
553− [ benchIOSink value "foldl'/build/IO" foldl'Build
554− , benchIdentitySink value "foldl'/build/Identity" foldl'Build
555− , benchIOSink value "foldlM'/build/IO" foldlM'Build
556− , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
557− ]
558− ]
559−#endif
560−
561−-- For comparisons
562−{-# INLINE showInstanceList #-}
563−showInstanceList :: [Int] -> String
564−showInstanceList = show
565−
566−o_n_heap_elimination_buffered :: Int -> [Benchmark]
567−o_n_heap_elimination_buffered value =
568− [ bgroup "buffered"
569− -- Buffers the output of show/read.
570− -- XXX can the outputs be streaming? Can we have special read/show
571− -- style type classes, readM/showM supporting streaming effects?
572− [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)
573− -- XXX This is not o-1-space for GHC-8.10
574− , benchPureSink value "showsPrec pure streams" showInstance
575− ]
576− ]
577−
578−{-# INLINE foldrMReduce #-}
579−foldrMReduce :: Monad m => Stream m Int -> m Int
580−foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
581−
582−o_n_space_elimination_foldr :: Int -> [Benchmark]
583−o_n_space_elimination_foldr value =
584− -- Head recursive strict right folds.
585− [ bgroup "foldr"
586− -- accumulation due to strictness of IO monad
587− [ benchIOSink value "foldrM/build/IO (toList)" foldrMBuild
588− -- Right folds for reducing are inherently non-streaming as the
589− -- expression needs to be fully built before it can be reduced.
590− , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce
591− , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce
592− ]
593− ]
594−
595−#ifdef USE_PRELUDE
596−o_n_heap_elimination_toList :: Int -> [Benchmark]
597−o_n_heap_elimination_toList value =
598− [ bgroup "toList"
599− -- Converting the stream to a list or pure stream in a strict monad
600− [ benchIOSink value "toListRev" S.toListRev
601− , benchIOSink value "toStreamRev"
602− (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))
603− ]
604− ]
605−
606−o_n_space_elimination_toList :: Int -> [Benchmark]
607−o_n_space_elimination_toList value =
608− [ bgroup "toList"
609− -- Converting the stream to a list or pure stream in a strict monad
610− [ benchIOSink value "toList" S.toList
611−#ifndef USE_PRELUDE
612− , benchIOSink value "toStream"
613− (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))
614−#endif
615− ]
616− ]
617−#endif
618−
619−-------------------------------------------------------------------------------
620−-- Multi-stream folds
621−-------------------------------------------------------------------------------
622−
623−-------------------------------------------------------------------------------
624−-- Multi-stream pure
625−-------------------------------------------------------------------------------
626−
627−{-# INLINE eqBy' #-}
628−eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool
629−eqBy' src = S.eqBy (==) src src
630−
631−{-# INLINE eqByPure #-}
632−eqByPure :: Int -> Int -> Identity Bool
633−eqByPure value n = eqBy' (sourceUnfoldr value n)
634−
635−#ifdef INSPECTION
636−inspect $ hasNoTypeClasses 'eqByPure
637−inspect $ 'eqByPure `hasNoType` ''SPEC
638−inspect $ 'eqByPure `hasNoType` ''D.Step
639−#endif
640−
641−{-# INLINE eqInstance #-}
642−eqInstance :: Stream Identity Int -> Bool
643−eqInstance src = src == src
644−
645−{-# INLINE eqInstanceNotEq #-}
646−eqInstanceNotEq :: Stream Identity Int -> Bool
647−eqInstanceNotEq src = src /= src
648−
649−{-# INLINE cmpBy' #-}
650−cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering
651−cmpBy' src = S.cmpBy compare src src
652−
653−{-# INLINE cmpByPure #-}
654−cmpByPure :: Int -> Int -> Identity Ordering
655−cmpByPure value n = cmpBy' (sourceUnfoldr value n)
656−
657−#ifdef INSPECTION
658−inspect $ hasNoTypeClasses 'cmpByPure
659−inspect $ 'cmpByPure `hasNoType` ''SPEC
660−inspect $ 'cmpByPure `hasNoType` ''D.Step
661−#endif
662−
663−{-# INLINE ordInstance #-}
664−ordInstance :: Stream Identity Int -> Bool
665−ordInstance src = src < src
666−
667−o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
668−o_1_space_elimination_multi_stream_pure value =
669− [ bgroup "multi-stream-pure"
670− [ benchPureSink1 "eqBy" (eqByPure value)
671− , benchPureSink value "==" eqInstance
672− , benchPureSink value "/=" eqInstanceNotEq
673− , benchPureSink1 "cmpBy" (cmpByPure value)
674− , benchPureSink value "<" ordInstance
675− ]
676− ]
677−
678−{-# INLINE isPrefixOf #-}
679−isPrefixOf :: Monad m => Stream m Int -> m Bool
680−isPrefixOf src = S.isPrefixOf src src
681−
682−{-# INLINE isSubsequenceOf #-}
683−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
684−isSubsequenceOf src = S.isSubsequenceOf src src
685−
686−{-# INLINE stripPrefix #-}
687−stripPrefix :: Monad m => Stream m Int -> m ()
688−stripPrefix src = do
689− _ <- S.stripPrefix src src
690− return ()
691−
692−{-# INLINE eqBy #-}
693−eqBy :: Int -> Int -> IO Bool
694−eqBy value n = eqBy' (sourceUnfoldrM value n)
695−
696−#ifdef INSPECTION
697−inspect $ hasNoTypeClasses 'eqBy
698−inspect $ 'eqBy `hasNoType` ''SPEC
699−inspect $ 'eqBy `hasNoType` ''D.Step
700−#endif
701−
702−{-# INLINE cmpBy #-}
703−cmpBy :: Int -> Int -> IO Ordering
704−cmpBy value n = cmpBy' (sourceUnfoldrM value n)
705−
706−#ifdef INSPECTION
707−inspect $ hasNoTypeClasses 'cmpBy
708−inspect $ 'cmpBy `hasNoType` ''SPEC
709−inspect $ 'cmpBy `hasNoType` ''D.Step
710−#endif
711−
712−o_1_space_elimination_multi_stream :: Int -> [Benchmark]
713−o_1_space_elimination_multi_stream value =
714− [ bgroup "multi-stream"
715− [ benchIOSink1 "eqBy" (eqBy value)
716− , benchIOSink1 "cmpBy" (cmpBy value)
717− , benchIOSink value "isPrefixOf" isPrefixOf
718− , benchIOSink value "isSubsequenceOf" isSubsequenceOf
719− , benchIOSink value "stripPrefix" stripPrefix
720− ]
721− ]
722−
723−-------------------------------------------------------------------------------
724−-- Main
725−-------------------------------------------------------------------------------
726−
727−-- In addition to gauge options, the number of elements in the stream can be
728−-- passed using the --stream-size option.
729−--
730−benchmarks :: String -> Int -> [Benchmark]
731−benchmarks moduleName size =
732− [ bgroup (o_1_space_prefix moduleName) $ concat
733− [ o_1_space_elimination_foldable size
734− , o_1_space_elimination_folds size
735− , o_1_space_elimination_multi_stream_pure size
736− , o_1_space_elimination_multi_stream size
737− ]
738−
739− , bgroup (o_n_heap_prefix moduleName) $
740− o_n_heap_elimination_buffered size
741−#ifdef USE_PRELUDE
742− ++ o_n_heap_elimination_foldl size
743− ++ o_n_heap_elimination_toList size
744− ++ o_n_space_elimination_toList size
745−#endif
746− , bgroup (o_n_space_prefix moduleName) $
747− o_n_space_elimination_foldr size
748− ]
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hsdeleted−371
@@ -1,371 +0,0 @@
1−-- |
2−-- Module : Stream.Exceptions
3−-- Copyright : (c) 2019 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−-- Stability : experimental
7−-- Portability : GHC
8−
9−{-# LANGUAGE CPP #-}
10−{-# LANGUAGE FlexibleContexts #-}
11−{-# LANGUAGE ScopedTypeVariables #-}
12−
13−#ifdef USE_PRELUDE
14−{-# OPTIONS_GHC -Wno-deprecations #-}
15−#endif
16−
17−#ifdef __HADDOCK_VERSION__
18−#undef INSPECTION
19−#endif
20−
21−#ifdef INSPECTION
22−{-# LANGUAGE TemplateHaskell #-}
23−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24−#endif
25−
26−module Stream.Exceptions (benchmarks) where
27−
28−import Control.Exception (Exception, throwIO)
29−import Stream.Common (drain)
30−
31−import qualified Data.IORef as Ref
32−import qualified Data.Map.Strict as Map
33−
34−import Control.Exception (SomeException)
35−import System.IO (Handle, hClose, hPutChar)
36−import qualified Streamly.FileSystem.Handle as FH
37−import qualified Streamly.Internal.FileSystem.Handle as IFH
38−import qualified Streamly.Internal.Data.Unfold as IUF
39−import qualified Streamly.Internal.Data.Unfold.Prelude as IUF
40−
41−#ifdef USE_PRELUDE
42−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
43−#else
44−import qualified Streamly.Internal.Data.Stream as Stream
45−import qualified Streamly.Internal.Data.Stream.Prelude as Stream
46−#endif
47−
48−import Test.Tasty.Bench hiding (env)
49−import Prelude hiding (last, length)
50−import Streamly.Benchmark.Common
51−import Streamly.Benchmark.Common.Handle
52−
53−#ifdef INSPECTION
54−import Control.Monad.Catch (MonadCatch)
55−import Test.Inspection
56−
57−import qualified Streamly.Internal.Data.Stream as D
58−#endif
59−
60−#ifdef USE_PRELUDE
61−type Stream = Stream.SerialT
62−toStreamD = Stream.toStream
63−fromStreamD = Stream.fromStream
64−#else
65−type Stream = Stream.Stream
66−toStreamD :: a -> a
67−toStreamD = id
68−fromStreamD :: a -> a
69−fromStreamD = id
70−#endif
71−
72−afterUnsafe :: IO b -> Stream IO a -> Stream IO a
73−finallyUnsafe :: IO b -> Stream IO a -> Stream IO a
74−bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a
75−#ifdef USE_PRELUDE
76−afterUnsafe = Stream.after_
77−finallyUnsafe = Stream.finally_
78−bracketUnsafe = Stream.bracket_
79−#else
80−afterUnsafe = Stream.afterUnsafe
81−finallyUnsafe = Stream.finallyUnsafe
82−bracketUnsafe = Stream.bracketUnsafe
83−#endif
84−
85−-------------------------------------------------------------------------------
86−-- stream exceptions
87−-------------------------------------------------------------------------------
88−
89−data BenchException
90− = BenchException1
91− | BenchException2
92− deriving (Show, Eq, Ord)
93−
94−instance Exception BenchException
95−
96−retryNoneSimple :: Int -> Int -> IO ()
97−retryNoneSimple length from =
98− drain
99− $ Stream.retry
100− (Map.singleton BenchException1 length)
101− (const Stream.nil)
102− source
103−
104− where
105−
106− source = Stream.enumerateFromTo from (from + length)
107−
108−retryNone :: Int -> Int -> IO ()
109−retryNone length from = do
110− ref <- Ref.newIORef (0 :: Int)
111− drain
112− $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
113− $ source ref
114−
115− where
116−
117− source ref =
118− Stream.replicateM (from + length)
119− $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
120−
121−retryAll :: Int -> Int -> IO ()
122−retryAll length from = do
123− ref <- Ref.newIORef 0
124− drain
125− $ Stream.retry
126− (Map.singleton BenchException1 (length + from)) (const Stream.nil)
127− $ source ref
128−
129− where
130−
131− source ref =
132− Stream.fromEffect
133− $ do
134− Ref.modifyIORef' ref (+ 1)
135− val <- Ref.readIORef ref
136− if val >= length
137− then return length
138− else throwIO BenchException1
139−
140−retryUnknown :: Int -> Int -> IO ()
141−retryUnknown length from = do
142− drain
143− $ Stream.retry (Map.singleton BenchException1 length) (const source)
144− $ throwIO BenchException2 `Stream.before` Stream.nil
145−
146− where
147−
148− source = Stream.enumerateFromTo from (from + length)
149−
150−
151−o_1_space_serial_exceptions :: Int -> [Benchmark]
152−o_1_space_serial_exceptions length =
153− [ bgroup
154− "exceptions/serial"
155− [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
156− , benchIOSrc1 "retryNone" (retryNone length)
157− , benchIOSrc1 "retryAll" (retryAll length)
158− , benchIOSrc1 "retryUnknown" (retryUnknown length)
159− ]
160− ]
161−
162−-- XXX Move these to FileSystem.Handle benchmarks
163−
164−-------------------------------------------------------------------------------
165−-- copy stream exceptions
166−-------------------------------------------------------------------------------
167−
168−-- | Send the file contents to /dev/null with exception handling
169−readWriteOnExceptionStream :: Handle -> Handle -> IO ()
170−readWriteOnExceptionStream inh devNull =
171− let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
172− in Stream.fold (FH.write devNull) readEx
173−
174−#ifdef INSPECTION
175−inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
176−#endif
177−
178−-- | Send the file contents to /dev/null with exception handling
179−readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
180−readWriteHandleExceptionStream inh devNull =
181− let handler (_e :: SomeException) =
182− return $ Stream.fromEffect (hClose inh >> return 10)
183− readEx = Stream.handle handler (Stream.unfold FH.reader inh)
184− in Stream.fold (FH.write devNull) readEx
185−
186−#ifdef INSPECTION
187−inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
188−#endif
189−
190−-- | Send the file contents to /dev/null with exception handling
191−readWriteFinally_Stream :: Handle -> Handle -> IO ()
192−readWriteFinally_Stream inh devNull =
193− let readEx =
194− finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
195− in Stream.fold (FH.write devNull) readEx
196−
197−#ifdef INSPECTION
198−inspect $ hasNoTypeClasses 'readWriteFinally_Stream
199−#endif
200−
201−readWriteFinallyStream :: Handle -> Handle -> IO ()
202−readWriteFinallyStream inh devNull =
203− let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
204− in Stream.fold (FH.write devNull) readEx
205−
206−-- | Send the file contents to /dev/null with exception handling
207−fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
208−fromToBytesBracket_Stream inh devNull =
209− let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
210− (\_ -> fromStreamD $ IFH.read inh)
211− in IFH.putBytes devNull (toStreamD readEx)
212−
213−#ifdef INSPECTION
214−inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
215−#endif
216−
217−fromToBytesBracketStream :: Handle -> Handle -> IO ()
218−fromToBytesBracketStream inh devNull =
219− let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
220− (\_ -> fromStreamD $ IFH.read inh)
221− in IFH.putBytes devNull (toStreamD readEx)
222−
223−readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
224−readWriteBeforeAfterStream inh devNull =
225− let readEx =
226− Stream.after (hClose inh)
227− $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
228− in Stream.fold (FH.write devNull) readEx
229−
230−#ifdef INSPECTION
231−inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
232−#endif
233−
234−readWriteAfterStream :: Handle -> Handle -> IO ()
235−readWriteAfterStream inh devNull =
236− let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
237− in Stream.fold (FH.write devNull) readEx
238−
239−#ifdef INSPECTION
240−inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
241−#endif
242−
243−readWriteAfter_Stream :: Handle -> Handle -> IO ()
244−readWriteAfter_Stream inh devNull =
245− let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
246− in Stream.fold (FH.write devNull) readEx
247−
248−#ifdef INSPECTION
249−inspect $ hasNoTypeClasses 'readWriteAfter_Stream
250−inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
251−#endif
252−
253−o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
254−o_1_space_copy_stream_exceptions env =
255− [ bgroup "exceptions"
256− [ mkBenchSmall "Stream.onException" env $ \inh _ ->
257− readWriteOnExceptionStream inh (nullH env)
258− , mkBenchSmall "Stream.handle" env $ \inh _ ->
259− readWriteHandleExceptionStream inh (nullH env)
260− , mkBenchSmall "Stream.finally_" env $ \inh _ ->
261− readWriteFinally_Stream inh (nullH env)
262− , mkBenchSmall "Stream.finally" env $ \inh _ ->
263− readWriteFinallyStream inh (nullH env)
264− , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
265− readWriteBeforeAfterStream inh (nullH env)
266− , mkBenchSmall "Stream.after" env $ \inh _ ->
267− readWriteAfterStream inh (nullH env)
268− , mkBenchSmall "Stream.after_" env $ \inh _ ->
269− readWriteAfter_Stream inh (nullH env)
270− ]
271− , bgroup "exceptions/fromToBytes"
272− [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
273− fromToBytesBracket_Stream inh (nullH env)
274− , mkBenchSmall "Stream.bracket" env $ \inh _ ->
275− fromToBytesBracketStream inh (nullH env)
276− ]
277− ]
278−
279− -------------------------------------------------------------------------------
280−-- Exceptions readChunks
281−-------------------------------------------------------------------------------
282−
283−-- | Send the file contents to /dev/null with exception handling
284−readChunksOnException :: Handle -> Handle -> IO ()
285−readChunksOnException inh devNull =
286− let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
287− in IUF.fold (IFH.writeChunks devNull) readEx inh
288−
289−#ifdef INSPECTION
290−#if __GLASGOW_HASKELL__ >= 906
291−inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
292−#else
293−inspect $ hasNoTypeClasses 'readChunksOnException
294−#endif
295−#endif
296−
297−-- | Send the file contents to /dev/null with exception handling
298−readChunksBracket_ :: Handle -> Handle -> IO ()
299−readChunksBracket_ inh devNull =
300− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
301− in IUF.fold (IFH.writeChunks devNull) readEx inh
302−
303−#ifdef INSPECTION
304−#if __GLASGOW_HASKELL__ >= 906
305−inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
306−#else
307−inspect $ hasNoTypeClasses 'readChunksBracket_
308−#endif
309−#endif
310−
311−readChunksBracket :: Handle -> Handle -> IO ()
312−readChunksBracket inh devNull =
313− let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
314− in IUF.fold (IFH.writeChunks devNull) readEx inh
315−
316−o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
317−o_1_space_copy_exceptions_readChunks env =
318− [ bgroup "exceptions/readChunks"
319− [ mkBench "UF.onException" env $ \inH _ ->
320− readChunksOnException inH (nullH env)
321− , mkBench "UF.bracket_" env $ \inH _ ->
322− readChunksBracket_ inH (nullH env)
323− , mkBench "UF.bracket" env $ \inH _ ->
324− readChunksBracket inH (nullH env)
325− ]
326− ]
327−
328−-------------------------------------------------------------------------------
329−-- Exceptions toChunks
330−-------------------------------------------------------------------------------
331−
332−-- | Send the file contents to /dev/null with exception handling
333−toChunksBracket_ :: Handle -> Handle -> IO ()
334−toChunksBracket_ inh devNull =
335− let readEx = bracketUnsafe
336− (return ())
337− (\_ -> hClose inh)
338− (\_ -> fromStreamD $ IFH.readChunks inh)
339− in Stream.fold (IFH.writeChunks devNull) readEx
340−
341−#ifdef INSPECTION
342−inspect $ hasNoTypeClasses 'toChunksBracket_
343−#endif
344−
345−toChunksBracket :: Handle -> Handle -> IO ()
346−toChunksBracket inh devNull =
347− let readEx = Stream.bracket
348− (return ())
349− (\_ -> hClose inh)
350− (\_ -> fromStreamD $ IFH.readChunks inh)
351− in Stream.fold (IFH.writeChunks devNull) readEx
352−
353−o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
354−o_1_space_copy_exceptions_toChunks env =
355− [ bgroup "exceptions/toChunks"
356− [ mkBench "Stream.bracket_" env $ \inH _ ->
357− toChunksBracket_ inH (nullH env)
358− , mkBench "Stream.bracket" env $ \inH _ ->
359− toChunksBracket inH (nullH env)
360− ]
361− ]
362−
363−benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
364−benchmarks moduleName _env size =
365− [ bgroup (o_1_space_prefix moduleName) $ concat
366− [ o_1_space_serial_exceptions size
367− , o_1_space_copy_exceptions_readChunks _env
368− , o_1_space_copy_exceptions_toChunks _env
369− , o_1_space_copy_stream_exceptions _env
370− ]
371− ]
benchmark/Streamly/Benchmark/Data/Stream/Expand.hsdeleted−563
@@ -1,563 +0,0 @@
1−-- |
2−-- Module : Stream.Expand
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE RankNTypes #-}
11−{-# LANGUAGE TupleSections #-}
12−
13−#ifdef USE_PRELUDE
14−{-# OPTIONS_GHC -Wno-deprecations #-}
15−#endif
16−
17−#ifdef __HADDOCK_VERSION__
18−#undef INSPECTION
19−#endif
20−
21−#ifdef INSPECTION
22−{-# LANGUAGE TemplateHaskell #-}
23−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24−#endif
25−
26−module Stream.Expand (benchmarks) where
27−
28−#ifdef INSPECTION
29−import GHC.Types (SPEC(..))
30−import Test.Inspection
31−
32−import qualified Streamly.Internal.Data.Stream as D
33−#endif
34−
35−import qualified Stream.Common as Common
36−import qualified Streamly.Internal.Data.Unfold as UF
37−
38−#ifdef USE_PRELUDE
39−import qualified Streamly.Internal.Data.Stream.IsStream as S
40−import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
41−import Streamly.Benchmark.Prelude
42− ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM
43− , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith)
44−#else
45−import qualified Streamly.Internal.Data.Stream as S
46−#ifdef USE_STREAMK
47−import Streamly.Internal.Data.Stream (Stream)
48−import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)
49−import qualified Control.Applicative as AP
50−import qualified Streamly.Internal.Data.Fold as Fold
51−import qualified Streamly.Internal.Data.StreamK as StreamK
52−#else
53−import qualified Streamly.Internal.Data.Stream as StreamK
54−#endif
55−#endif
56−
57−import Test.Tasty.Bench
58−import Stream.Common
59−import Streamly.Benchmark.Common
60−import Prelude hiding (concatMap)
61−
62−-------------------------------------------------------------------------------
63−-- Iteration/looping utilities
64−-------------------------------------------------------------------------------
65−
66−#ifdef USE_STREAMK
67−{-# INLINE iterateN #-}
68−iterateN :: (Int -> a -> a) -> a -> Int -> a
69−iterateN g initial count = f count initial
70−
71− where
72−
73− f (0 :: Int) x = x
74− f i x = f (i - 1) (g i x)
75−
76−-- Iterate a transformation over a singleton stream
77−{-# INLINE iterateSingleton #-}
78−iterateSingleton :: Applicative m =>
79− (Int -> CrossStreamK m Int -> CrossStreamK m Int)
80− -> Int
81− -> Int
82− -> Stream m Int
83−iterateSingleton g count n =
84− toStream
85− $ StreamK.unCross
86− $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count
87−#endif
88−
89−{-
90−-- XXX need to check why this is slower than the explicit recursion above, even
91−-- if the above code is written in a foldr like head recursive way. We also
92−-- need to try this with foldlM' once #150 is fixed.
93−-- However, it is perhaps best to keep the iteration benchmarks independent of
94−-- foldrM and any related fusion issues.
95−{-# INLINE _iterateSingleton #-}
96−_iterateSingleton ::
97− Monad m
98− => (Int -> Stream m Int -> Stream m Int)
99− -> Int
100− -> Int
101− -> Stream m Int
102−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
103−-}
104−
105−-------------------------------------------------------------------------------
106−-- Multi-Stream
107−-------------------------------------------------------------------------------
108−
109−-------------------------------------------------------------------------------
110−-- Appending
111−-------------------------------------------------------------------------------
112−
113−{-# INLINE serial2 #-}
114−serial2 :: Int -> Int -> IO ()
115−serial2 count n =
116− drain $ toStream $
117− Common.append
118− (fromStream $ sourceUnfoldrM count n)
119− (fromStream $ sourceUnfoldrM count (n + 1))
120−
121−{-# INLINE serial4 #-}
122−serial4 :: Int -> Int -> IO ()
123−serial4 count n =
124− drain $ toStream $
125− Common.append
126− (Common.append
127− (fromStream $ sourceUnfoldrM count n)
128− (fromStream $ sourceUnfoldrM count (n + 1)))
129− (Common.append
130− (fromStream $ sourceUnfoldrM count (n + 2))
131− (fromStream $ sourceUnfoldrM count (n + 3)))
132−
133−o_1_space_joining :: Int -> [Benchmark]
134−o_1_space_joining value =
135− [ bgroup "joining"
136− [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
137− , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
138− ]
139− ]
140−
141−-------------------------------------------------------------------------------
142−-- Concat Foldable containers
143−-------------------------------------------------------------------------------
144−
145−#ifdef USE_PRELUDE
146−o_1_space_concatFoldable :: Int -> [Benchmark]
147−o_1_space_concatFoldable value =
148− [ bgroup "concat-foldable"
149− [ benchIOSrc "foldMapWith (<>) (List)"
150− (sourceFoldMapWith value)
151− , benchIOSrc "foldMapWith (<>) (Stream)"
152− (sourceFoldMapWithStream value)
153− , benchIOSrc "foldMapWithM (<>) (List)"
154− (sourceFoldMapWithM value)
155− , benchIOSrc "S.concatFoldableWith (<>) (List)"
156− (concatFoldableWith value)
157− , benchIOSrc "S.concatForFoldableWith (<>) (List)"
158− (concatForFoldableWith value)
159− , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
160− ]
161− ]
162−#endif
163−
164−-------------------------------------------------------------------------------
165−-- Concat
166−-------------------------------------------------------------------------------
167−
168−-- concatMap unfoldrM/unfoldrM
169−
170−{-# INLINE concatMap #-}
171−concatMap :: Int -> Int -> Int -> IO ()
172−concatMap outer inner n =
173− drain $ toStream $ StreamK.concatMap
174− (\_ -> fromStream $ sourceUnfoldrM inner n)
175− (fromStream $ sourceUnfoldrM outer n)
176−
177−#ifndef USE_STREAMK
178−{-# INLINE concatMapM #-}
179−concatMapM :: Int -> Int -> Int -> IO ()
180−concatMapM outer inner n =
181− drain $ S.concatMapM
182− (\_ -> return $ sourceUnfoldrM inner n)
183− (sourceUnfoldrM outer n)
184−
185−#ifdef INSPECTION
186−inspect $ hasNoTypeClasses 'concatMap
187−inspect $ 'concatMap `hasNoType` ''SPEC
188−#endif
189−#endif
190−
191−-- concatMap unfoldr/unfoldr
192−
193−{-# INLINE concatMapPure #-}
194−concatMapPure :: Int -> Int -> Int -> IO ()
195−concatMapPure outer inner n =
196− drain $ toStream $ StreamK.concatMap
197− (\_ -> fromStream $ sourceUnfoldr inner n)
198− (fromStream $ sourceUnfoldr outer n)
199−
200−#ifdef INSPECTION
201−#if __GLASGOW_HASKELL__ >= 906
202−inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]
203−#else
204−inspect $ hasNoTypeClasses 'concatMapPure
205−#endif
206−inspect $ 'concatMapPure `hasNoType` ''SPEC
207−#endif
208−
209−-- concatMap replicate/unfoldrM
210−
211−{-# INLINE concatMapRepl #-}
212−concatMapRepl :: Int -> Int -> Int -> IO ()
213−concatMapRepl outer inner n =
214− drain $ toStream $ StreamK.concatMap
215− (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)
216−
217−#ifdef INSPECTION
218−#if __GLASGOW_HASKELL__ >= 906
219−inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]
220−#else
221−inspect $ hasNoTypeClasses 'concatMapRepl
222−#endif
223−inspect $ 'concatMapRepl `hasNoType` ''SPEC
224−#endif
225−
226−-- concatMapWith
227−
228−#ifdef USE_STREAMK
229−{-# INLINE concatMapWithSerial #-}
230−concatMapWithSerial :: Int -> Int -> Int -> IO ()
231−concatMapWithSerial = concatStreamsWith Common.append
232−
233−#ifdef INSPECTION
234−inspect $ hasNoTypeClasses 'concatMapWithSerial
235−inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
236−#endif
237−
238−{-
239−{-# INLINE concatMapWithAppend #-}
240−concatMapWithAppend :: Int -> Int -> Int -> IO ()
241−concatMapWithAppend = concatStreamsWith Common.append2
242−
243−#ifdef INSPECTION
244−inspect $ hasNoTypeClasses 'concatMapWithAppend
245−inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
246−#endif
247−-}
248−
249−-- mergeMapWith
250−
251−{-# INLINE mergeMapWithSerial #-}
252−mergeMapWithSerial :: Int -> Int -> Int -> IO ()
253−mergeMapWithSerial = mergeMapWith Common.append
254−
255−{-
256−{-# INLINE mergeMapWithAppend #-}
257−mergeMapWithAppend :: Int -> Int -> Int -> IO ()
258−mergeMapWithAppend = mergeMapWith Common.append2
259−-}
260−#endif
261−
262−-- unfoldMany
263−
264−-- unfoldMany replicate/unfoldrM
265−
266−{-# INLINE unfoldManyRepl #-}
267−unfoldManyRepl :: Int -> Int -> Int -> IO ()
268−unfoldManyRepl outer inner n =
269− drain
270− $ S.unfoldMany
271− UF.replicateM
272− (fmap ((inner,) . return) (sourceUnfoldrM outer n))
273−
274−
275−#ifdef INSPECTION
276−inspect $ hasNoTypeClasses 'unfoldManyRepl
277−inspect $ 'unfoldManyRepl `hasNoType` ''D.ConcatMapUState
278−inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
279−#endif
280−
281−o_1_space_concat :: Int -> [Benchmark]
282−o_1_space_concat value = sqrtVal `seq`
283− [ bgroup "concat"
284− [ benchIOSrc1 "concatMapPure (n of 1)"
285− (concatMapPure value 1)
286− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
287− (concatMapPure sqrtVal sqrtVal)
288− , benchIOSrc1 "concatMapPure (1 of n)"
289− (concatMapPure 1 value)
290−
291− , benchIOSrc1 "concatMap (n of 1)"
292− (concatMap value 1)
293− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
294− (concatMap sqrtVal sqrtVal)
295− , benchIOSrc1 "concatMap (1 of n)"
296− (concatMap 1 value)
297−
298−#ifndef USE_STREAMK
299− -- This is for comparison with foldMapWith
300− , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
301− (S.concatMap id . sourceConcatMapId value)
302−
303− , benchIOSrc1 "concatMapM (n of 1)"
304− (concatMapM value 1)
305− , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
306− (concatMapM sqrtVal sqrtVal)
307− , benchIOSrc1 "concatMapM (1 of n)"
308− (concatMapM 1 value)
309−#endif
310−
311−#ifdef USE_STREAMK
312− {-
313− -- This is for comparison with foldMapWith
314− , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
315− (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
316− -}
317−
318− , benchIOSrc1 "concatMapWith (n of 1)"
319− (concatMapWithSerial value 1)
320− , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
321− (concatMapWithSerial sqrtVal sqrtVal)
322− , benchIOSrc1 "concatMapWith (1 of n)"
323− (concatMapWithSerial 1 value)
324−
325− {-
326− -- quadratic with number of outer streams
327− , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
328− (concatMapWithAppend 2 (value `div` 2))
329− -}
330−#endif
331−
332− -- concatMap vs unfoldMany
333− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
334− (concatMapRepl sqrtVal sqrtVal)
335− , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
336− (unfoldManyRepl sqrtVal sqrtVal)
337− ]
338− ]
339−
340− where
341−
342− sqrtVal = round $ sqrt (fromIntegral value :: Double)
343−
344−#ifdef USE_STREAMK
345−o_n_space_merge :: Int -> [Benchmark]
346−o_n_space_merge value = sqrtVal `seq`
347− [ bgroup "concat"
348− [
349− -------------------mergeMapWith-----------------
350−
351− -- Use large number of streams to check scalability
352−
353− benchIOSrc1 "mergeMapWithSerial (n of 1)"
354− (mergeMapWithSerial value 1)
355− , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"
356− (mergeMapWithSerial sqrtVal sqrtVal)
357− , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"
358− (mergeMapWithSerial 2 (value `div` 2))
359−
360− {-
361− , benchIOSrc1 "mergeMapWithAppend (n of 1)"
362− (mergeMapWithAppend value 1)
363− , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"
364− (mergeMapWithAppend sqrtVal sqrtVal)
365− -}
366− ]
367− ]
368−
369− where
370−
371− sqrtVal = round $ sqrt (fromIntegral value :: Double)
372−#endif
373−
374−-------------------------------------------------------------------------------
375−-- Applicative
376−-------------------------------------------------------------------------------
377−
378−o_1_space_applicative :: Int -> [Benchmark]
379−o_1_space_applicative value =
380− [ bgroup "Applicative"
381− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
382− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
383− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
384− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
385− ]
386− ]
387−
388−#ifdef USE_STREAMK
389−o_n_space_applicative :: Int -> [Benchmark]
390−o_n_space_applicative value =
391− [ bgroup "iterated"
392− [ benchIOSrc "(*>) (n times)" $
393− iterateSingleton ((*>) . pure) value
394− , benchIOSrc "(<*) (n times)" $
395− iterateSingleton (\x xs -> xs <* pure x) value
396− , benchIOSrc "(<*>) (n times)" $
397− iterateSingleton (\x xs -> pure (+ x) <*> xs) value
398− , benchIOSrc "liftA2 (n times)" $
399− iterateSingleton (AP.liftA2 (+) . pure) value
400− ]
401− ]
402−#endif
403−
404−-------------------------------------------------------------------------------
405−-- Monad
406−-------------------------------------------------------------------------------
407−
408−o_1_space_monad :: Int -> [Benchmark]
409−o_1_space_monad value =
410− [ bgroup "Monad"
411− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
412− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
413− , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
414− filterAllOutM value
415− , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
416− filterAllInM value
417− , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
418− filterSome value
419− , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
420− breakAfterSome value
421− , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
422− toNullM3 value
423− ]
424− ]
425−
426−#ifdef USE_STREAMK
427−-- This is a good benchmark but inefficient way to compute primes. As we see a
428−-- new prime we keep appending a division filter for all the future numbers.
429−{-# INLINE sieve #-}
430−sieve :: Monad m => StreamK m Int -> StreamK m Int
431−sieve s = StreamK.concatEffect $ do
432− r <- StreamK.uncons s
433− case r of
434− Just (prime, rest) ->
435− -- XXX Use K.filter or rewrite to K.filter
436− let f = S.filter (\n -> n `mod` prime /= 0)
437− in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest)
438− Nothing -> pure StreamK.nil
439−
440−o_n_space_iterated :: Int -> [Benchmark]
441−o_n_space_iterated value =
442− [ bgroup "iterated"
443− [
444− benchIO "concatEffect prime sieve (n/4)"
445− (\n ->
446− S.fold Fold.sum
447− $ toStream
448− $ sieve
449− $ fromStream
450− $ S.enumerateFromTo 2 (value `div` 4 + n))
451− , benchIOSrc "(>>) (n times)" $
452− iterateSingleton ((>>) . pure) value
453− , benchIOSrc "(>>=) (n times)" $
454− iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
455− ]
456− ]
457−#endif
458−
459−o_n_space_monad :: Int -> [Benchmark]
460−o_n_space_monad value =
461− [ bgroup "Monad"
462− [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
463− toListM value
464− , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
465− toListSome value
466− ]
467− ]
468−
469−-------------------------------------------------------------------------------
470−-- Joining
471−-------------------------------------------------------------------------------
472−
473−{-
474−toKv :: Int -> (Int, Int)
475−toKv p = (p, p)
476−
477−{-# INLINE joinWith #-}
478−joinWith :: Common.MonadAsync m =>
479− ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)
480− -> Int
481− -> Int
482− -> m ()
483−joinWith j val i =
484− drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
485−
486−{-# INLINE joinMapWith #-}
487−joinMapWith :: Common.MonadAsync m =>
488− (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)
489− -> Int
490− -> Int
491− -> m ()
492−joinMapWith j val i =
493− drain
494− $ j
495− (fmap toKv (sourceUnfoldrM val i))
496− (fmap toKv (sourceUnfoldrM val (val `div` 2)))
497−
498−o_n_heap_buffering :: Int -> [Benchmark]
499−o_n_heap_buffering value =
500− [ bgroup "buffered"
501− [
502− benchIOSrc1 "joinInnerGeneric (sqrtVal)"
503− $ joinWith S.joinInnerGeneric sqrtVal
504− , benchIOSrc1 "joinInner"
505− $ joinMapWith S.joinInner halfVal
506− , benchIOSrc1 "joinLeftGeneric (sqrtVal)"
507− $ joinWith S.joinLeftGeneric sqrtVal
508− , benchIOSrc1 "joinLeft "
509− $ joinMapWith S.joinLeft halfVal
510− , benchIOSrc1 "joinOuterGeneric (sqrtVal)"
511− $ joinWith S.joinOuterGeneric sqrtVal
512− , benchIOSrc1 "joinOuter"
513− $ joinMapWith S.joinOuter halfVal
514− , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"
515− $ joinWith S.filterInStreamGenericBy sqrtVal
516− , benchIOSrc1 "filterInStreamAscBy"
517− $ joinMapWith (S.filterInStreamAscBy compare) halfVal
518− ]
519− ]
520−
521− where
522−
523− halfVal = value `div` 2
524− sqrtVal = round $ sqrt (fromIntegral value :: Double)
525−-}
526−
527−-------------------------------------------------------------------------------
528−-- Main
529−-------------------------------------------------------------------------------
530−
531−-- In addition to gauge options, the number of elements in the stream can be
532−-- passed using the --stream-size option.
533−--
534−{-# ANN benchmarks "HLint: ignore" #-}
535−benchmarks :: String -> Int -> [Benchmark]
536−benchmarks moduleName size =
537− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
538− [
539− -- multi-stream
540− o_1_space_joining size
541−#ifdef USE_PRELUDE
542− , o_1_space_concatFoldable size
543−#endif
544− , o_1_space_concat size
545− , o_1_space_applicative size
546− , o_1_space_monad size
547− ]
548− , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
549− [
550− -- multi-stream
551− o_n_space_monad size
552−#ifdef USE_STREAMK
553− , o_n_space_merge size
554− , o_n_space_iterated size
555− , o_n_space_applicative size
556−#endif
557− ]
558− {-
559− , bgroup (o_n_heap_prefix moduleName) $
560− -- multi-stream
561− o_n_heap_buffering size
562− -}
563− ]
benchmark/Streamly/Benchmark/Data/Stream/Generate.hsdeleted−278
@@ -1,278 +0,0 @@
1−-- |
2−-- Module : Stream.Generate
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE RankNTypes #-}
12−
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−module Stream.Generate (benchmarks) where
19−
20−import Control.DeepSeq (NFData(..))
21−import Data.Functor.Identity (Identity(..))
22−
23−import qualified GHC.Exts as GHC
24−import qualified Streamly.Internal.Data.Fold as Fold
25−
26−#ifdef USE_PRELUDE
27−import Streamly.Prelude (MonadAsync)
28−import Stream.Common hiding (MonadAsync)
29−import Streamly.Benchmark.Prelude (sourceFromFoldableM, absTimes)
30−import qualified Streamly.Prelude as S
31−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32−#else
33−import Stream.Common
34−import Streamly.Internal.Data.Stream (Stream)
35−import qualified Streamly.Internal.Data.Stream as Stream
36−#ifdef USE_STREAMK
37−import System.IO.Unsafe (unsafeInterleaveIO)
38−import qualified Streamly.Internal.Data.StreamK as StreamK
39−import qualified Stream.Common as Common
40−#endif
41−#endif
42−
43−import Test.Tasty.Bench
44−import Streamly.Benchmark.Common
45−import qualified Prelude
46−
47−import Prelude hiding (repeat, replicate, iterate)
48−
49−-------------------------------------------------------------------------------
50−-- Generation
51−-------------------------------------------------------------------------------
52−
53−#ifdef USE_PRELUDE
54−type Stream = Stream.SerialT
55−toStreamD = Stream.toStream
56−#else
57−toStreamD :: a -> a
58−toStreamD = id
59−#endif
60−
61−-------------------------------------------------------------------------------
62−-- fromList
63−-------------------------------------------------------------------------------
64−
65−{-# INLINE sourceFromList #-}
66−sourceFromList :: Monad m => Int -> Int -> Stream m Int
67−sourceFromList value n = Stream.fromList [n..n+value]
68−
69−{-# INLINE sourceFromListM #-}
70−sourceFromListM :: MonadAsync m => Int -> Int -> Stream m Int
71−sourceFromListM value n = fromListM (fmap return [n..n+value])
72−
73−{-# INLINE sourceIsList #-}
74−sourceIsList :: Int -> Int -> Stream Identity Int
75−sourceIsList value n = GHC.fromList [n..n+value]
76−
77−{-# INLINE sourceIsString #-}
78−sourceIsString :: Int -> Int -> Stream Identity Char
79−sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
80−
81−{-# INLINE readInstance #-}
82−readInstance :: String -> Stream Identity Int
83−readInstance str =
84− let r = reads str
85− in case r of
86− [(x,"")] -> x
87− _ -> error "readInstance: no parse"
88−
89−-- For comparisons
90−{-# INLINE readInstanceList #-}
91−readInstanceList :: String -> [Int]
92−readInstanceList str =
93− let r = reads str
94− in case r of
95− [(x,"")] -> x
96− _ -> error "readInstance: no parse"
97−
98−{-# INLINE repeat #-}
99−repeat :: Monad m => Int -> Int -> Stream m Int
100−repeat count = Stream.take count . Stream.repeat
101−
102−{-# INLINE replicate #-}
103−replicate :: Monad m => Int -> Int -> Stream m Int
104−replicate = Stream.replicate
105−
106−-------------------------------------------------------------------------------
107−-- enumerate
108−-------------------------------------------------------------------------------
109−
110−{-# INLINE sourceIntFromTo #-}
111−sourceIntFromTo :: Monad m => Int -> Int -> Stream m Int
112−sourceIntFromTo value n = Stream.enumerateFromTo n (n + value)
113−
114−{-# INLINE sourceIntFromThenTo #-}
115−sourceIntFromThenTo :: Monad m => Int -> Int -> Stream m Int
116−sourceIntFromThenTo value n = Stream.enumerateFromThenTo n (n + 1) (n + value)
117−
118−{-# INLINE sourceFracFromTo #-}
119−sourceFracFromTo :: Monad m => Int -> Int -> Stream m Double
120−sourceFracFromTo value n =
121− Stream.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))
122−
123−{-# INLINE sourceFracFromThenTo #-}
124−sourceFracFromThenTo :: Monad m => Int -> Int -> Stream m Double
125−sourceFracFromThenTo value n = Stream.enumerateFromThenTo (fromIntegral n)
126− (fromIntegral n + 1.0001) (fromIntegral (n + value))
127−
128−{-# INLINE sourceIntegerFromStep #-}
129−sourceIntegerFromStep :: Monad m => Int -> Int -> Stream m Integer
130−sourceIntegerFromStep value n =
131− Stream.take value $ Stream.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
132−
133−{-# INLINE enumerateFrom #-}
134−enumerateFrom :: Monad m => Int -> Int -> Stream m Int
135−enumerateFrom count = Stream.take count . Stream.enumerateFrom
136−
137−{-# INLINE enumerateFromTo #-}
138−enumerateFromTo :: Monad m => Int -> Int -> Stream m Int
139−enumerateFromTo = sourceIntFromTo
140−
141−{-# INLINE enumerateFromThen #-}
142−enumerateFromThen :: Monad m => Int -> Int -> Stream m Int
143−enumerateFromThen count inp = Stream.take count $ Stream.enumerateFromThen inp (inp + 1)
144−
145−{-# INLINE enumerateFromThenTo #-}
146−enumerateFromThenTo :: Monad m => Int -> Int -> Stream m Int
147−enumerateFromThenTo = sourceIntFromThenTo
148−
149−-- n ~ 1
150−{-# INLINE enumerate #-}
151−enumerate :: Monad m => Int -> Int -> Stream m Int
152−enumerate count n = Stream.take (count + n) Stream.enumerate
153−
154−-- n ~ 1
155−{-# INLINE enumerateTo #-}
156−enumerateTo :: Monad m => Int -> Int -> Stream m Int
157−enumerateTo count n = Stream.enumerateTo (minBound + count + n)
158−
159−{-# INLINE iterate #-}
160−iterate :: Monad m => Int -> Int -> Stream m Int
161−iterate count = Stream.take count . Stream.iterate (+1)
162−
163−{-# INLINE iterateM #-}
164−iterateM :: MonadAsync m => Int -> Int -> Stream m Int
165−iterateM count = Stream.take count . Stream.iterateM (return . (+1)) . return
166−
167−{-# INLINE repeatM #-}
168−repeatM :: MonadAsync m => Int -> Int -> Stream m Int
169−repeatM count = Stream.take count . Stream.repeatM . return
170−
171−{-# INLINE replicateM #-}
172−replicateM :: MonadAsync m => Int -> Int -> Stream m Int
173−replicateM count = Stream.replicateM count . return
174−
175−#ifdef USE_PRELUDE
176−{-# INLINE fromIndices #-}
177−fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
178−fromIndices value n = S.take value $ S.fromIndices (+ n)
179−
180−{-# INLINE fromIndicesM #-}
181−fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
182−fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
183−#endif
184−
185−#ifdef USE_STREAMK
186−{-# INLINE mfixUnfold #-}
187−mfixUnfold :: Int -> Int -> Stream IO (Int, Int)
188−mfixUnfold count start = toStream $ StreamK.mfix f
189− where
190− f action = StreamK.unCross $ do
191− let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
192− x <- StreamK.mkCross (fromStream $ Common.fromListM [incr 1 action, incr 2 action])
193− y <- StreamK.mkCross (fromStream $ Common.sourceUnfoldr count start)
194− return (x, y)
195−#endif
196−
197−o_1_space_generation :: Int -> [Benchmark]
198−o_1_space_generation value =
199− [ bgroup "generation"
200− [ benchIOSrc "unfoldr" (sourceUnfoldr value)
201− , benchIOSrc "unfoldrM" (sourceUnfoldrM value)
202− , benchIOSrc "repeat" (repeat value)
203− , benchIOSrc "replicate" (replicate value)
204− , benchIOSrc "iterate" (iterate value)
205− , benchIOSrc "iterateM" (iterateM value)
206− , benchIOSrc "intFromTo" (sourceIntFromTo value)
207− , benchIOSrc "intFromThenTo" (sourceIntFromThenTo value)
208− , benchIOSrc "integerFromStep" (sourceIntegerFromStep value)
209− , benchIOSrc "fracFromThenTo" (sourceFracFromThenTo value)
210− , benchIOSrc "fracFromTo" (sourceFracFromTo value)
211− , benchIOSrc "fromList" (sourceFromList value)
212− , benchIOSrc "fromListM" (sourceFromListM value)
213− , benchPureSrc "IsList.fromList" (toStreamD . sourceIsList value)
214− , benchPureSrc "IsString.fromString" (toStreamD . sourceIsString value)
215− , benchIOSrc "enumerateFrom" (enumerateFrom value)
216− , benchIOSrc "enumerateFromTo" (enumerateFromTo value)
217− , benchIOSrc "enumerateFromThen" (enumerateFromThen value)
218− , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value)
219− , benchIOSrc "enumerate" (enumerate value)
220− , benchIOSrc "enumerateTo" (enumerateTo value)
221− , benchIOSrc "repeatM" (repeatM value)
222− , benchIOSrc "replicateM" (replicateM value)
223−#ifdef USE_PRELUDE
224− , benchIOSrc "fromIndices" (fromIndices value)
225− , benchIOSrc "fromIndicesM" (fromIndicesM value)
226−#endif
227−
228− -- These essentially test cons and consM
229−#ifdef USE_STREAMK
230− , benchIOSrc "fromFoldable" (sourceFromFoldable value)
231− -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)
232−#else
233− -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)
234−#endif
235−
236−#ifdef USE_PRELUDE
237− , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)
238− , benchIOSrc "absTimes" $ absTimes value
239−#endif
240−#ifdef USE_STREAMK
241− , Common.benchIOSrc "mfix_10" (mfixUnfold 10)
242− , Common.benchIOSrc "mfix_100" (mfixUnfold 100)
243− , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000)
244−#endif
245− ]
246− ]
247−
248−#ifndef USE_PRELUDE
249−instance NFData a => NFData (Stream Identity a) where
250− {-# INLINE rnf #-}
251− rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs
252−#endif
253−
254−o_n_heap_generation :: Int -> [Benchmark]
255−o_n_heap_generation value =
256− [ bgroup "buffered"
257− -- Buffers the output of show/read.
258− -- XXX can the outputs be streaming? Can we have special read/show
259− -- style type classes, readM/showM supporting streaming effects?
260− [ bench "readsPrec pure streams" $
261− nf readInstance (mkString value)
262− , bench "readsPrec Haskell lists" $
263− nf readInstanceList (mkListString value)
264− ]
265− ]
266−
267−-------------------------------------------------------------------------------
268−-- Main
269−-------------------------------------------------------------------------------
270−
271−-- In addition to gauge options, the number of elements in the stream can be
272−-- passed using the --stream-size option.
273−--
274−benchmarks :: String -> Int -> [Benchmark]
275−benchmarks moduleName size =
276− [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
277− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
278− ]
benchmark/Streamly/Benchmark/Data/Stream/Lift.hsdeleted−146
@@ -1,146 +0,0 @@
1−-- |
2−-- Module : Stream.Lift
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE RankNTypes #-}
11−
12−#ifdef USE_PRELUDE
13−{-# OPTIONS_GHC -Wno-deprecations #-}
14−#endif
15−
16−module Stream.Lift (benchmarks) where
17−
18−import Control.DeepSeq (NFData(..))
19−import Control.Monad.State.Strict (StateT, get, put)
20−import Data.Functor.Identity (Identity)
21−import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
22−import System.Random (randomRIO)
23−
24−import qualified Stream.Common as Common
25−import qualified Streamly.Internal.Data.Fold as Fold
26−
27−#ifdef USE_PRELUDE
28−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
29−#else
30−import Streamly.Internal.Data.Stream (Stream)
31−import qualified Streamly.Internal.Data.Stream as Stream
32−#ifdef USE_STREAMK
33−import Stream.Common (benchIO, drain)
34−import Streamly.Internal.Data.StreamK (StreamK)
35−import qualified Streamly.Internal.Data.StreamK as StreamK
36−import qualified Control.Monad.State.Strict as State
37−#endif
38−#endif
39−
40−import Test.Tasty.Bench
41−import Streamly.Benchmark.Common
42−import Prelude hiding (reverse, tail)
43−
44−#ifdef USE_PRELUDE
45−type Stream = Stream.SerialT
46−#endif
47−
48−-------------------------------------------------------------------------------
49−-- Monad transformation (hoisting etc.)
50−-------------------------------------------------------------------------------
51−
52−{-# INLINE sourceUnfoldrState #-}
53−sourceUnfoldrState :: Common.MonadAsync m =>
54− Int -> Int -> Stream (StateT Int m) Int
55−sourceUnfoldrState value n = Stream.unfoldrM step n
56− where
57− step cnt =
58− if cnt > n + value
59− then return Nothing
60− else do
61− s <- get
62− put (s + 1)
63− return (Just (s, cnt + 1))
64−
65−{-# INLINE evalStateT #-}
66−evalStateT :: Common.MonadAsync m => Int -> Int -> Stream m Int
67−evalStateT value n =
68− Stream.evalStateT (return 0) (sourceUnfoldrState value n)
69−
70−{-# INLINE withState #-}
71−withState :: Common.MonadAsync m => Int -> Int -> Stream m Int
72−withState value n =
73− Stream.evalStateT
74− (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
75−
76−{-# INLINE benchHoistSink #-}
77−benchHoistSink
78− :: (NFData b)
79− => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
80−benchHoistSink value name f =
81− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
82−
83−o_1_space_hoisting :: Int -> [Benchmark]
84−o_1_space_hoisting value =
85− [ bgroup "hoisting"
86− [ benchIOSrc "evalState" (evalStateT value)
87− , benchIOSrc "withState" (withState value)
88−#ifndef USE_PRELUDE
89− , benchHoistSink value "generalizeInner"
90− ((\xs -> Stream.fold Fold.length xs :: IO Int)
91− . Stream.generalizeInner)
92−#endif
93− ]
94− ]
95−
96−#ifdef USE_STREAMK
97−{-# INLINE iterateStateIO #-}
98−iterateStateIO ::
99− Monad m
100− => Int
101− -> StateT Int m Int
102−iterateStateIO n = do
103− x <- get
104− if x > n
105− then do
106− put (x - 1)
107− iterateStateIO n
108− else return x
109−
110−-- XXX This is basically testing the perf of concatEffect, change it to just
111−-- use concatEffect and move it along with other concatMap benchmarks.
112−{-# INLINE iterateStateT #-}
113−iterateStateT :: Int -> StreamK (StateT Int IO) Int
114−iterateStateT n = StreamK.concatEffect $ do
115− x <- get
116− if x > n
117− then do
118− put (x - 1)
119− return $ iterateStateT n
120− else return $ StreamK.fromPure x
121−
122−o_n_heap_transformer :: Int -> [Benchmark]
123−o_n_heap_transformer value =
124− [ bgroup "transformer"
125− [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
126− State.evalStateT (iterateStateIO n) value
127− , benchIO "Stream (StateT Int IO) (n times)" $ \n ->
128− State.evalStateT (drain $ Common.toStream (iterateStateT n)) value
129− ]
130− ]
131−#endif
132−
133−-------------------------------------------------------------------------------
134−-- Main
135−-------------------------------------------------------------------------------
136−
137−-- In addition to gauge options, the number of elements in the stream can be
138−-- passed using the --stream-size option.
139−--
140−benchmarks :: String -> Int -> [Benchmark]
141−benchmarks moduleName size =
142− [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
143−#ifdef USE_STREAMK
144− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
145−#endif
146− ]
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hsdeleted−588
@@ -1,588 +0,0 @@
1−-- |
2−-- Module : Stream.Reduce
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE DeriveAnyClass #-}
11−{-# LANGUAGE DeriveGeneric #-}
12−{-# LANGUAGE RankNTypes #-}
13−
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−module Stream.Reduce (benchmarks) where
19−
20−import Control.DeepSeq (NFData(..))
21−import Control.Monad.IO.Class (MonadIO(..))
22−import Data.Monoid (Sum(..))
23−import GHC.Generics (Generic)
24−
25−import qualified Streamly.Internal.Data.Refold.Type as Refold
26−import qualified Streamly.Internal.Data.Fold as FL
27−import qualified Stream.Common as Common
28−
29−#ifndef USE_STREAMLY_CORE
30−import Data.HashMap.Strict (HashMap)
31−import Data.Proxy (Proxy(..))
32−import Streamly.Internal.Data.IsMap.HashMap ()
33−#endif
34−
35−#ifdef USE_PRELUDE
36−import Control.Monad (when)
37−import qualified Streamly.Internal.Data.Stream.IsStream as S
38−import qualified Streamly.Prelude as S
39−import Streamly.Prelude (fromSerial)
40−import Streamly.Benchmark.Prelude hiding
41− ( benchIO, benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2
42− , toNullAp, monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM
43− , filterSome, breakAfterSome, toListM, toListSome, transformMapM
44− , transformComposeMapM, transformTeeMapM, transformZipMapM)
45−#else
46−
47−import Streamly.Internal.Data.Stream (Stream)
48−import qualified Streamly.Internal.Data.Stream as S
49−#ifndef USE_STREAMLY_CORE
50−import qualified Streamly.Data.Stream.Prelude as S
51−import qualified Streamly.Internal.Data.Stream.Prelude as S
52−#endif
53−
54−#ifdef USE_STREAMK
55−import Streamly.Internal.Data.StreamK (StreamK)
56−import qualified Streamly.Internal.Data.Parser as PR
57−import qualified Streamly.Internal.Data.StreamK as K
58−#else
59−import qualified Streamly.Internal.Data.Stream as K
60−#endif
61−
62−#endif
63−
64−import Test.Tasty.Bench
65−import Streamly.Benchmark.Common
66−import Stream.Common
67−import Prelude hiding (reverse, tail)
68−
69−#ifdef USE_PRELUDE
70−type Stream = S.SerialT
71−#endif
72−
73−-- Apply transformation g count times on a stream of length len
74−#ifdef USE_STREAMK
75−{-# INLINE iterateSource #-}
76−iterateSource ::
77− MonadAsync m
78− => (StreamK m Int -> StreamK m Int)
79− -> Int
80− -> Int
81− -> Int
82− -> StreamK m Int
83−iterateSource g count len n = f count (fromStream $ sourceUnfoldrM len n)
84−
85− where
86−
87− f (0 :: Int) stream = stream
88− f i stream = f (i - 1) (g stream)
89−#else
90−{-# INLINE iterateSource #-}
91−iterateSource ::
92− MonadAsync m
93− => (Stream m Int -> Stream m Int)
94− -> Int
95− -> Int
96− -> Int
97− -> Stream m Int
98−iterateSource g count len n = f count (sourceUnfoldrM len n)
99−
100− where
101−
102− f (0 :: Int) stream = stream
103− f i stream = f (i - 1) (g stream)
104−#endif
105−
106−-------------------------------------------------------------------------------
107−-- Grouping transformations
108−-------------------------------------------------------------------------------
109−
110−{-# INLINE groups #-}
111−groups :: MonadIO m => Stream m Int -> m ()
112−groups =
113−#ifdef USE_PRELUDE
114− Common.drain . S.groups FL.drain
115−#else
116− Common.drain . S.groupsWhile (==) FL.drain
117−#endif
118−
119−{-# INLINE groupsWhileLT #-}
120−groupsWhileLT :: MonadIO m => Stream m Int -> m ()
121−groupsWhileLT =
122−#ifdef USE_PRELUDE
123− Common.drain . S.groupsBy (>) FL.drain
124−#else
125− Common.drain . S.groupsWhile (<) FL.drain
126−#endif
127−
128−{-# INLINE groupsWhileEq #-}
129−groupsWhileEq :: MonadIO m => Stream m Int -> m ()
130−groupsWhileEq =
131−#ifdef USE_PRELUDE
132− Common.drain . S.groupsBy (==) FL.drain
133−#else
134− Common.drain . S.groupsWhile (==) FL.drain
135−#endif
136−
137−
138−{-# INLINE groupsByRollingLT #-}
139−groupsByRollingLT :: MonadIO m => Stream m Int -> m ()
140−groupsByRollingLT =
141−#ifdef USE_PRELUDE
142− Common.drain . S.groupsByRolling (<) FL.drain
143−#else
144− Common.drain . S.groupsRollingBy (<) FL.drain
145−#endif
146−
147−{-# INLINE groupsByRollingEq #-}
148−groupsByRollingEq :: MonadIO m => Stream m Int -> m ()
149−groupsByRollingEq =
150−#ifdef USE_PRELUDE
151− Common.drain . S.groupsByRolling (==) FL.drain
152−#else
153− Common.drain . S.groupsRollingBy (==) FL.drain
154−#endif
155−
156−{-# INLINE foldMany #-}
157−foldMany :: Monad m => Stream m Int -> m ()
158−foldMany =
159− Common.drain
160− . fmap getSum
161− . S.foldMany (FL.take 2 FL.mconcat)
162− . fmap Sum
163−
164−{-# INLINE foldManyPost #-}
165−foldManyPost :: Monad m => Stream m Int -> m ()
166−foldManyPost =
167− Common.drain
168− . fmap getSum
169− . S.foldManyPost (FL.take 2 FL.mconcat)
170− . fmap Sum
171−
172−{-# INLINE refoldMany #-}
173−refoldMany :: Monad m => Stream m Int -> m ()
174−refoldMany =
175− Common.drain
176− . fmap getSum
177− . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
178− . fmap Sum
179−
180−{-# INLINE foldIterateM #-}
181−foldIterateM :: Monad m => Stream m Int -> m ()
182−foldIterateM =
183− Common.drain
184− . fmap getSum
185− . S.foldIterateM
186− (return . FL.take 2 . FL.sconcat) (return (Sum 0))
187− . fmap Sum
188−
189−{-# INLINE refoldIterateM #-}
190−refoldIterateM :: Monad m => Stream m Int -> m ()
191−refoldIterateM =
192− Common.drain
193− . fmap getSum
194− . S.refoldIterateM
195− (Refold.take 2 Refold.sconcat) (return (Sum 0))
196− . fmap Sum
197−
198−#ifdef USE_STREAMK
199−{-# INLINE parseBreak #-}
200−parseBreak :: Monad m => StreamK m Int -> m ()
201−parseBreak s = do
202− r <- K.parseDBreak PR.one s
203− case r of
204− (Left _, _) -> return ()
205− (Right _, s1) -> parseBreak s1
206−#endif
207−
208−o_1_space_grouping :: Int -> [Benchmark]
209−o_1_space_grouping value =
210− -- Buffering operations using heap proportional to group/window sizes.
211− [ bgroup "grouping"
212− [
213− benchIOSink value "groups" groups
214− , benchIOSink value "groupsWhileLT" groupsWhileLT
215− , benchIOSink value "groupsWhileEq" groupsWhileEq
216− , benchIOSink value "groupsByRollingLT" groupsByRollingLT
217− , benchIOSink value "groupsByRollingEq" groupsByRollingEq
218− ,
219−
220− -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD
221− -- modules we can bring those here. chunksOf benchmarks are in
222− -- Parser/ParserD/Array.Stream/FileSystem.Handle.
223− benchIOSink value "foldMany" foldMany
224− , benchIOSink value "foldManyPost" foldManyPost
225− , benchIOSink value "refoldMany" refoldMany
226− , benchIOSink value "foldIterateM" foldIterateM
227− , benchIOSink value "refoldIterateM" refoldIterateM
228−#ifdef USE_STREAMK
229− , benchIOSink value "parseBreak (recursive)" (parseBreak . fromStream)
230−#endif
231−
232−#ifndef USE_STREAMLY_CORE
233− , benchIOSink value "classifySessionsOf (10000 buckets)"
234− (classifySessionsOf (getKey 10000))
235− , benchIOSink value "classifySessionsOf (64 buckets)"
236− (classifySessionsOf (getKey 64))
237− , benchIOSink value "classifySessionsOfHash (10000 buckets)"
238− (classifySessionsOfHash (getKey 10000))
239− , benchIOSink value "classifySessionsOfHash (64 buckets)"
240− (classifySessionsOfHash (getKey 64))
241−#endif
242− ]
243− ]
244−
245−#ifndef USE_STREAMLY_CORE
246− where
247−
248− getKey :: Int -> Int -> Int
249− getKey n = (`mod` n)
250−#endif
251−
252−-------------------------------------------------------------------------------
253−-- Size conserving transformations (reordering, buffering, etc.)
254−-------------------------------------------------------------------------------
255−
256−#ifndef USE_PRELUDE
257−{-# INLINE reverse #-}
258−reverse :: MonadIO m => Int -> Stream m Int -> m ()
259−reverse n = composeN n (toStream . K.reverse . fromStream)
260−
261−{-# INLINE reverse' #-}
262−reverse' :: MonadIO m => Int -> Stream m Int -> m ()
263−reverse' n = composeN n S.reverseUnbox
264−#endif
265−
266−o_n_heap_buffering :: Int -> [Benchmark]
267−o_n_heap_buffering value =
268− [ bgroup "buffered"
269− [
270−#ifndef USE_PRELUDE
271− -- Reversing a stream
272− benchIOSink value "reverse" (reverse 1)
273− , benchIOSink value "reverse'" (reverse' 1)
274−#else
275− benchIOSink value "mkAsync" (mkAsync fromSerial)
276−#endif
277− ]
278− ]
279−
280−-------------------------------------------------------------------------------
281−-- Grouping/Splitting
282−-------------------------------------------------------------------------------
283−
284−#ifndef USE_STREAMLY_CORE
285−{-# INLINE classifySessionsOf #-}
286−classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> Stream m Int -> m ()
287−classifySessionsOf getKey =
288− Common.drain
289− . S.classifySessionsOf
290− (const (return False)) 3 (FL.take 10 FL.sum)
291− . S.timestamped
292− . fmap (\x -> (getKey x, x))
293−
294−{-# INLINE classifySessionsOfHash #-}
295−classifySessionsOfHash :: S.MonadAsync m =>
296− (Int -> Int) -> Stream m Int -> m ()
297−classifySessionsOfHash getKey =
298− Common.drain
299− . S.classifySessionsByGeneric
300− (Proxy :: Proxy (HashMap k))
301− 1 False (const (return False)) 3 (FL.take 10 FL.sum)
302− . S.timestamped
303− . fmap (\x -> (getKey x, x))
304−#endif
305−
306−-------------------------------------------------------------------------------
307−-- Mixed Transformation
308−-------------------------------------------------------------------------------
309−
310−{-# INLINE scanMap #-}
311−scanMap :: MonadIO m => Int -> Stream m Int -> m ()
312−scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0
313−
314−{-# INLINE dropMap #-}
315−dropMap :: MonadIO m => Int -> Stream m Int -> m ()
316−dropMap n = composeN n $ fmap (subtract 1) . S.drop 1
317−
318−{-# INLINE dropScan #-}
319−dropScan :: MonadIO m => Int -> Stream m Int -> m ()
320−dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1
321−
322−{-# INLINE takeDrop #-}
323−takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
324−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
325−
326−{-# INLINE takeScan #-}
327−takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m ()
328−takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1)
329−
330−{-# INLINE takeMap #-}
331−takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
332−takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1)
333−
334−{-# INLINE filterDrop #-}
335−filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
336−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
337−
338−{-# INLINE filterTake #-}
339−filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m ()
340−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
341−
342−{-# INLINE filterScan #-}
343−filterScan :: MonadIO m => Int -> Stream m Int -> m ()
344−filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound)
345−
346−#ifdef USE_PRELUDE
347−{-# INLINE filterScanl1 #-}
348−filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()
349−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
350−#endif
351−
352−{-# INLINE filterMap #-}
353−filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
354−filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1))
355−
356−-------------------------------------------------------------------------------
357−-- Scan and fold
358−-------------------------------------------------------------------------------
359−
360−data Pair a b =
361− Pair !a !b
362− deriving (Generic, NFData)
363−
364−{-# INLINE sumProductFold #-}
365−sumProductFold :: Monad m => Stream m Int -> m (Pair Int Int)
366−sumProductFold =
367− Common.foldl' (\(Pair s p) x -> Pair (s + x) (p * x)) (Pair 0 1)
368−
369−{-# INLINE sumProductScan #-}
370−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
371−sumProductScan =
372− Common.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
373− Common.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
374−
375−{-# INLINE foldl'ReduceMap #-}
376−foldl'ReduceMap :: Monad m => Stream m Int -> m Int
377−foldl'ReduceMap = fmap (+ 1) . Common.foldl' (+) 0
378−
379−o_1_space_transformations_mixed :: Int -> [Benchmark]
380−o_1_space_transformations_mixed value =
381− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
382− -- library. If scan/fold followed by a map is efficient enough we may not
383− -- need monolithic implementations of these.
384− [ bgroup "mixed"
385− [ benchIOSink value "scanl-map" (scanMap 1)
386− , benchIOSink value "foldl-map" foldl'ReduceMap
387− , benchIOSink value "sum-product-fold" sumProductFold
388− , benchIOSink value "sum-product-scan" sumProductScan
389− ]
390− ]
391−
392−o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
393−o_1_space_transformations_mixedX4 value =
394− [ bgroup "mixedX4"
395− [ benchIOSink value "scan-map" (scanMap 4)
396− , benchIOSink value "drop-map" (dropMap 4)
397− , benchIOSink value "drop-scan" (dropScan 4)
398− , benchIOSink value "take-drop" (takeDrop value 4)
399− , benchIOSink value "take-scan" (takeScan value 4)
400− , benchIOSink value "take-map" (takeMap value 4)
401− , benchIOSink value "filter-drop" (filterDrop value 4)
402− , benchIOSink value "filter-take" (filterTake value 4)
403− , benchIOSink value "filter-scan" (filterScan 4)
404−#ifdef USE_PRELUDE
405− , benchIOSink value "filter-scanl1" (filterScanl1 4)
406−#endif
407− , benchIOSink value "filter-map" (filterMap value 4)
408− ]
409− ]
410−
411−-------------------------------------------------------------------------------
412−-- Iterating a transformation over and over again
413−-------------------------------------------------------------------------------
414−
415−#ifdef USE_STREAMK
416−{-
417−-- this is quadratic
418−{-# INLINE iterateScan #-}
419−iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int
420−iterateScan count len = toStream . iterateSource (K.scanl' (+) 0) count len
421−-}
422−
423−{-# INLINE iterateMapM #-}
424−iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int
425−iterateMapM count len = toStream . iterateSource (K.mapM return) count len
426−
427−{-# INLINE iterateFilterEven #-}
428−iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int
429−iterateFilterEven count len =
430− toStream . iterateSource (K.filter even) count len
431−
432−{-# INLINE iterateTakeAll #-}
433−iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
434−iterateTakeAll value count len =
435− toStream . iterateSource (K.take (value + 1)) count len
436−
437−{-# INLINE iterateDropOne #-}
438−iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int
439−iterateDropOne count len = toStream . iterateSource (K.drop 1) count len
440−
441−{-# INLINE iterateDropWhileTrue #-}
442−iterateDropWhileTrue :: MonadAsync m
443− => Int -> Int -> Int -> Int -> Stream m Int
444−iterateDropWhileTrue value count len =
445− toStream . iterateSource (K.dropWhile (<= (value + 1))) count len
446−
447−{-# INLINE iterateDropWhileFalse #-}
448−iterateDropWhileFalse :: MonadAsync m
449− => Int -> Int -> Int -> Int -> Stream m Int
450−iterateDropWhileFalse value count len =
451− toStream . iterateSource (K.dropWhile (> (value + 1))) count len
452−
453−#else
454−
455−-- this is quadratic
456−{-# INLINE iterateScan #-}
457−iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int
458−iterateScan = iterateSource (Common.scanl' (+) 0)
459−
460−#ifdef USE_PRELUDE
461−-- this is quadratic
462−{-# INLINE iterateScanl1 #-}
463−iterateScanl1 :: MonadAsync m => Int -> Int -> Int -> Stream m Int
464−iterateScanl1 = iterateSource (S.scanl1' (+))
465−#endif
466−
467−{-# INLINE iterateMapM #-}
468−iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int
469−iterateMapM = iterateSource (S.mapM return)
470−
471−{-# INLINE iterateFilterEven #-}
472−iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int
473−iterateFilterEven = iterateSource (S.filter even)
474−
475−{-# INLINE iterateTakeAll #-}
476−iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
477−iterateTakeAll value = iterateSource (S.take (value + 1))
478−
479−{-# INLINE iterateDropOne #-}
480−iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int
481−iterateDropOne = iterateSource (S.drop 1)
482−
483−{-# INLINE iterateDropWhileTrue #-}
484−iterateDropWhileTrue :: MonadAsync m
485− => Int -> Int -> Int -> Int -> Stream m Int
486−iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
487−#endif
488−
489−#ifdef USE_PRELUDE
490−{-# INLINE tail #-}
491−tail :: Monad m => Stream m a -> m ()
492−tail s = S.tail s >>= mapM_ tail
493−
494−{-# INLINE nullHeadTail #-}
495−nullHeadTail :: Monad m => Stream m Int -> m ()
496−nullHeadTail s = do
497− r <- S.null s
498− when (not r) $ do
499− _ <- S.head s
500− S.tail s >>= mapM_ nullHeadTail
501−#endif
502−
503−-- Head recursive operations.
504−o_n_stack_iterated :: Int -> [Benchmark]
505−o_n_stack_iterated value = by10 `seq` by100 `seq`
506− [ bgroup "iterated"
507− [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10
508−#ifndef USE_STREAMK
509− , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $
510− iterateScan by100 100
511−#endif
512−#ifdef USE_PRELUDE
513− , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
514−#endif
515− , benchIOSrc "filterEven (n/10 x 10)" $
516− iterateFilterEven by10 10
517− , benchIOSrc "takeAll (n/10 x 10)" $
518− iterateTakeAll value by10 10
519− , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10
520−#ifdef USE_STREAMK
521− , benchIOSrc "dropWhileFalse (n/10 x 10)" $
522− iterateDropWhileFalse value by10 10
523−#endif
524− , benchIOSrc "dropWhileTrue (n/10 x 10)" $
525− iterateDropWhileTrue value by10 10
526−#ifdef USE_PRELUDE
527− , benchIOSink value "tail" tail
528− , benchIOSink value "nullHeadTail" nullHeadTail
529−#endif
530− ]
531− ]
532−
533− where
534−
535− by10 = value `div` 10
536− by100 = value `div` 100
537−
538−-------------------------------------------------------------------------------
539−-- Pipes
540−-------------------------------------------------------------------------------
541−
542−o_1_space_pipes :: Int -> [Benchmark]
543−o_1_space_pipes value =
544− [ bgroup "pipes"
545− [ benchIOSink value "mapM" (transformMapM 1)
546− , benchIOSink value "compose" (transformComposeMapM 1)
547− , benchIOSink value "tee" (transformTeeMapM 1)
548−#ifdef DEVBUILD
549− -- XXX this take 1 GB memory to compile
550− , benchIOSink value "zip" (transformZipMapM 1)
551−#endif
552− ]
553− ]
554−
555−o_1_space_pipesX4 :: Int -> [Benchmark]
556−o_1_space_pipesX4 value =
557− [ bgroup "pipesX4"
558− [ benchIOSink value "mapM" (transformMapM 4)
559− , benchIOSink value "compose" (transformComposeMapM 4)
560− , benchIOSink value "tee" (transformTeeMapM 4)
561−#ifdef DEVBUILD
562− -- XXX this take 1 GB memory to compile
563− , benchIOSink value "zip" (transformZipMapM 4)
564−#endif
565− ]
566− ]
567−
568−-------------------------------------------------------------------------------
569−-- Main
570−-------------------------------------------------------------------------------
571−
572−-- In addition to gauge options, the number of elements in the stream can be
573−-- passed using the --stream-size option.
574−--
575−benchmarks :: String -> Int -> [Benchmark]
576−benchmarks moduleName size =
577− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
578− [ o_1_space_grouping size
579− , o_1_space_transformations_mixed size
580− , o_1_space_transformations_mixedX4 size
581−
582− -- pipes
583− , o_1_space_pipes size
584− , o_1_space_pipesX4 size
585− ]
586− , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
587− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size)
588− ]
benchmark/Streamly/Benchmark/Data/Stream/Split.hsdeleted−244
@@ -1,244 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−-- |
4−-- Module : Stream.Split
5−-- Copyright : (c) 2019 Composewell Technologies
6−-- License : BSD-3-Clause
7−-- Maintainer : streamly@composewell.com
8−-- Stability : experimental
9−-- Portability : GHC
10−
11−{-# LANGUAGE CPP #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−module Stream.Split (benchmarks) where
24−
25−import Data.Char (ord)
26−import Data.Word (Word8)
27−import System.IO (Handle)
28−
29−import qualified Streamly.FileSystem.Handle as FH
30−import qualified Streamly.Internal.Data.Array as A
31−import qualified Streamly.Internal.Data.Fold as FL
32−import qualified Streamly.Internal.Data.Parser as PR
33−import qualified Streamly.Internal.Data.Stream.IsStream as IP
34−import qualified Streamly.Internal.FileSystem.Handle as IFH
35−import qualified Streamly.Internal.Unicode.Stream as IUS
36−import qualified Streamly.Prelude as S
37−
38−import Test.Tasty.Bench hiding (env)
39−import Prelude hiding (last, length)
40−import Streamly.Benchmark.Common
41−import Streamly.Benchmark.Common.Handle
42−
43−#ifdef INSPECTION
44−import Streamly.Internal.Data.Stream (Step(..))
45−
46−import qualified Streamly.Internal.Data.MutArray as MA
47−import qualified Streamly.Internal.Data.Unfold as IUF
48−
49−import Test.Inspection
50−#endif
51−
52− -------------------------------------------------------------------------------
53−-- reduce with splitting transformations
54−-------------------------------------------------------------------------------
55−
56−lf :: Word8
57−lf = fromIntegral (ord '\n')
58−
59−toarr :: String -> A.Array Word8
60−toarr = A.fromList . map (fromIntegral . ord)
61−
62−-- | Split on line feed.
63−splitOn :: Handle -> IO Int
64−splitOn inh =
65− (S.length $ S.splitOn (== lf) FL.drain
66− $ S.unfold FH.read inh) -- >>= print
67−
68−#ifdef INSPECTION
69−inspect $ hasNoTypeClasses 'splitOn
70−inspect $ 'splitOn `hasNoType` ''Step
71−inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
72−inspect $ 'splitOn `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
73−#endif
74−
75−-- | Split suffix on line feed.
76−splitOnSuffix :: Handle -> IO Int
77−splitOnSuffix inh =
78− (S.length $ S.splitOnSuffix (== lf) FL.drain
79− $ S.unfold FH.read inh) -- >>= print
80−
81−#ifdef INSPECTION
82−inspect $ hasNoTypeClasses 'splitOnSuffix
83−inspect $ 'splitOnSuffix `hasNoType` ''Step
84−inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'splitOnSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
86−#endif
87−
88−-- | Split suffix with line feed.
89−splitWithSuffix :: Handle -> IO Int
90−splitWithSuffix inh =
91− (S.length $ S.splitWithSuffix (== lf) FL.drain
92− $ S.unfold FH.read inh) -- >>= print
93−
94−#ifdef INSPECTION
95−inspect $ hasNoTypeClasses 'splitWithSuffix
96−inspect $ 'splitWithSuffix `hasNoType` ''Step
97−inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'splitWithSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
99−#endif
100−
101−-- | Split on line feed.
102−foldManySepBy :: Handle -> IO Int
103−foldManySepBy inh =
104− (S.length
105− $ IP.foldMany
106− (FL.takeEndBy_ (== lf) FL.drain)
107− (S.unfold FH.read inh)
108− ) -- >>= print
109−
110−-- | Split on line feed.
111−parseManySepBy :: Handle -> IO Int
112−parseManySepBy inh =
113− (S.length
114− $ IP.parseMany
115− (PR.fromFold $ FL.takeEndBy_ (== lf) FL.drain)
116− (S.unfold FH.read inh)
117− ) -- >>= print
118−
119−-- | Words by space
120−wordsBy :: Handle -> IO Int
121−wordsBy inh =
122− (S.length $ S.wordsBy isSp FL.drain
123− $ S.unfold FH.read inh) -- >>= print
124−
125−#ifdef INSPECTION
126−inspect $ hasNoTypeClasses 'wordsBy
127−inspect $ 'wordsBy `hasNoType` ''Step
128−inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
129−inspect $ 'wordsBy `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
130−#endif
131−
132−-- | Split on a word8 sequence.
133−splitOnSeq :: String -> Handle -> IO Int
134−splitOnSeq str inh =
135− (S.length $ IP.splitOnSeq (toarr str) FL.drain
136− $ S.unfold FH.read inh) -- >>= print
137−
138−#ifdef INSPECTION
139−-- inspect $ hasNoTypeClasses 'splitOnSeq
140−-- inspect $ 'splitOnSeq `hasNoType` ''Step
141−#endif
142−
143−-- | Split on a word8 sequence.
144−splitOnSeq100k :: Handle -> IO Int
145−splitOnSeq100k inh = do
146− arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123
147− (S.length $ IP.splitOnSeq arr FL.drain
148− $ S.unfold FH.read inh) -- >>= print
149−
150−-- | Split on suffix sequence.
151−splitOnSuffixSeq :: String -> Handle -> IO Int
152−splitOnSuffixSeq str inh =
153− (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
154− $ S.unfold FH.read inh) -- >>= print
155−
156−#ifdef INSPECTION
157−-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
158−-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
159−#endif
160−
161−-- | Split on suffix sequence.
162−splitWithSuffixSeq :: String -> Handle -> IO Int
163−splitWithSuffixSeq str inh =
164− S.length $ IP.splitWithSuffixSeq (toarr str) FL.drain
165− $ S.unfold FH.read inh -- >>= print
166−
167−o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
168−o_1_space_reduce_read_split env =
169− [ bgroup "split"
170− [ mkBench "S.foldMany (FL.takeEndBy_ (== lf) FL.drain)" env
171− $ \inh _ -> foldManySepBy inh
172− , mkBench "S.parseMany (FL.takeEndBy_ (== lf) FL.drain)" env
173− $ \inh _ -> parseManySepBy inh
174− , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->
175− wordsBy inh
176− , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->
177− splitOn inh
178− , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->
179− splitOnSuffix inh
180− , mkBench "S.splitWithSuffix (== lf) FL.drain" env $ \inh _ ->
181− splitWithSuffix inh
182− , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->
183− splitOnSeq "" inh
184− , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->
185− splitOnSuffixSeq "" inh
186− , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->
187− splitOnSeq "\n" inh
188− , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->
189− splitOnSuffixSeq "\n" inh
190− , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->
191− splitOnSeq "a" inh
192− , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
193− splitOnSeq "\r\n" inh
194− , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
195− splitOnSuffixSeq "\r\n" inh
196− , mkBench "S.splitWithSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
197− splitWithSuffixSeq "\r\n" inh
198− , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
199− splitOnSeq "aa" inh
200− , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
201− splitOnSeq "aaaa" inh
202− , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->
203− splitOnSeq "abcdefgh" inh
204− , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->
205− splitOnSeq "abcdefghi" inh
206− , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->
207− splitOnSeq "catcatcatcatcat" inh
208− , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
209− env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
210− , mkBench "S.splitOnSeq 100k long pattern"
211− env $ \inh _ -> splitOnSeq100k inh
212− , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
213− env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
214− , mkBenchSmall "S.splitWithSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
215− env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
216− ]
217− ]
218−
219−-- | Split on a character sequence.
220−splitOnSeqUtf8 :: String -> Handle -> IO Int
221−splitOnSeqUtf8 str inh =
222− (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
223− $ IP.fromStream
224− $ IUS.decodeUtf8Arrays
225− $ IFH.readChunks inh) -- >>= print
226−
227−o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
228−o_1_space_reduce_toChunks_split env =
229− [ bgroup "split/toChunks"
230− [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "
231− ++ ". US.decodeUtf8Arrays") env $ \inh _ ->
232− splitOnSeqUtf8 "abcdefgh" inh
233− , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
234− env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
235− ]
236− ]
237−
238−benchmarks :: String -> BenchEnv -> [Benchmark]
239−benchmarks moduleName env =
240− [ bgroup (o_1_space_prefix moduleName) $ concat
241− [ o_1_space_reduce_read_split env
242− , o_1_space_reduce_toChunks_split env
243− ]
244− ]
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hsdeleted−658
@@ -1,658 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Stream.StreamD
3−-- Copyright : (c) 2018 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE TupleSections #-}
12−{-# OPTIONS_GHC -Wno-orphans #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−module Main (main) where
24−
25−#if !MIN_VERSION_base(4,18,0)
26−import Control.Applicative (liftA2)
27−#endif
28−import Control.Monad (when)
29−import Data.Maybe (isJust)
30−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
31−import System.Random (randomRIO)
32−import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
33−
34−import qualified Prelude as P
35−import qualified Streamly.Internal.Data.Stream as S
36−import qualified Streamly.Internal.Data.Unfold as UF
37−import qualified Streamly.Internal.Data.Fold as FL
38−
39−import Streamly.Benchmark.Common
40−
41−#ifdef INSPECTION
42−import GHC.Types (SPEC(..))
43−import Test.Inspection
44−#endif
45−
46−-- We try to keep the total number of iterations same irrespective of nesting
47−-- of the loops so that the overhead is easy to compare.
48−value, value2, value3, value16, maxValue :: Int
49−value = 100000
50−value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
51−value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
52−value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
53−maxValue = value
54−
55−-------------------------------------------------------------------------------
56−-- Stream generation and elimination
57−-------------------------------------------------------------------------------
58−
59−type Stream m a = S.Stream m a
60−
61−{-# INLINE sourceUnfoldr #-}
62−sourceUnfoldr :: Monad m => Int -> Stream m Int
63−sourceUnfoldr n = S.unfoldr step n
64− where
65− step cnt =
66− if cnt > n + value
67− then Nothing
68− else Just (cnt, cnt + 1)
69−
70−{-# INLINE sourceUnfoldrN #-}
71−sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int
72−sourceUnfoldrN m n = S.unfoldr step n
73− where
74− step cnt =
75− if cnt > n + m
76− then Nothing
77− else Just (cnt, cnt + 1)
78−
79−{-# INLINE sourceUnfoldrMN #-}
80−sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int
81−sourceUnfoldrMN m n = S.unfoldrM step n
82− where
83− step cnt =
84− if cnt > n + m
85− then return Nothing
86− else return (Just (cnt, cnt + 1))
87−
88−{-# INLINE sourceUnfoldrM #-}
89−sourceUnfoldrM :: Monad m => Int -> Stream m Int
90−sourceUnfoldrM n = S.unfoldrM step n
91− where
92− step cnt =
93− if cnt > n + value
94− then return Nothing
95− else return (Just (cnt, cnt + 1))
96−
97−{-# INLINE sourceIntFromTo #-}
98−sourceIntFromTo :: Monad m => Int -> Stream m Int
99−sourceIntFromTo n = S.enumerateFromToIntegral n (n + value)
100−
101−{-# INLINE sourceFromList #-}
102−sourceFromList :: Monad m => Int -> Stream m Int
103−sourceFromList n = S.fromList [n..n+value]
104−
105−-------------------------------------------------------------------------------
106−-- Elimination
107−-------------------------------------------------------------------------------
108−
109−{-# INLINE runStream #-}
110−runStream :: Monad m => Stream m a -> m ()
111−runStream = S.drain
112−
113−{-# INLINE mapM_ #-}
114−mapM_ :: Monad m => Stream m a -> m ()
115−mapM_ = S.mapM_ (\_ -> return ())
116−
117−{-# INLINE toNull #-}
118−toNull :: Monad m => Stream m Int -> m ()
119−toNull = runStream
120−
121−{-# INLINE uncons #-}
122−{-# INLINE nullTail #-}
123−{-# INLINE headTail #-}
124−uncons, nullTail, headTail
125− :: Monad m
126− => Stream m Int -> m ()
127−
128−uncons s = do
129− r <- S.uncons s
130− case r of
131− Nothing -> return ()
132− Just (_, t) -> uncons t
133−
134−{-# INLINE foldBreak #-}
135−foldBreak :: Monad m => Stream m Int -> m ()
136−foldBreak s = do
137− (r, s1) <- S.foldBreak (FL.take 1 FL.length) s
138− when (r /= 0) $ foldBreak s1
139−
140−{-# INLINE tail #-}
141−tail :: Monad m => Stream m a -> m ()
142−tail s = S.tail s >>= P.mapM_ tail
143−
144−nullTail s = do
145− r <- S.null s
146− when (not r) $ S.tail s >>= P.mapM_ nullTail
147−
148−headTail s = do
149− h <- S.head s
150− when (isJust h) $ S.tail s >>= P.mapM_ headTail
151−
152−{-# INLINE toList #-}
153−toList :: Monad m => Stream m Int -> m [Int]
154−toList = S.toList
155−
156−{-# INLINE foldl #-}
157−foldl :: Monad m => Stream m Int -> m Int
158−foldl = S.foldl' (+) 0
159−
160−{-# INLINE last #-}
161−last :: Monad m => Stream m Int -> m (Maybe Int)
162−last = S.last
163−
164−-------------------------------------------------------------------------------
165−-- Transformation
166−-------------------------------------------------------------------------------
167−
168−{-# INLINE transform #-}
169−transform :: Monad m => Stream m a -> m ()
170−transform = runStream
171−
172−{-# INLINE composeN #-}
173−composeN
174− :: Monad m
175− => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
176−composeN n f =
177− case n of
178− 1 -> transform . f
179− 2 -> transform . f . f
180− 3 -> transform . f . f . f
181− 4 -> transform . f . f . f . f
182− _ -> undefined
183−
184−{-# INLINE scan #-}
185−{-# INLINE map #-}
186−{-# INLINE fmapD #-}
187−{-# INLINE mapM #-}
188−{-# INLINE mapMaybe #-}
189−{-# INLINE mapMaybeM #-}
190−{-# INLINE filterEven #-}
191−{-# INLINE filterAllOut #-}
192−{-# INLINE filterAllIn #-}
193−{-# INLINE _takeOne #-}
194−{-# INLINE takeAll #-}
195−{-# INLINE takeWhileTrue #-}
196−{-# INLINE _takeWhileMTrue #-}
197−{-# INLINE dropOne #-}
198−{-# INLINE dropAll #-}
199−{-# INLINE dropWhileTrue #-}
200−{-# INLINE _dropWhileMTrue #-}
201−{-# INLINE dropWhileFalse #-}
202−{-# INLINE _foldrS #-}
203−{-# INLINE _foldlS #-}
204−{-# INLINE intersperse #-}
205−scan, map, fmapD, mapM, mapMaybe, mapMaybeM, filterEven, filterAllOut,
206− filterAllIn, _takeOne, takeAll, takeWhileTrue, _takeWhileMTrue, dropOne,
207− dropAll, dropWhileTrue, _dropWhileMTrue, dropWhileFalse, _foldrS, _foldlS,
208− intersperse
209− :: Monad m
210− => Int -> Stream m Int -> m ()
211−
212−scan n = composeN n $ S.scanl' (+) 0
213−fmapD n = composeN n $ Prelude.fmap (+1)
214−map n = composeN n $ S.map (+1)
215−mapM n = composeN n $ S.mapM return
216−mapMaybe n = composeN n $ S.mapMaybe
217− (\x -> if Prelude.odd x then Nothing else Just x)
218−mapMaybeM n = composeN n $ S.mapMaybeM
219− (\x -> if Prelude.odd x then return Nothing else return $ Just x)
220−filterEven n = composeN n $ S.filter even
221−filterAllOut n = composeN n $ S.filter (> maxValue)
222−filterAllIn n = composeN n $ S.filter (<= maxValue)
223−_takeOne n = composeN n $ S.take 1
224−takeAll n = composeN n $ S.take maxValue
225−takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
226−_takeWhileMTrue n = composeN n $ S.takeWhileM (return . (<= maxValue))
227−dropOne n = composeN n $ S.drop 1
228−dropAll n = composeN n $ S.drop maxValue
229−dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
230−_dropWhileMTrue n = composeN n $ S.dropWhileM (return . (<= maxValue))
231−dropWhileFalse n = composeN n $ S.dropWhile (> maxValue)
232−_foldrS n = composeN n $ S.foldrS S.cons S.nil
233−_foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
234−intersperse n = composeN n $ S.intersperse maxValue
235−
236−-------------------------------------------------------------------------------
237−-- Iteration
238−-------------------------------------------------------------------------------
239−
240−iterStreamLen, maxIters :: Int
241−iterStreamLen = 10
242−maxIters = 10000
243−
244−{-# INLINE iterateSource #-}
245−iterateSource
246− :: Monad m
247− => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
248−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
249− where
250− f (0 :: Int) m = g m
251− f x m = g (f (x P.- 1) m)
252−
253−{-# INLINE iterateMapM #-}
254−{-# INLINE iterateScan #-}
255−{-# INLINE iterateFilterEven #-}
256−{-# INLINE iterateTakeAll #-}
257−{-# INLINE iterateDropOne #-}
258−{-# INLINE iterateDropWhileFalse #-}
259−{-# INLINE iterateDropWhileTrue #-}
260−iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
261− iterateDropWhileFalse, iterateDropWhileTrue
262− :: Monad m
263− => Int -> Stream m Int
264−
265−-- this is quadratic
266−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
267−iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
268− (maxIters `div` 10)
269−
270−iterateMapM = iterateSource (S.mapM return) maxIters
271−iterateFilterEven = iterateSource (S.filter even) maxIters
272−iterateTakeAll = iterateSource (S.take maxValue) maxIters
273−iterateDropOne = iterateSource (S.drop 1) maxIters
274−iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
275−
276−{-# INLINE iterateM #-}
277−iterateM :: Monad m => Int -> Stream m Int
278−iterateM i = S.take maxIters (S.iterateM (\x -> return (x + 1)) (return i))
279−
280−-------------------------------------------------------------------------------
281−-- Zipping
282−-------------------------------------------------------------------------------
283−
284−{-# INLINE eqBy #-}
285−eqBy :: (Monad m, P.Eq a) => S.Stream m a -> m P.Bool
286−eqBy src = S.eqBy (==) src src
287−
288−{-# INLINE cmpBy #-}
289−cmpBy :: (Monad m, P.Ord a) => S.Stream m a -> m P.Ordering
290−cmpBy src = S.cmpBy P.compare src src
291−
292−{-# INLINE zip #-}
293−zip :: Monad m => Stream m Int -> m ()
294−zip src = transform $ S.zipWith (,) src src
295−
296−-------------------------------------------------------------------------------
297−-- Mixed Composition
298−-------------------------------------------------------------------------------
299−
300−{-# INLINE scanMap #-}
301−{-# INLINE dropMap #-}
302−{-# INLINE dropScan #-}
303−{-# INLINE takeDrop #-}
304−{-# INLINE takeScan #-}
305−{-# INLINE takeMap #-}
306−{-# INLINE filterDrop #-}
307−{-# INLINE filterTake #-}
308−{-# INLINE filterScan #-}
309−{-# INLINE filterMap #-}
310−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
311− filterTake, filterScan, filterMap
312− :: Monad m => Int -> Stream m Int -> m ()
313−
314−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
315−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
316−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
317−takeDrop n = composeN n $ S.drop 1 . S.take maxValue
318−takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
319−takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
320−filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
321−filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
322−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
323−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
324−
325−-------------------------------------------------------------------------------
326−-- Nested Composition
327−-------------------------------------------------------------------------------
328−
329−instance Monad f => Applicative (S.Stream f) where
330− {-# INLINE pure #-}
331− pure = S.fromPure
332−
333− {-# INLINE (<*>) #-}
334− (<*>) = S.crossApply
335−
336− {-# INLINE liftA2 #-}
337− liftA2 f x = (<*>) (fmap f x)
338−
339− {-# INLINE (*>) #-}
340− (*>) = S.crossApplySnd
341−
342− {-# INLINE (<*) #-}
343− (<*) = S.crossApplyFst
344−
345−-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,
346−-- the monad instance does not seem to be significantly faster.
347−instance Monad m => Monad (S.Stream m) where
348− {-# INLINE return #-}
349− return = pure
350−
351− {-# INLINE (>>=) #-}
352− (>>=) = flip S.concatMap
353−
354− {-# INLINE (>>) #-}
355− (>>) = (*>)
356−
357−{-# INLINE toNullApNested #-}
358−toNullApNested :: Monad m => Stream m Int -> m ()
359−toNullApNested s = runStream $ do
360− (+) <$> s <*> s
361−
362−{-# INLINE toNullNested #-}
363−toNullNested :: Monad m => Stream m Int -> m ()
364−toNullNested s = runStream $ do
365− x <- s
366− y <- s
367− return $ x + y
368−
369−{-# INLINE toNullNested3 #-}
370−toNullNested3 :: Monad m => Stream m Int -> m ()
371−toNullNested3 s = runStream $ do
372− x <- s
373− y <- s
374− z <- s
375− return $ x + y + z
376−
377−{-# INLINE filterAllOutNested #-}
378−filterAllOutNested
379− :: Monad m
380− => Stream m Int -> m ()
381−filterAllOutNested str = runStream $ do
382− x <- str
383− y <- str
384− let s = x + y
385− if s < 0
386− then return s
387− else S.nil
388−
389−{-# INLINE filterAllInNested #-}
390−filterAllInNested
391− :: Monad m
392− => Stream m Int -> m ()
393−filterAllInNested str = runStream $ do
394− x <- str
395− y <- str
396− let s = x + y
397− if s > 0
398− then return s
399− else S.nil
400−
401−-------------------------------------------------------------------------------
402−-- ConcatMap
403−-------------------------------------------------------------------------------
404−
405−-- concatMap unfoldrM/unfoldrM
406−
407−{-# INLINE concatMap #-}
408−concatMap :: Int -> Int -> Int -> IO ()
409−concatMap outer inner n =
410− S.drain $ S.concatMap
411− (\_ -> sourceUnfoldrMN inner n)
412− (sourceUnfoldrMN outer n)
413−
414−#ifdef INSPECTION
415−inspect $ hasNoTypeClasses 'concatMap
416−inspect $ 'concatMap `hasNoType` ''SPEC
417−#endif
418−
419−-- concatMap unfoldr/unfoldr
420−
421−{-# INLINE concatMapPure #-}
422−concatMapPure :: Int -> Int -> Int -> IO ()
423−concatMapPure outer inner n =
424− S.drain $ S.concatMap
425− (\_ -> sourceUnfoldrN inner n)
426− (sourceUnfoldrN outer n)
427−
428−#ifdef INSPECTION
429−inspect $ hasNoTypeClasses 'concatMapPure
430−inspect $ 'concatMapPure `hasNoType` ''SPEC
431−#endif
432−
433−-- concatMap replicate/unfoldrM
434−
435−{-# INLINE concatMapRepl #-}
436−concatMapRepl :: Int -> Int -> Int -> IO ()
437−concatMapRepl outer inner n =
438− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
439−
440−#ifdef INSPECTION
441−inspect $ hasNoTypeClasses 'concatMapRepl
442−inspect $ 'concatMapRepl `hasNoType` ''SPEC
443−#endif
444−
445−-- unfoldMany replicate/unfoldrM
446−
447−{-# INLINE unfoldManyRepl #-}
448−unfoldManyRepl :: Int -> Int -> Int -> IO ()
449−unfoldManyRepl outer inner n =
450− S.drain
451− $ S.unfoldMany
452− UF.replicateM
453− (S.map ((inner,) . return) (sourceUnfoldrMN outer n))
454−
455−#ifdef INSPECTION
456−inspect $ hasNoTypeClasses 'unfoldManyRepl
457−inspect $ 'unfoldManyRepl `hasNoType` ''S.ConcatMapUState
458−inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
459−#endif
460−
461−-------------------------------------------------------------------------------
462−-- Benchmarks
463−-------------------------------------------------------------------------------
464−
465−moduleName :: String
466−moduleName = "Data.StreamD"
467−
468−o_1_space :: [Benchmark]
469−o_1_space =
470− [ bgroup (o_1_space_prefix moduleName)
471− [ bgroup "generation"
472− [ benchFold "unfoldr" toNull sourceUnfoldr
473− , benchFold "unfoldrM" toNull sourceUnfoldrM
474− , benchFold "intFromTo" toNull sourceIntFromTo
475−
476− , benchFold "fromList" toNull sourceFromList
477− ]
478− , bgroup "elimination"
479− [ benchFold "toNull" toNull sourceUnfoldrM
480− , benchFold "mapM_" mapM_ sourceUnfoldrM
481− , benchFold "uncons" uncons sourceUnfoldrM
482− , benchFold "foldBreak" foldBreak sourceUnfoldrM
483− , benchFold "foldl'" foldl sourceUnfoldrM
484− , benchFold "last" last sourceUnfoldrM
485− ]
486− , bgroup "nested"
487− [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)
488− , benchFold "toNull" toNullNested (sourceUnfoldrMN value2)
489− , benchFold "toNull3" toNullNested3 (sourceUnfoldrMN value3)
490− , benchFold "filterAllIn" filterAllInNested (sourceUnfoldrMN value2)
491− , benchFold "filterAllOut" filterAllOutNested (sourceUnfoldrMN value2)
492− , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)
493− , benchFold "toNullPure" toNullNested (sourceUnfoldrN value2)
494− , benchFold "toNull3Pure" toNullNested3 (sourceUnfoldrN value3)
495− , benchFold "filterAllInPure" filterAllInNested (sourceUnfoldrN value2)
496− , benchFold "filterAllOutPure" filterAllOutNested (sourceUnfoldrN value2)
497− ]
498− , bgroup "transformation"
499− [ benchFold "scan" (scan 1) sourceUnfoldrM
500− , benchFold "map" (map 1) sourceUnfoldrM
501− , benchFold "fmap" (fmapD 1) sourceUnfoldrM
502− , benchFold "mapM" (mapM 1) sourceUnfoldrM
503− , benchFold "mapMaybe" (mapMaybe 1) sourceUnfoldrM
504− , benchFold "mapMaybeM" (mapMaybeM 1) sourceUnfoldrM
505− ]
506− , bgroup "transformationX4"
507− [ benchFold "scan" (scan 4) sourceUnfoldrM
508− , benchFold "map" (map 4) sourceUnfoldrM
509− , benchFold "fmap" (fmapD 4) sourceUnfoldrM
510− , benchFold "mapM" (mapM 4) sourceUnfoldrM
511− , benchFold "mapMaybe" (mapMaybe 4) sourceUnfoldrM
512− , benchFold "mapMaybeM" (mapMaybeM 4) sourceUnfoldrM
513− -- XXX this is horribly slow
514− -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
515− ]
516−
517− , bgroup "concat"
518− [ benchIOSrc1 "concatMapPure (n of 1)"
519− (concatMapPure value 1)
520− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
521− (concatMapPure value2 value2)
522− , benchIOSrc1 "concatMapPure (1 of n)"
523− (concatMapPure 1 value)
524−
525− , benchIOSrc1 "concatMap (n of 1)"
526− (concatMap value 1)
527− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
528− (concatMap value2 value2)
529− , benchIOSrc1 "concatMap (1 of n)"
530− (concatMap 1 value)
531−
532− -- concatMap vs unfoldMany
533− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
534− (concatMapRepl value2 value2)
535− , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
536− (unfoldManyRepl value2 value2)
537− ]
538− , bgroup "filtering"
539− [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
540− , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
541− , benchFold "filter-all-in" (filterAllIn 1) sourceUnfoldrM
542− , benchFold "take-all" (takeAll 1) sourceUnfoldrM
543− , benchFold "takeWhile-true" (takeWhileTrue 1) sourceUnfoldrM
544− , benchFold "drop-one" (dropOne 1) sourceUnfoldrM
545− , benchFold "drop-all" (dropAll 1) sourceUnfoldrM
546− , benchFold "dropWhile-true" (dropWhileTrue 1) sourceUnfoldrM
547− , benchFold "dropWhile-false" (dropWhileFalse 1) sourceUnfoldrM
548− ]
549− , bgroup "filteringX4"
550− [ benchFold "filter-even" (filterEven 4) sourceUnfoldrM
551− , benchFold "filter-all-out" (filterAllOut 4) sourceUnfoldrM
552− , benchFold "filter-all-in" (filterAllIn 4) sourceUnfoldrM
553− , benchFold "take-all" (takeAll 4) sourceUnfoldrM
554− , benchFold "takeWhile-true" (takeWhileTrue 4) sourceUnfoldrM
555− , benchFold "drop-one" (dropOne 4) sourceUnfoldrM
556− , benchFold "drop-all" (dropAll 4) sourceUnfoldrM
557− , benchFold "dropWhile-true" (dropWhileTrue 4) sourceUnfoldrM
558− , benchFold "dropWhile-false" (dropWhileFalse 4) sourceUnfoldrM
559− ]
560− , bgroup "zipping"
561− [ benchFold "eqBy" eqBy sourceUnfoldrM
562− , benchFold "cmpBy" cmpBy sourceUnfoldrM
563− , benchFold "zip" zip sourceUnfoldrM
564− ]
565− , bgroup "mixed"
566− [ benchFold "scan-map" (scanMap 1) sourceUnfoldrM
567− , benchFold "drop-map" (dropMap 1) sourceUnfoldrM
568− , benchFold "drop-scan" (dropScan 1) sourceUnfoldrM
569− , benchFold "take-drop" (takeDrop 1) sourceUnfoldrM
570− , benchFold "take-scan" (takeScan 1) sourceUnfoldrM
571− , benchFold "take-map" (takeMap 1) sourceUnfoldrM
572− , benchFold "filter-drop" (filterDrop 1) sourceUnfoldrM
573− , benchFold "filter-take" (filterTake 1) sourceUnfoldrM
574− , benchFold "filter-scan" (filterScan 1) sourceUnfoldrM
575− , benchFold "filter-map" (filterMap 1) sourceUnfoldrM
576− ]
577− , bgroup "mixedX2"
578− [ benchFold "scan-map" (scanMap 2) sourceUnfoldrM
579− , benchFold "drop-map" (dropMap 2) sourceUnfoldrM
580− , benchFold "drop-scan" (dropScan 2) sourceUnfoldrM
581− , benchFold "take-drop" (takeDrop 2) sourceUnfoldrM
582− , benchFold "take-scan" (takeScan 2) sourceUnfoldrM
583− , benchFold "take-map" (takeMap 2) sourceUnfoldrM
584− , benchFold "filter-drop" (filterDrop 2) sourceUnfoldrM
585− , benchFold "filter-take" (filterTake 2) sourceUnfoldrM
586− , benchFold "filter-scan" (filterScan 2) sourceUnfoldrM
587− , benchFold "filter-map" (filterMap 2) sourceUnfoldrM
588− ]
589− , bgroup "mixedX4"
590− [ benchFold "scan-map" (scanMap 4) sourceUnfoldrM
591− , benchFold "drop-map" (dropMap 4) sourceUnfoldrM
592− , benchFold "drop-scan" (dropScan 4) sourceUnfoldrM
593− , benchFold "take-drop" (takeDrop 4) sourceUnfoldrM
594− , benchFold "take-scan" (takeScan 4) sourceUnfoldrM
595− , benchFold "take-map" (takeMap 4) sourceUnfoldrM
596− , benchFold "filter-drop" (filterDrop 4) sourceUnfoldrM
597− , benchFold "filter-take" (filterTake 4) sourceUnfoldrM
598− , benchFold "filter-scan" (filterScan 4) sourceUnfoldrM
599− , benchFold "filter-map" (filterMap 4) sourceUnfoldrM
600− ]
601− ]
602− ]
603−
604−-- | Takes a source, and uses it with a default drain/fold method.
605−{-# INLINE benchD #-}
606−benchD :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
607−benchD name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
608−
609−o_n_stack :: [Benchmark]
610−o_n_stack =
611− [ bgroup (o_n_stack_prefix moduleName)
612− [ bgroup "elimination"
613− [ benchFold "tail" tail sourceUnfoldrM
614− , benchFold "nullTail" nullTail sourceUnfoldrM
615− , benchFold "headTail" headTail sourceUnfoldrM
616− ]
617− , bgroup "transformation"
618− [
619− -- this is horribly slow
620− -- benchFold "foldrS" (_foldrS 1) sourceUnfoldrM
621− -- XXX why do these need so much stack
622− benchFold "intersperse" (intersperse 1) (sourceUnfoldrMN value2)
623− , benchFold "interspersePure" (intersperse 1) (sourceUnfoldrN value2)
624− ]
625− , bgroup "transformationX4"
626− [
627− benchFold "intersperse" (intersperse 4) (sourceUnfoldrMN value16)
628− ]
629− , bgroup "iterated"
630− [ benchD "mapM" iterateMapM
631− , benchD "scan(1/10)" iterateScan
632− , benchD "filterEven" iterateFilterEven
633− , benchD "takeAll" iterateTakeAll
634− , benchD "dropOne" iterateDropOne
635− , benchD "dropWhileFalse(1/10)" iterateDropWhileFalse
636− , benchD "dropWhileTrue" iterateDropWhileTrue
637− , benchD "iterateM" iterateM
638− ]
639− ]
640− ]
641−
642−o_n_space :: [Benchmark]
643−o_n_space =
644− [ bgroup (o_n_space_prefix moduleName)
645− [ bgroup "elimination"
646− [ benchFold "toList" toList sourceUnfoldrM
647− ]
648− , bgroup "transformation"
649− [
650−
651− -- This is horribly slow, never finishes
652− -- benchFold "foldlS" (_foldlS 1) sourceUnfoldrM
653− ]
654− ]
655− ]
656−
657−main :: IO ()
658−main = defaultMain $ concat [o_1_space, o_n_stack, o_n_space]
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hsdeleted−934
@@ -1,934 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Stream.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#ifdef __HADDOCK_VERSION__
14−#undef INSPECTION
15−#endif
16−
17−#ifdef INSPECTION
18−{-# LANGUAGE TemplateHaskell #-}
19−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20−#endif
21−
22−module Main (main) where
23−
24−#if !MIN_VERSION_base(4,18,0)
25−import Control.Applicative (liftA2)
26−#endif
27−import Control.Monad (when)
28−import Data.Maybe (isJust)
29−import System.Random (randomRIO)
30−import Prelude hiding
31− ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
32− , repeat, replicate
33− )
34−
35−import qualified Prelude as P
36−import qualified Data.List as List
37−
38−import qualified Streamly.Internal.Data.StreamK as S
39−
40−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
41−
42−import Streamly.Benchmark.Common
43−
44−#ifdef INSPECTION
45−import Test.Inspection
46−#endif
47−
48−{-
49−
50−Benchmarks that need to be added
51−
52−-- fromList
53−
54−-- bindWith
55−-- concatPairsWith
56−-- apWith
57−-- apSerial
58−-- apSerialDiscardFst
59−-- apSerialDiscardSnd
60−
61−-- the
62−-- serial
63−-- consMStream
64−-- withLocal
65−-- mfix
66−
67−-- elem
68−-- notElem
69−-- all
70−-- any
71−-- minimum
72−-- minimumBy
73−-- maximum
74−-- maximumBy
75−-- findIndices
76−-- lookup
77−-- findM
78−-- find
79−-- (!!)
80−
81−-- foldlM'
82−-- foldlT
83−-- foldlx'
84−-- foldlMx'
85−-- fold
86−
87−-- sequence
88−
89−-- foldrSM
90−-- buildS
91−-- buildM
92−-- augmentS
93−-- augmentSM
94−-- foldr
95−-- foldr1
96−-- foldrM
97−-- foldrT
98−
99−-- intersperseM
100−-- insertBy
101−-- deleteBy
102−-- reverse
103−-- mapMaybe
104−
105−-- zipWithM
106−-- mergeBy
107−-- mergeByM
108−
109−-- toStreamK (Probably can be skipped)
110−-- hoist
111−
112−-- scanlx'
113−
114−-}
115−
116−-------------------------------------------------------------------------------
117−-- Stream generation and elimination
118−-------------------------------------------------------------------------------
119−
120−type Stream m a = S.StreamK m a
121−
122−{-# INLINE unfoldr #-}
123−unfoldr :: Int -> Int -> Stream m Int
124−unfoldr streamLen n = S.unfoldr step n
125− where
126− step cnt =
127− if cnt > n + streamLen
128− then Nothing
129− else Just (cnt, cnt + 1)
130−
131−{-# INLINE unfoldrM #-}
132−unfoldrM :: Monad m => Int -> Int -> Stream m Int
133−unfoldrM streamLen n = S.unfoldrMWith S.consM step n
134− where
135− step cnt =
136− if cnt > n + streamLen
137− then return Nothing
138− else return (Just (cnt, cnt + 1))
139−
140−{-# INLINE repeat #-}
141−repeat :: Int -> Int -> Stream m Int
142−repeat streamLen = S.take streamLen . S.repeat
143−
144−{-# INLINE repeatM #-}
145−repeatM :: Monad m => Int -> Int -> Stream m Int
146−repeatM streamLen = S.take streamLen . S.repeatM . return
147−
148−{-# INLINE replicate #-}
149−replicate :: Int -> Int -> Stream m Int
150−replicate = S.replicate
151−
152−{-# INLINE replicateM #-}
153−replicateM :: Monad m => Int -> Int -> Stream m Int
154−replicateM streamLen = S.replicateMWith S.consM streamLen . return
155−
156−{-# INLINE iterate #-}
157−iterate :: Int -> Int -> Stream m Int
158−iterate streamLen = S.take streamLen . S.iterate (+1)
159−
160−{-# INLINE iterateM #-}
161−iterateM :: Monad m => Int -> Int -> Stream m Int
162−iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
163−
164−{-# INLINE fromFoldable #-}
165−fromFoldable :: Int -> Int -> Stream m Int
166−fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
167−
168−{-# INLINE fromFoldableM #-}
169−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
170−fromFoldableM streamLen n =
171− List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
172−
173−{-# INLINABLE concatMapFoldableWith #-}
174−concatMapFoldableWith :: P.Foldable f
175− => (Stream m b -> Stream m b -> Stream m b)
176− -> (a -> Stream m b)
177− -> f a
178− -> Stream m b
179−concatMapFoldableWith f g = P.foldr (f . g) S.nil
180−
181−{-# INLINE concatMapFoldableSerial #-}
182−concatMapFoldableSerial :: Int -> Int -> Stream m Int
183−concatMapFoldableSerial streamLen n =
184− concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
185−
186−{-# INLINE concatMapFoldableSerialM #-}
187−concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
188−concatMapFoldableSerialM streamLen n =
189− concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
190−
191−-------------------------------------------------------------------------------
192−-- Elimination
193−-------------------------------------------------------------------------------
194−
195−{-# INLINE drain #-}
196−drain :: Monad m => Stream m a -> m ()
197−drain = S.drain
198−
199−{-# INLINE mapM_ #-}
200−mapM_ :: Monad m => Stream m a -> m ()
201−mapM_ = S.mapM_ (\_ -> return ())
202−
203−{-# INLINE uncons #-}
204−uncons :: Monad m => Stream m Int -> m ()
205−uncons s = do
206− r <- S.uncons s
207− case r of
208− Nothing -> return ()
209− Just (_, t) -> uncons t
210−
211−{-# INLINE init #-}
212−init :: Monad m => Stream m a -> m ()
213−init s = do
214− t <- S.init s
215− P.mapM_ S.drain t
216−
217−{-# INLINE tail #-}
218−tail :: Monad m => Stream m a -> m ()
219−tail s = S.tail s >>= P.mapM_ tail
220−
221−{-# INLINE nullTail #-}
222−nullTail :: Monad m => Stream m Int -> m ()
223−nullTail s = do
224− r <- S.null s
225− when (not r) $ S.tail s >>= P.mapM_ nullTail
226−
227−{-# INLINE headTail #-}
228−headTail :: Monad m => Stream m Int -> m ()
229−headTail s = do
230− h <- S.head s
231− when (isJust h) $ S.tail s >>= P.mapM_ headTail
232−
233−{-# INLINE toList #-}
234−toList :: Monad m => Stream m Int -> m [Int]
235−toList = S.toList
236−
237−{-# INLINE foldl' #-}
238−foldl' :: Monad m => Stream m Int -> m Int
239−foldl' = S.foldl' (+) 0
240−
241−{-# INLINE last #-}
242−last :: Monad m => Stream m Int -> m (Maybe Int)
243−last = S.last
244−
245−-------------------------------------------------------------------------------
246−-- Transformation
247−-------------------------------------------------------------------------------
248−
249−{-# INLINE composeN #-}
250−composeN
251− :: Monad m
252− => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
253−composeN n f =
254− case n of
255− 1 -> drain . f
256− 2 -> drain . f . f
257− 3 -> drain . f . f . f
258− 4 -> drain . f . f . f . f
259− _ -> undefined
260−
261−{-# INLINE scanl' #-}
262−scanl' :: Monad m => Int -> Stream m Int -> m ()
263−scanl' n = composeN n $ S.scanl' (+) 0
264−
265−{-# INLINE map #-}
266−map :: Monad m => Int -> Stream m Int -> m ()
267−map n = composeN n $ S.map (+ 1)
268−
269−{-# INLINE fmapK #-}
270−fmapK :: Monad m => Int -> Stream m Int -> m ()
271−fmapK n = composeN n $ P.fmap (+ 1)
272−
273−{-# INLINE mapM #-}
274−mapM :: Monad m => Int -> Stream m Int -> m ()
275−mapM n = composeN n $ S.mapMWith S.consM return
276−
277−{-# INLINE mapMSerial #-}
278−mapMSerial :: Monad m => Int -> Stream m Int -> m ()
279−mapMSerial n = composeN n $ S.mapMSerial return
280−
281−{-# INLINE filterEven #-}
282−filterEven :: Monad m => Int -> Stream m Int -> m ()
283−filterEven n = composeN n $ S.filter even
284−
285−{-# INLINE filterAllOut #-}
286−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
288−
289−{-# INLINE filterAllIn #-}
290−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
292−
293−{-# INLINE _takeOne #-}
294−_takeOne :: Monad m => Int -> Stream m Int -> m ()
295−_takeOne n = composeN n $ S.take 1
296−
297−{-# INLINE takeAll #-}
298−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299−takeAll streamLen n = composeN n $ S.take streamLen
300−
301−{-# INLINE takeWhileTrue #-}
302−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
304−
305−{-# INLINE dropOne #-}
306−dropOne :: Monad m => Int -> Stream m Int -> m ()
307−dropOne n = composeN n $ S.drop 1
308−
309−{-# INLINE dropAll #-}
310−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311−dropAll streamLen n = composeN n $ S.drop streamLen
312−
313−{-# INLINE dropWhileTrue #-}
314−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
316−
317−{-# INLINE dropWhileFalse #-}
318−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
320−
321−{-# INLINE foldrS #-}
322−foldrS :: Monad m => Int -> Stream m Int -> m ()
323−foldrS n = composeN n $ S.foldrS S.cons S.nil
324−
325−{-# INLINE foldlS #-}
326−foldlS :: Monad m => Int -> Stream m Int -> m ()
327−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
328−
329−{-# INLINE intersperse #-}
330−intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
331−intersperse streamLen n = composeN n $ S.intersperse streamLen
332−
333−-------------------------------------------------------------------------------
334−-- Iteration
335−-------------------------------------------------------------------------------
336−
337−{-# INLINE iterateSource #-}
338−iterateSource
339− :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
340−iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
341− where
342− f (0 :: Int) m = g m
343− f x m = g (f (x P.- 1) m)
344−
345−-- this is quadratic
346−{-# INLINE iterateScan #-}
347−iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
348−iterateScan iterStreamLen maxIters =
349− iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
350−
351−-- this is quadratic
352−{-# INLINE iterateDropWhileFalse #-}
353−iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
354−iterateDropWhileFalse streamLen iterStreamLen maxIters =
355− iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
356−
357−{-# INLINE iterateMapM #-}
358−iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359−iterateMapM iterStreamLen =
360− iterateSource iterStreamLen (S.mapMWith S.consM return)
361−
362−{-# INLINE iterateFilterEven #-}
363−iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365−
366−{-# INLINE iterateTakeAll #-}
367−iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368−iterateTakeAll streamLen iterStreamLen =
369− iterateSource iterStreamLen (S.take streamLen)
370−
371−{-# INLINE iterateDropOne #-}
372−iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
373−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
374−
375−{-# INLINE iterateDropWhileTrue #-}
376−iterateDropWhileTrue ::
377− Monad m => Int -> Int -> Int -> Int -> Stream m Int
378−iterateDropWhileTrue streamLen iterStreamLen =
379− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
380−
381−-------------------------------------------------------------------------------
382−-- Zipping
383−-------------------------------------------------------------------------------
384−
385−{-# INLINE zipWith #-}
386−zipWith :: Monad m => Stream m Int -> m ()
387−zipWith src = drain $ S.zipWith (,) src src
388−
389−{-# INLINE zipWithM #-}
390−zipWithM :: Monad m => Stream m Int -> m ()
391−zipWithM src = drain $ S.zipWithM (curry return) src src
392−
393−{-# INLINE sortByK #-}
394−sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395−sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
396−
397−{-# INLINE sortBy #-}
398−sortBy :: Monad m => Stream m Int -> m ()
399−sortBy = drain . sortByK compare
400−
401−-------------------------------------------------------------------------------
402−-- Mixed Composition
403−-------------------------------------------------------------------------------
404−
405−{-# INLINE scanMap #-}
406−scanMap :: Monad m => Int -> Stream m Int -> m ()
407−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
408−
409−{-# INLINE dropMap #-}
410−dropMap :: Monad m => Int -> Stream m Int -> m ()
411−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
412−
413−{-# INLINE dropScan #-}
414−dropScan :: Monad m => Int -> Stream m Int -> m ()
415−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
416−
417−{-# INLINE takeDrop #-}
418−takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
419−takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
420−
421−{-# INLINE takeScan #-}
422−takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
423−takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
424−
425−{-# INLINE takeMap #-}
426−takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
427−takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
428−
429−{-# INLINE filterDrop #-}
430−filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
431−filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
432−
433−{-# INLINE filterTake #-}
434−filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
435−filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
436−
437−{-# INLINE filterScan #-}
438−filterScan :: Monad m => Int -> Stream m Int -> m ()
439−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
440−
441−{-# INLINE filterMap #-}
442−filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
443−filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
444−
445−-------------------------------------------------------------------------------
446−-- ConcatMap
447−-------------------------------------------------------------------------------
448−
449−-- concatMap unfoldrM/unfoldrM
450−
451−{-# INLINE concatMap #-}
452−concatMap :: Int -> Int -> Int -> IO ()
453−concatMap outer inner n =
454− S.drain $ S.concatMap
455− (\_ -> unfoldrM inner n)
456− (unfoldrM outer n)
457−
458−#ifdef INSPECTION
459−inspect $ hasNoTypeClasses 'concatMap
460−#endif
461−
462−-- concatMap unfoldr/unfoldr
463−
464−{-# INLINE concatMapPure #-}
465−concatMapPure :: Int -> Int -> Int -> IO ()
466−concatMapPure outer inner n =
467− S.drain $ S.concatMap
468− (\_ -> unfoldr inner n)
469− (unfoldr outer n)
470−
471−#ifdef INSPECTION
472−inspect $ hasNoTypeClasses 'concatMapPure
473−#endif
474−
475−-- concatMap replicate/unfoldrM
476−
477−{-# INLINE concatMapRepl #-}
478−concatMapRepl :: Int -> Int -> Int -> IO ()
479−concatMapRepl outer inner n =
480− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
481−
482−#ifdef INSPECTION
483−inspect $ hasNoTypeClasses 'concatMapRepl
484−#endif
485−
486−-- concatMapWith
487−
488−{-# INLINE sourceConcatMapId #-}
489−sourceConcatMapId :: Monad m
490− => Int -> Int -> Stream m (Stream m Int)
491−sourceConcatMapId val n =
492− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
493−
494−{-# INLINE concatMapBySerial #-}
495−concatMapBySerial :: Int -> Int -> Int -> IO ()
496−concatMapBySerial outer inner n =
497− S.drain $ S.concatMapWith S.append
498− (unfoldrM inner)
499− (unfoldrM outer n)
500−
501−-------------------------------------------------------------------------------
502−-- Nested Composition
503−-------------------------------------------------------------------------------
504−
505−instance Monad m => Applicative (S.StreamK m) where
506− {-# INLINE pure #-}
507− pure = S.fromPure
508−
509− {-# INLINE (<*>) #-}
510− (<*>) = S.crossApply
511−
512− {-# INLINE liftA2 #-}
513− liftA2 f x = (<*>) (fmap f x)
514−
515− {-# INLINE (*>) #-}
516− (*>) = S.crossApplySnd
517−
518− {-# INLINE (<*) #-}
519− (<*) = S.crossApplyFst
520−
521−-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
522−-- the monad instance of StreamD is slower than StreamK after foldr/build
523−-- fusion.
524−instance Monad m => Monad (S.StreamK m) where
525− {-# INLINE return #-}
526− return = pure
527−
528− {-# INLINE (>>=) #-}
529− (>>=) = flip S.concatMap
530−
531−{-# INLINE drainApplicative #-}
532−drainApplicative :: Monad m => Stream m Int -> m ()
533−drainApplicative s = drain $ do
534− (+) <$> s <*> s
535−
536−{-# INLINE drainMonad #-}
537−drainMonad :: Monad m => Stream m Int -> m ()
538−drainMonad s = drain $ do
539− x <- s
540− y <- s
541− return $ x + y
542−
543−{-# INLINE drainMonad3 #-}
544−drainMonad3 :: Monad m => Stream m Int -> m ()
545−drainMonad3 s = drain $ do
546− x <- s
547− y <- s
548− z <- s
549− return $ x + y + z
550−
551−{-# INLINE filterAllOutMonad #-}
552−filterAllOutMonad
553− :: Monad m
554− => Stream m Int -> m ()
555−filterAllOutMonad str = drain $ do
556− x <- str
557− y <- str
558− let s = x + y
559− if s < 0
560− then return s
561− else S.nil
562−
563−{-# INLINE filterAllInMonad #-}
564−filterAllInMonad
565− :: Monad m
566− => Stream m Int -> m ()
567−filterAllInMonad str = drain $ do
568− x <- str
569− y <- str
570− let s = x + y
571− if s > 0
572− then return s
573− else S.nil
574−
575−-------------------------------------------------------------------------------
576−-- Nested Composition Pure lists
577−-------------------------------------------------------------------------------
578−
579−-- There are several list benchmarks here for comparison with lists. It is easy
580−-- and convenient to see the comparisons when they are here, otherwise we'll
581−-- have to add a separate module for list benchmarks with the same names and
582−-- then add a comparison in bench.sh.
583−
584−{-# INLINE unfoldrList #-}
585−unfoldrList :: Int -> Int -> [Int]
586−unfoldrList maxval n = List.unfoldr step n
587− where
588− step cnt =
589− if cnt > n + maxval
590− then Nothing
591− else Just (cnt, cnt + 1)
592−
593−{-# INLINE toNullApNestedList #-}
594−toNullApNestedList :: [Int] -> [Int]
595−toNullApNestedList s = (+) <$> s <*> s
596−
597−{-# INLINE toNullNestedList #-}
598−toNullNestedList :: [Int] -> [Int]
599−toNullNestedList s = do
600− x <- s
601− y <- s
602− return $ x + y
603−
604−{-# INLINE toNullNestedList3 #-}
605−toNullNestedList3 :: [Int] -> [Int]
606−toNullNestedList3 s = do
607− x <- s
608− y <- s
609− z <- s
610− return $ x + y + z
611−
612−{-# INLINE filterAllOutNestedList #-}
613−filterAllOutNestedList :: [Int] -> [Int]
614−filterAllOutNestedList str = do
615− x <- str
616− y <- str
617− let s = x + y
618− if s < 0
619− then return s
620− else []
621−
622−{-# INLINE filterAllInNestedList #-}
623−filterAllInNestedList :: [Int] -> [Int]
624−filterAllInNestedList str = do
625− x <- str
626− y <- str
627− let s = x + y
628− if s > 0
629− then return s
630− else []
631−
632−-------------------------------------------------------------------------------
633−-- Benchmarks
634−-------------------------------------------------------------------------------
635−
636−moduleName :: String
637−moduleName = "Data.StreamK"
638−
639−o_1_space_generation :: Int -> Benchmark
640−o_1_space_generation streamLen =
641− bgroup "generation"
642− [ benchFold "unfoldr" drain (unfoldr streamLen)
643− , benchFold "unfoldrM" drain (unfoldrM streamLen)
644− , benchFold "repeat" drain (repeat streamLen)
645− , benchFold "repeatM" drain (repeatM streamLen)
646− , benchFold "replicate" drain (replicate streamLen)
647− , benchFold "replicateM" drain (replicateM streamLen)
648− , benchFold "iterate" drain (iterate streamLen)
649− , benchFold "iterateM" drain (iterateM streamLen)
650−
651− , benchFold "fromFoldable" drain (fromFoldable streamLen)
652− , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
653−
654− -- appends
655− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
657− ]
658−
659−o_1_space_elimination :: Int -> Benchmark
660−o_1_space_elimination streamLen =
661− bgroup "elimination"
662− [ benchFold "toNull" drain (unfoldrM streamLen)
663− , benchFold "mapM_" mapM_ (unfoldrM streamLen)
664− , benchFold "uncons" uncons (unfoldrM streamLen)
665− , benchFold "init" init (unfoldrM streamLen)
666− , benchFold "foldl'" foldl' (unfoldrM streamLen)
667− , benchFold "last" last (unfoldrM streamLen)
668− ]
669−
670−o_1_space_nested :: Int -> Benchmark
671−o_1_space_nested streamLen =
672− bgroup "nested"
673− [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
674− , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
675− , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
676− , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
677− , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
678− , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
679− , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
680− , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
681− , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
682− , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
683− ]
684− where
685− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
686− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
687−
688−o_1_space_transformation :: Int -> Benchmark
689−o_1_space_transformation streamLen =
690− bgroup "transformation"
691− [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
692− , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
693− , benchFold "map" (map 1) (unfoldrM streamLen)
694− , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
695− , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
696− , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
697− ]
698−
699−o_1_space_transformationX4 :: Int -> Benchmark
700−o_1_space_transformationX4 streamLen =
701− bgroup "transformationX4"
702− [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
703− , benchFold "map" (map 4) (unfoldrM streamLen)
704− , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
705− , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
706− , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
707− -- XXX this is horribly slow
708− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
709− ]
710−
711−o_1_space_concat :: Int -> Benchmark
712−o_1_space_concat streamLen =
713− bgroup "concat"
714− [ benchIOSrc1 "concatMapPure (n of 1)"
715− (concatMapPure streamLen 1)
716− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
717− (concatMapPure streamLen2 streamLen2)
718− , benchIOSrc1 "concatMapPure (1 of n)"
719− (concatMapPure 1 streamLen)
720−
721− , benchIOSrc1 "concatMap (n of 1)"
722− (concatMap streamLen 1)
723− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
724− (concatMap streamLen2 streamLen2)
725− , benchIOSrc1 "concatMap (1 of n)"
726− (concatMap 1 streamLen)
727−
728− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
729− (concatMapRepl streamLen2 streamLen2)
730−
731− -- This is for comparison with concatMapFoldableWith
732− , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
733− (S.drain
734− . S.concatMapWith S.append id
735− . sourceConcatMapId streamLen)
736−
737− , benchIOSrc1 "concatMapBy serial (n of 1)"
738− (concatMapBySerial streamLen 1)
739− , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
740− (concatMapBySerial streamLen2 streamLen2)
741− , benchIOSrc1 "concatMapBy serial (1 of n)"
742− (concatMapBySerial 1 streamLen)
743− , benchFold "sortBy" sortBy (unfoldrM streamLen)
744− ]
745− where
746− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
747−
748−o_1_space_filtering :: Int -> Benchmark
749−o_1_space_filtering streamLen =
750− bgroup "filtering"
751− [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
752− , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
753− , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
754− , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
755− , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
756− , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
757− , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
758− , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
759− , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
760− ]
761−
762−o_1_space_filteringX4 :: Int -> Benchmark
763−o_1_space_filteringX4 streamLen =
764− bgroup "filteringX4"
765− [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
766− , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
767− , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
768− , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
769− , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
770− , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
771− , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
772− , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
773− , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
774− ]
775−
776−o_1_space_zipping :: Int -> Benchmark
777−o_1_space_zipping streamLen =
778− bgroup "zipping"
779− [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780− , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
781− ]
782−
783−o_1_space_mixed :: Int -> Benchmark
784−o_1_space_mixed streamLen =
785− bgroup "mixed"
786− [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
787− , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
788− , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
789− , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
790− , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
791− , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
792− , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
793− , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
794− , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
795− , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
796− ]
797−
798−o_1_space_mixedX2 :: Int -> Benchmark
799−o_1_space_mixedX2 streamLen =
800− bgroup "mixedX2"
801− [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
802− , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
803− , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
804− , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
805− , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
806− , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
807− , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
808− , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
809− , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
810− , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
811− ]
812−
813−o_1_space_mixedX4 :: Int -> Benchmark
814−o_1_space_mixedX4 streamLen =
815− bgroup "mixedX4"
816− [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
817− , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
818− , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
819− , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
820− , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
821− , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
822− , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
823− , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
824− , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
825− , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
826− ]
827−
828−o_1_space_list :: Int -> Benchmark
829−o_1_space_list streamLen =
830− bgroup "list"
831− [ bgroup "elimination"
832− [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
833− ]
834− , bgroup "nested"
835− [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
836− , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
837− , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
838− , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
839− , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
840− ]
841− ]
842− where
843−
844− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
845− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
846−
847−o_1_space :: Int -> Benchmark
848−o_1_space streamLen =
849− bgroup (o_1_space_prefix moduleName)
850− [ o_1_space_generation streamLen
851− , o_1_space_elimination streamLen
852− , o_1_space_nested streamLen
853− , o_1_space_transformation streamLen
854− , o_1_space_transformationX4 streamLen
855− , o_1_space_concat streamLen
856− , o_1_space_filtering streamLen
857− , o_1_space_filteringX4 streamLen
858− , o_1_space_zipping streamLen
859− , o_1_space_mixed streamLen
860− , o_1_space_mixedX2 streamLen
861− , o_1_space_mixedX4 streamLen
862− , o_1_space_list streamLen
863− ]
864−
865−o_n_heap :: Int -> Benchmark
866−o_n_heap streamLen =
867− bgroup (o_n_heap_prefix moduleName)
868− [ bgroup "transformation"
869− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
870− ]
871− ]
872−
873−{-# INLINE benchK #-}
874−benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
875−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
876−
877−o_n_stack :: Int -> Int -> Int -> Benchmark
878−o_n_stack streamLen iterStreamLen maxIters =
879− bgroup (o_n_stack_prefix moduleName)
880− [ bgroup "elimination"
881− [ benchFold "tail" tail (unfoldrM streamLen)
882− , benchFold "nullTail" nullTail (unfoldrM streamLen)
883− , benchFold "headTail" headTail (unfoldrM streamLen)
884− ]
885− , bgroup "transformation"
886− [
887− -- XXX why do these need so much stack
888− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
889− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
890− ]
891− , bgroup "transformationX4"
892− [
893− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
894− ]
895− , bgroup "iterated"
896− [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
897− , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
898− , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
899− , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
900− , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
901− , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
902− , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
903− ]
904− ]
905− where
906− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
907− streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
908−
909−o_n_space :: Int -> Benchmark
910−o_n_space streamLen =
911− bgroup (o_n_space_prefix moduleName)
912− [ bgroup "elimination"
913− [ benchFold "toList" toList (unfoldrM streamLen)
914− ]
915− ]
916−
917−{-# INLINE benchList #-}
918−benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
919−benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
920−
921−main :: IO ()
922−main =
923− defaultMain
924− [ o_1_space streamLen
925− , o_n_stack streamLen iterStreamLen maxIters
926− , o_n_heap streamLen
927− , o_n_space streamLen
928− ]
929−
930− where
931−
932− streamLen = 100000
933− maxIters = 10000
934− iterStreamLen = 10
benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hsdeleted−938
@@ -1,938 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#ifdef __HADDOCK_VERSION__
14−#undef INSPECTION
15−#endif
16−
17−#ifdef INSPECTION
18−{-# LANGUAGE TemplateHaskell #-}
19−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20−#endif
21−
22−module Main (main) where
23−
24−-- import Control.Applicative (liftA2)
25−-- import Control.Monad (when)
26−-- import Data.Maybe (isJust)
27−-- import System.Random (randomRIO)
28−import Prelude hiding
29− ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
30− , repeat, replicate
31− )
32−
33−import qualified Prelude as P
34−-- import qualified Data.List as List
35−
36−import qualified Streamly.Internal.Data.StreamK as S
37−import qualified Streamly.Internal.Data.Stream as D
38−import qualified Streamly.Internal.Data.Fold as Fold
39−
40−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
41−
42−import Streamly.Benchmark.Common
43−
44−#ifdef INSPECTION
45−import Test.Inspection
46−#endif
47−
48−-------------------------------------------------------------------------------
49−-- Stream generation and elimination
50−-------------------------------------------------------------------------------
51−
52−type Stream m a = S.Stream m a
53−
54−{-# INLINE unfoldrD #-}
55−unfoldrD :: Monad m => Int -> Int -> Stream m Int
56−unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
57− where
58− step cnt =
59− if cnt > n + streamLen
60− then Nothing
61− else Just (cnt, cnt + 1)
62−
63−{-# INLINE unfoldrMD #-}
64−unfoldrMD :: Monad m => Int -> Int -> Stream m Int
65−unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
66− where
67− step cnt =
68− if cnt > n + streamLen
69− then return Nothing
70− else return (Just (cnt, cnt + 1))
71−
72−{-
73−{-# INLINE unfoldrK #-}
74−unfoldrK :: Int -> Int -> Stream m Int
75−unfoldrK streamLen n = S.unfoldr step n
76− where
77− step cnt =
78− if cnt > n + streamLen
79− then Nothing
80− else Just (cnt, cnt + 1)
81−-}
82−
83−{-# INLINE unfoldrMK #-}
84−unfoldrMK :: Monad m => Int -> Int -> Stream m Int
85−unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
86− where
87− step cnt =
88− if cnt > n + streamLen
89− then return Nothing
90− else return (Just (cnt, cnt + 1))
91−
92−{-# INLINE repeat #-}
93−repeat :: Monad m => Int -> Int -> Stream m Int
94−repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
95−
96−{-# INLINE repeatM #-}
97−repeatM :: Monad m => Int -> Int -> Stream m Int
98−repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
99−
100−{-# INLINE replicate #-}
101−replicate :: Monad m => Int -> Int -> Stream m Int
102−replicate x y = D.toStreamK $ D.replicate x y
103−
104−{-# INLINE replicateM #-}
105−replicateM :: Monad m => Int -> Int -> Stream m Int
106−replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
107−
108−{-# INLINE iterate #-}
109−iterate :: Monad m => Int -> Int -> Stream m Int
110−iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
111−
112−{-# INLINE iterateM #-}
113−iterateM :: Monad m => Int -> Int -> Stream m Int
114−iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
115−
116−{-# INLINE fromFoldable #-}
117−fromFoldable :: Int -> Int -> Stream m Int
118−fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
119−
120−{-# INLINE fromFoldableM #-}
121−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
122−fromFoldableM streamLen n =
123− Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
124−
125−{-
126−{-# INLINABLE concatMapFoldableWith #-}
127−concatMapFoldableWith :: Foldable f
128− => (Stream m b -> Stream m b -> Stream m b)
129− -> (a -> Stream m b)
130− -> f a
131− -> Stream m b
132−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
133−-}
134−
135−{-# INLINE concatMapFoldableSerial #-}
136−concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
137−concatMapFoldableSerial streamLen n =
138− D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
139−
140−{-# INLINE concatMapFoldableSerialM #-}
141−concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
142−concatMapFoldableSerialM streamLen n =
143− -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
144− D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
145−
146−-------------------------------------------------------------------------------
147−-- Elimination
148−-------------------------------------------------------------------------------
149−
150−{-# INLINE drainD #-}
151−drainD :: Monad m => Stream m a -> m ()
152−drainD = D.drain . D.fromStreamK
153−
154−{-# INLINE drain #-}
155−drain :: Monad m => Stream m a -> m ()
156−drain = S.drain
157−
158−{-# INLINE mapM_ #-}
159−mapM_ :: Monad m => Stream m a -> m ()
160−mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
161−
162−{-
163−{-# INLINE uncons #-}
164−uncons :: Monad m => Stream m Int -> m ()
165−uncons s = do
166− r <- D.uncons $ D.fromStreamK s
167− case r of
168− Nothing -> return ()
169− Just (_, t) -> uncons (D.toStreamK t)
170−
171−{-# INLINE init #-}
172−init :: Monad m => Stream m a -> m ()
173−init s = do
174− t <- S.init s
175− P.mapM_ S.drain t
176−
177−{-# INLINE tail #-}
178−tail :: Monad m => Stream m a -> m ()
179−tail s = S.tail s >>= P.mapM_ tail
180−
181−{-# INLINE nullTail #-}
182−nullTail :: Monad m => Stream m Int -> m ()
183−nullTail s = do
184− r <- S.null s
185− when (not r) $ S.tail s >>= P.mapM_ nullTail
186−
187−{-# INLINE headTail #-}
188−headTail :: Monad m => Stream m Int -> m ()
189−headTail s = do
190− h <- S.head s
191− when (isJust h) $ S.tail s >>= P.mapM_ headTail
192−-}
193−
194−{-# INLINE toList #-}
195−toList :: Monad m => Stream m Int -> m [Int]
196−toList = D.fold Fold.toList . D.fromStreamK
197−
198−{-# INLINE foldl' #-}
199−foldl' :: Monad m => Stream m Int -> m Int
200−foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
201−
202−{-# INLINE last #-}
203−last :: Monad m => Stream m Int -> m (Maybe Int)
204−last = D.fold Fold.latest . D.fromStreamK
205−
206−-------------------------------------------------------------------------------
207−-- Transformation
208−-------------------------------------------------------------------------------
209−
210−{-# INLINE composeN #-}
211−composeN
212− :: Monad m
213− => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
214−composeN n f =
215− case n of
216− 1 -> drain . f
217− 2 -> drain . f . f
218− 3 -> drain . f . f . f
219− 4 -> drain . f . f . f . f
220− _ -> undefined
221−
222−{-# INLINE scanl' #-}
223−scanl' :: Monad m => Int -> Stream m Int -> m ()
224−scanl' n =
225− composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)
226−
227−{-# INLINE map #-}
228−map :: Monad m => Int -> Stream m Int -> m ()
229−map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
230−
231−{-
232−{-# INLINE fmapK #-}
233−fmapK :: Monad m => Int -> Stream m Int -> m ()
234−fmapK n = composeN n $ P.fmap (+ 1)
235−-}
236−
237−{-# INLINE mapM #-}
238−mapM :: Monad m => Int -> Stream m Int -> m ()
239−mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
240−
241−{-
242−{-# INLINE mapMSerial #-}
243−mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
244−mapMSerial n = composeN n $ S.mapMSerial return
245−-}
246−
247−{-# INLINE filterEven #-}
248−filterEven :: Monad m => Int -> Stream m Int -> m ()
249−filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
250−
251−{-
252−{-# INLINE filterAllOut #-}
253−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
254−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
255−
256−{-# INLINE filterAllIn #-}
257−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
258−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
259−
260−{-# INLINE _takeOne #-}
261−_takeOne :: Monad m => Int -> Stream m Int -> m ()
262−_takeOne n = composeN n $ S.take 1
263−
264−{-# INLINE takeAll #-}
265−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
266−takeAll streamLen n = composeN n $ S.take streamLen
267−
268−{-# INLINE takeWhileTrue #-}
269−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
270−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
271−
272−{-# INLINE dropOne #-}
273−dropOne :: Monad m => Int -> Stream m Int -> m ()
274−dropOne n = composeN n $ S.drop 1
275−
276−{-# INLINE dropAll #-}
277−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
278−dropAll streamLen n = composeN n $ S.drop streamLen
279−
280−{-# INLINE dropWhileTrue #-}
281−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
282−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
283−
284−{-# INLINE dropWhileFalse #-}
285−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
286−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
287−-}
288−
289−{-
290−{-# INLINE foldrS #-}
291−foldrS :: Monad m => Int -> Stream m Int -> m ()
292−foldrS n = composeN n $ S.foldrS S.cons S.nil
293−
294−{-# INLINE foldlS #-}
295−foldlS :: Monad m => Int -> Stream m Int -> m ()
296−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
297−-}
298−
299−{-
300−{-# INLINE intersperse #-}
301−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
302−intersperse streamLen n = composeN n $ S.intersperse streamLen
303−-}
304−
305−-------------------------------------------------------------------------------
306−-- Iteration
307−-------------------------------------------------------------------------------
308−
309−{-
310−{-# INLINE iterateSource #-}
311−iterateSource
312− :: S.MonadAsync m
313− => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
314−iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
315− where
316− f (0 :: Int) m = g m
317− f x m = g (f (x P.- 1) m)
318−
319−-- this is quadratic
320−{-# INLINE iterateScan #-}
321−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
322−iterateScan iterStreamLen maxIters =
323− iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
324−
325−-- this is quadratic
326−{-# INLINE iterateDropWhileFalse #-}
327−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
328−iterateDropWhileFalse streamLen iterStreamLen maxIters =
329− iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
330−
331−{-# INLINE iterateMapM #-}
332−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
333−iterateMapM iterStreamLen =
334− iterateSource iterStreamLen (S.mapMWith S.consM return)
335−
336−{-# INLINE iterateFilterEven #-}
337−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
338−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
339−
340−{-# INLINE iterateTakeAll #-}
341−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
342−iterateTakeAll streamLen iterStreamLen =
343− iterateSource iterStreamLen (S.take streamLen)
344−
345−{-# INLINE iterateDropOne #-}
346−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
348−
349−{-# INLINE iterateDropWhileTrue #-}
350−iterateDropWhileTrue :: S.MonadAsync m =>
351− Int -> Int -> Int -> Int -> Stream m Int
352−iterateDropWhileTrue streamLen iterStreamLen =
353− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
354−-}
355−
356−-------------------------------------------------------------------------------
357−-- Zipping
358−-------------------------------------------------------------------------------
359−
360−{-
361−{-# INLINE zipWith #-}
362−zipWith :: Monad m => Stream m Int -> m ()
363−zipWith src = drain $ S.zipWith (,) src src
364−
365−{-# INLINE zipWithM #-}
366−zipWithM :: Monad m => Stream m Int -> m ()
367−zipWithM src = drain $ S.zipWithM (curry return) src src
368−
369−{-# INLINE sortByK #-}
370−sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
371−sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
372−
373−{-# INLINE sortBy #-}
374−sortBy :: Monad m => Stream m Int -> m ()
375−sortBy = drain . sortByK compare
376−
377−-------------------------------------------------------------------------------
378−-- Mixed Composition
379−-------------------------------------------------------------------------------
380−
381−{-# INLINE scanMap #-}
382−scanMap :: Monad m => Int -> Stream m Int -> m ()
383−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
384−
385−{-# INLINE dropMap #-}
386−dropMap :: Monad m => Int -> Stream m Int -> m ()
387−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
388−
389−{-# INLINE dropScan #-}
390−dropScan :: Monad m => Int -> Stream m Int -> m ()
391−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
392−
393−{-# INLINE takeDrop #-}
394−takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
395−takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
396−
397−{-# INLINE takeScan #-}
398−takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
399−takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
400−
401−{-# INLINE takeMap #-}
402−takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
403−takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
404−
405−{-# INLINE filterDrop #-}
406−filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
407−filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
408−
409−{-# INLINE filterTake #-}
410−filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
411−filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
412−
413−{-# INLINE filterScan #-}
414−filterScan :: Monad m => Int -> Stream m Int -> m ()
415−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
416−
417−{-# INLINE filterMap #-}
418−filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
419−filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
420−-}
421−
422−-------------------------------------------------------------------------------
423−-- ConcatMap
424−-------------------------------------------------------------------------------
425−
426−-- concatMap unfoldrM/unfoldrM
427−
428−{-# INLINE concatMap #-}
429−concatMap :: Int -> Int -> Int -> IO ()
430−concatMap outer inner n =
431− S.drain $ D.toStreamK $ D.concatMap
432− (\_ -> D.fromStreamK $ unfoldrMK inner n)
433− (D.fromStreamK $ unfoldrMK outer n)
434−
435−#ifdef INSPECTION
436−inspect $ hasNoTypeClasses 'concatMap
437−#endif
438−
439−-- concatMap unfoldr/unfoldr
440−
441−{-
442−{-# INLINE concatMapPure #-}
443−concatMapPure :: Int -> Int -> Int -> IO ()
444−concatMapPure outer inner n =
445− S.drain $ S.concatMap
446− (\_ -> unfoldr inner n)
447− (unfoldr outer n)
448−
449−#ifdef INSPECTION
450−inspect $ hasNoTypeClasses 'concatMapPure
451−#endif
452−
453−-- concatMap replicate/unfoldrM
454−
455−{-# INLINE concatMapRepl #-}
456−concatMapRepl :: Int -> Int -> Int -> IO ()
457−concatMapRepl outer inner n =
458− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459−
460−#ifdef INSPECTION
461−inspect $ hasNoTypeClasses 'concatMapRepl
462−#endif
463−
464−-- concatMapWith
465−
466−{-# INLINE sourceConcatMapId #-}
467−sourceConcatMapId :: Monad m
468− => Int -> Int -> Stream m (Stream m Int)
469−sourceConcatMapId val n =
470− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471−
472−{-# INLINE concatMapBySerial #-}
473−concatMapBySerial :: Int -> Int -> Int -> IO ()
474−concatMapBySerial outer inner n =
475− S.drain $ S.concatMapWith S.serial
476− (unfoldrM inner)
477− (unfoldrM outer n)
478−-}
479−
480−{-
481−-------------------------------------------------------------------------------
482−-- Nested Composition
483−-------------------------------------------------------------------------------
484−
485−instance Monad m => Applicative (S.Stream m) where
486− {-# INLINE pure #-}
487− pure = S.fromPure
488−
489− {-# INLINE (<*>) #-}
490− (<*>) = S.crossApply
491−
492− {-# INLINE liftA2 #-}
493− liftA2 f x = (<*>) (fmap f x)
494−
495− {-# INLINE (*>) #-}
496− (*>) = S.crossApplySnd
497−
498− {-# INLINE (<*) #-}
499− (<*) = S.crossApplyFst
500−
501−-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
502−-- the monad instance of StreamD is slower than StreamK after foldr/build
503−-- fusion.
504−instance Monad m => Monad (S.Stream m) where
505− {-# INLINE return #-}
506− return = pure
507−
508− {-# INLINE (>>=) #-}
509− (>>=) = flip S.concatMap
510−
511−{-# INLINE drainApplicative #-}
512−drainApplicative :: Monad m => Stream m Int -> m ()
513−drainApplicative s = drain $ do
514− (+) <$> s <*> s
515−
516−{-# INLINE drainMonad #-}
517−drainMonad :: Monad m => Stream m Int -> m ()
518−drainMonad s = drain $ do
519− x <- s
520− y <- s
521− return $ x + y
522−
523−{-# INLINE drainMonad3 #-}
524−drainMonad3 :: Monad m => Stream m Int -> m ()
525−drainMonad3 s = drain $ do
526− x <- s
527− y <- s
528− z <- s
529− return $ x + y + z
530−
531−{-# INLINE filterAllOutMonad #-}
532−filterAllOutMonad
533− :: Monad m
534− => Stream m Int -> m ()
535−filterAllOutMonad str = drain $ do
536− x <- str
537− y <- str
538− let s = x + y
539− if s < 0
540− then return s
541− else S.nil
542−
543−{-# INLINE filterAllInMonad #-}
544−filterAllInMonad
545− :: Monad m
546− => Stream m Int -> m ()
547−filterAllInMonad str = drain $ do
548− x <- str
549− y <- str
550− let s = x + y
551− if s > 0
552− then return s
553− else S.nil
554−
555−-------------------------------------------------------------------------------
556−-- Nested Composition Pure lists
557−-------------------------------------------------------------------------------
558−
559−-- There are several list benchmarks here for comparison with lists. It is easy
560−-- and convenient to see the comparisons when they are here, otherwise we'll
561−-- have to add a separate module for list benchmarks with the same names and
562−-- then add a comparison in bench.sh.
563−
564−{-# INLINE unfoldrList #-}
565−unfoldrList :: Int -> Int -> [Int]
566−unfoldrList maxval n = List.unfoldr step n
567− where
568− step cnt =
569− if cnt > n + maxval
570− then Nothing
571− else Just (cnt, cnt + 1)
572−
573−{-# INLINE toNullApNestedList #-}
574−toNullApNestedList :: [Int] -> [Int]
575−toNullApNestedList s = (+) <$> s <*> s
576−
577−{-# INLINE toNullNestedList #-}
578−toNullNestedList :: [Int] -> [Int]
579−toNullNestedList s = do
580− x <- s
581− y <- s
582− return $ x + y
583−
584−{-# INLINE toNullNestedList3 #-}
585−toNullNestedList3 :: [Int] -> [Int]
586−toNullNestedList3 s = do
587− x <- s
588− y <- s
589− z <- s
590− return $ x + y + z
591−
592−{-# INLINE filterAllOutNestedList #-}
593−filterAllOutNestedList :: [Int] -> [Int]
594−filterAllOutNestedList str = do
595− x <- str
596− y <- str
597− let s = x + y
598− if s < 0
599− then return s
600− else []
601−
602−{-# INLINE filterAllInNestedList #-}
603−filterAllInNestedList :: [Int] -> [Int]
604−filterAllInNestedList str = do
605− x <- str
606− y <- str
607− let s = x + y
608− if s > 0
609− then return s
610− else []
611− -}
612−
613−-------------------------------------------------------------------------------
614−-- Benchmarks
615−-------------------------------------------------------------------------------
616−
617−moduleName :: String
618−moduleName = "Data.Stream.ToStreamK"
619−
620−-- Generation of StreamK using StreamD generation functions and eleminating
621−-- using StreamK drain.
622−o_1_space_generation :: Int -> Benchmark
623−o_1_space_generation streamLen =
624− bgroup "generation"
625− [ benchFold "unfoldr" drain (unfoldrD streamLen)
626− , benchFold "unfoldrM" drain (unfoldrMD streamLen)
627− , benchFold "repeat" drain (repeat streamLen)
628− , benchFold "repeatM" drain (repeatM streamLen)
629− , benchFold "replicate" drain (replicate streamLen)
630− , benchFold "replicateM" drain (replicateM streamLen)
631− , benchFold "iterate" drain (iterate streamLen)
632− , benchFold "iterateM" drain (iterateM streamLen)
633−
634− , benchFold "fromFoldable" drain (fromFoldable streamLen)
635− , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
636−
637− -- appends
638− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
639− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
640− ]
641−
642−-- Generating using StreamK and eliminating using StreamD folds.
643−o_1_space_elimination :: Int -> Benchmark
644−o_1_space_elimination streamLen =
645− bgroup "elimination"
646− [ benchFold "toNull" drainD (unfoldrMK streamLen)
647− , benchFold "mapM_" mapM_ (unfoldrMK streamLen)
648− -- , benchFold "uncons" uncons (unfoldrMK streamLen)
649− -- , benchFold "init" init (unfoldrM streamLen)
650− , benchFold "foldl'" foldl' (unfoldrMK streamLen)
651− , benchFold "last" last (unfoldrMK streamLen)
652− ]
653−
654−{-
655−o_1_space_nested :: Int -> Benchmark
656−o_1_space_nested streamLen =
657− bgroup "nested"
658− [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
659− , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
660− , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
661− , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
662− , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
663− , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
664− , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
665− , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
666− , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
667− , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
668− ]
669− where
670− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
671− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
672−-}
673−
674−-- Generate using StreamK and transform using StreamD transformation functions
675−-- and then drain using StreamK.
676−o_1_space_transformation :: Int -> Benchmark
677−o_1_space_transformation streamLen =
678− bgroup "transformation"
679− [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
680− benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
681− , benchFold "map" (map 1) (unfoldrMK streamLen)
682− -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
683− , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
684− -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685− ]
686−
687−o_1_space_transformationX4 :: Int -> Benchmark
688−o_1_space_transformationX4 streamLen =
689− bgroup "transformationX4"
690− [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
691− , benchFold "map" (map 4) (unfoldrMK streamLen)
692− -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
693− , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
694− -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
695− -- XXX this is horribly slow
696− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697− ]
698−
699−-- Generate using K, fold using K, concat using D.concatMap
700−o_1_space_concat :: Int -> Benchmark
701−o_1_space_concat streamLen =
702− bgroup "concat"
703− [ {- benchIOSrc1 "concatMapPure (n of 1)"
704− (concatMapPure streamLen 1)
705− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
706− (concatMapPure streamLen2 streamLen2)
707− , benchIOSrc1 "concatMapPure (1 of n)"
708− (concatMapPure 1 streamLen)
709− -}
710−
711− benchIOSrc1 "concatMap (n of 1)"
712− (concatMap streamLen 1)
713− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
714− (concatMap streamLen2 streamLen2)
715− , benchIOSrc1 "concatMap (1 of n)"
716− (concatMap 1 streamLen)
717−
718−{-
719− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
720− (concatMapRepl streamLen2 streamLen2)
721−
722− -- This is for comparison with concatMapFoldableWith
723− , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
724− (S.drain
725− . S.concatMapWith S.serial id
726− . sourceConcatMapId streamLen)
727−
728− , benchIOSrc1 "concatMapBy serial (n of 1)"
729− (concatMapBySerial streamLen 1)
730− , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
731− (concatMapBySerial streamLen2 streamLen2)
732− , benchIOSrc1 "concatMapBy serial (1 of n)"
733− (concatMapBySerial 1 streamLen)
734− , benchFold "sortBy" sortBy (unfoldrM streamLen)
735− -}
736− ]
737− where
738− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
739−
740−o_1_space_filtering :: Int -> Benchmark
741−o_1_space_filtering streamLen =
742− bgroup "filtering"
743− [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
744− {-
745− , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
746− , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
747− , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
748− , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
749− , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
750− , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
751− , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
752− , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753− -}
754− ]
755−
756−o_1_space_filteringX4 :: Int -> Benchmark
757−o_1_space_filteringX4 streamLen =
758− bgroup "filteringX4"
759− [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
760− {-
761− , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
762− , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
763− , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
764− , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
765− , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
766− , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
767− , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
768− , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
769− -}
770− ]
771−
772−{-
773−o_1_space_zipping :: Int -> Benchmark
774−o_1_space_zipping streamLen =
775− bgroup "zipping"
776− [ benchFold "zipWith" zipWith (unfoldrM streamLen)
777− , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
778− ]
779−
780−o_1_space_mixed :: Int -> Benchmark
781−o_1_space_mixed streamLen =
782− bgroup "mixed"
783− [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
784− , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
785− , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
786− , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
787− , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
788− , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
789− , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
790− , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
791− , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
792− , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
793− ]
794−
795−o_1_space_mixedX2 :: Int -> Benchmark
796−o_1_space_mixedX2 streamLen =
797− bgroup "mixedX2"
798− [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
799− , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
800− , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
801− , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
802− , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
803− , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
804− , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
805− , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
806− , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
807− , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
808− ]
809−
810−o_1_space_mixedX4 :: Int -> Benchmark
811−o_1_space_mixedX4 streamLen =
812− bgroup "mixedX4"
813− [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
814− , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
815− , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
816− , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
817− , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
818− , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
819− , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
820− , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
821− , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
822− , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
823− ]
824− -}
825−
826−{-
827−o_1_space_list :: Int -> Benchmark
828−o_1_space_list streamLen =
829− bgroup "list"
830− [ bgroup "elimination"
831− [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
832− ]
833− , bgroup "nested"
834− [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
835− , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
836− , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
837− , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
838− , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
839− ]
840− ]
841− where
842−
843− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
844− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845−-}
846−
847−o_1_space :: Int -> Benchmark
848−o_1_space streamLen =
849− bgroup (o_1_space_prefix moduleName)
850− [ o_1_space_generation streamLen
851− , o_1_space_elimination streamLen
852− -- , o_1_space_nested streamLen
853− , o_1_space_transformation streamLen
854− , o_1_space_transformationX4 streamLen
855− , o_1_space_concat streamLen
856− , o_1_space_filtering streamLen
857− , o_1_space_filteringX4 streamLen
858− -- , o_1_space_zipping streamLen
859− -- , o_1_space_mixed streamLen
860− -- , o_1_space_mixedX2 streamLen
861− -- , o_1_space_mixedX4 streamLen
862− -- , o_1_space_list streamLen
863− ]
864−
865−{-
866−o_n_heap :: Int -> Benchmark
867−o_n_heap streamLen =
868− bgroup (o_n_heap_prefix moduleName)
869− [ bgroup "transformation"
870− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871− ]
872− ]
873−
874−{-# INLINE benchK #-}
875−benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
876−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
877−
878−o_n_stack :: Int -> Int -> Int -> Benchmark
879−o_n_stack streamLen iterStreamLen maxIters =
880− bgroup (o_n_stack_prefix moduleName)
881− [ bgroup "elimination"
882− [ benchFold "tail" tail (unfoldrM streamLen)
883− , benchFold "nullTail" nullTail (unfoldrM streamLen)
884− , benchFold "headTail" headTail (unfoldrM streamLen)
885− ]
886− , bgroup "transformation"
887− [
888− -- XXX why do these need so much stack
889− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
890− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
891− ]
892− , bgroup "transformationX4"
893− [
894− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
895− ]
896− , bgroup "iterated"
897− [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
898− , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
899− , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
900− , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
901− , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
902− , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
903− , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
904− ]
905− ]
906− where
907− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
908− streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
909−-}
910−
911−o_n_space :: Int -> Benchmark
912−o_n_space streamLen =
913− bgroup (o_n_space_prefix moduleName)
914− [ bgroup "elimination"
915− [ benchFold "toList" toList (unfoldrMK streamLen)
916− ]
917− ]
918−
919−{-
920−{-# INLINE benchList #-}
921−benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
922−benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
923−-}
924−
925−main :: IO ()
926−main =
927− defaultMain
928− [ o_1_space streamLen
929− -- , o_n_stack streamLen iterStreamLen maxIters
930− -- , o_n_heap streamLen
931− , o_n_space streamLen
932− ]
933−
934− where
935−
936− streamLen = 100000
937− -- maxIters = 10000
938− -- iterStreamLen = 10
benchmark/Streamly/Benchmark/Data/Stream/Transform.hsdeleted−687
@@ -1,687 +0,0 @@
1−-- |
2−-- Module : Stream.Transform
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE RankNTypes #-}
12−
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−#ifdef __HADDOCK_VERSION__
19−#undef INSPECTION
20−#endif
21−
22−#ifdef INSPECTION
23−{-# LANGUAGE TemplateHaskell #-}
24−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25−#endif
26−
27−module Stream.Transform (benchmarks) where
28−
29−import Control.Monad.IO.Class (MonadIO(..))
30−
31−import System.Random (randomRIO)
32−
33−import qualified Streamly.Internal.Data.Fold as FL
34−
35−import qualified Stream.Common as Common
36−import qualified Streamly.Internal.Data.Unfold as Unfold
37−
38−#ifdef USE_PRELUDE
39−import Control.DeepSeq (NFData(..))
40−import Data.Functor.Identity (Identity(..))
41−import qualified Prelude
42−import qualified Streamly.Internal.Data.Fold as Fold
43−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
44−import Streamly.Internal.Data.Time.Units
45−#else
46−import Streamly.Internal.Data.Stream (Stream)
47−import qualified Streamly.Internal.Data.Stream as Stream
48−#ifndef USE_STREAMLY_CORE
49−import qualified Streamly.Internal.Data.Stream.Prelude as Stream
50−#endif
51−#ifdef USE_STREAMK
52−import Control.DeepSeq (NFData(..))
53−import Data.Functor.Identity (Identity(..))
54−import qualified Prelude
55−import qualified Streamly.Internal.Data.Fold as Fold
56−import Streamly.Internal.Data.StreamK (StreamK)
57−import qualified Streamly.Internal.Data.StreamK as StreamK
58−#endif
59−#endif
60−
61−import Test.Tasty.Bench
62−import Stream.Common hiding (scanl')
63−import Streamly.Benchmark.Common
64−import Prelude hiding (sequence, mapM)
65−
66−#ifdef USE_PRELUDE
67−type Stream = Stream.SerialT
68−#endif
69−
70−-------------------------------------------------------------------------------
71−-- Pipelines (stream-to-stream transformations)
72−-------------------------------------------------------------------------------
73−
74−-------------------------------------------------------------------------------
75−-- one-to-one transformations
76−-------------------------------------------------------------------------------
77−
78−-------------------------------------------------------------------------------
79−-- Traversable Instance
80−-------------------------------------------------------------------------------
81−
82−#ifdef USE_STREAMK
83−{-# INLINE traversableTraverse #-}
84−traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)
85−traversableTraverse = traverse return
86−
87−{-# INLINE traversableSequenceA #-}
88−traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)
89−traversableSequenceA = sequenceA . Prelude.fmap return
90−
91−{-# INLINE traversableMapM #-}
92−traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)
93−traversableMapM = Prelude.mapM return
94−
95−{-# INLINE traversableSequence #-}
96−traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)
97−traversableSequence = Prelude.sequence . Prelude.fmap return
98−
99−{-# INLINE benchPureSinkIO #-}
100−benchPureSinkIO
101− :: NFData b
102− => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark
103−benchPureSinkIO value name f =
104− bench name
105− $ nfIO $ randomRIO (1, 1) >>= f . fromStream . sourceUnfoldr value
106−
107−instance NFData a => NFData (StreamK Identity a) where
108− {-# INLINE rnf #-}
109− rnf xs =
110− runIdentity
111− $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (toStream xs)
112−
113−o_n_space_traversable :: Int -> [Benchmark]
114−o_n_space_traversable value =
115− -- Buffering operations using heap proportional to number of elements.
116− [ bgroup "traversable"
117− -- Traversable instance
118− [ benchPureSinkIO value "traverse" traversableTraverse
119− , benchPureSinkIO value "sequenceA" traversableSequenceA
120− , benchPureSinkIO value "mapM" traversableMapM
121− , benchPureSinkIO value "sequence" traversableSequence
122− ]
123− ]
124−#endif
125−
126−-------------------------------------------------------------------------------
127−-- maps and scans
128−-------------------------------------------------------------------------------
129−
130−#ifdef USE_PRELUDE
131−{-# INLINE scanl' #-}
132−scanl' :: MonadIO m => Int -> Stream m Int -> m ()
133−scanl' n = composeN n $ Stream.scanl' (+) 0
134−
135−{-# INLINE scanlM' #-}
136−scanlM' :: MonadIO m => Int -> Stream m Int -> m ()
137−scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
138−
139−{-# INLINE scanl1' #-}
140−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
141−scanl1' n = composeN n $ Stream.scanl1' (+)
142−
143−{-# INLINE scanl1M' #-}
144−scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()
145−scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
146−#endif
147−
148−{-# INLINE scan #-}
149−scan :: MonadIO m => Int -> Stream m Int -> m ()
150−scan n = composeN n $ Stream.scan FL.sum
151−
152−#ifdef USE_PRELUDE
153−{-# INLINE postscanl' #-}
154−postscanl' :: MonadIO m => Int -> Stream m Int -> m ()
155−postscanl' n = composeN n $ Stream.postscanl' (+) 0
156−
157−{-# INLINE postscanlM' #-}
158−postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()
159−postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
160−#endif
161−
162−{-# INLINE postscan #-}
163−postscan :: MonadIO m => Int -> Stream m Int -> m ()
164−postscan n = composeN n $ Stream.postscan FL.sum
165−
166−{-# INLINE sequence #-}
167−sequence :: MonadAsync m => Stream m (m Int) -> m ()
168−sequence = Common.drain . Stream.sequence
169−
170−{-# INLINE tap #-}
171−tap :: MonadIO m => Int -> Stream m Int -> m ()
172−tap n = composeN n $ Stream.tap FL.sum
173−
174−#ifdef USE_PRELUDE
175−{-# INLINE pollCounts #-}
176−pollCounts :: Int -> Stream IO Int -> IO ()
177−pollCounts n =
178− composeN n (Stream.pollCounts (const True) f)
179−
180− where
181−
182− f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
183−
184−{-# INLINE timestamped #-}
185−timestamped :: (MonadAsync m) => Stream m Int -> m ()
186−timestamped = Stream.drain . Stream.timestamped
187−#endif
188−
189−#ifdef USE_STREAMK
190−{-# INLINE foldrS #-}
191−foldrS :: MonadIO m => Int -> Stream m Int -> m ()
192−foldrS n =
193− composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream)
194−
195−{-# INLINE foldrSMap #-}
196−foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
197−foldrSMap n =
198− composeN n
199− ( toStream
200− . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil
201− . fromStream
202− )
203−#endif
204−
205−{-
206−{-# INLINE foldrT #-}
207−foldrT :: MonadIO m => Int -> Stream m Int -> m ()
208−foldrT n = composeN n (unCrossStream . Stream.foldrT cns (CrossStream Stream.nil))
209−
210− where cns x (CrossStream xs) = CrossStream (Stream.cons x xs)
211−
212−{-# INLINE foldrTMap #-}
213−foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()
214−foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
215−-}
216−
217−{-# INLINE trace #-}
218−trace :: MonadAsync m => Int -> Stream m Int -> m ()
219−trace n = composeN n $ Stream.trace return
220−
221−o_1_space_mapping :: Int -> [Benchmark]
222−o_1_space_mapping value =
223− [ bgroup
224− "mapping"
225− [
226−#ifdef USE_STREAMK
227− -- Right folds
228− benchIOSink value "foldrS" (foldrS 1)
229− , benchIOSink value "foldrSMap" (foldrSMap 1)
230− ,
231−#endif
232− -- , benchIOSink value "foldrT" (foldrT 1)
233− -- , benchIOSink value "foldrTMap" (foldrTMap 1)
234−
235− -- Mapping
236− benchIOSink value "map" (mapN 1)
237− , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
238− sequence (sourceUnfoldrAction value n)
239− , benchIOSink value "mapM" (mapM 1)
240− , benchIOSink value "tap" (tap 1)
241−#ifdef USE_PRELUDE
242− , benchIOSink value "pollCounts 1 second" (pollCounts 1)
243− , benchIOSink value "timestamped" timestamped
244−
245− -- Scanning
246− , benchIOSink value "scanl'" (scanl' 1)
247− , benchIOSink value "scanl1'" (scanl1' 1)
248− , benchIOSink value "scanlM'" (scanlM' 1)
249− , benchIOSink value "scanl1M'" (scanl1M' 1)
250− , benchIOSink value "postscanl'" (postscanl' 1)
251− , benchIOSink value "postscanlM'" (postscanlM' 1)
252−#endif
253− , benchIOSink value "scan" (scan 1)
254− , benchIOSink value "postscan" (postscan 1)
255− ]
256− ]
257−
258−o_1_space_mappingX4 :: Int -> [Benchmark]
259−o_1_space_mappingX4 value =
260− [ bgroup "mappingX4"
261− [ benchIOSink value "map" (mapN 4)
262− , benchIOSink value "mapM" (mapM 4)
263− , benchIOSink value "trace" (trace 4)
264−
265−#ifdef USE_PRELUDE
266− , benchIOSink value "scanl'" (scanl' 4)
267− , benchIOSink value "scanl1'" (scanl1' 4)
268− , benchIOSink value "scanlM'" (scanlM' 4)
269− , benchIOSink value "scanl1M'" (scanl1M' 4)
270− , benchIOSink value "postscanl'" (postscanl' 4)
271− , benchIOSink value "postscanlM'" (postscanlM' 4)
272−#endif
273− ]
274− ]
275−
276−{-# INLINE sieveScan #-}
277−sieveScan :: Monad m => Stream m Int -> Stream m Int
278−sieveScan =
279− Stream.mapMaybe snd
280− . Stream.scan (FL.foldlM' (\(primes, _) n -> do
281− return $
282− let ps = takeWhile (\p -> p * p <= n) primes
283− in if all (\p -> n `mod` p /= 0) ps
284− then (primes ++ [n], Just n)
285− else (primes, Nothing)) (return ([2], Just 2)))
286−
287−o_n_space_mapping :: Int -> [Benchmark]
288−o_n_space_mapping value =
289− [ bgroup "mapping"
290− [ benchIO "naive prime sieve"
291− (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))
292− ]
293− ]
294−
295−-------------------------------------------------------------------------------
296−-- Functor
297−-------------------------------------------------------------------------------
298−
299−o_1_space_functor :: Int -> [Benchmark]
300−o_1_space_functor value =
301− [ bgroup "Functor"
302− [ benchIOSink value "fmap" (mapN 1)
303− , benchIOSink value "fmap x 4" (mapN 4)
304− ]
305− ]
306−
307−-------------------------------------------------------------------------------
308−-- Iteration/looping utilities
309−-------------------------------------------------------------------------------
310−
311−{-# INLINE iterateN #-}
312−iterateN :: (Int -> a -> a) -> a -> Int -> a
313−iterateN g initial count = f count initial
314−
315− where
316−
317− f (0 :: Int) x = x
318− f i x = f (i - 1) (g i x)
319−
320−#ifdef USE_STREAMK
321−-- Iterate a transformation over a singleton stream
322−{-# INLINE iterateSingleton #-}
323−iterateSingleton :: Applicative m =>
324− (Int -> StreamK m Int -> StreamK m Int)
325− -> Int
326− -> Int
327− -> Stream m Int
328−iterateSingleton g count n = toStream $ iterateN g (StreamK.fromPure n) count
329−#else
330−-- Iterate a transformation over a singleton stream
331−{-# INLINE iterateSingleton #-}
332−iterateSingleton :: Applicative m =>
333− (Int -> Stream m Int -> Stream m Int)
334− -> Int
335− -> Int
336− -> Stream m Int
337−iterateSingleton g count n = iterateN g (Stream.fromPure n) count
338−#endif
339−
340−{-
341−-- XXX need to check why this is slower than the explicit recursion above, even
342−-- if the above code is written in a foldr like head recursive way. We also
343−-- need to try this with foldlM' once #150 is fixed.
344−-- However, it is perhaps best to keep the iteration benchmarks independent of
345−-- foldrM and any related fusion issues.
346−{-# INLINE _iterateSingleton #-}
347−_iterateSingleton ::
348− Monad m
349− => (Int -> Stream m Int -> Stream m Int)
350− -> Int
351− -> Int
352− -> Stream m Int
353−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
354−-}
355−
356−o_n_space_iterated :: Int -> [Benchmark]
357−o_n_space_iterated value =
358− [ bgroup "iterated"
359− [ benchIO "(+) (n times) (baseline)" $ \i0 ->
360− iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
361− , benchIOSrc "(<$) (n times)" $
362− iterateSingleton (<$) value
363− , benchIOSrc "fmap (n times)" $
364− iterateSingleton (fmap . (+)) value
365− {-
366− , benchIOSrc fromSerial "_(<$) (n times)" $
367− _iterateSingleton (<$) value
368− , benchIOSrc fromSerial "_fmap (n times)" $
369− _iterateSingleton (fmap . (+)) value
370− -}
371− ]
372− ]
373−
374−-------------------------------------------------------------------------------
375−-- Size reducing transformations (filtering)
376−-------------------------------------------------------------------------------
377−
378−{-# INLINE filterEven #-}
379−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
380−filterEven n = composeN n $ Stream.filter even
381−
382−{-# INLINE filterAllOut #-}
383−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
384−filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
385−
386−{-# INLINE filterAllIn #-}
387−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
388−filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
389−
390−{-# INLINE filterMEven #-}
391−filterMEven :: MonadIO m => Int -> Stream m Int -> m ()
392−filterMEven n = composeN n $ Stream.filterM (return . even)
393−
394−{-# INLINE filterMAllOut #-}
395−filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
396−filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
397−
398−{-# INLINE filterMAllIn #-}
399−filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
400−filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
401−
402−{-# INLINE _takeOne #-}
403−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
404−_takeOne n = composeN n $ Stream.take 1
405−
406−{-# INLINE takeAll #-}
407−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
408−takeAll value n = composeN n $ Stream.take (value + 1)
409−
410−{-# INLINE takeWhileTrue #-}
411−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
412−takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
413−
414−{-# INLINE takeWhileMTrue #-}
415−takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
416−takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
417−
418−#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
419−{-# INLINE takeInterval #-}
420−takeInterval :: Double -> Int -> Stream IO Int -> IO ()
421−takeInterval i n = composeN n (Stream.takeInterval i)
422−
423−-- Inspection testing is disabled for takeInterval
424−-- Enable it when looking at it throughly
425−#ifdef INSPECTION
426−-- inspect $ hasNoType 'takeInterval ''SPEC
427−-- inspect $ hasNoTypeClasses 'takeInterval
428−-- inspect $ 'takeInterval `hasNoType` ''D.Step
429−#endif
430−
431−{-# INLINE dropInterval #-}
432−dropInterval :: Double -> Int -> Stream IO Int -> IO ()
433−dropInterval i n = composeN n (Stream.dropInterval i)
434−
435−-- Inspection testing is disabled for dropInterval
436−-- Enable it when looking at it throughly
437−#ifdef INSPECTION
438−-- inspect $ hasNoTypeClasses 'dropInterval
439−-- inspect $ 'dropInterval `hasNoType` ''D.Step
440−#endif
441−#endif
442−
443−{-# INLINE dropOne #-}
444−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
445−dropOne n = composeN n $ Stream.drop 1
446−
447−{-# INLINE dropAll #-}
448−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
449−dropAll value n = composeN n $ Stream.drop (value + 1)
450−
451−{-# INLINE dropWhileTrue #-}
452−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
453−dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
454−
455−{-# INLINE dropWhileMTrue #-}
456−dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
457−dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
458−
459−{-# INLINE dropWhileFalse #-}
460−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
461−dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
462−
463−#ifdef USE_PRELUDE
464−-- XXX Decide on the time interval
465−{-# INLINE _intervalsOfSum #-}
466−_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()
467−_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
468−#endif
469−
470−{-# INLINE findIndices #-}
471−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
472−findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
473−
474−{-# INLINE elemIndices #-}
475−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
476−elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
477−
478−{-# INLINE deleteBy #-}
479−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
480−deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
481−
482−-- uniq . uniq == uniq, composeN 2 ~ composeN 1
483−{-# INLINE uniq #-}
484−uniq :: MonadIO m => Int -> Stream m Int -> m ()
485−uniq n = composeN n Stream.uniq
486−
487−{-# INLINE mapMaybe #-}
488−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
489−mapMaybe n =
490− composeN n $
491− Stream.mapMaybe
492− (\x ->
493− if odd x
494− then Nothing
495− else Just x)
496−
497−{-# INLINE mapMaybeM #-}
498−mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()
499−mapMaybeM n =
500− composeN n $
501− Stream.mapMaybeM
502− (\x ->
503− if odd x
504− then return Nothing
505− else return $ Just x)
506−
507−o_1_space_filtering :: Int -> [Benchmark]
508−o_1_space_filtering value =
509− [ bgroup "filtering"
510− [ benchIOSink value "filter-even" (filterEven 1)
511− , benchIOSink value "filter-all-out" (filterAllOut value 1)
512− , benchIOSink value "filter-all-in" (filterAllIn value 1)
513−
514− , benchIOSink value "filterM-even" (filterMEven 1)
515− , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
516− , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
517−
518− -- Trimming
519− , benchIOSink value "take-all" (takeAll value 1)
520− , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
521− -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
522− , benchIOSink value "drop-one" (dropOne 1)
523− , benchIOSink value "drop-all" (dropAll value 1)
524−#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
525− , benchIOSink value "takeInterval-all" (takeInterval 10000 1)
526− , benchIOSink value "dropInterval-all" (dropInterval 10000 1)
527−#endif
528− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
529− -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
530− , benchIOSink
531− value
532− "dropWhile-false"
533− (dropWhileFalse value 1)
534− , benchIOSink value "deleteBy" (deleteBy value 1)
535−
536− , benchIOSink value "uniq" (uniq 1)
537−
538− -- Map and filter
539− , benchIOSink value "mapMaybe" (mapMaybe 1)
540− , benchIOSink value "mapMaybeM" (mapMaybeM 1)
541−
542− -- Searching (stateful map and filter)
543− , benchIOSink value "findIndices" (findIndices value 1)
544− , benchIOSink value "elemIndices" (elemIndices value 1)
545− ]
546− ]
547−
548−o_1_space_filteringX4 :: Int -> [Benchmark]
549−o_1_space_filteringX4 value =
550− [ bgroup "filteringX4"
551− [ benchIOSink value "filter-even" (filterEven 4)
552− , benchIOSink value "filter-all-out" (filterAllOut value 4)
553− , benchIOSink value "filter-all-in" (filterAllIn value 4)
554−
555− , benchIOSink value "filterM-even" (filterMEven 4)
556− , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
557− , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
558−
559− -- trimming
560− , benchIOSink value "take-all" (takeAll value 4)
561− , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
562− , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)
563− , benchIOSink value "drop-one" (dropOne 4)
564− , benchIOSink value "drop-all" (dropAll value 4)
565− , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
566− , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)
567− , benchIOSink
568− value
569− "dropWhile-false"
570− (dropWhileFalse value 4)
571− , benchIOSink value "deleteBy" (deleteBy value 4)
572−
573− , benchIOSink value "uniq" (uniq 4)
574−
575− -- map and filter
576− , benchIOSink value "mapMaybe" (mapMaybe 4)
577− , benchIOSink value "mapMaybeM" (mapMaybeM 4)
578−
579− -- searching
580− , benchIOSink value "findIndices" (findIndices value 4)
581− , benchIOSink value "elemIndices" (elemIndices value 4)
582− ]
583− ]
584−
585−-------------------------------------------------------------------------------
586−-- Size increasing transformations (insertions)
587−-------------------------------------------------------------------------------
588−
589−{-# INLINE intersperse #-}
590−intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
591−intersperse value n = composeN n $ Stream.intersperse (value + 1)
592−
593−{-# INLINE intersperseM #-}
594−intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
595−intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
596−
597−{-# INLINE insertBy #-}
598−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
599−insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
600−
601−{-# INLINE interposeSuffix #-}
602−interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
603−interposeSuffix value n =
604− composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
605−
606−{-# INLINE intercalateSuffix #-}
607−intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
608−intercalateSuffix value n =
609− composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
610−
611−o_1_space_inserting :: Int -> [Benchmark]
612−o_1_space_inserting value =
613− [ bgroup "inserting"
614− [ benchIOSink value "intersperse" (intersperse value 1)
615− , benchIOSink value "intersperseM" (intersperseM value 1)
616− , benchIOSink value "insertBy" (insertBy value 1)
617− , benchIOSink value "interposeSuffix" (interposeSuffix value 1)
618− , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)
619− ]
620− ]
621−
622−o_1_space_insertingX4 :: Int -> [Benchmark]
623−o_1_space_insertingX4 value =
624− [ bgroup "insertingX4"
625− [ benchIOSink value "intersperse" (intersperse value 4)
626− , benchIOSink value "insertBy" (insertBy value 4)
627− ]
628− ]
629−
630−-------------------------------------------------------------------------------
631−-- Indexing
632−-------------------------------------------------------------------------------
633−
634−{-# INLINE indexed #-}
635−indexed :: MonadIO m => Int -> Stream m Int -> m ()
636−indexed n = composeN n (fmap snd . Stream.indexed)
637−
638−{-# INLINE indexedR #-}
639−indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()
640−indexedR value n = composeN n (fmap snd . Stream.indexedR value)
641−
642−o_1_space_indexing :: Int -> [Benchmark]
643−o_1_space_indexing value =
644− [ bgroup "indexing"
645− [ benchIOSink value "indexed" (indexed 1)
646− , benchIOSink value "indexedR" (indexedR value 1)
647− ]
648− ]
649−
650−o_1_space_indexingX4 :: Int -> [Benchmark]
651−o_1_space_indexingX4 value =
652− [ bgroup "indexingx4"
653− [ benchIOSink value "indexed" (indexed 4)
654− , benchIOSink value "indexedR" (indexedR value 4)
655− ]
656− ]
657−
658−-------------------------------------------------------------------------------
659−-- Main
660−-------------------------------------------------------------------------------
661−
662−-- In addition to gauge options, the number of elements in the stream can be
663−-- passed using the --stream-size option.
664−--
665−benchmarks :: String -> Int -> [Benchmark]
666−benchmarks moduleName size =
667− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
668− [ o_1_space_functor size
669− , o_1_space_mapping size
670− , o_1_space_mappingX4 size
671− , o_1_space_filtering size
672− , o_1_space_filteringX4 size
673− , o_1_space_inserting size
674− , o_1_space_insertingX4 size
675− , o_1_space_indexing size
676− , o_1_space_indexingX4 size
677− ]
678− , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
679− [
680−#ifdef USE_STREAMK
681− o_n_space_traversable size
682− ,
683−#endif
684− o_n_space_mapping size
685− , o_n_space_iterated size
686− ]
687− ]
benchmark/Streamly/Benchmark/Data/Unfold.hsdeleted−856

This diff is too big to show here.

benchmark/Streamly/Benchmark/FileIO/Array.hsnew file+259

This diff is too big to show here.

benchmark/Streamly/Benchmark/FileIO/Stream.hsnew file+651

This diff is too big to show here.

benchmark/Streamly/Benchmark/FileSystem/Handle.hsdeleted−52

This diff is too big to show here.

benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hsdeleted−305

This diff is too big to show here.

benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hsdeleted−214

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude.hsnew file+1202

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/Ahead.hsdeleted−135

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/Async.hsdeleted−204

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/Merge.hsdeleted−298

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/Parallel.hsdeleted−240

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/Rate.hsdeleted−110

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/WAsync.hsdeleted−186

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/WSerial.hsdeleted−369

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/ZipAsync.hsdeleted−97

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/ZipSerial.hsdeleted−187

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Char.hsdeleted−90

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Parser.hsdeleted−107

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Stream.hsdeleted−349

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Utf8.hsdeleted−55

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/AllChars.txtdeleted−216

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Deutsch.txtdeleted−153

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txtdeleted−699

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/English.txtdeleted−58

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Japanese.txtdeleted−855

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Korean.txtdeleted−493

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Vietnamese.txtdeleted−402

This diff is too big to show here.

benchmark/bench-runner/Main.hsdeleted−183

This diff is too big to show here.

benchmark/bench-runner/bench-runner.cabaldeleted−42

This diff is too big to show here.

benchmark/bench-runner/cabal.projectdeleted−4

This diff is too big to show here.

benchmark/bench-runner/default.nixdeleted−164

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Common.hsdeleted−257

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Common/Handle.hsdeleted−228

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Prelude.hsdeleted−597

This diff is too big to show here.

benchmark/streamly-benchmarks.cabaldeleted−778

This diff is too big to show here.

bin/ghc.shdeleted−45

This diff is too big to show here.

bin/mk-hscope.shdeleted−46

This diff is too big to show here.

bin/mk-tags.shdeleted−25

This diff is too big to show here.

bin/repldeleted−3

This diff is too big to show here.

bin/run-ci.shdeleted−334

This diff is too big to show here.

bin/run-repl-quick.shdeleted−113

This diff is too big to show here.

cabal.projectdeleted−5

This diff is too big to show here.

cabal.project.O0deleted−24

This diff is too big to show here.

cabal.project.Werrordeleted−17

This diff is too big to show here.

cabal.project.Werror-nocodedeleted−21

This diff is too big to show here.

cabal.project.cinew file+6

This diff is too big to show here.

cabal.project.coveragedeleted−14

This diff is too big to show here.

cabal.project.doctestdeleted−24

This diff is too big to show here.

cabal.project.ghc-headdeleted−35

This diff is too big to show here.

cabal.project.hpc-coverallsdeleted−9

This diff is too big to show here.

cabal.project.packdiffdeleted−9

This diff is too big to show here.

cabal.project.reportdeleted−30

This diff is too big to show here.

cabal.project.streamlydeleted−10

This diff is too big to show here.

docs/User/HowTo/streamly-vs-list-time.svg → charts-0/streamly-vs-list-time.svgrenamed

The content is the same.

configure+1310−1297

This diff is too big to show here.

configure.ac+5−11

This diff is too big to show here.

core/Changelog.mddeleted−1

This diff is too big to show here.

core/LICENSEdeleted−322

This diff is too big to show here.

core/Setup.hsdeleted−6

This diff is too big to show here.

core/configuredeleted−4349

This diff is too big to show here.

core/configure.acdeleted−17

This diff is too big to show here.

core/docs/ApiChangelogs/0.1.0-0.2.0.txtdeleted−1471

This diff is too big to show here.

core/docs/ApiChangelogs/0.1.0.txtdeleted−405

This diff is too big to show here.

core/docs/ApiChangelogs/0.2.0-0.2.2.txtdeleted−306

This diff is too big to show here.

core/docs/Changelog.mddeleted−97

This diff is too big to show here.

core/docs/Readme.mddeleted−1

This diff is too big to show here.

core/src/DocTestDataArray.hsdeleted−22

This diff is too big to show here.

core/src/DocTestDataFold.hsdeleted−27

This diff is too big to show here.

core/src/DocTestDataMutArray.hsdeleted−10

This diff is too big to show here.

core/src/DocTestDataMutArrayGeneric.hsdeleted−10

This diff is too big to show here.

core/src/DocTestDataParser.hsdeleted−20

This diff is too big to show here.

core/src/DocTestDataParserK.hsdeleted−15

This diff is too big to show here.

core/src/DocTestDataStream.hsdeleted−39

This diff is too big to show here.

core/src/DocTestDataStreamK.hsdeleted−21

This diff is too big to show here.

core/src/DocTestDataUnfold.hsdeleted−12

This diff is too big to show here.

core/src/DocTestFileSystemHandle.hsdeleted−15

This diff is too big to show here.

core/src/DocTestUnicodeParser.hsdeleted−9

This diff is too big to show here.

core/src/DocTestUnicodeStream.hsdeleted−12

This diff is too big to show here.

core/src/DocTestUnicodeString.hsdeleted−5

This diff is too big to show here.

core/src/Streamly/Console/Stdio.hsdeleted−30

This diff is too big to show here.

core/src/Streamly/Data/Array.hsdeleted−167

This diff is too big to show here.

core/src/Streamly/Data/Array/Generic.hsdeleted−51

This diff is too big to show here.

core/src/Streamly/Data/Fold.hsdeleted−415

This diff is too big to show here.

core/src/Streamly/Data/MutArray.hsdeleted−110

This diff is too big to show here.

core/src/Streamly/Data/MutArray/Generic.hsdeleted−70

This diff is too big to show here.

core/src/Streamly/Data/MutByteArray.hsdeleted−106

This diff is too big to show here.

core/src/Streamly/Data/Parser.hsdeleted−247

This diff is too big to show here.

core/src/Streamly/Data/ParserK.hsdeleted−139

This diff is too big to show here.

core/src/Streamly/Data/Stream.hsdeleted−746

This diff is too big to show here.

core/src/Streamly/Data/StreamK.hsdeleted−194

This diff is too big to show here.

core/src/Streamly/Data/Unfold.hsdeleted−233

This diff is too big to show here.

core/src/Streamly/FileSystem/Dir.hsdeleted−23

This diff is too big to show here.

core/src/Streamly/FileSystem/File.hsdeleted−60

This diff is too big to show here.

core/src/Streamly/FileSystem/Handle.hsdeleted−117

This diff is too big to show here.

core/src/Streamly/Internal/Console/Stdio.hsdeleted−228

This diff is too big to show here.

core/src/Streamly/Internal/Control/Exception.hsdeleted−38

This diff is too big to show here.

core/src/Streamly/Internal/Control/ForkIO.hsdeleted−50

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array.hsdeleted−1018

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/ArrayMacros.hdeleted−43

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Generic.hsdeleted−342

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Stream.hsdeleted−725

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Type.hsdeleted−1148

This diff is too big to show here.

core/src/Streamly/Internal/Data/Binary/Parser.hsdeleted−399

This diff is too big to show here.

core/src/Streamly/Internal/Data/Binary/Stream.hsdeleted−383

This diff is too big to show here.

core/src/Streamly/Internal/Data/Builder.hsdeleted−82

This diff is too big to show here.

core/src/Streamly/Internal/Data/Either/Strict.hsdeleted−57

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold.hsdeleted−33

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Chunked.hsdeleted−379

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Combinators.hsdeleted−2452

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Container.hsdeleted−783

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Step.hsdeleted−83

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Tee.hsdeleted−184

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Type.hsdeleted−2099

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Window.hsdeleted−357

This diff is too big to show here.

core/src/Streamly/Internal/Data/IOFinalizer.hsdeleted−101

This diff is too big to show here.

core/src/Streamly/Internal/Data/IORef/Unboxed.hsdeleted−101

This diff is too big to show here.

core/src/Streamly/Internal/Data/IsMap.hsdeleted−60

This diff is too big to show here.

core/src/Streamly/Internal/Data/List.hsdeleted−234

This diff is too big to show here.

core/src/Streamly/Internal/Data/Maybe/Strict.hsdeleted−57

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray.hsdeleted−207

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Generic.hsdeleted−947

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Stream.hsdeleted−145

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Type.hsdeleted−3318

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutByteArray.hsdeleted−251

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutByteArray/Type.hsdeleted−321

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser.hsdeleted−3621

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Tee.hsdeleted−617

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Type.hsdeleted−1452

This diff is too big to show here.

core/src/Streamly/Internal/Data/ParserK.hsdeleted−16

This diff is too big to show here.

core/src/Streamly/Internal/Data/ParserK/Type.hsdeleted−752

This diff is too big to show here.

core/src/Streamly/Internal/Data/Pipe.hsdeleted−273

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer.hsdeleted−81

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer/Source.hsdeleted−303

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer/Type.hsdeleted−186

This diff is too big to show here.

core/src/Streamly/Internal/Data/Refold/Type.hsdeleted−251

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring.hsdeleted−619

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring/Generic.hsdeleted−185

This diff is too big to show here.

core/src/Streamly/Internal/Data/SVar/Type.hsdeleted−540

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH.hsdeleted−530

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hsdeleted−475

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/Common.hsdeleted−70

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hsdeleted−411

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/Type.hsdeleted−317

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream.hsdeleted−42

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Container.hsdeleted−310

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Eliminate.hsdeleted−849

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Exception.hsdeleted−501

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Generate.hsdeleted−1191

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Lift.hsdeleted−129

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Nesting.hsdeleted−3024

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Step.hsdeleted−39

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/StreamD.hsdeleted−16

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Top.hsdeleted−480

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Transform.hsdeleted−1971

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Transformer.hsdeleted−183

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Type.hsdeleted−2220

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK.hsdeleted−1730

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK/Transformer.hsdeleted−79

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK/Type.hsdeleted−2153

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock.hsdeleted−180

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock/config-clock.hdeleted−11

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/TimeSpec.hscdeleted−152

This diff is too big to show here.

core/src/Streamly/Internal/Data/Tuple/Strict.hsdeleted−46

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unbox.hsdeleted−908

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unbox/TH.hsdeleted−498

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold.hsdeleted−1077

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Enumeration.hsdeleted−543

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Type.hsdeleted−999

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Path.hsdeleted−515

This diff is too big to show here.

core/src/Streamly/Internal/System/IO.hsdeleted−58

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Array.hsdeleted−104

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Parser.hsdeleted−627

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Stream.hsdeleted−1123

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/String.hsdeleted−158

This diff is too big to show here.

core/src/Streamly/Unicode/Parser.hsdeleted−69

This diff is too big to show here.

core/src/Streamly/Unicode/String.hsdeleted−30

This diff is too big to show here.

core/src/assert.hsdeleted−6

This diff is too big to show here.

core/src/inline.hsdeleted−27

This diff is too big to show here.

core/streamly-core.cabaldeleted−534

This diff is too big to show here.

credits/CONTRIBUTORS.mdnew file+85

This diff is too big to show here.

credits/COPYRIGHTS.mdnew file+64

This diff is too big to show here.

docs/User/Project/Credits.md → credits/README.mdrenamed+1−3

This diff is too big to show here.

credits/Yampa-0.10.6.2.txtnew file+29

This diff is too big to show here.

credits/base-4.12.0.0.txtnew file+83

This diff is too big to show here.

credits/bjoern-2008-2009.txtnew file+19

This diff is too big to show here.

credits/clock-0.7.2.txtnew file+32

This diff is too big to show here.

credits/foldl-1.4.5.txtnew file+24

This diff is too big to show here.

credits/pipes-concurrency-2.0.8.txtnew file+24

This diff is too big to show here.

credits/primitive-0.7.0.0.txtnew file+30

This diff is too big to show here.

credits/transient-0.5.5.txtnew file+18

This diff is too big to show here.

credits/vector-0.12.0.2.txtnew file+30

This diff is too big to show here.

default.nixdeleted−150

This diff is too big to show here.

docs/Developer/dfa-bytes.png → design/dfa-bytes.pngrenamed

Binary file not shown.

docs/Developer/dfa-classes.png → design/dfa-classes.pngrenamed

Binary file not shown.

docs/Developer/dfa-rearr.png → design/dfa-rearr.pngrenamed

Binary file not shown.

design/inlining.mdnew file+123

This diff is too big to show here.

docs/Developer/linked-lists.md → design/linked-lists.mdrenamed

The content is the same.

design/module-organization.mdnew file+134

This diff is too big to show here.

docs/Developer/utf8-decoder.md → design/utf8-decoder.mdrenamed+3−3

This diff is too big to show here.

docs/Build.mdnew file+91

This diff is too big to show here.

docs/Developer/Benchmarks.mddeleted−342

This diff is too big to show here.

docs/Developer/Contributing.mddeleted−271

This diff is too big to show here.

docs/Developer/Github.linkdeleted−1

This diff is too big to show here.

docs/Developer/MAINTAINING.mddeleted−422

This diff is too big to show here.

docs/Developer/Tests.mddeleted−139

This diff is too big to show here.

docs/Developer/ci-tests.mddeleted−64

This diff is too big to show here.

docs/Developer/container-api.mddeleted−124

This diff is too big to show here.

docs/Developer/cps-vs-direct.rstdeleted−328

This diff is too big to show here.

docs/Developer/module-organization.mddeleted−250

This diff is too big to show here.

docs/Developer/optimization-guidelines.mddeleted−370

This diff is too big to show here.

docs/Developer/overview.mddeleted−24

This diff is too big to show here.

docs/Developer/paths.rstdeleted−253

This diff is too big to show here.

docs/Developer/related-packages.mddeleted−71

This diff is too big to show here.

docs/Developer/resources.mddeleted−45

This diff is too big to show here.

docs/Developer/roadmap.mddeleted−36

This diff is too big to show here.

docs/Developer/unicode.mddeleted−224

This diff is too big to show here.

docs/Documentation.mddeleted−5

This diff is too big to show here.

docs/Setup.hsdeleted−6

This diff is too big to show here.

docs/User/Explanatory/Overview.mddeleted−468

This diff is too big to show here.

docs/User/Explanatory/design.mddeleted−42

This diff is too big to show here.

docs/User/Explanatory/monad-transformers.mddeleted−65

This diff is too big to show here.

docs/User/Explanatory/performance.mddeleted−7

This diff is too big to show here.

docs/User/Explanatory/streaming-pradigms.rstdeleted−117

This diff is too big to show here.

docs/User/Explanatory/unified-abstractions.mddeleted−275

This diff is too big to show here.

docs/User/HowTo/Compiling.mddeleted−145

This diff is too big to show here.

docs/User/HowTo/Examples.linkdeleted−1

This diff is too big to show here.

docs/User/HowTo/faq.mddeleted−94

This diff is too big to show here.

docs/User/HowTo/interoperation.mddeleted−11

This diff is too big to show here.

docs/User/HowTo/optimizing.mddeleted−98

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txtdeleted−175

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.8.3.txtdeleted−261

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txtdeleted−424

This diff is too big to show here.

docs/User/Project/CONTRIBUTORS.mddeleted−164

This diff is too big to show here.

docs/User/Project/Github.linkdeleted−1

This diff is too big to show here.

docs/User/Project/README.mddeleted−141

This diff is too big to show here.

docs/User/Project/Roadmap.linkdeleted−1

This diff is too big to show here.

docs/User/Project/Upgrading-0.8-to-0.9.mddeleted−384

This diff is too big to show here.

docs/User/Tutorials/ConcurrentStreams.hsdeleted−771

This diff is too big to show here.

docs/User/Tutorials/Examples.linkdeleted−1

This diff is too big to show here.

docs/User/Tutorials/ReactiveProgramming.hsdeleted−126

This diff is too big to show here.

docs/User/Tutorials/Tutorial.hsdeleted−521

This diff is too big to show here.

docs/User/Tutorials/before-you-begin.mddeleted−77

This diff is too big to show here.

docs/User/Tutorials/getting-started.mddeleted−225

This diff is too big to show here.

docs/User/Tutorials/haskell-lazy-evaluation.mddeleted−215

This diff is too big to show here.

docs/User/Tutorials/quick-overview.mddeleted−517

This diff is too big to show here.

docs/User/Tutorials/why-haskell-streamly.mddeleted−91

This diff is too big to show here.

docs/User/resources.mddeleted−18

This diff is too big to show here.

docs/streamly-docs.cabaldeleted−49

This diff is too big to show here.

docs/User/HowTo/streamly-vs-async.md → docs/streamly-vs-async.mdrenamed+17−19

This diff is too big to show here.

docs/User/HowTo/streamly-vs-lists.md → docs/streamly-vs-lists.mdrenamed+5−7

This diff is too big to show here.

docs/transformers.mdnew file+32

This diff is too big to show here.

examples/AcidRain.hsnew file+58

This diff is too big to show here.

examples/CamelCase.hsnew file+33

This diff is too big to show here.

examples/CirclingSquare.hsnew file+83

This diff is too big to show here.

examples/ControlFlow.hsnew file+303

This diff is too big to show here.

examples/EchoServer.hsnew file+19

This diff is too big to show here.

examples/FileIOExamples.hsnew file+65

This diff is too big to show here.

examples/FileSinkServer.hsnew file+38

This diff is too big to show here.

examples/FromFileClient.hsnew file+21

This diff is too big to show here.

examples/HandleIO.hsnew file+107

This diff is too big to show here.

examples/ListDir.hsnew file+25

This diff is too big to show here.

examples/MergeSort.hsnew file+24

This diff is too big to show here.

examples/README.md+43−2

This diff is too big to show here.

examples/SearchQuery.hsnew file+29

This diff is too big to show here.

examples/Split.hsnew file+44

This diff is too big to show here.

examples/WordClassifier.hsnew file+75

This diff is too big to show here.

examples/WordCount.hsnew file+630

This diff is too big to show here.

hie.yamldeleted−177

This diff is too big to show here.

core/jsbits/clock.js → jsbits/clock.jsrenamed

The content is the same.

src/Streamly.hsnew file+648

This diff is too big to show here.

src/Streamly/Data/Array.hsnew file+43

This diff is too big to show here.

src/Streamly/Data/Fold.hsnew file+270

This diff is too big to show here.

src/Streamly/Data/Fold/Prelude.hsdeleted−65

This diff is too big to show here.

src/Streamly/Data/Fold/Tee.hsdeleted−16

This diff is too big to show here.

src/Streamly/Data/Prim/Array.hsnew file+44

This diff is too big to show here.

src/Streamly/Data/SmallArray.hs+2−2

This diff is too big to show here.

src/Streamly/Data/Stream/MkType.hsdeleted−115

This diff is too big to show here.

src/Streamly/Data/Stream/Prelude.hsdeleted−232

This diff is too big to show here.

src/Streamly/Data/Unfold.hsnew file+69

This diff is too big to show here.

core/src/Streamly/Unicode/Stream.hs → src/Streamly/Data/Unicode/Stream.hsrenamed+27−41

This diff is too big to show here.

src/Streamly/Examples.hsnew file+60

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FD.hs → src/Streamly/FileSystem/FD.hsrenamed+76−91

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FDIO.hs → src/Streamly/FileSystem/FDIO.hsrenamed+22−9

This diff is too big to show here.

src/Streamly/FileSystem/Handle.hsnew file+88

This diff is too big to show here.

src/Streamly/Internal/System/IOVec/Type.hsc → src/Streamly/FileSystem/IOVec.hscrenamed+12−15

This diff is too big to show here.

core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hsrenamed+7−15

This diff is too big to show here.

src/Streamly/Internal/Control/Concurrent.hsdeleted−77

This diff is too big to show here.

src/Streamly/Internal/Control/ForkLifted.hsdeleted−66

This diff is too big to show here.

core/src/Streamly/Internal/Control/Monad.hs → src/Streamly/Internal/Control/Monad.hsrenamed+4−2

This diff is too big to show here.

src/Streamly/Internal/Data/Array.hsnew file+203

This diff is too big to show here.

src/Streamly/Internal/Data/Atomics.hs+2

This diff is too big to show here.

src/Streamly/Internal/Data/Channel.hsdeleted−19

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Dispatcher.hsdeleted−294

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Types.hsdeleted−817

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Worker.hsdeleted−375

This diff is too big to show here.

src/Streamly/Internal/Data/Cont.hsdeleted−36

This diff is too big to show here.

src/Streamly/Internal/Data/Fold.hsnew file+1338

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Async.hsdeleted−133

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent.hsdeleted−57

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent/Channel.hsdeleted−112

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hsdeleted−331

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Prelude.hsdeleted−19

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/SVar.hsdeleted−79

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Types.hsnew file+478

This diff is too big to show here.

src/Streamly/Internal/Data/IOFinalizer/Lifted.hsdeleted−74

This diff is too big to show here.

src/Streamly/Internal/Data/IsMap/HashMap.hsdeleted−42

This diff is too big to show here.

src/Streamly/Internal/Data/List.hsnew file+199

This diff is too big to show here.

src/Streamly/Internal/Data/Pipe.hsnew file+1976

This diff is too big to show here.

core/src/Streamly/Internal/Data/Pipe/Type.hs → src/Streamly/Internal/Data/Pipe/Types.hsrenamed+22−16

This diff is too big to show here.

src/Streamly/Internal/Data/Prim/Array.hsnew file+205

This diff is too big to show here.

src/Streamly/Internal/Data/Prim/Array/Types.hsnew file+943

This diff is too big to show here.

src/Streamly/Internal/Data/SVar.hs+2056−120

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Dispatch.hsdeleted−739

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Pull.hsdeleted−164

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Worker.hsdeleted−544

This diff is too big to show here.

src/Streamly/Internal/Data/Sink.hsnew file+245

This diff is too big to show here.

src/Streamly/Internal/Data/Sink/Types.hsnew file+24

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray.hs+40−51

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray/Type.hs → src/Streamly/Internal/Data/SmallArray/Types.hsrenamed+88−14

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Ahead.hs+130−173

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Async.hs+243−309

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs → src/Streamly/Internal/Data/Stream/Combinators.hsrenamed+16−35

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Common.hsdeleted−105

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent.hsdeleted−903

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel.hsdeleted−109

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hsdeleted−1046

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Consumer.hsdeleted−127

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hsdeleted−417

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hsdeleted−252

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hsdeleted−294

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hsdeleted−172

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs → src/Streamly/Internal/Data/Stream/Enumeration.hsrenamed+52−96

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Instances.hs+30−30

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream.hsdeleted−56

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Common.hsdeleted−747

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hsdeleted−1035

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Exception.hsdeleted−284

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Expand.hsdeleted−1158

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Generate.hsdeleted−640

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Lift.hsdeleted−150

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hsdeleted−1627

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Top.hsdeleted−749

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Transform.hsdeleted−1595

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Type.hsdeleted−783

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Lifted.hsdeleted−335

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/MkType.hsdeleted−641

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Parallel.hs+258−261

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Prelude.hs+328−8

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar.hs+230−8

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Eliminate.hsdeleted−405

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Generate.hsdeleted−294

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Serial.hs+257−241

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD.hsnew file+4271

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Type.hsnew file+647

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamDK.hsnew file+165

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK/Alt.hs → src/Streamly/Internal/Data/Stream/StreamDK/Type.hsrenamed+8−144

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamK.hsnew file+1095

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamK/Type.hsnew file+989

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Time.hsdeleted−950

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Zip.hs+187−95

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/ZipAsync.hsdeleted−134

This diff is too big to show here.

src/Streamly/Internal/Data/Strict.hsnew file+59

This diff is too big to show here.

src/Streamly/Internal/Data/Time.hsnew file+74

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock/Type.hsc → src/Streamly/Internal/Data/Time/Clock.hscrenamed+67−10

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock/Darwin.c → src/Streamly/Internal/Data/Time/Darwin.crenamed

The content is the same.

core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hsrenamed+88−28

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock/Windows.c → src/Streamly/Internal/Data/Time/Windows.crenamed

The content is the same.

core/src/config.h.in → src/Streamly/Internal/Data/Time/config.h.inrenamed+5−7

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold.hsnew file+956

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Exception.hsdeleted−214

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Prelude.hsdeleted−17

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/SVar.hsdeleted−161

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Types.hsnew file+31

This diff is too big to show here.

src/Streamly/Internal/Data/Unicode/Char.hsnew file+50

This diff is too big to show here.

src/Streamly/Internal/Data/Unicode/Stream.hsnew file+744

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hsrenamed+105−195

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event.hsdeleted−245

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.hdeleted−63

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.hsdeleted−1086

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.mdeleted−294

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Linux.hsdeleted−1294

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Windows.hsdeleted−640

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/File.hs → src/Streamly/Internal/FileSystem/File.hsrenamed+181−282

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hsrenamed+300−332

This diff is too big to show here.

src/Streamly/Internal/Memory/Array.hsnew file+510

This diff is too big to show here.

src/Streamly/Internal/Memory/Array/Types.hsnew file+1357

This diff is too big to show here.

src/Streamly/Internal/Memory/ArrayStream.hsnew file+224

This diff is too big to show here.

src/Streamly/Internal/Memory/Unicode/Array.hsnew file+86

This diff is too big to show here.

src/Streamly/Internal/Mutable/Prim/Var.hsnew file+88

This diff is too big to show here.

src/Streamly/Internal/Network/Inet/TCP.hs+158−199

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+302−279

This diff is too big to show here.

src/Streamly/Internal/Prelude.hsnew file+4489

This diff is too big to show here.

src/Streamly/Internal/System/IOVec.hsdeleted−132

This diff is too big to show here.

src/Streamly/Internal/Unicode/Char.hsdeleted−328

This diff is too big to show here.

src/Streamly/Internal/Unicode/Utf8.hsdeleted−73

This diff is too big to show here.

src/Streamly/Data/Array/Foreign.hs → src/Streamly/Memory/Array.hsrenamed+11−54

This diff is too big to show here.

src/Streamly/Memory/Malloc.hsnew file+54

This diff is too big to show here.

src/Streamly/Memory/Ring.hsnew file+205

This diff is too big to show here.

src/Streamly/Network/Inet/TCP.hs+6−49

This diff is too big to show here.

src/Streamly/Network/Socket.hs+21−119

This diff is too big to show here.

src/Streamly/Prelude.hs+355−670

This diff is too big to show here.

src/Streamly/Tutorial.hsnew file+1742

This diff is too big to show here.

src/assert.hsdeleted−6

This diff is too big to show here.

src/config.h.indeleted−43

This diff is too big to show here.

src/inline.hs+2−2

This diff is too big to show here.

stack.yaml+13−12

This diff is too big to show here.

streamly.cabal+1039−427

This diff is too big to show here.

targets/Targets.hsdeleted−213

This diff is too big to show here.

targets/cabal.projectdeleted−1

This diff is too big to show here.

targets/default.nixdeleted−163

This diff is too big to show here.

targets/streamly-targets.cabaldeleted−12

This diff is too big to show here.

test/Main.hsnew file+1152

This diff is too big to show here.

test/Streamly/Test/Prelude/Rate.hs → test/MaxRate.hsrenamed+46−67

This diff is too big to show here.

test/Prop.hsnew file+1328

This diff is too big to show here.

test/Streamly/Test/Data/List.hs → test/PureStreams.hsrenamed+32−29

This diff is too big to show here.

test/README.mddeleted−1

This diff is too big to show here.

test/Streamly/Test/Array.hsnew file+178

This diff is too big to show here.

test/Streamly/Test/Data/Array.hsdeleted−276

This diff is too big to show here.

test/Streamly/Test/Data/Array/Common.hsdeleted−101

This diff is too big to show here.

test/Streamly/Test/Data/Array/CommonImports.hsdeleted−13

This diff is too big to show here.

test/Streamly/Test/Data/Array/Generic.hsdeleted−65

This diff is too big to show here.

test/Streamly/Test/Data/Array/Stream.hsdeleted−113

This diff is too big to show here.

test/Streamly/Test/Data/Fold.hsdeleted−815

This diff is too big to show here.

test/Streamly/Test/Data/Fold/Window.hsdeleted−67

This diff is too big to show here.

test/Streamly/Test/Data/MutArray.hsdeleted−152

This diff is too big to show here.

test/Streamly/Test/Data/Parser.hsdeleted−1379

This diff is too big to show here.

test/Streamly/Test/Data/ParserK.hsdeleted−841

This diff is too big to show here.

test/Streamly/Test/Data/Ring/Unboxed.hsdeleted−53

This diff is too big to show here.

test/Streamly/Test/Data/Serialize.hsdeleted−306

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/CompatV0.hsdeleted−46

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/CompatV1.hsdeleted−48

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/TH.hsdeleted−82

This diff is too big to show here.

test/Streamly/Test/Data/SmallArray.hsdeleted−29

This diff is too big to show here.

test/Streamly/Test/Data/Stream.hsdeleted−33

This diff is too big to show here.

test/Streamly/Test/Data/Stream/Concurrent.hsdeleted−363

This diff is too big to show here.

test/Streamly/Test/Data/Unbox.hsdeleted−347

This diff is too big to show here.

test/Streamly/Test/Data/Unbox/TH.hsdeleted−146

This diff is too big to show here.

test/Streamly/Test/Data/Unfold.hsdeleted−701

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event.hsdeleted−28

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Common.hsdeleted−422

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Darwin.hsdeleted−86

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Linux.hsdeleted−163

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Windows.hsdeleted−51

This diff is too big to show here.

test/Streamly/Test/FileSystem/Handle.hsdeleted−228

This diff is too big to show here.

test/Streamly/Test/Internal/Data/Fold.hsnew file+27

This diff is too big to show here.

test/Streamly/Test/Internal/Prelude.hsnew file+78

This diff is too big to show here.

test/Streamly/Test/Network/Inet/TCP.hsdeleted−144

This diff is too big to show here.

test/Streamly/Test/Network/Socket.hsdeleted−160

This diff is too big to show here.

test/Streamly/Test/Prelude.hsdeleted−188

This diff is too big to show here.

test/Streamly/Test/Prelude/Ahead.hsdeleted−137

This diff is too big to show here.

test/Streamly/Test/Prelude/Async.hsdeleted−147

This diff is too big to show here.

test/Streamly/Test/Prelude/Concurrent.hsdeleted−507

This diff is too big to show here.

test/Streamly/Test/Prelude/Fold.hsdeleted−201

This diff is too big to show here.

test/Streamly/Test/Prelude/Parallel.hsdeleted−121

This diff is too big to show here.

test/Streamly/Test/Prelude/Serial.hsdeleted−741

This diff is too big to show here.

test/Streamly/Test/Prelude/Top.hsdeleted−224

This diff is too big to show here.

test/Streamly/Test/Prelude/WAsync.hsdeleted−222

This diff is too big to show here.

test/Streamly/Test/Prelude/WSerial.hsdeleted−184

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipAsync.hsdeleted−70

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipSerial.hsdeleted−73

This diff is too big to show here.

test/Streamly/Test/Serialize/Serializable.hsdeleted−237

This diff is too big to show here.

test/Streamly/Test/Unicode/Char.hsdeleted−133

This diff is too big to show here.

test/Streamly/Test/Unicode/Parser.hsdeleted−231

This diff is too big to show here.

test/Streamly/Test/Unicode/Stream.hsdeleted−190

This diff is too big to show here.

test/Streamly/Test/Unicode/extra/NormalizationTest.txtdeleted−9

This diff is too big to show here.

test/Streamly/Test/Unicode/ucd/NormalizationTest.txt−18908

This diff is too big to show here.

test/String.hs+135

This diff is too big to show here.

test/lib/Streamly/Test/Common.hs−66

This diff is too big to show here.

test/lib/Streamly/Test/Prelude/Common.hs−1757

This diff is too big to show here.

test/loops.hs+76

This diff is too big to show here.

test/nested-loops.hs+25

This diff is too big to show here.

test/parallel-loops.hs+27

This diff is too big to show here.

test/rate-timestamp.hs+26

This diff is too big to show here.

test/streamly-tests.cabal−593

This diff is too big to show here.

test/test-runner/Main.hs−33

This diff is too big to show here.

test/test-runner/cabal.project−4

This diff is too big to show here.

test/test-runner/default.nix−164

This diff is too big to show here.

test/test-runner/test-runner.cabal−41

This diff is too big to show here.