on 4d0631a help sign in
553 files changed+53184−148138
since splitsnapshots
unifiedsplit
.circleci/config.yml+135−106 .ghci−1 .github/workflows/haskell.yml+54−224 .github/workflows/packdiff.yml−39 .github/workflows/regression-check.yml−165 .gitignore+3−8 .hlint.ignore+18−38 .hlint.yaml+2−18 .packcheck.ignore−34 .travis.yml+248 CHANGELOG.md−1 CONTRIBUTING.md+221−1 docs/User/Project/Changelog.md → Changelog.md+23−256 INSTALL.md+298 LICENSE+1−69 MAINTAINING.md+219 README.md+612−1 appveyor.yml+6−8 bench.sh+598 benchmark/Chart.hs+194 benchmark/NanoBenchmarks.hs+23−28 benchmark/README.md+124−1 benchmark/Streamly/Benchmark/Data/Array.hs+127−89 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+235 benchmark/Streamly/Benchmark/Data/Fold.hs+141−462 benchmark/Streamly/Benchmark/Data/Fold/Window.hs−191 benchmark/Streamly/Benchmark/Data/MutArray.hs−300 benchmark/Streamly/Benchmark/Data/NestedUnfoldOps.hs+126 benchmark/Streamly/Benchmark/Data/Parser.hs+127−722 benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+244 benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+198 benchmark/Streamly/Benchmark/Data/ParserK.hs−437 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/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+15−59 benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs+7−9 benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+358−593 benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs−938 benchmark/Streamly/Benchmark/Data/Stream/Transform.hs−687 benchmark/Streamly/Benchmark/Data/Unfold.hs+31−814 benchmark/Streamly/Benchmark/FileSystem/Handle.hs+75−6 benchmark/Streamly/Benchmark/FileSystem/Handle/Common.hs+152 benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+337−108 benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+467−85 benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+41−52 benchmark/Streamly/Benchmark/Prelude/Ahead.hs+29−33 benchmark/Streamly/Benchmark/Prelude/Async.hs+33−47 benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+19−28 benchmark/Streamly/Benchmark/Prelude/Merge.hs−298 benchmark/Streamly/Benchmark/Prelude/Parallel.hs+35−70 benchmark/Streamly/Benchmark/Prelude/Rate.hs+39−76 benchmark/Streamly/Benchmark/Prelude/Serial.hs+1829 benchmark/Streamly/Benchmark/Prelude/WAsync.hs+29−71 benchmark/Streamly/Benchmark/Prelude/WSerial.hs+69−219 benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+19−34 benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+28−72 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+17−65 benchmark/lib/Streamly/Benchmark/Common/Handle.hs−228 benchmark/lib/Streamly/Benchmark/Prelude.hs+56−138 benchmark/streamly-benchmarks.cabal+164−485 bin/bench-exec-one.sh+163 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+11 cabal.project.coverage+13−8 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+1309−1283 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/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/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 docs/User/Project/CONTRIBUTORS.md → credits/CONTRIBUTORS.md+2−58 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/paths.rst → design/paths.rst+2−25 docs/Developer/unicode.md → design/unicode.md docs/Developer/utf8-decoder.md → design/utf8-decoder.md+3−3 docs/User/HowTo/optimizing.md → docs/Build.md+91−10 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/related-packages.md−71 docs/Developer/resources.md−45 docs/Developer/roadmap.md−36 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/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/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+22 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/Rate.hs+11 examples/SearchQuery.hs+29 examples/Split.hs+38 examples/WordClassifier.hs+75 examples/WordCount.hs+629 hie.yaml−177 core/jsbits/clock.js → jsbits/clock.js src/Streamly.hs+644 src/Streamly/Data/Array.hs+43 src/Streamly/Data/Fold.hs+276 src/Streamly/Data/Fold/Prelude.hs−65 src/Streamly/Data/Fold/Tee.hs−16 src/Streamly/Data/Prim/Array.hs+43 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+62 core/src/Streamly/Unicode/Stream.hs → src/Streamly/Data/Unicode/Stream.hs+26−41 src/Streamly/Internal/FileSystem/FD.hs → src/Streamly/FileSystem/FD.hs+70−89 src/Streamly/Internal/FileSystem/FDIO.hs → src/Streamly/FileSystem/FDIO.hs+15−6 src/Streamly/FileSystem/Handle.hs+86 src/Streamly/Internal/System/IOVec/Type.hsc → src/Streamly/FileSystem/IOVec.hsc+8−7 core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hs+5−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+1−1 src/Streamly/Internal/Data/Array.hs+204 src/Streamly/Internal/Data/Array/Prim.hs+110 src/Streamly/Internal/Data/Array/Prim/Mut/Types.hs+94 src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs+400 src/Streamly/Internal/Data/Array/Prim/Pinned.hs+108 src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Types.hs+176 src/Streamly/Internal/Data/Array/Prim/Pinned/Types.hs+127 src/Streamly/Internal/Data/Array/Prim/Types.hs+98 src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs+694 src/Streamly/Internal/Data/Array/PrimInclude.hs+185 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+1648 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+590 src/Streamly/Internal/Data/IOFinalizer/Lifted.hs−74 src/Streamly/Internal/Data/IsMap/HashMap.hs−42 src/Streamly/Internal/Data/List.hs+193 src/Streamly/Internal/Data/Parser.hs+1105 src/Streamly/Internal/Data/Parser/ParserD.hs+731 core/src/Streamly/Internal/Data/Parser/Tee.hs → src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+22−89 src/Streamly/Internal/Data/Parser/ParserD/Types.hs+637 src/Streamly/Internal/Data/Parser/ParserK/Types.hs+213 src/Streamly/Internal/Data/Pipe.hs+1968 core/src/Streamly/Internal/Data/Pipe/Type.hs → src/Streamly/Internal/Data/Pipe/Types.hs+6−3 src/Streamly/Internal/Data/SVar.hs+2040−119 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+34−48 src/Streamly/Internal/Data/SmallArray/Type.hs → src/Streamly/Internal/Data/SmallArray/Types.hs+76−9 src/Streamly/Internal/Data/Stream/Ahead.hs+122−172 src/Streamly/Internal/Data/Stream/Async.hs+232−307 src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs → src/Streamly/Internal/Data/Stream/Combinators.hs+15−33 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+51−97 src/Streamly/Internal/Data/Stream/Instances.hs+27−22 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+289−260 src/Streamly/Internal/Data/Stream/Prelude.hs+340−8 src/Streamly/Internal/Data/Stream/SVar.hs+233−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+251−218 src/Streamly/Internal/Data/Stream/StreamD.hs+4667 src/Streamly/Internal/Data/Stream/StreamD/Type.hs+681 src/Streamly/Internal/Data/Stream/StreamDK.hs+156 core/src/Streamly/Internal/Data/StreamK/Alt.hs → src/Streamly/Internal/Data/Stream/StreamDK/Type.hs+4−144 src/Streamly/Internal/Data/Stream/StreamK.hs+1092 src/Streamly/Internal/Data/Stream/StreamK/Type.hs+1094 src/Streamly/Internal/Data/Stream/Time.hs−950 src/Streamly/Internal/Data/Stream/Zip.hs+178−94 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+7−5 core/src/Streamly/Internal/Data/Time/Clock/Darwin.c → src/Streamly/Internal/Data/Time/Darwin.c core/src/Streamly/Internal/Data/Time/TimeSpec.hsc → src/Streamly/Internal/Data/Time/TimeSpec.hsc+10−6 core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hs+4−12 core/src/Streamly/Internal/Data/Time/Clock/Windows.c → src/Streamly/Internal/Data/Time/Windows.c core/src/Streamly/Internal/Data/Time/Clock/config-clock.h → src/Streamly/Internal/Data/Time/config-clock.h+1−1 core/src/config.h.in → src/Streamly/Internal/Data/Time/config.h.in+5−7 src/Streamly/Internal/Data/Unfold.hs+1098 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+27 src/Streamly/Internal/Data/Unicode/Char.hs+65 src/Streamly/Internal/Data/Unicode/Stream.hs+738 src/Streamly/Internal/Data/Zipper.hs+343 core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hs+99−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+173−281 core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hs+290−331 src/Streamly/Internal/Memory/Array.hs+499 src/Streamly/Internal/Memory/Array/Types.hs+580 src/Streamly/Internal/Memory/ArrayStream.hs+236 src/Streamly/Internal/Memory/Mutable/Array/Types.hs+1440 src/Streamly/Internal/Memory/Unicode/Array.hs+84 src/Streamly/Internal/Mutable/Prim/Var.hs+83 src/Streamly/Internal/Network/Inet/TCP.hs+153−194 src/Streamly/Internal/Network/Socket.hs+288−229 src/Streamly/Internal/Prelude.hs+5032 src/Streamly/Internal/System/IOVec.hs−132 src/Streamly/Internal/Unicode/Array/Prim/Pinned.hs+84 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+8−54 src/Streamly/Memory/Malloc.hs+48 src/Streamly/Memory/Ring.hs+200 src/Streamly/Network/Inet/TCP.hs+6−49 src/Streamly/Network/Socket.hs+56−94 src/Streamly/Prelude.hs+205−646 src/Streamly/Tutorial.hs+1742 src/assert.hs−6 src/config.h.in−43 src/inline.hs+2−2 stack.yaml+13−11 streamly.cabal+831−386 targets/Targets.hs−213 targets/cabal.project−1 targets/default.nix−163 targets/streamly-targets.cabal−12 test/Main.hs+1167 test/Streamly/Test/Prelude/Rate.hs → test/MaxRate.hs+38−60 test/Prop.hs+1406 test/Streamly/Test/Data/List.hs → test/PureStreams.hs+26−29 test/README.md−1 test/Streamly/Test/Array.hs+210 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+215 test/Streamly/Test/Internal/Data/Parser.hs+502 test/Streamly/Test/Internal/Data/Parser/ParserD.hs+540 test/Streamly/Test/Internal/Prelude.hs+102 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+132 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/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+135−106
@@ -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: "563702bd02c41343dcd3dfcfef0845ca428a9240"
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,175 @@ 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
9288
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
103−
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"
165139 - *save
166− cabal-ghc-9_8_1-docspec:
140+ cabal-ghc-8.2.2:
167141 <<: *env
168− executor: amd64-executor
169142 steps:
170143 - checkout
144+ - *preinstall
171145 - *restore
146+ - run: |
147+ apt-get install -y ghc-8.2.2
148+ apt-get install -y cabal-install-3.2
149+ apt-get install libtinfo-dev
150+ bash -c "$PACKCHECK cabal-v2"
151+ - *save
152+ cabal-ghc-8.0.2:
153+ <<: *env
154+ steps:
155+ - checkout
172156 - *preinstall
157+ - *restore
158+ - run: |
159+ apt-get install -y ghc-8.0.2
160+ apt-get install -y cabal-install-2.4
161+ bash -c "$PACKCHECK cabal-v2"
162+ - *save
163+ cabal-ghc-7.10.3:
164+ <<: *env
165+ steps:
166+ - checkout
167+ - *preinstall
168+ - *restore
169+ - run: |
170+ apt-get install -y ghc-7.10.3
171+ apt-get install -y cabal-install-2.4
172+ bash -c "$PACKCHECK cabal-v2"
173+ - *save
174+ stack-ghc-8.4:
175+ <<: *env
176+ steps:
177+ - checkout
178+ - *preinstall
179+ - *restore
180+ - run: |
181+ bash -c "$PACKCHECK stack RESOLVER=lts-12"
182+ - *save
183+ stack-ghc-8.2:
184+ <<: *env
185+ steps:
186+ - checkout
187+ - *preinstall
188+ - *restore
189+ - run: |
190+ bash -c "$PACKCHECK stack RESOLVER=lts-11"
191+ - *save
192+ coveralls-ghc-8.2.2:
193+ <<: *env
194+ steps:
195+ - checkout
196+ - *preinstall
197+ - *restore
173198 - run:
174199 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"
200+ BUILD: cabal
201+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test test"
202+ GHC_OPTIONS: "-DCOVERAGE_BUILD"
185203 command: |
186− bash -c "$PACKCHECK cabal"
204+ apt-get install -y ghc-8.2.2
205+ apt-get install -y cabal-install-2.4
206+ # required by hpc-coveralls
207+ apt-get install -y libcurl4-gnutls-dev
208+ apt-get install -y git
209+ apt-get install libtinfo-dev
210+ bash -c "$PACKCHECK cabal-v1"
187211 - *save
188− hlint-trailing-spaces:
212+ coveralls-ghc-8.8.3:
189213 <<: *env
190− executor: amd64-executor
191214 steps:
192215 - checkout
193− - *restore
194216 - *preinstall
217+ - *restore
195218 - run:
196− name: hlint and trailing spaces
197219 environment:
198− DISABLE_SDIST_BUILD: "yes"
199− HLINT_VERSION: 3.6.1
200− HLINT_OPTIONS: lint
201− HLINT_TARGETS: core/src src test benchmark
220+ BUILD: cabal-v2
221+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test"
222+ CABAL_PROJECT: "cabal.project.coverage"
223+ CABAL_BUILD_TARGETS: ""
202224 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
225+ apt-get install -y ghc-8.8.3
226+ apt-get install -y cabal-install-3.0
227+ # required by hpc-coveralls
228+ apt-get install -y libcurl4-gnutls-dev
229+ apt-get install -y git
230+ apt-get install libtinfo-dev
231+ bash -c "$PACKCHECK cabal-v2"
232+ no_output_timeout: 25m
207233 - *save
208234
209235workflows:
210236 version: 2
211237 build:
212238 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
239+ #- cabal-ghc-8.6.5
240+ #- cabal-ghc-8.4.4
241+ - cabal-ghc-8.2.2
242+ #- cabal-ghc-8.0.2
243+ #- cabal-ghc-7.10.3
244+ #- stack-ghc-8.4
245+ #- stack-ghc-8.2
246+ #- coveralls-ghc-8.2.2
247+ #- coveralls-ghc-8.8.3
.ghcideleted−1
@@ -1 +0,0 @@
1−:set -fobject-code
.github/workflows/haskell.yml+54−224
@@ -8,251 +8,81 @@ on:
88
99jobs:
1010 build:
11− name: GHC ${{matrix.name}}
11+ name: GHC ${{ matrix.name }}
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 }}
4619
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"
51−
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: "563702bd02c41343dcd3dfcfef0845ca428a9240"
6027
61− # Subdir
62− SUBDIR: ${{ matrix.subdir }}
28+ BUILD: ${{ matrix.build }}
29+ GHCVER: ${{ matrix.ghc_version }}
30+ CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }}
31+ CABAL_PROJECT: ${{ matrix.cabal_project }}
32+ DISABLE_DOCS: ${{ matrix.disable_docs }}
6333
64− runs-on: ${{ matrix.runner }}
65− continue-on-error: ${{ matrix.ignore_error }}
34+ runs-on: ubuntu-latest
6635 strategy:
67− fail-fast: true
36+ fail-fast: false
6837 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.
38+ name: [8.8.3+inspection+Werror, 8.6.5+streamk, 8.6.5+fusion-plugin, 8.4.4+debug]
39+ cabal_version: ["3.2"]
7840 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
41+ - name: 8.8.3+inspection+Werror
42+ ghc_version: 8.8.3
43+ build: cabal-v2
44+ cabal_project: cabal.project.ci
45+ - name: 8.6.5+streamk
18946 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
47+ build: cabal-v2
48+ cabal_build_options: "--flags streamk"
49+ - name: 8.6.5+fusion-plugin
50+ ghc_version: 8.6.5
51+ build: cabal-v2
52+ cabal_build_options: "--flags fusion-plugin"
53+ # haddock generation does not work with 8.6.5+fusion-plugin
54+ disable_docs: "y"
55+ - name: 8.4.4+debug
56+ ghc_version: 8.4.4
57+ build: cabal-v2
58+ cabal_build_options: "--flag debug"
20159
20260 steps:
20361 - uses: actions/checkout@v2
20462
63+ - uses: actions/setup-haskell@v1
64+ with:
65+ ghc-version: ${{ matrix.ghc_version }}
66+ cabal-version: ${{ matrix.cabal_version }}
67+
20568 - uses: actions/cache@v1
206− name: Cache common directories
69+ name: Cache ~/.cabal
20770 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
71+ path: ~/.cabal
72+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal
21573
21674 - name: Download packcheck
21775 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
76+ # If a custom stack-yaml is specified, replace the default with that
77+ if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
78+ unset STACK_YAML
79+
80+ # Get packcheck if needed
81+ CURL=$(which curl)
82+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
83+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
84+ chmod +x $PACKCHECK_LOCAL_PATH
23185
232− - name: Run tests
86+ - name: Run packcheck
23387 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
88+ 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.ignore+18−38
@@ -1,40 +1,20 @@
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
1+src/Streamly/Internal/Data/Stream/SVar.hs
62src/Streamly/Internal/Data/Stream/Serial.hs
73src/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
4+src/Streamly/Internal/Data/Stream/Parallel.hs
5+src/Streamly/Internal/Data/Stream/Async.hs
6+src/Streamly/Internal/Data/Stream/Enumeration.hs
7+src/Streamly/Internal/Data/Stream/StreamDK.hs
8+src/Streamly/Internal/Data/Stream/StreamK.hs
9+src/Streamly/Internal/Data/Stream/StreamK/Type.hs
10+src/Streamly/Internal/Data/Stream/Ahead.hs
11+src/Streamly/Internal/Data/Stream/StreamD/Type.hs
12+src/Streamly/Internal/Data/Stream/StreamDK/Type.hs
13+src/Streamly/Internal/Data/Stream/StreamD.hs
14+src/Streamly/Internal/Data/Pipe/Types.hs
15+src/Streamly/Internal/Data/SmallArray/Types.hs
16+src/Streamly/Internal/Data/Unicode/Stream.hs
17+src/Streamly/Internal/Mutable/Prim/Var.hs
18+src/Streamly/Internal/Data/Array/Prim/Types.hs
19+src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs
20+src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs
.hlint.yaml+2−18
@@ -10,8 +10,6 @@
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
@@ -23,25 +21,11 @@
2321- ignore: {name: "Use <$>"}
2422- ignore: {name: "Use uncurry"}
2523- ignore: {name: "Redundant $!"}
26−- ignore: {name: "Use fmap"}
27−- ignore: {name: "Use ++"}
2824
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}
3525
3626# Specify additional command line arguments
3727#
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− ]
28+# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
4529
4630
4731# Control which extensions/flags/modules/functions can be used
@@ -71,7 +55,7 @@
7155# Turn on hints that are off by default
7256#
7357# Ban "module X(module X) where", to require a real export list
74−- warn: {name: Use explicit module export list}
58+# - warn: {name: Use explicit module export list}
7559#
7660# Replace a $ b $ c with a . b $ c
7761# - group: {name: dollar, enabled: true}
.packcheck.ignore−34
@@ -1,36 +1,2 @@
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
91.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
182cabal.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+248
@@ -0,0 +1,248 @@
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="563702bd02c41343dcd3dfcfef0845ca428a9240"
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+ # os: linux
93+ # arch: amd64
94+
95+ # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
96+ #- env: BUILD=cabal-v2 GHCVER=8.2.2 GHC_OPTIONS="" DISABLE_BENCH=y
97+ # addons: {apt: {packages: [cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
98+
99+ - env: BUILD=cabal-v2 GHCVER=8.0.2 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flags examples-sdl"
100+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.0.2,libsdl1.2-dev], sources: [hvr-ghc]}}
101+ os: linux
102+ arch: amd64
103+
104+ - env: BUILD=cabal-v2 GHCVER=7.10.3 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flags examples-sdl"
105+ addons: {apt: {packages: [cabal-install-2.4,ghc-7.10.3,libsdl1.2-dev], sources: [hvr-ghc]}}
106+ os: linux
107+ arch: amd64
108+
109+
110+ - env: BUILD=cabal-v2 GHCVER=8.4.4 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flag debug"
111+ addons: {apt: {packages: [cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}
112+ os: linux
113+ arch: x86
114+
115+
116+ # You can specify build flags like this:
117+ #- env: BUILD=cabal-v2 CABAL_BUILD_OPTIONS="--flags=dev"
118+ # addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
119+
120+ # --------------------------------------------------------------------------
121+ # GHCJS cabal builds
122+ # --------------------------------------------------------------------------
123+
124+ # Use CABAL_BUILD_OPTIONS to pass any options to cabal e.g. project-file
125+ # DISABLE_SDIST_BUILD is set because of a cabal issue. 'cabal info'
126+ # unnecessarily requires "ghc".
127+ - env: BUILD=cabal-v2 ENABLE_GHCJS=y DISABLE_TEST=y ENABLE_INSTALL= DISABLE_DOCS=y DISABLE_SDIST_BUILD=y
128+ addons:
129+ apt:
130+ sources:
131+ - hvr-ghc
132+ - sourceline: 'ppa:hvr/ghcjs'
133+ - sourceline: 'deb https://deb.nodesource.com/node_11.x xenial main'
134+ key_url: 'https://deb.nodesource.com/gpgkey/nodesource.gpg.key'
135+ packages: [cabal-install-2.4,ghcjs-8.4]
136+
137+ # --------------------------------------------------------------------------
138+ # (Linux) stack builds (BUILD=stack). Some common envvars for stack builds
139+ # are: STACK_YAML, STACK_OPTIONS, STACK_BUILD_OPTIONS
140+ # --------------------------------------------------------------------------
141+ #
142+ # NOTE: cabal-install is required for some of the packcheck options to work.
143+ # We just install it so that packcheck does not build it from source
144+ # otherwise.
145+
146+ #- env: BUILD=stack RESOLVER=nightly
147+ # addons: {apt: {packages: [cabal-install-1.24], sources: [hvr-ghc]}}
148+
149+ - env: BUILD=stack RESOLVER=lts-14.25 GHCVER=8.6 STACK_BUILD_OPTIONS="--flag streamly:examples-sdl" SDIST_OPTIONS="--ignore-check"
150+ addons: {apt: {packages: [cabal-install-2.4,libsdl1.2-dev], sources: [hvr-ghc]}}
151+ os: linux
152+ arch: amd64
153+
154+ #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
155+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
156+
157+ # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
158+ # So disable the benchmarks for this build.
159+ #- env: BUILD=stack GHCVER=8.2.2 RESOLVER=lts-11 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y DISABLE_BENCH=y
160+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
161+
162+ #- env: BUILD=stack RESOLVER=lts-9 GHCVER=8.0
163+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
164+
165+ #- env: BUILD=stack RESOLVER=lts-6 GHCVER=7.10
166+ # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
167+
168+ # You can keep a STACK_YAML file at any path location
169+ #- env: BUILD=stack STACK_YAML=.ci/stack-8.0.yaml
170+
171+ # You can specify build flags like this:
172+ #- env: BUILD=stack RESOLVER=lts-12 STACK_BUILD_OPTIONS="--flag packcheck:dev"
173+
174+ # --------------------------------------------------------------------------
175+ # OS X builds
176+ # --------------------------------------------------------------------------
177+
178+ # GHC 8.6 cabal build using stack!
179+ # On OSX autoreconf is not installed therefore disable sdist build
180+ - env: BUILD=cabal-v2 RESOLVER=lts-14.25 GHCVER=8.6 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y
181+ os: osx
182+
183+ # GHC 8.4/stack
184+ #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
185+ # os: osx
186+
187+ # --------------------------------------------------------------------------
188+ # Lint e.g. HLINT_COMMANDS="hlint lint src; hlint lint test"
189+ # --------------------------------------------------------------------------
190+
191+ - env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="src"
192+ - env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="test benchmarks"
193+
194+ # --------------------------------------------------------------------------
195+ # Build and send coverage report to coveralls.io using hpc-coveralls. Add
196+ # your project to coveralls.io first, for available options see hpc-coveralls
197+ # docs. CAVEATS:
198+ # * Works only with BUILD=cabal-v1
199+ # * Does not work for multi-package repos
200+ # * hpc-coveralls does not build with Cabal-2.2/GHC-8.4.3. The workaround is
201+ # to have a prebuilt hpc-coveralls binary installed on the build machine
202+ # and then you can use any version of ghc.
203+ # --------------------------------------------------------------------------
204+
205+ - name: "GHC 8.10.1+inspection+Werror+coverage"
206+ env: BUILD=cabal-v2 COVERALLS_OPTIONS=" --repo-token=9ezA743hCAcmzX3Ic273LhNlIXVdl7D1l --coverage-mode=StrictlyFullLines --exclude-dir=test" CABAL_PROJECT="cabal.project.coverage" GHC_OPTIONS=""
207+ addons: {apt: {packages: [cabal-install-3.2,ghc-8.10.1], sources: [hvr-ghc]}}
208+
209+ # --------------------------------------------------------------------------
210+ # Builds that are allowed to fail
211+ # --------------------------------------------------------------------------
212+
213+ allow_failures:
214+ - env: BUILD=cabal-v2 GHCVER=head GHC_OPTIONS=""
215+ - env: BUILD=stack RESOLVER=nightly DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y
216+ - env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="test benchmarks"
217+
218+# ------------------------------------------------------------------------
219+# Settings beyond this point are advanced and normally not tweaked
220+# ------------------------------------------------------------------------
221+
222+language: generic
223+sudo: false
224+cache:
225+ directories:
226+ - $HOME/.cabal
227+ - $HOME/.ghc
228+ - $HOME/.ghcjs
229+ - $HOME/.local
230+ - $HOME/.stack
231+install: true
232+
233+script:
234+ - |
235+ # If a custom stack-yaml is specified, replace the default with that
236+ if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
237+ unset STACK_YAML
238+
239+ # Get packcheck if needed
240+ CURL=$(which curl)
241+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
242+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
243+ chmod +x $PACKCHECK_LOCAL_PATH
244+
245+ # This script is governed by various PACKCHECK envvars that are set above.
246+ # In addition, hpc-coveralls needs TRAVIS, TRAVIS_JOB_ID variables set by
247+ # the travis CI environment.
248+ - 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+221−1
@@ -1 +0,0 @@
1−docs/Developer/Contributing.md
@@ -0,0 +1,221 @@
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+The first level of check is the regression in "allocations", this is
112+the most stable measure of regression. "bytesCopied" is another stable
113+measure, it gives an idea of the amount of long lived data being copied
114+across generations of GC.
115+
116+The next measure to look at is "cpuTime" this may have some variance
117+from run to run because of factors like cpu frequency scaling, load on
118+the system or the number of context switches etc. However, the variance
119+would usually be within 5-10%, anything more than that is likely to be a
120+red flag.
121+
122+Quite often an increase in "cpuTime" would correspond to an increase
123+in "allocations". Increase in "allocations" indicates an inefficiency
124+in computing due to too much GC activity e.g. due to lack of
125+fusion. However, it is also possible for the cpu time to go up without
126+the allocations going up, this indicates an inefficiency in processing
127+in general or more CPU being used for the same task. It could be because
128+of inefficient code generation, branch mis-predictions or lack of cache
129+locality etc.
130+
131+For concurrent benchmarks we can compare "cpuTime" and "time" to check
132+the degree of concurrency and total efficiency.
133+
134+### Changelog
135+
136+Any new changes that affect the user of the library in some way must be
137+documented under `Unreleased` section at the top of the `Changelog`. The
138+changes in the changelog must be organized in the following categories, in that
139+order:
140+
141+* Breaking Changes
142+* Enhancements
143+* Bug Fixes
144+* Deprecations
145+
146+If there are very few changes then you can just prefix a bullet with these
147+annotations. If there are many changes make sections to group them. A section
148+can be absent if there is nothing to add in it.
149+
150+If you make changes that are incompatible with the released versions
151+of the library please indicate that in the `Changelog` as `Breaking Changes`
152+and also write short notes regarding what the programmers need to do to adapt
153+their existing code to the new change.
154+
155+## Developer documentation
156+
157+To build haddock documentation for all modules, including the ones not exposed
158+to users of the library, use the following commands:
159+
160+```
161+$ cabal haddock
162+$ stack haddock --no-haddock-deps
163+```
164+
165+For design documentation see the `design` directory.
166+
167+## Coding Guidelines
168+
169+### Coding Style
170+
171+Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).
172+
173+### StreamD coding style
174+
175+Some conventions that we follow in the StreamD code are illustrated by the
176+following example:
177+
178+```
179+mapM f (Stream step1 state1) = Stream step state
180+ where
181+
182+ step gst st = do
183+ r <- step1 (adaptState gst) st
184+ case r of
185+ Yield x s -> f x >>= \a -> return $ Yield a s
186+ Skip s -> return $ Skip s
187+ Stop -> return Stop
188+```
189+
190+* For the input streams use numbering for `step` and `state` e.g.
191+ step1/state1. For the output stream use `step` and `state`.
192+* For state argument of `step`, use `st`.
193+* For result of executing a `step` use `r` or `res`
194+* For the yielded element use `x`
195+* For the yielded state use `s`
196+
197+In general, the rule is - the shorter the scope of a variable the shorter its
198+name can be. For example, `s` has the shortest scope in the above code, `st`
199+has a bigger scope and `state` has the biggest scope.
200+
201+For better fusion we try to keep a single yield point in the state machine.
202+
203+### Tricky Parts
204+
205+The state-passing through each API is currently fragile. Every time we run a
206+stream we need to be careful about the state we are passing to it. In case of
207+folds where there is no incoming state, we start with the initial state
208+`defState`. When we have an incoming state passed to us there are two cases:
209+
210+1. When we are building a concurrent stream that needs to share the same `SVar`
211+ we pass the incoming state as is.
212+2. In all other cases we must not share the SVar and every time we pass on the
213+ state to run a stream we must use `adaptState` to reset the `SVar` in the
214+ state.
215+
216+When in doubt just use `adaptState` on the state before passing it on, we will at
217+most lose concurrency but the behavior will be correct.
218+
219+There is no type level enforcement about this as of now, and therefore we need
220+to be careful when coding. There are specific tests to detect and report any
221+problems due to this, all transform operations must be added to those tests.
docs/User/Project/Changelog.md → Changelog.mdrenamed+23−256
@@ -1,252 +1,19 @@
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.
1+## Unreleased
1702
1713### Breaking changes
1724
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.
5+* Change the signature of `foldlM'` to make the initial value of the
6+ accumulator monadic.
7+* Change the signature of `concatMapWith` to ensure that it can be
8+ used with a wide variety of combining functions.
1889
18910### Bug Fixes
19011
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
12+* `accept*` and `connect` APIs in `Streamly.Network.Inet.TCP` and the `accept`
13+ API in `Streamly.Network.Socket` now close the socket if an exception is
20314 thrown.
20415
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)
16+## 0.7.2
25017
25118### Bug Fixes
25219
@@ -262,7 +29,7 @@ Bug fixes:
26229* Now builds with newer `QuickCheck` package version >= 2.14 && < 2.15.
26330* Now builds with GHC 8.10.
26431
265−## 0.7.1 (February 2020)
32+## 0.7.1
26633
26734### Bug Fixes
26835
@@ -291,7 +58,7 @@ Bug fixes:
29158* Significant improvement in performance of concurrent stream operations.
29259* Improved space and time performance of `Foldable` instance.
29360
294−## 0.7.0 (November 2019)
61+## 0.7.0
29562
29663### Breaking changes
29764
@@ -405,7 +172,7 @@ concurrently using this.
405172 effects
406173 * `tap` redirects a copy of the stream to a `Fold`
407174
408−## 0.6.1 (March 2019)
175+## 0.6.1
409176
410177### Bug Fixes
411178
@@ -417,7 +184,7 @@ concurrently using this.
417184* Add GHCJS support
418185* Remove dependency on "clock" package
419186
420−## 0.6.0 (December 2018)
187+## 0.6.0
421188
422189### Breaking changes
423190
@@ -445,7 +212,7 @@ concurrently using this.
445212* Performance improvements
446213* Add benchmarks to measure composed and iterated operations
447214
448−## 0.5.2 (October 2018)
215+## 0.5.2
449216
450217### Bug Fixes
451218
@@ -460,12 +227,12 @@ concurrently using this.
460227 used in a stateful monad e.g. `StateT`. Particularly, this bug cannot affect
461228 `ReaderT`.
462229
463−## 0.5.1 (September 2018)
230+## 0.5.1
464231
465232* Performance improvements, especially space consumption, for concurrent
466233 streams
467234
468−## 0.5.0 (September 2018)
235+## 0.5.0
469236
470237### Bug Fixes
471238
@@ -491,13 +258,13 @@ concurrently using this.
491258* The `Streamly.Time` module is now deprecated, its functionality is subsumed
492259 by the new rate limiting combinators.
493260
494−## 0.4.1 (July 2018)
261+## 0.4.1
495262
496263### Bug Fixes
497264
498265* foldxM was not fully strict, fixed.
499266
500−## 0.4.0 (July 2018)
267+## 0.4.0
501268
502269### Breaking changes
503270
@@ -524,7 +291,7 @@ concurrently using this.
524291* Add `takeWhileM` and `dropWhileM`
525292* Add `filterM`
526293
527−## 0.3.0 (June 2018)
294+## 0.3.0
528295
529296### Breaking changes
530297
@@ -552,14 +319,14 @@ concurrently using this.
552319 stream processing function application pipeline concurrently.
553320* Added `mapMaybe` and `mapMaybeM`.
554321
555−## 0.2.1 (June 2018)
322+## 0.2.1
556323
557324### Bug Fixes
558325* Fixed a bug that caused some transformation ops to return incorrect results
559326 when used with concurrent streams. The affected ops are `take`, `filter`,
560327 `takeWhile`, `drop`, `dropWhile`, and `reverse`.
561328
562−## 0.2.0 (May 2018)
329+## 0.2.0
563330
564331### Breaking changes
565332* Changed the semantics of the Semigroup instance for `InterleavedT`, `AsyncT`
@@ -637,7 +404,7 @@ concurrently using this.
637404* Put a bound (1500) on the output buffer used for asynchronous tasks
638405* Put a limit (1500) on the number of threads used for Async and WAsync types
639406
640−## 0.1.2 (March 2018)
407+## 0.1.2
641408
642409### Enhancements
643410* Add `iterate`, `iterateM` stream operations
@@ -646,7 +413,7 @@ concurrently using this.
646413* Fixed a bug that caused unexpected behavior when `pure` was used to inject
647414 values in Applicative composition of `ZipStream` and `ZipAsync` types.
648415
649−## 0.1.1 (March 2018)
416+## 0.1.1
650417
651418### Enhancements
652419* Make `cons` right associative and provide an operator form `.:` for it
@@ -657,6 +424,6 @@ concurrently using this.
657424* Fix the `product` operation. Earlier, it always returned 0 due to a bug
658425* Fix the `last` operation, which returned `Nothing` for singleton streams
659426
660−## 0.1.0 (December 2017)
427+## 0.1.0
661428
662429* Initial release
INSTALL.mdnew file+298
@@ -0,0 +1,298 @@
1+<!--
2+Portions (c) 2020, Google LLC.
3+SPDX-License-Identifer: BSD-3-Clause
4+-->
5+
6+# Getting started with the `streamly` package
7+
8+This guide will show you how to write a simple program that uses
9+`streamly`, using the [`cabal`](https://www.haskell.org/cabal/) build
10+manager for Haskell.
11+
12+<!-- TODO: Add instructions for `stack` and `nix`.
13+
14+If you are using `stack` or `nix` please make sure to add the latest
15+version from Hackage to your tool configuration. -->
16+
17+No prior knowledge of either Haskell or of `cabal` is needed. We do
18+however assume that you are using a command-line shell on a POSIX
19+operating system. If you are running Windows&trade; then you may need
20+to run a command-line shell under `msys` and some of the commands
21+below may also need to be changed in small ways to make them work.
22+
23+**Note**: If you are new to Haskell you may find the [Haskell Getting
24+Started
25+Guide](https://github.com/composewell/haskell-dev/blob/master/getting-started.rst)
26+to be useful.
27+
28+If you know your way around Haskell, and have an up to date toolchain
29+already installed, then you can jump straight to the section titled
30+"[_Prepare Your Build Directory_](#user-content-prepare-your-build-directory)".
31+
32+## Getting started with `streamly` using `cabal`
33+
34+To get started, you will need a recent `cabal` binary to be installed
35+on your system.
36+
37+### Installing `cabal`
38+
39+A pre-packaged `cabal` binary may already be available for your
40+operating system.
41+
42+For example, on Debian GNU/Linux, you could install `cabal` using::
43+
44+```
45+$ sudo apt install cabal-install
46+```
47+
48+### Installing `ghc`
49+
50+You would also need to install the Glasgow Haskell Compiler `ghc`. In
51+most operating systems, using the system's package manager to install
52+`cabal` would also bring in a version of `ghc` as a dependency.
53+
54+Please verify that `ghc` is present:
55+
56+```
57+$ ghc --version
58+The Glorious Glasgow Haskell Compilation System, version 8.0.2
59+```
60+
61+If `ghc` isn't present, please install it using your operating
62+system's package manager. For example, on Debian GNU/Linux, use:
63+
64+```
65+$ sudo apt install ghc
66+```
67+
68+### Update `cabal` if necessary
69+
70+Many operating systems ship an old version of `cabal`; in order to use
71+`streamly` you should use `cabal` version 3.0 (or later).
72+
73+You can check the installed version of `cabal` by using its
74+`--version` flag:
75+
76+```
77+$ which cabal
78+/usr/bin/cabal
79+$ /usr/bin/cabal --version
80+cabal-install version 1.24.0.2
81+compiled using version 1.24.2.0 of the Cabal library
82+```
83+
84+In this example, the installed `cabal` binary is too old for our
85+needs. It would need to be upgraded.
86+
87+You can ask `cabal` to upgrade itself (please see
88+<https://www.haskell.org/cabal/>):
89+
90+```
91+$ cabal install Cabal cabal-install
92+Resolving dependencies...
93+Downloading base16-bytestring-0.1.1.7...
94+... lots of build output ...
95+Building cabal-install-3.0.0.0...
96+Installed cabal-install-3.0.0.0
97+```
98+
99+`cabal` will usually place its compiled binaries inside the directory
100+`$HOME/.cabal/bin`.
101+
102+You can verify the version of your newly installed binary by using the
103+`--version` flag again:
104+
105+```
106+$ $HOME/.cabal/bin/cabal --version
107+cabal-install version 3.0.0.0
108+compiled using version 3.0.2.0 of the Cabal library
109+```
110+
111+If you have upgraded `cabal`, do be sure to specify `$HOME/.cabal/bin`
112+early in your `PATH` shell variable, so that the new binary gets used
113+instead of the older version on your system.
114+
115+```
116+$ PATH=$HOME/.cabal/bin:$PATH
117+```
118+
119+Once you have `cabal` version 3.0 (or later) successfully installed,
120+please refresh its package list by using `cabal update`.
121+
122+```
123+$ cabal update
124+Downloading the latest package list from hackage.haskell.org
125+```
126+
127+### Prepare Your Build Directory
128+
129+Next, create a build directory, so that you can use `cabal`'s isolated
130+builds feature.
131+
132+```
133+$ mkdir streamly-play
134+$ cd streamly-play
135+```
136+
137+Run `cabal init` to create an initial set of project files:
138+
139+```
140+$ cabal init --minimal --dependency base --dependency streamly
141+
142+Generating LICENSE...
143+... other messages ...
144+Generating Main.hs...
145+Generating streamly-play.cabal...
146+
147+Warning: no synopsis given. You should edit the .cabal file and add one.
148+You may want to edit the .cabal file and add a Description field.
149+```
150+
151+This invocation will set up a build with two build dependencies,
152+namely `base` and `streamly`. You can add additional dependencies
153+later, by editing the `build-depends` section of the generated cabal
154+file `streamly-play.cabal`. Please see the [Cabal User
155+Guide](https://www.haskell.org/cabal/users-guide/) for more
156+information on how to configure `cabal`.
157+
158+This invocation also creates a skeletal `Main.hs` program which we
159+will use later.
160+
161+### Try `streamly` in the GHCi REPL
162+
163+You can now try out `streamly` using the `GHCi` interpreter's
164+read-eval-print-loop (REPL) facility.
165+
166+To start up the GHCi REPL using the released `streamly` version on
167+Hackage, please use:
168+
169+```
170+$ cabal repl --build-depends streamly
171+... plenty of build messaages, the first time around ...
172+GHCi, version 8.8.3: https://www.haskell.org/ghc/ :? for help
173+[1 of 1] Compiling Main ( Main.hs, interpreted )
174+Ok, one module loaded.
175+*Main>
176+```
177+
178+Once at the `*Main>` prompt, you can import `streamly` and use it
179+directly:
180+
181+```
182+*Main> import qualified Streamly.Prelude as S
183+
184+*Main S> S.drain $ S.mapM print $ S.fromList [1..3]
185+1
186+2
187+3
188+*Main S>
189+```
190+
191+For the curious, here is a high level overview of what these lines
192+do:
193+
194+1. `import qualified Streamly.Prelude as S` imports the Streamly
195+ prelude into GHCi, and makes it available as module `S`.
196+2. `[1..3]` generates the Haskell list `[1, 2, 3]`.
197+3. `S.fromList` transforms that list into a stream of integers.
198+4. `S.mapM print` transforms the stream of integers into a stream of
199+ actions that would print those integers when executed.
200+5. `S.drain` transforms that stream of actions into an IO action that
201+ `main` or GHCi's REPL can execute.
202+
203+These concepts are explained in greater detail in the [Streamly
204+Tutorial][tutorial].
205+
206+#### Using a specific version of `streamly` in the REPL
207+
208+You can also ask `cabal` to use a specific version of `streamly` by
209+adding a version number constraint to the `--build-depends` flag:
210+
211+```
212+$ cabal repl --build-depends streamly==0.7.2
213+[1 of 1] Compiling Main ( Main.hs, interpreted )
214+Ok, modules loaded: Main.
215+*Main>
216+```
217+
218+#### (Advanced) Using the development version of `streamly` in the REPL
219+
220+To use the development version of `streamly`, we need to configure
221+`cabal` to fetch it from Github.
222+
223+Create a `cabal.project` file in the current directory with the
224+following content:
225+
226+```
227+packages: .
228+source-repository-package
229+ type: git
230+ location: https://github.com/composewell/streamly
231+ tag: master
232+```
233+
234+With this file present, `cabal` will fetch and build the current
235+version of `streamly` from Github every time it is run. For example:
236+
237+```
238+$ cabal repl
239+... fetches the 'master' branch of streamly from Github ...
240+... build messages ...
241+[1 of 1] Compiling Main v ( Main.hs, interpreted )
242+Ok, modules loaded: Main.
243+*Main>
244+```
245+
246+### Using `streamly` in a standalone program
247+
248+Let us now turn the single-line stanza above into a standalone program
249+that uses `streamly`.
250+
251+Edit `Main.hs` to contain the following:
252+
253+```haskell
254+module Main where
255+
256+import qualified Streamly.Prelude as S
257+
258+main :: IO ()
259+main = S.drain $ S.mapM print $ S.fromList [1..3]
260+```
261+
262+Build and run this program using `cabal run`:
263+
264+```
265+$ cabal run
266+... build messages ...
267+1
268+2
269+3
270+```
271+
272+## Which version of `streamly` should you use?
273+
274+If you are new to Streamly, we recommend using latest [stable release
275+of streamly][streamly-hackage] on Hackage.
276+
277+If you need access to cutting edge features (and do not mind the
278+occasional breakage), please use the [development version of
279+streamly][streamly-github] on Github.
280+
281+
282+## Next Steps
283+
284+If you got this far successfully, congratulations!
285+
286+* For an overview of the `streamly` package, please read the
287+ [Streamly Tutorial][tutorial].
288+* Please browse the code examples in the
289+ [`examples`](./examples/README.md) directory.
290+* If you would like to start on a real world project, please take a
291+ look at the [recommended compilation options](./docs/Build.md).
292+
293+
294+<!-- Markdown Links -->
295+
296+ [tutorial]: https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html
297+ [streamly-hackage]: https://hackage.haskell.org/package/streamly
298+ [streamly-github]: https://github.com/composewell/streamly
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+219
@@ -0,0 +1,219 @@
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+* Identify breaking changes, or changes that may require depndency
14+ version bound changes. See https://pvp.haskell.org/. Also see the
15+ "Breaking changes section below".
16+* Optionally, look at hlint output if anything in that is worth fixing.
17+* Merge the PR by rebasing. Note that github always creates new commits when
18+ merged with rebase, it records the committer as well as the author in the
19+ commit. This makes the local branch diverge from master. You can rebase and
20+ merge the commit manually in your local git tree and push the resulting
21+ master branch to avoid new commits and divergence from the original tree.
22+
23+## Release Checklist
24+
25+* Check if any critical pending bugs or issues are to be included
26+* If this is a major release check if any previously deprecated features are to
27+ be removed in this release.
28+* _Documentation_:
29+
30+ * README is updated
31+ * Haddock docs are consistent with the changes in the release
32+ * Tutorial has been updated for new changes
33+ * Documents in the `docs` directory are consistent with new changes
34+ * All combinators have time and space complexity annotations
35+ * All combinators have `since` annotation
36+
37+* _Benchmarks_:
38+
39+ * Check regressions from previous release
40+ * Run benchmarks with large stream size (`bench.sh -- long`) to
41+ check for space leaks and to ensure constant memory usage for streaming
42+ operations.
43+ * Run benchmarks with `dev` flag on. Some `fileio` benchmarks are disabled
44+ in regular runs.
45+ * Check comparative benchmarks using streaming-benchmarks
46+
47+* _Tests_:
48+
49+ * Run tests with `dev` flag on. Many tests are disabled in regular runs.
50+
51+* _Update Package Metadata:_
52+
53+ * Update `stack.yaml` to latest stable resolver, cleanup extra-deps
54+ * Make sure the description in cabal file is in sync with README and other docs
55+ * Make sure CI configs include last three major releases of GHC in CI testing.
56+ * Update `tested-with` field
57+ * Make sure all dependency bounds can use latest versions
58+ * Make sure any additional files are added to `extra-source-files` in cabal
59+ file
60+
61+* Copyrights and Contibutors
62+
63+ * Make sure contributors to the release are listed in
64+ `credits/CONTRIBUTORS.md`.
65+ * Bump the release version in `credits/CONTRIBUTORS.md`.
66+ * Make sure any third party code included in the release has been listed in
67+ `credits/COPYRIGHTS.md` and the license is added to the repo.
68+ * Change the `Unreleased` section, if exists, at the top of
69+ `credits/COPYRIGHTS.md` to the new release version number.
70+
71+* _Update changelog & Version_:
72+
73+ * Make sure all the bug fixes being included in this release are marked
74+ with a target release on github. So that users can search by release if
75+ they want.
76+ * Change the `Unreleased` section at the top of changelog file to the new
77+ release version number.
78+ * Bump the package version in cabal file or package.yaml
79+ * Bump the package version in configure.ac and run autoreconf
80+
81+* _Upload_:
82+
83+ * Wait for final CI tests to pass:
84+
85+ * Create a git tag corresponding to the release where X.Y.Z is the new
86+ package version (`git tag vX.Y.Z && git push -f origin vX.Y.Z`).
87+ * Mask out the build status lines from the README
88+ * Upload to hackage
89+ * Use a clean workspace to create source distribution
90+ by freshly cloning the git repository. The reason for
91+ doing this is that we use wild-cards in cabal file for
92+ `extra-source-files`, these wild-cards may match additional
93+ files lying around in the workspace and unintentionally ship
94+ them as well.
95+ * `cabal v2-sdist`; `cabal upload --publish <tarpath>`
96+ * `stack upload .`
97+ * Add to stackage (`build-constraints.yaml` in Stackage repo) if needed
98+ * Optionally upload `package-X.Y.Z-sdist.tar.gz` to github release page
99+ * Update release contributors on github release page
100+ (`git shortlog -s prev_tag..new_tag | sed $'s/^[0-9 \t]*/* /' | sort -f`)
101+ * Update and if needed release streaming-benchmarks package
102+ * Check https://matrix.hackage.haskell.org/package/streamly
103+ * Check haddocks on Hackage, upload if not built
104+ * Announce to haskell-cafe@haskell.org
105+
106+## Breaking Changes
107+
108+This section lists what constitutes breaking changes. See
109+https://pvp.haskell.org/ breaking changes that can be determined by the
110+API alone. We specify some additional recommendations here:
111+
112+Behavior changes, this kind of changes are nasty and should be avoided. If such
113+changes are made they should be emphasized adequately in the changelog:
114+
115+* Silent changes in the behavior of an API without any changes to the
116+ signature.
117+* Even fixing a bug could break things as users may have employed workarounds
118+ for the bug.
119+* Changes in the behavior of a dependency may also cause a change in behavior.
120+
121+Be cautious about the following:
122+
123+* Change in version bounds of dependencies may cause compilation failure for
124+ some programs because they may not be able to find a build plan.
125+* Ideally, new warnings should not be considered breaking, dependencies
126+ should never be compiled with -Werror. But packages may not be following
127+ it perfectly.
128+* Deprecating an API may issue new warnings, however the code can still be
129+ compiled if warnings are not treated as errors.
130+
131+Internal APIs:
132+
133+* Internal APIs can change without having to change the major version. However,
134+ we should try to align the Internal API changes with a major release as long
135+ as possible.
136+
137+## Managing Issues
138+
139+### User Impacting Changes
140+
141+__RULE__: Any commit that may affect the end user in some way MUST have either a
142+changelog entry OR MUST have an issue marked with one of the following labels
143+OR both. We can have more than one of these labels on the same issue e.g.
144+breaking, enhancement:
145+
146+* breaking
147+* deprecating
148+* enhancement
149+* performance
150+* usability
151+* documentation
152+* bug
153+
154+Note that if you are making a big feature change you may have a single issue
155+for that feature and attach many commits with it. So you do not necessarily
156+need to have an issue for each commit.
157+
158+### Maintenance Changes
159+
160+Commits that do not impact the end user in any way are not required to have a
161+changelog entry or an issue. Issues that do not have a corresponding commit
162+may be left without a label but preferably should be marked with one of the
163+following:
164+
165+* question
166+* discussion
167+* maintenance
168+* testing
169+* invalid
170+* wontfix
171+
172+### Feature Labels
173+
174+For big features with many issues we can introduce a custom feature label to
175+group the issues together.
176+
177+### Other Labels
178+
179+* help wanted
180+* duplicate
181+* deferred
182+
183+## Correlating Changes, Issues and Releases
184+
185+For planning purposes, open issues may be marked with milestones or target
186+releases. However, it may not always be known which release a fix will finally
187+land in. For example, we may decide to make a minor release instead of a major
188+one if there are no breaking changes yet, so we may not always know what would
189+be the next release version.
190+
191+Trackability means that we should be able to find which issues got fixed in
192+which release. Or what all issues got fixed in a particular release. We track
193+significant changes using the changelog. However, there may be more changes
194+that can only be tracked via issues, PRs or commits. When we make a release we
195+can mark all the issues fixed in that release with a correct release target for
196+future trackability.
197+
198+For better trackability of which issue got fixed in which release we need the
199+following:
200+
201+* Before you close an issue make sure a commit or a PR fixing the issue is
202+ attached with it. In the commit message you can reference an issue like
203+ "fixes #50", you can do the same in a PR as well.
204+* Before we make a new release EVERY issue with a commit included in that
205+ release that affects the end user, especially bugs and breaking changes MUST
206+ have the target release correctly set.
207+
208+## Changelog Management
209+
210+Keep the unreleased changes in the `Unreleased` section at the top of changelog
211+file. Using `Unreleased` instead of the next release number for unreleased
212+changes is important. First, we do not know the next release number in advance,
213+it could be a major or minor release. Second, if we use the next release
214+number instead, then when adding a new change to the changelog, at one look we
215+cannot know whether the release number on top is unreleased or released.
216+
217+## TODO
218+
219+* 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](http://hackage.haskell.org/package/vector))
601+ * Gabriel Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))
602+ * Alberto G. Corona ([transient](https://hackage.haskell.org/package/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-14.25"
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: "563702bd02c41343dcd3dfcfef0845ca428a9240"
6967
7068 # Override the temp directory to avoid sed escaping issues
7169 # See https://github.com/haskell/cabal/issues/5386
bench.shnew file+598
@@ -0,0 +1,598 @@
1+#!/bin/bash
2+
3+#------------------------------------------------------------------------------
4+# Benchmark groups
5+#------------------------------------------------------------------------------
6+
7+# IMPORTANT NOTE: the names "_grp" and "_cmp" suffixes are special, do
8+# not rename them to something else.
9+
10+base_stream_grp="\
11+ Data.Stream.StreamD \
12+ Data.Stream.StreamK \
13+ Data.Stream.StreamDK"
14+
15+prelude_serial_grp="\
16+ Prelude.Serial \
17+ Prelude.WSerial \
18+ Prelude.ZipSerial"
19+
20+prelude_concurrent_grp="\
21+ Prelude.Async \
22+ Prelude.WAsync \
23+ Prelude.Ahead \
24+ Prelude.Parallel \
25+ Prelude.ZipAsync"
26+
27+prelude_other_grp="\
28+ Prelude.Rate \
29+ Prelude.Concurrent \
30+ Prelude.Adaptive"
31+
32+array_grp="\
33+ Memory.Array \
34+ Data.Array \
35+ Data.Array.Prim \
36+ Data.SmallArray \
37+ Data.Array.Prim.Pinned"
38+
39+base_parser_grp="Data.Parser.ParserD Data.Parser.ParserK"
40+parser_grp="Data.Fold Data.Parser"
41+
42+#------------------------------------------------------------------------------
43+# Streaming vs non-streaming
44+#------------------------------------------------------------------------------
45+# The "o-1-space" groups of these benchmarks are run with long stream
46+# sizes when --long option is used.
47+
48+infinite_grp="\
49+ $prelude_serial_grp \
50+ $prelude_concurrent_grp \
51+ Prelude.Rate"
52+
53+#------------------------------------------------------------------------------
54+# Comparison groups
55+#------------------------------------------------------------------------------
56+# *_cmp denotes a comparison benchmarks, the benchmarks provided in *_cmp
57+# variables are compared with each other
58+base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"
59+serial_wserial_cmp="Prelude.Serial Prelude.WSerial"
60+serial_async_cmp="Prelude.Serial Prelude.Async"
61+concurrent_cmp="Prelude.Async Prelude.WAsync Prelude.Ahead Prelude.Parallel"
62+array_cmp="Memory.Array Data.Array.Prim Data.Array Data.Array.Prim.Pinned"
63+pinned_array_cmp="Memory.Array Data.Array.Prim.Pinned"
64+base_parser_cmp=$base_parser_grp
65+COMPARISONS="\
66+ base_stream_cmp \
67+ serial_wserial_cmp \
68+ serial_async_cmp \
69+ concurrent_cmp \
70+ array_cmp \
71+ pinned_array_cmp \
72+ base_parser_cmp"
73+
74+#------------------------------------------------------------------------------
75+# All
76+#------------------------------------------------------------------------------
77+# All high level benchmarks
78+all_grp="\
79+ $prelude_serial_grp \
80+ $prelude_concurrent_grp \
81+ $array_grp \
82+ $parser_grp \
83+ Data.Unfold \
84+ FileSystem.Handle"
85+
86+ALL_BENCH_GROUPS="\
87+ all_grp \
88+ prelude_serial_grp \
89+ prelude_concurrent_grp \
90+ array_grp \
91+ infinite_grp \
92+ base_stream_grp \
93+ base_parser_grp"
94+
95+#------------------------------------------------------------------------------
96+# Script
97+#------------------------------------------------------------------------------
98+
99+BENCH_SH_DIR=$(dirname $0)
100+
101+list_benches () {
102+ echo "Individual benchmarks:"
103+ for i in $all_grp
104+ do
105+ echo "$i"
106+ done
107+ echo
108+}
109+
110+list_bench_groups () {
111+ echo "Benchmark groups:"
112+ for i in $ALL_BENCH_GROUPS
113+ do
114+ echo -n "$i ["
115+ eval "echo -n \$$i"
116+ echo "]"
117+ done
118+ echo
119+}
120+
121+list_comparisons () {
122+ echo "Comparison groups:"
123+ for i in $COMPARISONS
124+ do
125+ echo -n "$i ["
126+ eval "echo -n \$$i"
127+ echo "]"
128+ done
129+ echo
130+}
131+
132+print_help () {
133+ echo "Usage: $0 "
134+ echo " [--benchmarks <"bench1 bench2 ..." | help>]"
135+ echo " [--fields <"field1 field2 ..." | help>]"
136+ echo " [--graphs]"
137+ echo " [--no-measure]"
138+ echo " [--append]"
139+ echo " [--long]"
140+ echo " [--slow]"
141+ echo " [--quick]"
142+ echo " [--cabal-build-flags <flag>]"
143+ echo " [--compare] [--base <commit>] [--candidate <commit>]"
144+ echo " -- <gauge options or benchmarks>"
145+ echo
146+ echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"
147+ echo "--fields: measurement fields to report, use 'help' for a list"
148+ echo "--graphs: Generate graphical reports"
149+ echo "--no-measure: Don't run benchmarks, run reports from previous results"
150+ echo "--append: Don't overwrite previous results, append for comparison"
151+ echo "--long: Use much longer stream size for infinite stream benchmarks"
152+ echo "--slow: Slightly more accurate results at the expense of speed"
153+ echo "--quick: Faster results, useful for longer benchmarks"
154+ echo "--cabal-build-flags: Pass any cabal builds flags to be used for build"
155+ echo
156+ echo "When specific space complexity group is chosen then (and only then) "
157+ echo "RTS memory restrictions are used accordingly. For example, "
158+ echo "bench.sh --benchmarks Data.Parser -- Data.Parser/o-1-space "
159+ echo "restricts Heap/Stack space for O(1) characterstics"
160+ echo
161+ echo "When using --compare, by default comparative chart of HEAD^ vs HEAD"
162+ echo "commit is generated, in the 'charts' directory."
163+ echo "Use --base and --candidate to select the commits to compare."
164+ echo
165+ echo "Any arguments after a '--' are passed directly to gauge"
166+ exit
167+}
168+
169+# $1: message
170+die () {
171+ >&2 echo -e "Error: $1"
172+ exit 1
173+}
174+
175+set_benchmarks() {
176+ if test -z "$BENCHMARKS"
177+ then
178+ echo $DEFAULT_BENCHMARKS
179+ else
180+ for i in $(echo $BENCHMARKS)
181+ do
182+ case $i in
183+ *_grp) eval "echo -n \$${i}" ;;
184+ *_cmp) eval "echo -n \$${i} $i" ;;
185+ *) echo -n $i ;;
186+ esac
187+ echo -n " "
188+ done
189+ fi
190+}
191+
192+find_report_prog() {
193+ local prog_name="chart"
194+ hash -r
195+ local prog_path=$($WHICH_COMMAND $prog_name)
196+ if test -x "$prog_path"
197+ then
198+ echo $prog_path
199+ else
200+ return 1
201+ fi
202+}
203+
204+build_report_prog() {
205+ local prog_name="chart"
206+ local prog_path=$($WHICH_COMMAND $prog_name)
207+
208+ hash -r
209+ if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"
210+ then
211+ echo "Building bench-graph executables"
212+ BUILD_ONCE=1
213+ $BUILD_CHART_EXE || die "build failed"
214+ elif test ! -x "$prog_path"
215+ then
216+ return 1
217+ fi
218+ return 0
219+}
220+
221+build_report_progs() {
222+ if test "$RAW" = "0"
223+ then
224+ build_report_prog || exit 1
225+ local prog
226+ prog=$(find_report_prog) || \
227+ die "Cannot find bench-graph executable"
228+ echo "Using bench-graph executable [$prog]"
229+ fi
230+}
231+
232+# We run the benchmarks in isolation in a separate process so that different
233+# benchmarks do not interfere with other. To enable that we need to pass the
234+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
235+# own path currently.
236+
237+# The path is dependent on the architecture and cabal version.
238+# Use this command to find the exe if this script fails with an error:
239+# find .stack-work/ -type f -name "benchmarks"
240+
241+stack_bench_prog () {
242+ local bench_name=$1
243+ local bench_prog=`stack path --dist-dir`/build/$bench_name/$bench_name
244+ if test -x "$bench_prog"
245+ then
246+ echo $bench_prog
247+ else
248+ return 1
249+ fi
250+}
251+
252+cabal_bench_prog () {
253+ local bench_name=$1
254+ local bench_prog=`$WHICH_COMMAND $1`
255+ if test -x "$bench_prog"
256+ then
257+ echo $bench_prog
258+ else
259+ return 1
260+ fi
261+}
262+
263+bench_output_file() {
264+ local bench_name=$1
265+ echo "charts/$bench_name/results.csv"
266+}
267+
268+# $1: command
269+function run_verbose() {
270+ echo "$*"
271+ bash -c "$*"
272+}
273+
274+# --min-duration 0 means exactly one iteration per sample. We use a million
275+# iterations in the benchmarking code explicitly and do not use the iterations
276+# done by the benchmarking tool.
277+#
278+# Benchmarking tool by default discards the first iteration to remove
279+# aberrations due to initial evaluations etc. We do not discard it because we
280+# are anyway doing iterations in the benchmarking code and many of them so that
281+# any constant factor gets amortized and anyway it is a cost that we pay in
282+# real life.
283+#
284+# We can pass --min-samples value from the command line as second argument
285+# after the benchmark name in case we want to use more than one sample.
286+
287+run_bench () {
288+ local bench_name=$1
289+ local bench_exe=$bench_name
290+ local output_file=$(bench_output_file $bench_name)
291+ local bench_prog
292+ bench_prog=$($GET_BENCH_PROG $bench_exe) || \
293+ die "Cannot find benchmark executable for benchmark $bench_name"
294+
295+ mkdir -p `dirname $output_file`
296+
297+ echo "Running benchmark $bench_name ..."
298+
299+ local QUICK_OPTS="--quick --min-duration 0"
300+ local SPEED_OPTIONS
301+ if test "$LONG" -eq 0
302+ then
303+ if test "$SLOW" -eq 0
304+ then
305+ export QUICK_MODE
306+ if test "$QUICK_MODE" -eq 0
307+ then
308+ # default mode, not super quick, not slow
309+ SPEED_OPTIONS="$QUICK_OPTS --min-samples 10 --time-limit 1"
310+ else
311+ # super quick but less accurate
312+ SPEED_OPTIONS="$QUICK_OPTS --time-limit 0 --include-first-iter"
313+ fi
314+ else
315+ # Slow but more accurate mode
316+ SPEED_OPTIONS="--min-duration 0"
317+ fi
318+ else
319+ # large stream size, always super quick
320+ GAUGE_ARGS="$GAUGE_ARGS $bench_name/o-1-space"
321+ SPEED_OPTIONS="--stream-size 10000000 $QUICK_OPTS --include-first-iter"
322+ fi
323+
324+ export BENCH_EXEC_PATH=$bench_prog
325+ export RTS_OPTIONS
326+ run_verbose $bench_prog $SPEED_OPTIONS \
327+ --csvraw=$output_file \
328+ -v 2 \
329+ --measure-with "$BENCH_SH_DIR/bin/bench-exec-one.sh" \
330+ $GAUGE_ARGS || die "Benchmarking failed"
331+}
332+
333+run_benches() {
334+ for i in $1
335+ do
336+ run_bench $i
337+ done
338+}
339+
340+run_benches_comparing() {
341+ local bench_list=$1
342+
343+ if test -z "$CANDIDATE"
344+ then
345+ CANDIDATE=$(git rev-parse HEAD)
346+ fi
347+ if test -z "$BASE"
348+ then
349+ # XXX Should be where the current branch is forked from master
350+ BASE="$CANDIDATE^"
351+ fi
352+ echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"
353+ echo "Checking out base commit [$BASE] for benchmarking"
354+ git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"
355+
356+ $BUILD_BENCH || die "build failed"
357+ run_benches "$bench_list"
358+
359+ echo "Checking out candidate commit [$CANDIDATE] for benchmarking"
360+ git checkout "$CANDIDATE" || \
361+ die "Checkout of candidate [$CANDIDATE] commit failed"
362+
363+ $BUILD_BENCH || die "build failed"
364+ run_benches "$bench_list"
365+ # XXX reset back to the original commit
366+}
367+
368+backup_output_file() {
369+ local bench_name=$1
370+ local output_file=$(bench_output_file $bench_name)
371+
372+ if test -e $output_file -a "$APPEND" != 1
373+ then
374+ mv -f -v $output_file ${output_file}.prev
375+ fi
376+}
377+
378+run_measurements() {
379+ local bench_list=$1
380+
381+ for i in $bench_list
382+ do
383+ backup_output_file $i
384+ done
385+
386+ if test "$COMPARE" = "0"
387+ then
388+ run_benches "$bench_list"
389+ else
390+ run_benches_comparing "$bench_list"
391+ fi
392+}
393+
394+run_reports() {
395+ local prog
396+ prog=$(find_report_prog) || \
397+ die "Cannot find bench-graph executable"
398+ echo
399+
400+ for i in $1
401+ do
402+ echo "Generating reports for ${i}..."
403+ $prog $(test "$GRAPH" = 1 && echo "--graphs") \
404+ --benchmark $i --fields "$FIELDS"
405+ done
406+}
407+
408+#-----------------------------------------------------------------------------
409+# Execution starts here
410+#-----------------------------------------------------------------------------
411+
412+DEFAULT_BENCHMARKS="$all_grp"
413+DEFAULT_FIELDS="allocated bytescopied cputime"
414+ALL_FIELDS="$FIELDS time cycles utime stime minflt majflt nvcsw nivcsw"
415+FIELDS=$DEFAULT_FIELDS
416+
417+COMPARE=0
418+BASE=
419+CANDIDATE=
420+
421+APPEND=0
422+SLOW=0
423+QUICK_MODE=0
424+LONG=0
425+RAW=0
426+GRAPH=0
427+MEASURE=1
428+
429+GAUGE_ARGS=
430+RTS_OPTIONS=
431+BUILD_ONCE=0
432+USE_STACK=0
433+CABAL_BUILD_FLAGS=""
434+
435+GHC_VERSION=$(ghc --numeric-version)
436+
437+cabal_which() {
438+ find dist-newstyle -type f -path "*${GHC_VERSION}*/$1"
439+}
440+
441+#-----------------------------------------------------------------------------
442+# Read command line
443+#-----------------------------------------------------------------------------
444+
445+while test -n "$1"
446+do
447+ case $1 in
448+ -h|--help|help) print_help ;;
449+ # options with arguments
450+ --benchmarks) shift; BENCHMARKS=$1; shift ;;
451+ --fields) shift; FIELDS=$1; shift ;;
452+ --base) shift; BASE=$1; shift ;;
453+ --candidate) shift; CANDIDATE=$1; shift ;;
454+ --cabal-build-flags) shift; CABAL_BUILD_FLAGS=$1; shift ;;
455+ --rtsopts) shift; RTS_OPTIONS=$1; shift ;;
456+ # flags
457+ --slow) SLOW=1; shift ;;
458+ --quick) QUICK_MODE=1; shift ;;
459+ --compare) COMPARE=1; shift ;;
460+ --raw) RAW=1; shift ;;
461+ --append) APPEND=1; shift ;;
462+ --long) LONG=1; shift ;;
463+ --graphs) GRAPH=1; shift ;;
464+ --no-measure) MEASURE=0; shift ;;
465+ --) shift; break ;;
466+ -*|--*) echo "Unknown flags: $*"; echo; print_help ;;
467+ *) break ;;
468+ esac
469+done
470+GAUGE_ARGS=$*
471+
472+only_real_benchmarks () {
473+ for i in $BENCHMARKS
474+ do
475+ local SKIP=0
476+ for j in $COMPARISONS
477+ do
478+ if test $i == $j
479+ then
480+ SKIP=1
481+ fi
482+ done
483+ if test "$SKIP" -eq 0
484+ then
485+ echo -n "$i "
486+ fi
487+ done
488+}
489+
490+has_item () {
491+ for i in $1
492+ do
493+ if test "$i" = "$2"
494+ then
495+ echo "$i"
496+ break
497+ fi
498+ done
499+}
500+
501+BENCHMARKS_ORIG=$BENCHMARKS
502+if test "$(has_item "$BENCHMARKS_ORIG" help)" = "help"
503+then
504+ list_bench_groups
505+ list_comparisons
506+ list_benches
507+ exit
508+fi
509+
510+if test "$(has_item "$FIELDS" help)" = "help"
511+then
512+ echo "Supported fields: $ALL_FIELDS"
513+ echo "Default fields: $DEFAULT_FIELDS"
514+ exit
515+fi
516+
517+if test "$LONG" -ne 0
518+then
519+ if test -n "$BENCHMARKS"
520+ then
521+ echo "Cannot specify benchmarks [$BENCHMARKS] with --long"
522+ exit
523+ fi
524+ BENCHMARKS=$infinite_grp
525+fi
526+
527+BENCHMARKS=$(set_benchmarks)
528+BENCHMARKS_ORIG=$BENCHMARKS
529+BENCHMARKS=$(only_real_benchmarks)
530+EXECUTABLES=$BENCHMARKS
531+
532+echo "Using benchmark suites [$BENCHMARKS]"
533+
534+if test "$USE_STACK" = "1"
535+then
536+ WHICH_COMMAND="stack exec which"
537+ BUILD_CHART_EXE="stack build --flag streamly:dev"
538+ GET_BENCH_PROG=stack_bench_prog
539+ BUILD_BENCH="stack build $STACK_BUILD_FLAGS --bench --no-run-benchmarks"
540+else
541+ # XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables
542+ #WHICH_COMMAND="cabal v2-exec which"
543+ WHICH_COMMAND=cabal_which
544+ BUILD_CHART_EXE="cabal v2-build --flags dev chart"
545+ GET_BENCH_PROG=cabal_bench_prog
546+ BUILD_BENCH="cabal v2-build $CABAL_BUILD_FLAGS --enable-benchmarks"
547+fi
548+
549+#-----------------------------------------------------------------------------
550+# Build stuff
551+#-----------------------------------------------------------------------------
552+
553+# We need to build the report progs first at the current (latest) commit before
554+# checking out any other commit for benchmarking.
555+build_report_progs "$BENCHMARKS"
556+
557+#-----------------------------------------------------------------------------
558+# Run benchmarks
559+#-----------------------------------------------------------------------------
560+
561+if test "$MEASURE" = "1"
562+then
563+ echo $BUILD_BENCH
564+ if test "$USE_STACK" = "1"
565+ then
566+ $BUILD_BENCH || die "build failed"
567+ else
568+ $BUILD_BENCH $EXECUTABLES || die "build failed"
569+ fi
570+ run_measurements "$BENCHMARKS"
571+fi
572+
573+#-----------------------------------------------------------------------------
574+# Run reports
575+#-----------------------------------------------------------------------------
576+
577+COMPARISON_REPORTS=""
578+for i in $COMPARISONS
579+do
580+ if test "$(has_item "$BENCHMARKS_ORIG" $i)" = $i
581+ then
582+ COMPARISON_REPORTS="$COMPARISON_REPORTS $i"
583+ mkdir -p "charts/$i"
584+ constituents=$(eval "echo -n \$${i}")
585+ dest_file="charts/$i/results.csv"
586+ : > $dest_file
587+ for j in $constituents
588+ do
589+ cat "charts/$j/results.csv" >> $dest_file
590+ done
591+ fi
592+done
593+
594+if test "$RAW" = "0"
595+then
596+ run_reports "$BENCHMARKS"
597+ run_reports "$COMPARISON_REPORTS"
598+fi
benchmark/Chart.hsnew file+194
@@ -0,0 +1,194 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
4+module Main where
5+
6+import Control.Exception (catch, ErrorCall(..))
7+import Control.Monad.Trans.State
8+import Control.Monad.Trans.Maybe
9+import Data.Char (toLower)
10+import Data.List
11+import System.Environment (getArgs)
12+import Control.Monad.IO.Class (liftIO)
13+import Control.Monad (mzero)
14+
15+import BenchShow
16+
17+------------------------------------------------------------------------------
18+-- Command line parsing
19+------------------------------------------------------------------------------
20+
21+data BenchType
22+ = Compare String
23+ | Standard String
24+ deriving Show
25+
26+data Options = Options
27+ { genGraphs :: Bool
28+ , benchType :: Maybe BenchType
29+ , fields :: [String]
30+ } deriving Show
31+
32+defaultOptions :: Options
33+defaultOptions = Options False Nothing ["time"]
34+
35+setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
36+setGenGraphs val = do
37+ (args, opts) <- get
38+ put (args, opts { genGraphs = val })
39+
40+setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
41+setBenchType val = do
42+ (args, opts) <- get
43+ put (args, opts { benchType = Just val })
44+
45+setFields :: Monad m => [String] -> StateT (a, Options) m ()
46+setFields val = do
47+ (args, opts) <- get
48+ put (args, opts { fields = val })
49+
50+-- Like the shell "shift" to shift the command line arguments
51+shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
52+shift = do
53+ s <- get
54+ case s of
55+ ([], _) -> return Nothing
56+ (x : xs, opts) -> put (xs, opts) >> return (Just x)
57+
58+parseBench :: StateT ([String], Options) (MaybeT IO) ()
59+parseBench = do
60+ x <- shift
61+ case x of
62+ Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
63+ Just str -> setBenchType (Standard str)
64+ Nothing -> do
65+ liftIO $ putStrLn "please provide a benchmark type "
66+ mzero
67+
68+parseFields :: StateT ([String], Options) (MaybeT IO) ()
69+parseFields = do
70+ x <- shift
71+ case x of
72+ Just str -> setFields (words str)
73+ Nothing -> do
74+ liftIO $ putStrLn
75+ "please provide a list of fields after --fields"
76+ mzero
77+
78+-- totally imperative style option parsing
79+parseOptions :: IO (Maybe Options)
80+parseOptions = do
81+ args <- getArgs
82+ runMaybeT $ flip evalStateT (args, defaultOptions) $ do
83+ parseLoop
84+ fmap snd get
85+
86+ where
87+
88+ parseOpt opt =
89+ case opt of
90+ "--graphs" -> setGenGraphs True
91+ "--benchmark" -> parseBench
92+ "--fields" -> parseFields
93+ str -> do
94+ liftIO $ putStrLn $ "Unrecognized option " <> str
95+ mzero
96+
97+ parseLoop = do
98+ next <- shift
99+ case next of
100+ Just opt -> parseOpt opt >> parseLoop
101+ Nothing -> return ()
102+
103+ignoringErr :: IO () -> IO ()
104+ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
105+ putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
106+
107+------------------------------------------------------------------------------
108+-- Generic
109+------------------------------------------------------------------------------
110+
111+makeGraphs :: String -> Config -> String -> IO ()
112+makeGraphs name cfg@Config{..} inputFile =
113+ ignoringErr $ graph inputFile name cfg
114+
115+------------------------------------------------------------------------------
116+-- Arrays
117+------------------------------------------------------------------------------
118+
119+showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
120+showComparisons Options{..} cfg inp out =
121+ let cfg1 = cfg { classifyBenchmark = classifyComparison }
122+ in if genGraphs
123+ then ignoringErr $ graph inp "comparison"
124+ cfg1 { outputDir = Just out
125+ , presentation = Groups Absolute
126+ }
127+ else ignoringErr $ report inp Nothing cfg1
128+
129+ where
130+
131+ dropComponent = dropWhile (== '/') . dropWhile (/= '/')
132+
133+ classifyComparison b = Just
134+ ( takeWhile (/= '/') b
135+ , dropComponent b
136+ )
137+
138+------------------------------------------------------------------------------
139+-- text reports
140+------------------------------------------------------------------------------
141+
142+selectBench
143+ :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
144+ -> [String]
145+selectBench f =
146+ reverse
147+ $ fmap fst
148+ $ either
149+ (const $ either error (sortOn snd) $ f (ColumnIndex 0) (Just PercentDiff))
150+ (sortOn snd)
151+ $ f (ColumnIndex 1) (Just PercentDiff)
152+
153+benchShow ::
154+ Options
155+ -> Config
156+ -> (Config -> String -> IO ())
157+ -> String
158+ -> FilePath
159+ -> IO ()
160+benchShow Options{..} cfg func inp out =
161+ if genGraphs
162+ then func cfg {outputDir = Just out} inp
163+ else ignoringErr $ report inp Nothing cfg
164+
165+main :: IO ()
166+main = do
167+ res <- parseOptions
168+ case res of
169+ Nothing -> do
170+ putStrLn "cannot parse options"
171+ return ()
172+ Just opts@Options{fields = fs, benchType = btype} ->
173+ let cfg = defaultConfig
174+ { presentation = Groups PercentDiff
175+ , selectBenchmarks = selectBench
176+ , selectFields = filter
177+ ( flip elem fs
178+ . fmap toLower
179+ )
180+ }
181+ in case btype of
182+ Just (Compare str) ->
183+ showComparisons opts cfg
184+ { title = Just str }
185+ ("charts/" ++ str ++ "/results.csv")
186+ ("charts/" ++ str)
187+ Just (Standard str) ->
188+ benchShow opts cfg
189+ { title = Just str }
190+ (makeGraphs str)
191+ ("charts/" ++ str ++ "/results.csv")
192+ ("charts/" ++ str)
193+ Nothing ->
194+ error "Please specify a benchmark using --benchmark."
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/README.mdmode 120000 → 100644+124−1
@@ -1 +0,0 @@
1−../docs/Developer/Benchmarks.md
@@ -0,0 +1,124 @@
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+You must be in the repo root directory to run these commands.
11+
12+Run the default benchmark suites:
13+
14+```
15+$ ./bench.sh --quick
16+```
17+
18+You can remove the `--quick` option to run benchmark with lower speed but
19+better accuracy, or use `--slow` to even further lower the speed and increase
20+the accuracy a bit.
21+
22+Show available benchmark suites:
23+
24+```
25+$ ./bench.sh --benchmarks help
26+```
27+
28+Run all benchmark suites in the `serial_grp` group:
29+
30+```
31+$ ./bench.sh --benchmarks serial_grp
32+```
33+
34+Run `Prelude.Serial` and `Data.Parser` benchmark suites:
35+
36+```
37+$ ./bench.sh --benchmarks "Prelude.Serial Data.Parser"
38+```
39+
40+Run all O(1) space complexity benchmarks in `Prelude.Serial` suite:
41+
42+```
43+$ ./bench.sh --benchmarks Prelude.Serial -- Prelude.Serial/o-1-space
44+```
45+
46+Anything after a `--` is passed to gauge, it basically selects all benchmarks
47+starting with `Prelude.Serial/o-1-space` prefix.
48+
49+Run a specific benchmark in `Prelude.Serial` suite:
50+
51+```
52+$ ./bench.sh --benchmarks Prelude.Serial -- Prelude.Serial/o-1-space/generation/unfoldr
53+```
54+
55+## Comparing results for regression
56+
57+To compare two sets of results, first run the benchmarks at the baseline
58+commit:
59+
60+```
61+$ ./bench.sh
62+```
63+
64+And then run with the `--append` option at the commit that you want to compare
65+with the baseline. It will show the comparison with the baseline:
66+
67+```
68+$ ./bench.sh --append
69+```
70+
71+Append just adds the next set of results in the same results file. You can keep
72+appending more results and all of them will be compared with the baseline.
73+
74+You can use `--compare` to compare the previous commit with the head commit:
75+
76+```
77+$ ./bench.sh --compare
78+```
79+
80+To compare the head commit with some other base commit:
81+
82+```
83+$ ./bench.sh --compare --base d918833
84+```
85+
86+To compare two arbitrary commits:
87+
88+```
89+$ ./bench.sh --compare --base d918833 --candidate 38aa5f2
90+```
91+
92+Note that the above may not always work because the script and the benchmarks
93+themselves might have changed across the commits. The `--append` method is more
94+reliable to compare.
95+
96+## Comparing benchmark suites
97+
98+First see the available benchmark suites:
99+
100+```
101+$ ./bench.sh --benchmarks help
102+```
103+
104+You will see some benchmark suites end with `_cmp`, these are comparison
105+groups. If you run a comparsion group benchmark, comparison of all the
106+benchmark suites in that group will be shown in the end. For example to compare
107+all array benchmark suites:
108+
109+```
110+$ ./bench.sh --benchmarks array_cmp
111+```
112+
113+## Reporting without measuring
114+
115+You can use the `--no-measure` option to report the already measured results in
116+the benchmarks results file. A results file may collect an arbitrary number of
117+results by running with `--append` multiple times. Each benchmark has its own
118+results file, for example the `Prelude.Serial` benchmark has the results file at
119+`charts/Prelude.Serial/results.csv`.
120+
121+You can also manually edit the file to remove a set of results if you like or
122+to append results from previously saved results or from some other results
123+file. After editing you can run `bench.sh` with the `--no-measure` option to
124+see the reports corresponding to the results.
benchmark/Streamly/Benchmark/Data/Array.hs+127−89
@@ -1,140 +1,178 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
1+-- |
2+-- Module : Main
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
37
48{-# LANGUAGE CPP #-}
59
6−#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
10+import Control.DeepSeq (NFData(..))
11+import System.Random (randomRIO)
712
8−import Control.DeepSeq (deepseq)
9−
10−import qualified Streamly.Internal.Data.Array as IA
11−import qualified GHC.Exts as GHC
13+import qualified Streamly.Benchmark.Data.ArrayOps as Ops
1214
13−-- import qualified Streamly.Data.Array as A
14−import qualified Streamly.Internal.Data.Array as A
15+import Gauge
16+import Streamly.Benchmark.Common hiding (benchPureSrc)
1517
16−type Stream = A.Array
17−
18−#include "Streamly/Benchmark/Data/Array/Common.hs"
18+#ifdef MEMORY_ARRAY
19+import qualified GHC.Exts as GHC
20+import Foreign.Storable (Storable(..))
21+#endif
1922
20−instance NFData (A.Array a) where
21− {-# INLINE rnf #-}
22− rnf _ = ()
23+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
24+import Control.DeepSeq (deepseq)
25+#endif
2326
2427-------------------------------------------------------------------------------
25−-- Benchmark helpers
28+--
2629-------------------------------------------------------------------------------
2730
31+#ifdef MEMORY_ARRAY
2832-- Drain a source that generates a pure array
2933{-# INLINE benchPureSrc #-}
30−benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
34+benchPureSrc ::
35+ (NFData a, Storable a) => String -> (Int -> Ops.Stream a) -> Benchmark
3136benchPureSrc name src = benchPure name src id
37+#endif
38+
39+{-# INLINE benchIO #-}
40+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
41+benchIO name src f = bench name $ nfIO $
42+ randomRIO (1,1) >>= src >>= return . f
3243
3344-- Drain a source that generates an array in the IO monad
3445{-# INLINE benchIOSrc #-}
35−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
36−benchIOSrc name src = benchIO name src id
37−
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"
53−
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−-}
46+benchIOSrc ::
47+ NFData a =>
48+#ifdef MEMORY_ARRAY
49+ Storable a =>
6450#endif
51+ String -> (Int -> IO (Ops.Stream a)) -> Benchmark
52+benchIOSrc name src = benchIO name src id
6553
66−{-# INLINE sourceIsList #-}
67−sourceIsList :: Int -> Int -> Stream Int
68−sourceIsList value n = GHC.fromList [n..n+value]
69−
70−{-# INLINE sourceIsString #-}
71−sourceIsString :: Int -> Int -> Stream P.Char
72−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
54+{-# INLINE benchPureSink #-}
55+benchPureSink :: NFData b => Int -> String -> (Ops.Stream Int -> b) -> Benchmark
56+benchPureSink value name f = benchIO name (Ops.sourceIntFromTo value) f
7357
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)
58+{-# INLINE benchIO' #-}
59+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
60+benchIO' name src f = bench name $ nfIO $
61+ randomRIO (1,1) >>= src >>= f
7762
78−-------------------------------------------------------------------------------
79−-- Bench groups
80−-------------------------------------------------------------------------------
63+{-# INLINE benchIOSink #-}
64+benchIOSink :: NFData b => Int -> String -> (Ops.Stream Int -> IO b) -> Benchmark
65+benchIOSink value name f = benchIO' name (Ops.sourceIntFromTo value) f
8166
8267o_1_space_generation :: Int -> [Benchmark]
8368o_1_space_generation value =
8469 [ bgroup
8570 "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)
71+ [ benchIOSrc "writeN . intFromTo" (Ops.sourceIntFromTo value)
72+#ifndef DATA_SMALLARRAY
73+ , benchIOSrc "write . intFromTo" (Ops.sourceIntFromToFromStream value)
74+#endif
75+ , benchIOSrc
76+ "fromList . intFromTo"
77+ (Ops.sourceIntFromToFromList value)
78+ , benchIOSrc "writeN . unfoldr" (Ops.sourceUnfoldr value)
79+ , benchIOSrc "writeN . fromList" (Ops.sourceFromList value)
80+#ifdef MEMORY_ARRAY
81+ , benchPureSrc "writeN . IsList.fromList" (Ops.sourceIsList value)
9082 , benchPureSrc
9183 "writeN . IsString.fromString"
92− (sourceIsString value)
93−
84+ (Ops.sourceIsString value)
85+#endif
86+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
87+#ifdef DATA_SMALLARRAY
88+ , let testStr =
89+ "fromListN " ++
90+ show (value + 1) ++
91+ "[1" ++ concat (replicate value ",1") ++ "]"
92+#else
93+ , let testStr = mkListString value
94+#endif
95+ in testStr `deepseq` (bench "read" $ nf Ops.readInstance testStr)
96+#endif
97+ , benchPureSink value "show" Ops.showInstance
9498 ]
9599 ]
96100
97101o_1_space_elimination :: Int -> [Benchmark]
98102o_1_space_elimination value =
99103 [ 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)
104+ [ benchPureSink value "id" id
105+ , benchPureSink value "==" Ops.eqInstance
106+ , benchPureSink value "/=" Ops.eqInstanceNotEq
107+ , benchPureSink value "<" Ops.ordInstance
108+ , benchPureSink value "min" Ops.ordInstanceMin
109+#ifdef MEMORY_ARRAY
110+ -- length is used to check for foldr/build fusion
111+ , benchPureSink value "length . IsList.toList" (length . GHC.toList)
112+#endif
113+ , benchIOSink value "foldl'" Ops.pureFoldl'
114+ , benchIOSink value "read" Ops.unfoldReadDrain
115+ , benchIOSink value "toStreamRev" Ops.toStreamRevDrain
116+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
105117#ifdef DEVBUILD
106−{-
107− benchPureSink value "foldable/foldl'" foldableFoldl'
108− , benchPureSink value "foldable/sum" foldableSum
109−-}
118+ , benchPureSink value "foldable/foldl'" Ops.foldableFoldl'
119+ , benchPureSink value "foldable/sum" Ops.foldableSum
120+#endif
110121#endif
111122 ]
112123 ]
113124
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− ]
122− ]
125+o_1_space_transformation :: Int -> [Benchmark]
126+o_1_space_transformation value =
127+ [ bgroup "transformation"
128+ [ benchIOSink value "scanl'" (Ops.scanl' value 1)
129+ , benchIOSink value "scanl1'" (Ops.scanl1' value 1)
130+ , benchIOSink value "map" (Ops.map value 1)
131+ ]
132+ ]
133+
134+o_1_space_transformationX4 :: Int -> [Benchmark]
135+o_1_space_transformationX4 value =
136+ [ bgroup "transformationX4"
137+ [ benchIOSink value "scanl'" (Ops.scanl' value 4)
138+ , benchIOSink value "scanl1'" (Ops.scanl1' value 4)
139+ , benchIOSink value "map" (Ops.map value 4)
140+ ]
141+ ]
123142
124143moduleName :: String
144+#ifdef DATA_SMALLARRAY
145+moduleName = "Data.SmallArray"
146+#elif defined(MEMORY_ARRAY)
147+moduleName = "Memory.Array"
148+#elif defined(DATA_ARRAY_PRIM)
149+moduleName = "Data.Array.Prim"
150+#elif defined(DATA_ARRAY_PRIM_PINNED)
151+moduleName = "Data.Array.Prim.Pinnned"
152+#else
125153moduleName = "Data.Array"
154+#endif
126155
156+#ifdef DATA_SMALLARRAY
157+defStreamSize :: Int
158+defStreamSize = 128
159+#else
127160defStreamSize :: Int
128161defStreamSize = defaultStreamSize
162+#endif
129163
130164main :: IO ()
131−main = runWithCLIOpts defStreamSize allBenchmarks
165+main = do
166+ (value, cfg, benches) <- parseCLIOpts defStreamSize
167+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
132168
133169 where
134170
135171 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
172+ [ bgroup (o_1_space_prefix moduleName) $ concat
173+ [ o_1_space_generation size
174+ , o_1_space_elimination size
175+ , o_1_space_transformation size
176+ , o_1_space_transformationX4 size
177+ ]
178+ ]
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+235
@@ -0,0 +1,235 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ArrayOps
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+
12+-- CPP:
13+-- MEMORY_ARRAY
14+-- DATA_ARRAY
15+-- DATA_PRIM_ARRAY
16+-- DATA_SMALLARRAY
17+
18+module Streamly.Benchmark.Data.ArrayOps where
19+
20+import Control.Monad.IO.Class (MonadIO)
21+import Prelude (Bool, Int, Maybe(..), ($), (+), (.), (==), (>), undefined)
22+
23+import qualified Prelude as P
24+import qualified Streamly as S hiding (foldMapWith, runStream)
25+import qualified Streamly.Prelude as S
26+
27+#ifndef DATA_PRIM_ARRAY
28+#ifdef DEVBUILD
29+import qualified Data.Foldable as F
30+#endif
31+#endif
32+
33+#ifdef DATA_SMALLARRAY
34+import qualified Streamly.Internal.Data.SmallArray as A
35+type Stream = A.SmallArray
36+#elif defined(MEMORY_ARRAY)
37+import qualified GHC.Exts as GHC
38+import qualified Streamly.Memory.Array as A
39+import qualified Streamly.Internal.Memory.Array as A
40+type Stream = A.Array
41+#elif defined(DATA_PRIM_ARRAY)
42+import qualified Streamly.Internal.Data.Prim.Array as A
43+type Stream = A.PrimArray
44+#else
45+import qualified Streamly.Internal.Data.Array as A
46+type Stream = A.Array
47+#endif
48+
49+-------------------------------------------------------------------------------
50+-- Benchmark ops
51+-------------------------------------------------------------------------------
52+
53+-------------------------------------------------------------------------------
54+-- Stream generation and elimination
55+-------------------------------------------------------------------------------
56+
57+-------------------------------------------------------------------------------
58+-- CPP Common to:
59+-- MEMORY_ARRAY
60+-- DATA_ARRAY
61+-- DATA_PRIM_ARRAY
62+-- DATA_SMALLARRAY
63+-------------------------------------------------------------------------------
64+
65+{-# INLINE sourceUnfoldr #-}
66+sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
67+sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n
68+ where
69+ step cnt =
70+ if cnt > n + value
71+ then Nothing
72+ else (Just (cnt, cnt + 1))
73+
74+{-# INLINE sourceIntFromTo #-}
75+sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
76+sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
77+
78+{-# INLINE sourceFromList #-}
79+sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
80+sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]
81+
82+-- Different defination of sourceIntFromToFromList for DATA_SMALLARRAY
83+-- CPP:
84+{-# INLINE sourceIntFromToFromList #-}
85+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
86+#ifndef DATA_SMALLARRAY
87+sourceIntFromToFromList value n = P.return $ A.fromList $ [n..n + value]
88+#else
89+sourceIntFromToFromList value n = P.return $ A.fromListN value $ [n..n + value]
90+#endif
91+
92+-------------------------------------------------------------------------------
93+-- CPP Common to:
94+-- MEMORY_ARRAY
95+-- DATA_ARRAY
96+-- DATA_PRIM_ARRAY
97+-------------------------------------------------------------------------------
98+
99+-- CPP:
100+#ifndef DATA_SMALLARRAY
101+{-# INLINE sourceIntFromToFromStream #-}
102+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
103+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
104+#endif
105+
106+-------------------------------------------------------------------------------
107+-- CPP Common to:
108+-- MEMORY_ARRAY
109+-------------------------------------------------------------------------------
110+
111+-- CPP:
112+#ifdef MEMORY_ARRAY
113+{-# INLINE sourceIsList #-}
114+sourceIsList :: Int -> Int -> Stream Int
115+sourceIsList value n = GHC.fromList [n..n+value]
116+
117+{-# INLINE sourceIsString #-}
118+sourceIsString :: Int -> Int -> Stream P.Char
119+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
120+#endif
121+
122+-------------------------------------------------------------------------------
123+-- Transformation
124+-------------------------------------------------------------------------------
125+
126+-------------------------------------------------------------------------------
127+-- CPP Common to:
128+-- MEMORY_ARRAY
129+-- DATA_ARRAY
130+-- DATA_PRIM_ARRAY
131+-- DATA_SMALLARRAY
132+-------------------------------------------------------------------------------
133+
134+{-# INLINE composeN #-}
135+composeN :: P.Monad m
136+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
137+composeN n f x =
138+ case n of
139+ 1 -> f x
140+ 2 -> f x P.>>= f
141+ 3 -> f x P.>>= f P.>>= f
142+ 4 -> f x P.>>= f P.>>= f P.>>= f
143+ _ -> undefined
144+
145+{-# INLINE scanl' #-}
146+{-# INLINE scanl1' #-}
147+{-# INLINE map #-}
148+
149+scanl' , scanl1', map
150+ :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
151+
152+
153+{-# INLINE onArray #-}
154+onArray
155+ :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)
156+ -> Stream Int
157+ -> m (Stream Int)
158+onArray value f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
159+
160+scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0
161+scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)
162+map value n = composeN n $ onArray value $ S.map (+1)
163+-- map n = composeN n $ A.map (+1)
164+
165+{-# INLINE eqInstance #-}
166+eqInstance :: Stream Int -> Bool
167+eqInstance src = src == src
168+
169+{-# INLINE eqInstanceNotEq #-}
170+eqInstanceNotEq :: Stream Int -> Bool
171+eqInstanceNotEq src = src P./= src
172+
173+{-# INLINE ordInstance #-}
174+ordInstance :: Stream Int -> Bool
175+ordInstance src = src P.< src
176+
177+{-# INLINE ordInstanceMin #-}
178+ordInstanceMin :: Stream Int -> Stream Int
179+ordInstanceMin src = P.min src src
180+
181+{-# INLINE showInstance #-}
182+showInstance :: Stream Int -> P.String
183+showInstance src = P.show src
184+
185+{-# INLINE pureFoldl' #-}
186+pureFoldl' :: MonadIO m => Stream Int -> m Int
187+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
188+
189+-------------------------------------------------------------------------------
190+-- CPP Common to:
191+-- MEMORY_ARRAY
192+-- DATA_ARRAY
193+-- DATA_SMALLARRAY
194+-------------------------------------------------------------------------------
195+
196+-- CPP:
197+#ifndef DATA_PRIM_ARRAY
198+{-# INLINE readInstance #-}
199+readInstance :: P.String -> Stream Int
200+readInstance str =
201+ let r = P.reads str
202+ in case r of
203+ [(x,"")] -> x
204+ _ -> P.error "readInstance: no parse"
205+
206+#ifdef DEVBUILD
207+{-# INLINE foldableFoldl' #-}
208+foldableFoldl' :: Stream Int -> Int
209+foldableFoldl' = F.foldl' (+) 0
210+
211+{-# INLINE foldableSum #-}
212+foldableSum :: Stream Int -> Int
213+foldableSum = P.sum
214+#endif
215+#endif
216+
217+-------------------------------------------------------------------------------
218+-- Elimination
219+-------------------------------------------------------------------------------
220+
221+-------------------------------------------------------------------------------
222+-- CPP Common to:
223+-- MEMORY_ARRAY
224+-- DATA_ARRAY
225+-- DATA_PRIM_ARRAY
226+-- DATA_SMALLARRAY
227+-------------------------------------------------------------------------------
228+
229+{-# INLINE unfoldReadDrain #-}
230+unfoldReadDrain :: MonadIO m => Stream Int -> m ()
231+unfoldReadDrain = S.drain . S.unfold A.read
232+
233+{-# INLINE toStreamRevDrain #-}
234+toStreamRevDrain :: MonadIO m => Stream Int -> m ()
235+toStreamRevDrain = S.drain . A.toStreamRev
benchmark/Streamly/Benchmark/Data/Fold.hs+141−462
@@ -6,51 +6,39 @@
66-- Maintainer : streamly@composewell.com
77
88{-# 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
199
2010module Main (main) where
2111
2212import 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)
3013import Data.Monoid (Last(..), Sum(..))
31−import System.Random (randomRIO)
3214
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)
15+import System.Random (randomRIO)
16+import Prelude (IO, Int, Double, String, (>), (<*>), (<$>), (+), ($),
17+ (<=), Monad(..), (==), Maybe(..), (.), fromIntegral,
18+ compare, (>=), concat, seq)
3719
20+import qualified Streamly as S hiding (runStream)
21+import qualified Streamly.Prelude as S
3822import 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
4123import qualified Streamly.Internal.Data.Pipe as Pipe
42−import qualified Streamly.Internal.Data.Stream as Stream
4324
44−import Test.Tasty.Bench
25+import qualified Streamly.Internal.Data.Sink as Sink
26+
27+import qualified Streamly.Memory.Array as A
28+import qualified Streamly.Internal.Memory.Array as IA
29+import qualified Streamly.Internal.Data.Fold as IFL
30+import qualified Streamly.Internal.Prelude as IP
31+
32+import Gauge
33+import Streamly hiding (runStream)
4534import Streamly.Benchmark.Common
46−import Prelude hiding (all, any, take, unzip, sequence_, filter)
4735
4836-- We need a monadic bind here to make sure that the function f does not get
4937-- completely optimized out by the compiler in some cases.
5038
5139{-# INLINE sourceUnfoldrM #-}
52−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
53−sourceUnfoldrM value n = Stream.unfoldrM step n
40+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
41+sourceUnfoldrM value n = S.unfoldrM step n
5442 where
5543 step cnt =
5644 if cnt > n + value
@@ -58,458 +46,166 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
5846 else return (Just (cnt, cnt + 1))
5947
6048{-# INLINE source #-}
61−source :: Monad m => Int -> Int -> Stream m Int
49+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
6250source = sourceUnfoldrM
6351
6452-- | Takes a fold method, and uses it with a default source.
6553{-# INLINE benchIOSink #-}
6654benchIOSink
67− :: NFData b
68− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
55+ :: (IsStream t, NFData b)
56+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
6957benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
7058
7159-------------------------------------------------------------------------------
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
60+-- Stream folds
29461-------------------------------------------------------------------------------
29562
29663moduleName :: String
29764moduleName = "Data.Fold"
29865
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−
30766o_1_space_serial_elimination :: Int -> [Benchmark]
30867o_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)))
68+ [ bgroup "serially"
69+ [ bgroup "elimination"
70+ [ benchIOSink value "drain" (S.fold FL.drain)
71+ , benchIOSink value "drainN" (S.fold (IFL.drainN value))
72+ , benchIOSink
73+ value
74+ "drainWhileTrue"
75+ (S.fold (IFL.drainWhile $ (<=) (value + 1)))
76+ , benchIOSink
77+ value
78+ "drainWhileFalse"
79+ (S.fold (IFL.drainWhile $ (>=) (value + 1)))
80+ , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
81+ , benchIOSink value "last" (S.fold FL.last)
82+ , benchIOSink value "lastN.1" (S.fold (IA.lastN 1))
83+ , benchIOSink value "lastN.10" (S.fold (IA.lastN 10))
84+ , benchIOSink value "length" (S.fold FL.length)
85+ , benchIOSink value "sum" (S.fold FL.sum)
86+ , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))
87+ , benchIOSink value "product" (S.fold FL.product)
88+ , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
89+ , benchIOSink value "maximum" (S.fold FL.maximum)
90+ , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
91+ , benchIOSink value "minimum" (S.fold FL.minimum)
92+ , benchIOSink
93+ value
94+ "mean"
95+ (\s ->
96+ S.fold
97+ FL.mean
98+ (S.map (fromIntegral :: Int -> Double) s))
99+ , benchIOSink
100+ value
101+ "variance"
102+ (\s ->
103+ S.fold
104+ FL.variance
105+ (S.map (fromIntegral :: Int -> Double) s))
106+ , benchIOSink
107+ value
108+ "stdDev"
109+ (\s ->
110+ S.fold
111+ FL.stdDev
112+ (S.map (fromIntegral :: Int -> Double) s))
113+ , benchIOSink
114+ value
115+ "mconcat"
116+ (S.fold FL.mconcat . (S.map (Last . Just)))
117+ , benchIOSink
118+ value
119+ "foldMap"
120+ (S.fold (FL.foldMap (Last . Just)))
121+ , benchIOSink value "index" (S.fold (FL.index (value + 1)))
122+ , benchIOSink value "head" (S.fold FL.head)
123+ , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
124+ , benchIOSink
125+ value
126+ "findIndex"
127+ (S.fold (FL.findIndex (== (value + 1))))
128+ , benchIOSink
129+ value
130+ "elemIndex"
131+ (S.fold (FL.elemIndex (value + 1)))
132+ , benchIOSink value "null" (S.fold FL.null)
133+ , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
134+ , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
135+ , benchIOSink value "all" (S.fold (FL.all (<= (value + 1))))
136+ , benchIOSink value "any" (S.fold (FL.any (> (value + 1))))
137+ , benchIOSink
138+ value
139+ "and"
140+ (\s -> S.fold FL.and (S.map (<= (value + 1)) s))
141+ , benchIOSink
142+ value
143+ "or"
144+ (\s -> S.fold FL.or (S.map (> (value + 1)) s))
145+ ]
372146 ]
373147 ]
374148
149+
375150o_1_space_serial_transformation :: Int -> [Benchmark]
376151o_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)
152+ [ bgroup "serially"
153+ [ bgroup "transformation"
154+ [ benchIOSink value "lmap" (S.fold (IFL.lmap (+ 1) FL.drain))
155+ , benchIOSink
156+ value
157+ "pipe-mapM"
158+ (S.fold
159+ (IFL.transform
160+ (Pipe.mapM (\x -> return $ x + 1))
161+ FL.drain))
162+ ]
406163 ]
407164 ]
408165
409166o_1_space_serial_composition :: Int -> [Benchmark]
410167o_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
168+ [ bgroup "serially"
169+ [ bgroup "composition" -- Applicative
170+ [ benchIOSink
171+ value
172+ "all,any"
173+ (S.fold
174+ ((,) <$> FL.all (<= (value + 1)) <*>
175+ FL.any (> (value + 1))))
176+ , benchIOSink
177+ value
178+ "sum,length"
179+ (S.fold ((,) <$> FL.sum <*> FL.length))
434180 ]
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))
181+ ]
440182 ]
441183
442184o_n_heap_serial :: Int -> [Benchmark]
443185o_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− ]
186+ [ bgroup "serially"
187+ [ bgroup "elimination"
188+ -- Left folds for building a structure are inherently non-streaming
189+ -- as the structure cannot be lazily consumed until fully built.
190+ [ benchIOSink value "toStream" (S.fold IP.toStream)
191+ , benchIOSink value "toStreamRev" (S.fold IP.toStreamRev)
192+ , benchIOSink value "toList" (S.fold FL.toList)
193+ , benchIOSink value "toListRevF" (S.fold IFL.toListRevF)
194+ -- Converting the stream to an array
195+ , benchIOSink value "lastN.Max" (S.fold (IA.lastN (value + 1)))
196+ , benchIOSink value "writeN" (S.fold (A.writeN value))
197+ ]
198+ ]
493199 ]
494200
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−
505201-------------------------------------------------------------------------------
506202-- Driver
507203-------------------------------------------------------------------------------
508204
509205main :: IO ()
510206main = do
511−#ifndef FUSION_CHECK
512− runWithCLIOpts defaultStreamSize allBenchmarks
207+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
208+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
513209
514210 where
515211
@@ -519,23 +215,6 @@ main = do
519215 , o_1_space_serial_transformation value
520216 , o_1_space_serial_composition value
521217 ]
522− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
523− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
218+ , bgroup (o_n_heap_prefix moduleName) $ concat
219+ [ o_n_heap_serial value ]
524220 ]
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/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 Streamly.Benchmark.Data.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/Streamly/Benchmark/Data/Parser.hs+127−722
@@ -1,10 +1,3 @@
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−
81-- |
92-- Module : Streamly.Benchmark.Data.Parser
103-- Copyright : (c) 2020 Composewell Technologies
@@ -12,46 +5,34 @@
125-- License : BSD-3-Clause
136-- Maintainer : streamly@composewell.com
147
15−{-# LANGUAGE CPP #-}
168{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# OPTIONS_GHC -Wno-orphans #-}
9+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
1910
2011module Main
2112 (
2213 main
2314 ) where
2415
25−import Control.Applicative ((<|>))
2616import Control.DeepSeq (NFData(..))
27−import Data.Function ((&))
28−import Data.Functor (($>))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
2919import Data.Monoid (Sum(..))
30−import GHC.Magic (inline)
31−import GHC.Magic (noinline)
32−import System.IO (Handle)
3320import 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)
21+import Prelude
22+ hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)
4023
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
4324import 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
25+import qualified Data.Foldable as F
26+import qualified Control.Applicative as AP
27+import qualified Streamly as S hiding (runStream)
28+import qualified Streamly.Prelude as S
29+import qualified Streamly.Internal.Data.Fold as FL
4730import 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
31+import qualified Streamly.Internal.Prelude as IP
5132
52−import Test.Tasty.Bench hiding (env)
33+import Gauge
34+import Streamly hiding (runStream)
5335import Streamly.Benchmark.Common
54−import Streamly.Benchmark.Common.Handle
5536
5637-------------------------------------------------------------------------------
5738-- Utilities
@@ -60,59 +41,19 @@ import Streamly.Benchmark.Common.Handle
6041-- XXX these can be moved to the common module
6142
6243{-# INLINE sourceUnfoldrM #-}
63−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
64−sourceUnfoldrM value n = Stream.unfoldrM step n
44+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
45+sourceUnfoldrM value n = S.unfoldrM step n
6546 where
6647 step cnt =
6748 if cnt > n + value
6849 then return Nothing
6950 else return (Just (cnt, cnt + 1))
7051
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−
11152-- | Takes a fold method, and uses it with a default source.
11253{-# INLINE benchIOSink #-}
11354benchIOSink
114− :: NFData b
115− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
55+ :: (IsStream t, NFData b)
56+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
11657benchIOSink value name f =
11758 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
11859
@@ -120,452 +61,100 @@ benchIOSink value name f =
12061-- Parsers
12162-------------------------------------------------------------------------------
12263
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)
64+{-# INLINE any #-}
65+any :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
66+any value = IP.parse (PR.any (> value))
13467
135−{-# INLINE dropWhile #-}
136−dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
137−dropWhile value = Stream.parse (PR.dropWhile (<= value))
68+{-# INLINE all #-}
69+all :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
70+all value = IP.parse (PR.all (<= value))
13871
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))
72+{-# INLINE take #-}
73+take :: MonadCatch m => Int -> SerialT m a -> m ()
74+take value = IP.parse (PR.take value FL.drain)
16375
16476{-# 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)
77+takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
78+takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
24579
24680{-# INLINE many #-}
247−many :: Monad m => Stream m Int -> m (Either ParseError Int)
248−many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
81+many :: MonadCatch m => SerialT m Int -> m Int
82+many = IP.parse (PR.many FL.length (PR.satisfy (> 0)))
24983
25084{-# INLINE manyAlt #-}
251−manyAlt :: Monad m => Stream m Int -> m Int
85+manyAlt :: MonadCatch m => SerialT m Int -> m Int
25286manyAlt xs = do
253− x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
87+ x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
25488 return $ Prelude.length x
25589
25690{-# INLINE some #-}
257−some :: Monad m => Stream m Int -> m (Either ParseError Int)
258−some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
91+some :: MonadCatch m => SerialT m Int -> m Int
92+some = IP.parse (PR.some FL.length (PR.satisfy (> 0)))
25993
26094{-# INLINE someAlt #-}
261−someAlt :: Monad m => Stream m Int -> m Int
95+someAlt :: MonadCatch m => SerialT m Int -> m Int
26296someAlt xs = do
263− x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
97+ x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
26498 return $ Prelude.length x
26599
266100{-# INLINE manyTill #-}
267−manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
101+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
268102manyTill 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− )
103+ IP.parse (PR.manyTill FL.length (PR.satisfy (> 0)) (PR.satisfy (== value)))
104+
105+{-# INLINE splitAp #-}
106+splitAp :: MonadCatch m
107+ => Int -> SerialT m Int -> m (Bool, Bool)
108+splitAp value =
109+ IP.parse ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
308110
309111{-# INLINE splitApBefore #-}
310−splitApBefore :: Monad m
311− => Int -> Stream m Int -> m (Either ParseError ())
112+splitApBefore :: MonadCatch m
113+ => Int -> SerialT m Int -> m Bool
312114splitApBefore value =
313− Stream.parse
314− ( PR.dropWhile (<= (value `div` 2))
315− *> PR.dropWhile (<= value)
316− )
115+ IP.parse (PR.all (<= (value `div` 2)) *> PR.any (> value))
317116
318117{-# INLINE splitApAfter #-}
319−splitApAfter :: Monad m
320− => Int -> Stream m Int -> m (Either ParseError ())
118+splitApAfter :: MonadCatch m
119+ => Int -> SerialT m Int -> m Bool
321120splitApAfter 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− )
121+ IP.parse (PR.all (<= (value `div` 2)) <* PR.any (> value))
122+
123+{-# INLINE splitWith #-}
124+splitWith :: MonadCatch m
125+ => Int -> SerialT m Int -> m (Bool, Bool)
126+splitWith value =
127+ IP.parse (PR.splitWith (,) (PR.all (<= (value `div` 2))) (PR.any (> value)))
336128
337129{-# INLINE split_ #-}
338−split_ :: Monad m
339− => Int -> Stream m Int -> m (Either ParseError ())
130+split_ :: MonadCatch m
131+ => Int -> SerialT m Int -> m Bool
340132split_ 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
133+ IP.parse (PR.split_ (PR.all (<= (value `div` 2))) (PR.any (> value)))
353134
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−{-
504135{-# INLINE teeAllAny #-}
505−teeAllAny :: Monad m
506− => Int -> Stream m Int -> m ((), ())
136+teeAllAny :: (MonadCatch m, Ord a)
137+ => a -> SerialT m a -> m (Bool, Bool)
507138teeAllAny value =
508− Stream.parse
509− (PR.teeWith (,)
510− (PR.dropWhile (<= value))
511− (PR.dropWhile (<= value))
512− )
139+ IP.parse (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
513140
514141{-# INLINE teeFstAllAny #-}
515−teeFstAllAny :: Monad m
516− => Int -> Stream m Int -> m ((), ())
142+teeFstAllAny :: (MonadCatch m, Ord a)
143+ => a -> SerialT m a -> m (Bool, Bool)
517144teeFstAllAny value =
518− Stream.parse
519− (PR.teeWithFst (,)
520− (PR.dropWhile (<= value))
521− (PR.dropWhile (<= value))
522− )
145+ IP.parse (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
523146
524147{-# INLINE shortestAllAny #-}
525−shortestAllAny :: Monad m
526− => Int -> Stream m Int -> m (Either ParseError ())
148+shortestAllAny :: (MonadCatch m, Ord a)
149+ => a -> SerialT m a -> m Bool
527150shortestAllAny value =
528− Stream.parse
529− (PR.shortest
530− (PR.dropWhile (<= value))
531− (PR.dropWhile (<= value))
532− )
151+ IP.parse (PR.shortest (PR.all (<= value)) (PR.any (> value)))
533152
534153{-# INLINE longestAllAny #-}
535−longestAllAny :: Monad m
536− => Int -> Stream m Int -> m (Either ParseError ())
154+longestAllAny :: (MonadCatch m, Ord a)
155+ => a -> SerialT m a -> m Bool
537156longestAllAny 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)
157+ IP.parse (PR.longest (PR.all (<= value)) (PR.any (> value)))
569158
570159-------------------------------------------------------------------------------
571160-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -576,129 +165,57 @@ parseManyChunksOfSum n inh =
576165-- not have to rely on it.
577166--
578167{-# INLINE lookAhead #-}
579−lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
168+lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
580169lookAhead value =
581− Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
170+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
582171
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
590172{-# INLINE sequenceA #-}
591−sequenceA :: Monad m => Int -> Stream m Int -> m Int
173+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
592174sequenceA value xs = do
593− x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
175+ x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
594176 return $ length x
595177
596−-- quadratic complexity
178+{-# INLINE sequenceA_ #-}
179+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
180+sequenceA_ value =
181+ IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
182+
597183{-# INLINE sequence #-}
598−sequence :: Monad m => Int -> Stream m Int -> m Int
184+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
599185sequence value xs = do
600− x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
186+ x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
601187 return $ length x
602188
603189{-# 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)
190+sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
191+sequence_ value =
192+ IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))
612193
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−{-
623194{-# INLINE choice #-}
624−choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
195+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
625196choice 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
197+ IP.parse (asum (replicate value (PR.satisfy (< 0)))
198+ AP.<|> PR.satisfy (> 0))
645199
646200-------------------------------------------------------------------------------
647201-- Stream transformation
648202-------------------------------------------------------------------------------
649203
650204{-# 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
205+parseMany :: MonadCatch m => SerialT m Int -> m ()
206+parseMany =
207+ S.drain
208+ . S.map getSum
209+ . IP.parseMany (PR.take 2 FL.mconcat)
210+ . S.map Sum
686211
687212{-# 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
213+parseIterate :: MonadCatch m => SerialT m Int -> m ()
214+parseIterate =
215+ S.drain
216+ . S.map getSum
217+ . IP.parseIterate (\b -> (PR.take 2 (FL.sconcat b))) (Sum 0)
218+ . S.map Sum
702219
703220-------------------------------------------------------------------------------
704221-- Benchmarks
@@ -707,141 +224,49 @@ concatSequence =
707224moduleName :: String
708225moduleName = "Data.Parser"
709226
710−instance NFData ParseError where
711− {-# INLINE rnf #-}
712− rnf (ParseError x) = rnf x
713−
714227o_1_space_serial :: Int -> [Benchmark]
715228o_1_space_serial value =
716− [ benchIOSink value "takeBetween" $ takeBetween value
229+ [ benchIOSink value "any" $ any value
230+ , benchIOSink value "all" $ all value
231+ , benchIOSink value "take" $ take value
717232 , 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
233+ , benchIOSink value "splitAp" $ splitAp value
736234 , benchIOSink value "splitApBefore" $ splitApBefore value
737235 , 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
236+ , benchIOSink value "splitWith" $ splitWith value
751237 , benchIOSink value "many" many
752− , benchIOSink value "many (wordBy even)" $ manyWordByEven
753238 , benchIOSink value "some" some
754239 , 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− {-
774240 , benchIOSink value "tee" $ teeAllAny value
775241 , benchIOSink value "teeFst" $ teeFstAllAny value
776242 , benchIOSink value "shortest" $ shortestAllAny value
777243 , 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
244+ , benchIOSink value "parseMany" parseMany
245+ , benchIOSink value "parseIterate" parseIterate
808246 ]
809247
810248o_n_heap_serial :: Int -> [Benchmark]
811249o_n_heap_serial value =
812250 [
813− benchIOSink value "takeEQ" $ takeEQ value
814− , benchIOSink value "takeGE" $ takeGE value
815−
816251 -- lookahead benchmark holds the entire input till end
817− , benchIOSink value "lookAhead" $ lookAhead value
252+ benchIOSink value "lookAhead" $ lookAhead value
818253
819− -- o-n-heap because of backtracking
820− , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
821− $ takeFramedByEsc_ value
254+ -- accumulates the results in a list
255+ , benchIOSink value "sequence" $ sequence value
256+ , benchIOSink value "sequenceA" $ sequenceA value
822257
258+ -- XXX why should this take O(n) heap, it discards the results?
259+ , benchIOSink value "sequence_" $ sequence_ value
260+ , benchIOSink value "sequenceA_" $ sequenceA_ value
823261 -- non-linear time complexity (parserD)
824262 , benchIOSink value "split_" $ split_ value
825− -- XXX Takes lot of space when run on a long stream, why?
826− , benchIOSink value "monad16" $ monad16 value
263+ -- XXX why O(n) heap?
264+ , benchIOSink value "choice" $ choice value
827265
828266 -- These show non-linear time complexity.
829267 -- They accumulate the results in a list.
830− , benchIOSink value "sepBy1" sepBy1
831268 , benchIOSink value "manyAlt" manyAlt
832269 , 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)
845270 ]
846271
847272-------------------------------------------------------------------------------
@@ -850,38 +275,18 @@ o_n_space_serial value =
850275
851276main :: IO ()
852277main = do
853−#ifndef FUSION_CHECK
854− env <- mkHandleBenchEnv
855− runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
278+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
279+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
856280
857281 where
858282
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)
283+ allBenchmarks value =
284+ [ bgroup (o_1_space_prefix moduleName) $ concat
285+ [
286+ o_1_space_serial value
287+ ]
288+ , bgroup (o_n_heap_prefix moduleName) $ concat
289+ [
290+ o_n_heap_serial value
291+ ]
870292 ]
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/Parser/ParserD.hsnew file+244
@@ -0,0 +1,244 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ParserD
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
10+
11+module Main
12+ (
13+ main
14+ ) where
15+
16+import Control.DeepSeq (NFData(..))
17+import Control.Monad.Catch (MonadCatch, MonadThrow)
18+import Data.Foldable (asum)
19+import System.Random (randomRIO)
20+import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21+
22+import qualified Data.Traversable as TR
23+import qualified Data.Foldable as F
24+import qualified Control.Applicative as AP
25+import qualified Streamly as S hiding (runStream)
26+import qualified Streamly.Prelude as S
27+import qualified Streamly.Internal.Data.Fold as FL
28+import qualified Streamly.Internal.Data.Parser.ParserD as PR
29+import qualified Streamly.Internal.Prelude as IP
30+
31+import Gauge
32+import Streamly hiding (runStream)
33+import Streamly.Benchmark.Common
34+
35+-------------------------------------------------------------------------------
36+-- Utilities
37+-------------------------------------------------------------------------------
38+
39+-- XXX these can be moved to the common module
40+
41+{-# INLINE sourceUnfoldrM #-}
42+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
43+sourceUnfoldrM value n = S.unfoldrM step n
44+ where
45+ step cnt =
46+ if cnt > n + value
47+ then return Nothing
48+ else return (Just (cnt, cnt + 1))
49+
50+-- | Takes a fold method, and uses it with a default source.
51+{-# INLINE benchIOSink #-}
52+benchIOSink
53+ :: (IsStream t, NFData b)
54+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
55+benchIOSink value name f =
56+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
57+
58+-------------------------------------------------------------------------------
59+-- Parsers
60+-------------------------------------------------------------------------------
61+
62+{-# INLINE any #-}
63+any :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
64+any value = IP.parseD (PR.any (> value))
65+
66+{-# INLINE all #-}
67+all :: (MonadThrow m, Ord a) => a -> SerialT m a -> m Bool
68+all value = IP.parseD (PR.all (<= value))
69+
70+{-# INLINE take #-}
71+take :: MonadThrow m => Int -> SerialT m a -> m ()
72+take value = IP.parseD (PR.take value FL.drain)
73+
74+{-# INLINE takeWhile #-}
75+takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
76+takeWhile value = IP.parseD (PR.takeWhile (<= value) FL.drain)
77+
78+{-# INLINE many #-}
79+many :: MonadCatch m => SerialT m Int -> m Int
80+many = IP.parseD (PR.many FL.length (PR.satisfy (> 0)))
81+
82+{-# INLINE manyAlt #-}
83+manyAlt :: MonadCatch m => SerialT m Int -> m Int
84+manyAlt xs = do
85+ x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
86+ return $ Prelude.length x
87+
88+{-# INLINE some #-}
89+some :: MonadCatch m => SerialT m Int -> m Int
90+some = IP.parseD (PR.some FL.length (PR.satisfy (> 0)))
91+
92+{-# INLINE someAlt #-}
93+someAlt :: MonadCatch m => SerialT m Int -> m Int
94+someAlt xs = do
95+ x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
96+ return $ Prelude.length x
97+
98+{-# INLINE manyTill #-}
99+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
100+manyTill value =
101+ let p = PR.satisfy (> 0)
102+ pcond = PR.satisfy (== value)
103+ in IP.parseD (PR.manyTill FL.length p pcond)
104+
105+{-# INLINE splitAllAny #-}
106+splitAllAny :: MonadThrow m
107+ => Int -> SerialT m Int -> m (Bool, Bool)
108+splitAllAny value =
109+ IP.parseD ((,) <$> PR.all (<= (value `div` 2)) <*> PR.any (> value))
110+
111+{-# INLINE teeAllAny #-}
112+teeAllAny :: (MonadThrow m, Ord a)
113+ => a -> SerialT m a -> m (Bool, Bool)
114+teeAllAny value =
115+ IP.parseD (PR.teeWith (,) (PR.all (<= value)) (PR.any (> value)))
116+
117+{-# INLINE teeFstAllAny #-}
118+teeFstAllAny :: (MonadThrow m, Ord a)
119+ => a -> SerialT m a -> m (Bool, Bool)
120+teeFstAllAny value =
121+ IP.parseD (PR.teeWithFst (,) (PR.all (<= value)) (PR.any (> value)))
122+
123+{-# INLINE shortestAllAny #-}
124+shortestAllAny :: (MonadThrow m, Ord a)
125+ => a -> SerialT m a -> m Bool
126+shortestAllAny value =
127+ IP.parseD (PR.shortest (PR.all (<= value)) (PR.any (> value)))
128+
129+{-# INLINE longestAllAny #-}
130+longestAllAny :: (MonadCatch m, Ord a)
131+ => a -> SerialT m a -> m Bool
132+longestAllAny value =
133+ IP.parseD (PR.longest (PR.all (<= value)) (PR.any (> value)))
134+
135+-------------------------------------------------------------------------------
136+-- Parsers in which -fspec-constr-recursive=16 is problematic
137+-------------------------------------------------------------------------------
138+
139+-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
140+-- We need to fix GHC so that we can have better control over that option or do
141+-- not have to rely on it.
142+--
143+{-# INLINE lookAhead #-}
144+lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
145+lookAhead value =
146+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) *> pure ())
147+
148+{-# INLINE sequenceA_ #-}
149+sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
150+sequenceA_ value =
151+ IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
152+
153+-- quadratic complexity
154+{-# INLINE sequenceA #-}
155+sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
156+sequenceA value xs = do
157+ x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
158+ return $ length x
159+
160+-- quadratic complexity
161+{-# INLINE sequence #-}
162+sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
163+sequence value xs = do
164+ x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
165+ return $ length x
166+
167+-- choice using the "Alternative" instance with direct style parser type has
168+-- quadratic performance complexity.
169+--
170+{-# INLINE choice #-}
171+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
172+choice value =
173+ IP.parseD (asum (replicate value (PR.satisfy (< 0)))
174+ AP.<|> PR.satisfy (> 0))
175+
176+-------------------------------------------------------------------------------
177+-- Benchmarks
178+-------------------------------------------------------------------------------
179+
180+moduleName :: String
181+moduleName = "Data.Parser.ParserD"
182+
183+o_1_space_serial :: Int -> [Benchmark]
184+o_1_space_serial value =
185+ [ benchIOSink value "any" $ any value
186+ , benchIOSink value "all" $ all value
187+ , benchIOSink value "take" $ take value
188+ , benchIOSink value "takeWhile" $ takeWhile value
189+ , benchIOSink value "split (all,any)" $ splitAllAny value
190+ , benchIOSink value "many" many
191+ , benchIOSink value "some" some
192+ , benchIOSink value "manyTill" $ manyTill value
193+ , benchIOSink value "tee (all,any)" $ teeAllAny value
194+ , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
195+ , benchIOSink value "shortest (all,any)" $ shortestAllAny value
196+ , benchIOSink value "longest (all,any)" $ longestAllAny value
197+ ]
198+
199+o_n_heap_serial :: Int -> [Benchmark]
200+o_n_heap_serial value =
201+ [
202+ -- lookahead benchmark holds the entire input till end
203+ benchIOSink value "lookAhead" $ lookAhead value
204+
205+ -- These show non-linear time complexity
206+ -- They accumulate the results in a list.
207+ , benchIOSink value "manyAlt" manyAlt
208+ , benchIOSink value "someAlt" someAlt
209+ ]
210+
211+-- accumulate results in a list in IO
212+o_n_space_serial :: Int -> [Benchmark]
213+o_n_space_serial value =
214+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
215+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
216+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)
217+ , benchIOSink value "choice/100" $ choice (value `div` 100)
218+ ]
219+
220+-------------------------------------------------------------------------------
221+-- Driver
222+-------------------------------------------------------------------------------
223+
224+main :: IO ()
225+main = do
226+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
227+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
228+
229+ where
230+
231+ allBenchmarks value =
232+ [ bgroup (o_1_space_prefix moduleName) $ concat
233+ [
234+ o_1_space_serial value
235+ ]
236+ , bgroup (o_n_heap_prefix moduleName) $ concat
237+ [
238+ o_n_heap_serial value
239+ ]
240+ , bgroup (o_n_space_prefix moduleName) $ concat
241+ [
242+ o_n_space_serial value
243+ ]
244+ ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hsnew file+198
@@ -0,0 +1,198 @@
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+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
11+
12+module Main
13+ (
14+ main
15+ ) where
16+
17+import Control.DeepSeq (NFData(..))
18+import Control.Monad.Catch (MonadCatch)
19+import Data.Foldable (asum)
20+import System.Random (randomRIO)
21+import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
22+
23+import qualified Control.Applicative as AP
24+import qualified Data.Foldable as F
25+import qualified Data.Traversable as TR
26+import qualified Streamly as S hiding (runStream)
27+import qualified Streamly.Prelude as S
28+import qualified Streamly.Internal.Data.Fold as FL
29+import qualified Streamly.Internal.Data.Parser.ParserK.Types as PR
30+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
31+import qualified Streamly.Internal.Prelude as IP
32+
33+import Gauge
34+import Streamly hiding (runStream)
35+import Streamly.Benchmark.Common
36+
37+-------------------------------------------------------------------------------
38+-- Utilities
39+-------------------------------------------------------------------------------
40+
41+-- XXX these can be moved to the common module
42+
43+{-# INLINE sourceUnfoldrM #-}
44+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
45+sourceUnfoldrM value n = S.unfoldrM step n
46+ where
47+ step cnt =
48+ if cnt > n + value
49+ then return Nothing
50+ else return (Just (cnt, cnt + 1))
51+
52+-- | Takes a fold method, and uses it with a default source.
53+{-# INLINE benchIOSink #-}
54+benchIOSink
55+ :: (IsStream t, NFData b)
56+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
57+benchIOSink value name f =
58+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
59+
60+-------------------------------------------------------------------------------
61+-- Parsers
62+-------------------------------------------------------------------------------
63+
64+#ifdef FROM_PARSERK
65+#define PARSE_OP (IP.parseD . PRD.fromParserK)
66+#else
67+#define PARSE_OP IP.parseK
68+#endif
69+
70+{-# INLINE satisfy #-}
71+satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
72+satisfy = PRD.toParserK . PRD.satisfy
73+
74+{-# INLINE any #-}
75+any :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
76+any = PRD.toParserK . PRD.any
77+
78+{-# INLINE anyK #-}
79+anyK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
80+anyK value = PARSE_OP (any (> value))
81+
82+{-# INLINE all #-}
83+all :: MonadCatch m => (a -> Bool) -> PR.Parser m a Bool
84+all = PRD.toParserK . PRD.all
85+
86+{-# INLINE allK #-}
87+allK :: (MonadCatch m, Ord a) => a -> SerialT m a -> m Bool
88+allK value = PARSE_OP (all (<= value))
89+
90+{-# INLINE take #-}
91+take :: MonadCatch m => Int -> PR.Parser m a ()
92+take value = PRD.toParserK $ PRD.take value FL.drain
93+
94+{-# INLINE takeK #-}
95+takeK :: MonadCatch m => Int -> SerialT m a -> m ()
96+takeK value = PARSE_OP (take value)
97+
98+{-# INLINE takeWhile #-}
99+takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
100+takeWhile p = PRD.toParserK $ PRD.takeWhile p FL.drain
101+
102+{-# INLINE takeWhileK #-}
103+takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
104+takeWhileK value = PARSE_OP (takeWhile (<= value))
105+
106+{-# INLINE splitApp #-}
107+splitApp :: MonadCatch m
108+ => Int -> SerialT m Int -> m (Bool, Bool)
109+splitApp value =
110+ PARSE_OP ((,) <$> any (>= (value `div` 2)) <*> any (> value))
111+
112+{-# INLINE sequenceA #-}
113+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
114+sequenceA value xs = do
115+ let parser = satisfy (> 0)
116+ list = Prelude.replicate value parser
117+ x <- PARSE_OP (TR.sequenceA list) xs
118+ return $ Prelude.length x
119+
120+{-# INLINE sequenceA_ #-}
121+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
122+sequenceA_ value xs = do
123+ let parser = satisfy (> 0)
124+ list = Prelude.replicate value parser
125+ PARSE_OP (F.sequenceA_ list) xs
126+
127+{-# INLINE sequence #-}
128+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
129+sequence value xs = do
130+ let parser = satisfy (> 0)
131+ list = Prelude.replicate value parser
132+ x <- PARSE_OP (TR.sequence list) xs
133+ return $ Prelude.length x
134+
135+{-# INLINE manyAlt #-}
136+manyAlt :: MonadCatch m => SerialT m Int -> m Int
137+manyAlt xs = do
138+ x <- PARSE_OP (AP.many (satisfy (> 0))) xs
139+ return $ Prelude.length x
140+
141+{-# INLINE someAlt #-}
142+someAlt :: MonadCatch m => SerialT m Int -> m Int
143+someAlt xs = do
144+ x <- PARSE_OP (AP.some (satisfy (> 0))) xs
145+ return $ Prelude.length x
146+
147+{-# INLINE choice #-}
148+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
149+choice value =
150+ PARSE_OP (asum (replicate value (satisfy (< 0)))
151+ AP.<|> satisfy (> 0))
152+
153+-------------------------------------------------------------------------------
154+-- Benchmarks
155+-------------------------------------------------------------------------------
156+
157+moduleName :: String
158+moduleName = "Data.Parser.ParserK"
159+
160+o_1_space_serial :: Int -> [Benchmark]
161+o_1_space_serial value =
162+ [ benchIOSink value "any" $ anyK value
163+ , benchIOSink value "all" $ allK value
164+ , benchIOSink value "take" $ takeK value
165+ , benchIOSink value "takeWhile" $ takeWhileK value
166+ , benchIOSink value "splitApp" $ splitApp value
167+ ]
168+
169+-- O(n) heap beacuse of accumulation of the list in strict IO monad?
170+o_n_heap_serial :: Int -> [Benchmark]
171+o_n_heap_serial value =
172+ [ benchIOSink value "sequenceA" $ sequenceA value
173+ , benchIOSink value "sequenceA_" $ sequenceA_ value
174+ , benchIOSink value "sequence" $ sequence value
175+ , benchIOSink value "manyAlt" manyAlt
176+ , benchIOSink value "someAlt" someAlt
177+ , benchIOSink value "choice" $ choice value
178+ ]
179+
180+-------------------------------------------------------------------------------
181+-- Driver
182+-------------------------------------------------------------------------------
183+
184+main :: IO ()
185+main = do
186+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
187+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
188+
189+ where
190+
191+ allBenchmarks value =
192+ [ bgroup (o_1_space_prefix moduleName) $ concat
193+ [ o_1_space_serial value
194+ ]
195+ , bgroup (o_n_heap_prefix moduleName) $ concat
196+ [ o_n_heap_serial value
197+ ]
198+ ]
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/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/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.hs+15−59
@@ -1,6 +1,6 @@
11-- |
22-- Module : Streamly.Benchmark.Data.Stream.StreamD
3−-- Copyright : (c) 2018 Composewell Technologies
3+-- Copyright : (c) 2018 Harendra Kumar
44--
55-- License : BSD3
66-- Maintainer : streamly@composewell.com
@@ -8,8 +8,6 @@
88{-# LANGUAGE CPP #-}
99{-# LANGUAGE FlexibleContexts #-}
1010{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE TupleSections #-}
12−{-# OPTIONS_GHC -Wno-orphans #-}
1311
1412#ifdef __HADDOCK_VERSION__
1513#undef INSPECTION
@@ -22,19 +20,15 @@
2220
2321module Main (main) where
2422
25−#if !MIN_VERSION_base(4,18,0)
26−import Control.Applicative (liftA2)
27−#endif
2823import Control.Monad (when)
2924import Data.Maybe (isJust)
30−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
25+import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
3126import System.Random (randomRIO)
3227import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
3328
3429import qualified Prelude as P
35−import qualified Streamly.Internal.Data.Stream as S
30+import qualified Streamly.Internal.Data.Stream.StreamD as S
3631import qualified Streamly.Internal.Data.Unfold as UF
37−import qualified Streamly.Internal.Data.Fold as FL
3832
3933import Streamly.Benchmark.Common
4034
@@ -131,12 +125,6 @@ uncons s = do
131125 Nothing -> return ()
132126 Just (_, t) -> uncons t
133127
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−
140128{-# INLINE tail #-}
141129tail :: Monad m => Stream m a -> m ()
142130tail s = S.tail s >>= P.mapM_ tail
@@ -326,34 +314,6 @@ filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
326314-- Nested Composition
327315-------------------------------------------------------------------------------
328316
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−
357317{-# INLINE toNullApNested #-}
358318toNullApNested :: Monad m => Stream m Int -> m ()
359319toNullApNested s = runStream $ do
@@ -442,20 +402,17 @@ inspect $ hasNoTypeClasses 'concatMapRepl
442402inspect $ 'concatMapRepl `hasNoType` ''SPEC
443403#endif
444404
445−-- unfoldMany replicate/unfoldrM
405+-- concatUnfold replicate/unfoldrM
446406
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))
407+{-# INLINE concatUnfoldRepl #-}
408+concatUnfoldRepl :: Int -> Int -> Int -> IO ()
409+concatUnfoldRepl outer inner n =
410+ S.drain $ S.concatMapU (UF.replicateM inner) (sourceUnfoldrMN outer n)
454411
455412#ifdef INSPECTION
456−inspect $ hasNoTypeClasses 'unfoldManyRepl
457−inspect $ 'unfoldManyRepl `hasNoType` ''S.ConcatMapUState
458−inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
413+inspect $ hasNoTypeClasses 'concatUnfoldRepl
414+inspect $ 'concatUnfoldRepl `hasNoType` ''S.ConcatMapUState
415+inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
459416#endif
460417
461418-------------------------------------------------------------------------------
@@ -463,7 +420,7 @@ inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
463420-------------------------------------------------------------------------------
464421
465422moduleName :: String
466−moduleName = "Data.StreamD"
423+moduleName = "Data.Stream.StreamD"
467424
468425o_1_space :: [Benchmark]
469426o_1_space =
@@ -479,7 +436,6 @@ o_1_space =
479436 [ benchFold "toNull" toNull sourceUnfoldrM
480437 , benchFold "mapM_" mapM_ sourceUnfoldrM
481438 , benchFold "uncons" uncons sourceUnfoldrM
482− , benchFold "foldBreak" foldBreak sourceUnfoldrM
483439 , benchFold "foldl'" foldl sourceUnfoldrM
484440 , benchFold "last" last sourceUnfoldrM
485441 ]
@@ -529,11 +485,11 @@ o_1_space =
529485 , benchIOSrc1 "concatMap (1 of n)"
530486 (concatMap 1 value)
531487
532− -- concatMap vs unfoldMany
488+ -- concatMap vs concatUnfold
533489 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
534490 (concatMapRepl value2 value2)
535− , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
536− (unfoldManyRepl value2 value2)
491+ , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
492+ (concatUnfoldRepl value2 value2)
537493 ]
538494 , bgroup "filtering"
539495 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hsrenamed+7−9
@@ -1,8 +1,6 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.Data.Stream.StreamDK
5−-- Copyright : (c) 2018 Composewell Technologies
3+-- Copyright : (c) 2018 Harendra Kumar
64--
75-- License : BSD3
86-- Maintainer : streamly@composewell.com
@@ -18,12 +16,12 @@ import Prelude hiding ()
1816-- import qualified Prelude as P
1917-- import qualified Data.List as List
2018
21−import qualified Streamly.Internal.Data.StreamK.Alt as S
22−-- import qualified Streamly.Internal.Data.Stream.Common as SP
19+import qualified Streamly.Internal.Data.Stream.StreamDK as S
20+-- import qualified Streamly.Internal.Data.Stream.Prelude as SP
2321-- import qualified Streamly.Internal.Data.SVar as S
2422
2523import Streamly.Benchmark.Common
26−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
24+import Gauge (bgroup, Benchmark, defaultMain)
2725
2826value :: Int
2927value = 100000
@@ -106,11 +104,11 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
106104{-
107105{-# INLINE sourceFoldMapWith #-}
108106sourceFoldMapWith :: Int -> Stream m Int
109−sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]
107+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
110108
111109{-# INLINE sourceFoldMapWithM #-}
112110sourceFoldMapWithM :: Monad m => Int -> Stream m Int
113−sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]
111+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
114112-}
115113
116114-------------------------------------------------------------------------------
@@ -452,4 +450,4 @@ o_1_space =
452450 ]
453451
454452main :: IO ()
455−main = defaultMain [o_1_space]
453+main = defaultMain $ concat [o_1_space]
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+358−593
@@ -1,6 +1,6 @@
11-- |
22-- Module : Streamly.Benchmark.Data.Stream.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
3+-- Copyright : (c) 2018 Harendra Kumar
44--
55-- License : BSD3
66-- Maintainer : streamly@composewell.com
@@ -8,7 +8,6 @@
88{-# LANGUAGE CPP #-}
99{-# LANGUAGE FlexibleContexts #-}
1010{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
1211
1312#ifdef __HADDOCK_VERSION__
1413#undef INSPECTION
@@ -21,23 +20,20 @@
2120
2221module Main (main) where
2322
24−#if !MIN_VERSION_base(4,18,0)
25−import Control.Applicative (liftA2)
26−#endif
2723import Control.Monad (when)
2824import Data.Maybe (isJust)
2925import System.Random (randomRIO)
3026import Prelude hiding
31− ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
32− , repeat, replicate
33− )
27+ (tail, mapM_, foldl, last, map, mapM, concatMap, zip, init)
3428
3529import qualified Prelude as P
3630import qualified Data.List as List
3731
38−import qualified Streamly.Internal.Data.StreamK as S
32+import qualified Streamly.Internal.Data.Stream.StreamK as S
33+import qualified Streamly.Internal.Data.Stream.Prelude as SP
34+import qualified Streamly.Internal.Data.SVar as S
3935
40−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
36+import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
4137
4238import Streamly.Benchmark.Common
4339
@@ -45,163 +41,106 @@ import Streamly.Benchmark.Common
4541import Test.Inspection
4642#endif
4743
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−-}
44+value, value2, value3, value16, maxValue :: Int
45+value = 100000
46+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
47+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
48+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
49+maxValue = value
50+
51+-------------------------------------------------------------------------------
52+-- Benchmark ops
53+-------------------------------------------------------------------------------
54+
55+{-# INLINE toNull #-}
56+{-# INLINE uncons #-}
57+{-# INLINE nullTail #-}
58+{-# INLINE headTail #-}
59+{-# INLINE zip #-}
60+toNull, uncons, nullTail, headTail, zip
61+ :: Monad m
62+ => Stream m Int -> m ()
63+
64+{-# INLINE toList #-}
65+toList :: Monad m => Stream m Int -> m [Int]
66+{-# INLINE foldl #-}
67+foldl :: Monad m => Stream m Int -> m Int
68+{-# INLINE last #-}
69+last :: Monad m => Stream m Int -> m (Maybe Int)
11570
11671-------------------------------------------------------------------------------
11772-- Stream generation and elimination
11873-------------------------------------------------------------------------------
11974
120−type Stream m a = S.StreamK m a
75+type Stream m a = S.Stream m a
12176
122−{-# INLINE unfoldr #-}
123−unfoldr :: Int -> Int -> Stream m Int
124−unfoldr streamLen n = S.unfoldr step n
77+{-# INLINE sourceUnfoldr #-}
78+sourceUnfoldr :: Int -> Stream m Int
79+sourceUnfoldr n = S.unfoldr step n
12580 where
12681 step cnt =
127− if cnt > n + streamLen
82+ if cnt > n + value
12883 then Nothing
12984 else Just (cnt, cnt + 1)
13085
131−{-# INLINE unfoldrM #-}
132−unfoldrM :: Monad m => Int -> Int -> Stream m Int
133−unfoldrM streamLen n = S.unfoldrMWith S.consM step n
86+{-# INLINE sourceUnfoldrN #-}
87+sourceUnfoldrN :: Int -> Int -> Stream m Int
88+sourceUnfoldrN m n = S.unfoldr step n
13489 where
13590 step cnt =
136− if cnt > n + streamLen
91+ if cnt > n + m
92+ then Nothing
93+ else Just (cnt, cnt + 1)
94+
95+{-# INLINE sourceUnfoldrM #-}
96+sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
97+sourceUnfoldrM n = S.unfoldrM step n
98+ where
99+ step cnt =
100+ if cnt > n + value
101+ then return Nothing
102+ else return (Just (cnt, cnt + 1))
103+
104+{-# INLINE sourceUnfoldrMN #-}
105+sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
106+sourceUnfoldrMN m n = S.unfoldrM step n
107+ where
108+ step cnt =
109+ if cnt > n + m
137110 then return Nothing
138111 else return (Just (cnt, cnt + 1))
139112
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]
113+{-# INLINE sourceFromFoldable #-}
114+sourceFromFoldable :: Int -> Stream m Int
115+sourceFromFoldable n = S.fromFoldable [n..n+value]
116+
117+{-# INLINE sourceFromFoldableM #-}
118+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
119+sourceFromFoldableM n =
120+ Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+value])
121+
122+{-# INLINE sourceFoldMapWith #-}
123+sourceFoldMapWith :: Int -> Stream m Int
124+sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
125+
126+{-# INLINE sourceFoldMapWithM #-}
127+sourceFoldMapWithM :: Monad m => Int -> Stream m Int
128+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
190129
191130-------------------------------------------------------------------------------
192131-- Elimination
193132-------------------------------------------------------------------------------
194133
195−{-# INLINE drain #-}
196−drain :: Monad m => Stream m a -> m ()
197−drain = S.drain
134+{-# INLINE runStream #-}
135+runStream :: Monad m => Stream m a -> m ()
136+runStream = S.drain
137+-- runStream = S.mapM_ (\_ -> return ())
198138
199139{-# INLINE mapM_ #-}
200140mapM_ :: Monad m => Stream m a -> m ()
201141mapM_ = S.mapM_ (\_ -> return ())
202142
203−{-# INLINE uncons #-}
204−uncons :: Monad m => Stream m Int -> m ()
143+toNull = runStream
205144uncons s = do
206145 r <- S.uncons s
207146 case r of
@@ -209,238 +148,167 @@ uncons s = do
209148 Just (_, t) -> uncons t
210149
211150{-# INLINE init #-}
212−init :: Monad m => Stream m a -> m ()
151+init :: (Monad m, S.IsStream t) => t m a -> m ()
213152init s = do
214153 t <- S.init s
215154 P.mapM_ S.drain t
216155
217156{-# INLINE tail #-}
218−tail :: Monad m => Stream m a -> m ()
157+tail :: (Monad m, S.IsStream t) => t m a -> m ()
219158tail s = S.tail s >>= P.mapM_ tail
220159
221−{-# INLINE nullTail #-}
222−nullTail :: Monad m => Stream m Int -> m ()
223160nullTail s = do
224161 r <- S.null s
225162 when (not r) $ S.tail s >>= P.mapM_ nullTail
226163
227−{-# INLINE headTail #-}
228−headTail :: Monad m => Stream m Int -> m ()
229164headTail s = do
230165 h <- S.head s
231166 when (isJust h) $ S.tail s >>= P.mapM_ headTail
232167
233−{-# INLINE toList #-}
234−toList :: Monad m => Stream m Int -> m [Int]
235168toList = 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
169+foldl = S.foldl' (+) 0
170+last = S.last
244171
245172-------------------------------------------------------------------------------
246173-- Transformation
247174-------------------------------------------------------------------------------
248175
176+{-# INLINE transform #-}
177+transform :: Monad m => Stream m a -> m ()
178+transform = runStream
179+
249180{-# INLINE composeN #-}
250181composeN
251182 :: Monad m
252183 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
253184composeN n f =
254185 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
186+ 1 -> transform . f
187+ 2 -> transform . f . f
188+ 3 -> transform . f . f . f
189+ 4 -> transform . f . f . f . f
259190 _ -> undefined
260191
261−{-# INLINE scanl' #-}
262−scanl' :: Monad m => Int -> Stream m Int -> m ()
263−scanl' n = composeN n $ S.scanl' (+) 0
264−
192+{-# INLINE scan #-}
265193{-# INLINE map #-}
266−map :: Monad m => Int -> Stream m Int -> m ()
267−map n = composeN n $ S.map (+ 1)
268−
269194{-# 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−
281195{-# INLINE filterEven #-}
282−filterEven :: Monad m => Int -> Stream m Int -> m ()
283−filterEven n = composeN n $ S.filter even
284−
285196{-# INLINE filterAllOut #-}
286−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
288−
289197{-# INLINE filterAllIn #-}
290−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
292−
293198{-# INLINE _takeOne #-}
294−_takeOne :: Monad m => Int -> Stream m Int -> m ()
295−_takeOne n = composeN n $ S.take 1
296−
297199{-# INLINE takeAll #-}
298−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299−takeAll streamLen n = composeN n $ S.take streamLen
300−
301200{-# INLINE takeWhileTrue #-}
302−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
304−
305201{-# INLINE dropOne #-}
306−dropOne :: Monad m => Int -> Stream m Int -> m ()
307−dropOne n = composeN n $ S.drop 1
308−
309202{-# INLINE dropAll #-}
310−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311−dropAll streamLen n = composeN n $ S.drop streamLen
312−
313203{-# INLINE dropWhileTrue #-}
314−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
316−
317204{-# INLINE dropWhileFalse #-}
318−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
320−
321205{-# INLINE foldrS #-}
322−foldrS :: Monad m => Int -> Stream m Int -> m ()
323−foldrS n = composeN n $ S.foldrS S.cons S.nil
324−
325206{-# INLINE foldlS #-}
326−foldlS :: Monad m => Int -> Stream m Int -> m ()
327−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
207+scan, map, fmapK, filterEven, filterAllOut,
208+ filterAllIn, _takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
209+ dropWhileTrue, dropWhileFalse, foldrS, foldlS
210+ :: Monad m
211+ => Int -> Stream m Int -> m ()
328212
213+{-# INLINE mapM #-}
214+{-# INLINE mapMSerial #-}
329215{-# INLINE intersperse #-}
330−intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
331−intersperse streamLen n = composeN n $ S.intersperse streamLen
216+mapM, mapMSerial, intersperse
217+ :: S.MonadAsync m => Int -> Stream m Int -> m ()
218+
219+scan n = composeN n $ S.scanl' (+) 0
220+map n = composeN n $ P.fmap (+1)
221+fmapK n = composeN n $ P.fmap (+1)
222+mapM n = composeN n $ S.mapM return
223+mapMSerial n = composeN n $ S.mapMSerial return
224+filterEven n = composeN n $ S.filter even
225+filterAllOut n = composeN n $ S.filter (> maxValue)
226+filterAllIn n = composeN n $ S.filter (<= maxValue)
227+_takeOne n = composeN n $ S.take 1
228+takeAll n = composeN n $ S.take maxValue
229+takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
230+dropOne n = composeN n $ S.drop 1
231+dropAll n = composeN n $ S.drop maxValue
232+dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
233+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
234+foldrS n = composeN n $ S.foldrS S.cons S.nil
235+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
236+intersperse n = composeN n $ S.intersperse maxValue
332237
333238-------------------------------------------------------------------------------
334239-- Iteration
335240-------------------------------------------------------------------------------
336241
242+iterStreamLen, maxIters :: Int
243+iterStreamLen = 10
244+maxIters = 10000
245+
337246{-# INLINE iterateSource #-}
338247iterateSource
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)
248+ :: S.MonadAsync m
249+ => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
250+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
341251 where
342252 f (0 :: Int) m = g m
343253 f x m = g (f (x P.- 1) m)
344254
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−
357255{-# INLINE iterateMapM #-}
358−iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359−iterateMapM iterStreamLen =
360− iterateSource iterStreamLen (S.mapMWith S.consM return)
361−
256+{-# INLINE iterateScan #-}
362257{-# INLINE iterateFilterEven #-}
363−iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365−
366258{-# INLINE iterateTakeAll #-}
367−iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368−iterateTakeAll streamLen iterStreamLen =
369− iterateSource iterStreamLen (S.take streamLen)
370−
371259{-# INLINE iterateDropOne #-}
372−iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
373−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
374−
260+{-# INLINE iterateDropWhileFalse #-}
375261{-# INLINE iterateDropWhileTrue #-}
376−iterateDropWhileTrue ::
377− Monad m => Int -> Int -> Int -> Int -> Stream m Int
378−iterateDropWhileTrue streamLen iterStreamLen =
379− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
262+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
263+ iterateDropWhileFalse, iterateDropWhileTrue
264+ :: S.MonadAsync m
265+ => Int -> Stream m Int
266+
267+-- this is quadratic
268+iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
269+iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
270+ (maxIters `div` 10)
271+
272+iterateMapM = iterateSource (S.mapM return) maxIters
273+iterateFilterEven = iterateSource (S.filter even) maxIters
274+iterateTakeAll = iterateSource (S.take maxValue) maxIters
275+iterateDropOne = iterateSource (S.drop 1) maxIters
276+iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
380277
381278-------------------------------------------------------------------------------
382279-- Zipping
383280-------------------------------------------------------------------------------
384281
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
282+zip src = transform $ S.zipWith (,) src src
400283
401284-------------------------------------------------------------------------------
402285-- Mixed Composition
403286-------------------------------------------------------------------------------
404287
405288{-# INLINE scanMap #-}
406−scanMap :: Monad m => Int -> Stream m Int -> m ()
407−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
408−
409289{-# INLINE dropMap #-}
410−dropMap :: Monad m => Int -> Stream m Int -> m ()
411−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
412−
413290{-# INLINE dropScan #-}
414−dropScan :: Monad m => Int -> Stream m Int -> m ()
415−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
416−
417291{-# 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−
421292{-# 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−
425293{-# 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−
429294{-# 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−
433295{-# 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−
437296{-# INLINE filterScan #-}
438−filterScan :: Monad m => Int -> Stream m Int -> m ()
439−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
440−
441297{-# 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)
298+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
299+ filterTake, filterScan, filterMap
300+ :: Monad m => Int -> Stream m Int -> m ()
301+
302+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
303+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
304+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
305+takeDrop n = composeN n $ S.drop 1 . S.take maxValue
306+takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
307+takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
308+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
309+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
310+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
311+filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
444312
445313-------------------------------------------------------------------------------
446314-- ConcatMap
@@ -452,8 +320,8 @@ filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen
452320concatMap :: Int -> Int -> Int -> IO ()
453321concatMap outer inner n =
454322 S.drain $ S.concatMap
455− (\_ -> unfoldrM inner n)
456− (unfoldrM outer n)
323+ (\_ -> sourceUnfoldrMN inner n)
324+ (sourceUnfoldrMN outer n)
457325
458326#ifdef INSPECTION
459327inspect $ hasNoTypeClasses 'concatMap
@@ -465,8 +333,8 @@ inspect $ hasNoTypeClasses 'concatMap
465333concatMapPure :: Int -> Int -> Int -> IO ()
466334concatMapPure outer inner n =
467335 S.drain $ S.concatMap
468− (\_ -> unfoldr inner n)
469− (unfoldr outer n)
336+ (\_ -> sourceUnfoldrN inner n)
337+ (sourceUnfoldrN outer n)
470338
471339#ifdef INSPECTION
472340inspect $ hasNoTypeClasses 'concatMapPure
@@ -477,7 +345,7 @@ inspect $ hasNoTypeClasses 'concatMapPure
477345{-# INLINE concatMapRepl #-}
478346concatMapRepl :: Int -> Int -> Int -> IO ()
479347concatMapRepl outer inner n =
480− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
348+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
481349
482350#ifdef INSPECTION
483351inspect $ hasNoTypeClasses 'concatMapRepl
@@ -489,70 +357,44 @@ inspect $ hasNoTypeClasses 'concatMapRepl
489357sourceConcatMapId :: Monad m
490358 => Int -> Int -> Stream m (Stream m Int)
491359sourceConcatMapId val n =
492− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
360+ S.fromFoldable $ fmap (S.yieldM . return) [n..n+val]
493361
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)
362+{-# INLINE concatStreamsWith #-}
363+concatStreamsWith :: Int -> Int -> Int -> IO ()
364+concatStreamsWith outer inner n =
365+ S.drain $ S.concatMapBy S.serial
366+ (sourceUnfoldrMN inner)
367+ (sourceUnfoldrMN outer n)
500368
501369-------------------------------------------------------------------------------
502370-- Nested Composition
503371-------------------------------------------------------------------------------
504372
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
373+{-# INLINE toNullApNested #-}
374+toNullApNested :: Monad m => Stream m Int -> m ()
375+toNullApNested s = runStream $ do
534376 (+) <$> s <*> s
535377
536−{-# INLINE drainMonad #-}
537−drainMonad :: Monad m => Stream m Int -> m ()
538−drainMonad s = drain $ do
378+{-# INLINE toNullNested #-}
379+toNullNested :: Monad m => Stream m Int -> m ()
380+toNullNested s = runStream $ do
539381 x <- s
540382 y <- s
541383 return $ x + y
542384
543−{-# INLINE drainMonad3 #-}
544−drainMonad3 :: Monad m => Stream m Int -> m ()
545−drainMonad3 s = drain $ do
385+{-# INLINE toNullNested3 #-}
386+toNullNested3 :: Monad m => Stream m Int -> m ()
387+toNullNested3 s = runStream $ do
546388 x <- s
547389 y <- s
548390 z <- s
549391 return $ x + y + z
550392
551−{-# INLINE filterAllOutMonad #-}
552−filterAllOutMonad
393+{-# INLINE filterAllOutNested #-}
394+filterAllOutNested
553395 :: Monad m
554396 => Stream m Int -> m ()
555−filterAllOutMonad str = drain $ do
397+filterAllOutNested str = runStream $ do
556398 x <- str
557399 y <- str
558400 let s = x + y
@@ -560,11 +402,11 @@ filterAllOutMonad str = drain $ do
560402 then return s
561403 else S.nil
562404
563−{-# INLINE filterAllInMonad #-}
564−filterAllInMonad
405+{-# INLINE filterAllInNested #-}
406+filterAllInNested
565407 :: Monad m
566408 => Stream m Int -> m ()
567−filterAllInMonad str = drain $ do
409+filterAllInNested str = runStream $ do
568410 x <- str
569411 y <- str
570412 let s = x + y
@@ -576,14 +418,9 @@ filterAllInMonad str = drain $ do
576418-- Nested Composition Pure lists
577419-------------------------------------------------------------------------------
578420
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
421+{-# INLINE sourceUnfoldrList #-}
422+sourceUnfoldrList :: Int -> Int -> [Int]
423+sourceUnfoldrList maxval n = List.unfoldr step n
587424 where
588425 step cnt =
589426 if cnt > n + maxval
@@ -634,301 +471,229 @@ filterAllInNestedList str = do
634471-------------------------------------------------------------------------------
635472
636473moduleName :: 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)
474+moduleName = "Data.Stream.StreamK"
475+
476+o_1_space :: [Benchmark]
477+o_1_space =
478+ [ bgroup (o_1_space_prefix moduleName)
479+ [ bgroup "generation"
480+ [ benchFold "unfoldr" toNull sourceUnfoldr
481+ , benchFold "unfoldrM" toNull sourceUnfoldrM
482+
483+ , benchFold "fromFoldable" toNull sourceFromFoldable
484+ , benchFold "fromFoldableM" toNull sourceFromFoldableM
653485
654486 -- appends
655− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
656− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
487+ , benchFold "foldMapWith" toNull sourceFoldMapWith
488+ , benchFold "foldMapWithM" toNull sourceFoldMapWithM
657489 ]
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)
490+ , bgroup "elimination"
491+ [ benchFold "toNull" toNull sourceUnfoldrM
492+ , benchFold "mapM_" mapM_ sourceUnfoldrM
493+ , benchFold "uncons" uncons sourceUnfoldrM
494+ , benchFold "init" init sourceUnfoldrM
495+ , benchFold "foldl'" foldl sourceUnfoldrM
496+ , benchFold "last" last sourceUnfoldrM
668497 ]
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)
498+ , bgroup "nested"
499+ [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)
500+ , benchFold "toNull" toNullNested (sourceUnfoldrMN value2)
501+ , benchFold "toNull3" toNullNested3 (sourceUnfoldrMN value3)
502+ , benchFold "filterAllIn" filterAllInNested (sourceUnfoldrMN value2)
503+ , benchFold "filterAllOut" filterAllOutNested (sourceUnfoldrMN value2)
504+ , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)
505+ , benchFold "toNullPure" toNullNested (sourceUnfoldrN value2)
506+ , benchFold "toNull3Pure" toNullNested3 (sourceUnfoldrN value3)
507+ , benchFold "filterAllInPure" filterAllInNested (sourceUnfoldrN value2)
508+ , benchFold "filterAllOutPure" filterAllOutNested (sourceUnfoldrN value2)
683509 ]
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)
510+ , bgroup "transformation"
511+ [ benchFold "foldrS" (foldrS 1) sourceUnfoldrM
512+ , benchFold "scan" (scan 1) sourceUnfoldrM
513+ , benchFold "map" (map 1) sourceUnfoldrM
514+ , benchFold "fmap" (fmapK 1) sourceUnfoldrM
515+ , benchFold "mapM" (mapM 1) sourceUnfoldrM
516+ , benchFold "mapMSerial" (mapMSerial 1) sourceUnfoldrM
697517 ]
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)
518+ , bgroup "transformationX4"
519+ [ benchFold "scan" (scan 4) sourceUnfoldrM
520+ , benchFold "map" (map 4) sourceUnfoldrM
521+ , benchFold "fmap" (fmapK 4) sourceUnfoldrM
522+ , benchFold "mapM" (mapM 4) sourceUnfoldrM
523+ , benchFold "mapMSerial" (mapMSerial 4) sourceUnfoldrM
707524 -- XXX this is horribly slow
708− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
525+ -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
709526 ]
710−
711−o_1_space_concat :: Int -> Benchmark
712−o_1_space_concat streamLen =
713− bgroup "concat"
527+ , bgroup "concat"
714528 [ benchIOSrc1 "concatMapPure (n of 1)"
715− (concatMapPure streamLen 1)
529+ (concatMapPure value 1)
716530 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
717− (concatMapPure streamLen2 streamLen2)
531+ (concatMapPure value2 value2)
718532 , benchIOSrc1 "concatMapPure (1 of n)"
719− (concatMapPure 1 streamLen)
533+ (concatMapPure 1 value)
720534
721535 , benchIOSrc1 "concatMap (n of 1)"
722− (concatMap streamLen 1)
536+ (concatMap value 1)
723537 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
724− (concatMap streamLen2 streamLen2)
538+ (concatMap value2 value2)
725539 , benchIOSrc1 "concatMap (1 of n)"
726− (concatMap 1 streamLen)
540+ (concatMap 1 value)
727541
728542 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
729− (concatMapRepl streamLen2 streamLen2)
543+ (concatMapRepl value2 value2)
730544
731− -- This is for comparison with concatMapFoldableWith
545+ -- This is for comparison with foldMapWith
732546 , 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)
547+ (S.drain . S.concatMapBy S.serial id . sourceConcatMapId value)
548+
549+ , benchIOSrc1 "concatMapWith (n of 1)"
550+ (concatStreamsWith value 1)
551+ , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
552+ (concatStreamsWith value2 value2)
553+ , benchIOSrc1 "concatMapWith (1 of n)"
554+ (concatStreamsWith 1 value)
744555 ]
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)
556+ , bgroup "filtering"
557+ [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
558+ , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
559+ , benchFold "filter-all-in" (filterAllIn 1) sourceUnfoldrM
560+ , benchFold "take-all" (takeAll 1) sourceUnfoldrM
561+ , benchFold "takeWhile-true" (takeWhileTrue 1) sourceUnfoldrM
562+ , benchFold "drop-one" (dropOne 1) sourceUnfoldrM
563+ , benchFold "drop-all" (dropAll 1) sourceUnfoldrM
564+ , benchFold "dropWhile-true" (dropWhileTrue 1) sourceUnfoldrM
565+ , benchFold "dropWhile-false" (dropWhileFalse 1) sourceUnfoldrM
760566 ]
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)
567+ , bgroup "filteringX4"
568+ [ benchFold "filter-even" (filterEven 4) sourceUnfoldrM
569+ , benchFold "filter-all-out" (filterAllOut 4) sourceUnfoldrM
570+ , benchFold "filter-all-in" (filterAllIn 4) sourceUnfoldrM
571+ , benchFold "take-all" (takeAll 4) sourceUnfoldrM
572+ , benchFold "takeWhile-true" (takeWhileTrue 4) sourceUnfoldrM
573+ , benchFold "drop-one" (dropOne 4) sourceUnfoldrM
574+ , benchFold "drop-all" (dropAll 4) sourceUnfoldrM
575+ , benchFold "dropWhile-true" (dropWhileTrue 4) sourceUnfoldrM
576+ , benchFold "dropWhile-false" (dropWhileFalse 4) sourceUnfoldrM
774577 ]
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)
578+ , bgroup "zipping"
579+ [ benchFold "zip" zip sourceUnfoldrM
781580 ]
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)
581+ , bgroup "mixed"
582+ [ benchFold "scan-map" (scanMap 1) sourceUnfoldrM
583+ , benchFold "drop-map" (dropMap 1) sourceUnfoldrM
584+ , benchFold "drop-scan" (dropScan 1) sourceUnfoldrM
585+ , benchFold "take-drop" (takeDrop 1) sourceUnfoldrM
586+ , benchFold "take-scan" (takeScan 1) sourceUnfoldrM
587+ , benchFold "take-map" (takeMap 1) sourceUnfoldrM
588+ , benchFold "filter-drop" (filterDrop 1) sourceUnfoldrM
589+ , benchFold "filter-take" (filterTake 1) sourceUnfoldrM
590+ , benchFold "filter-scan" (filterScan 1) sourceUnfoldrM
591+ , benchFold "filter-map" (filterMap 1) sourceUnfoldrM
796592 ]
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)
593+ , bgroup "mixedX2"
594+ [ benchFold "scan-map" (scanMap 2) sourceUnfoldrM
595+ , benchFold "drop-map" (dropMap 2) sourceUnfoldrM
596+ , benchFold "drop-scan" (dropScan 2) sourceUnfoldrM
597+ , benchFold "take-drop" (takeDrop 2) sourceUnfoldrM
598+ , benchFold "take-scan" (takeScan 2) sourceUnfoldrM
599+ , benchFold "take-map" (takeMap 2) sourceUnfoldrM
600+ , benchFold "filter-drop" (filterDrop 2) sourceUnfoldrM
601+ , benchFold "filter-take" (filterTake 2) sourceUnfoldrM
602+ , benchFold "filter-scan" (filterScan 2) sourceUnfoldrM
603+ , benchFold "filter-map" (filterMap 2) sourceUnfoldrM
811604 ]
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)
605+ , bgroup "mixedX4"
606+ [ benchFold "scan-map" (scanMap 4) sourceUnfoldrM
607+ , benchFold "drop-map" (dropMap 4) sourceUnfoldrM
608+ , benchFold "drop-scan" (dropScan 4) sourceUnfoldrM
609+ , benchFold "take-drop" (takeDrop 4) sourceUnfoldrM
610+ , benchFold "take-scan" (takeScan 4) sourceUnfoldrM
611+ , benchFold "take-map" (takeMap 4) sourceUnfoldrM
612+ , benchFold "filter-drop" (filterDrop 4) sourceUnfoldrM
613+ , benchFold "filter-take" (filterTake 4) sourceUnfoldrM
614+ , benchFold "filter-scan" (filterScan 4) sourceUnfoldrM
615+ , benchFold "filter-map" (filterMap 4) sourceUnfoldrM
840616 ]
841617 ]
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− ]
618+ ]
864619
865−o_n_heap :: Int -> Benchmark
866−o_n_heap streamLen =
867− bgroup (o_n_heap_prefix moduleName)
620+o_n_heap :: [Benchmark]
621+o_n_heap =
622+ [ bgroup (o_n_heap_prefix moduleName)
868623 [ bgroup "transformation"
869− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
624+ [ benchFold "foldlS" (foldlS 1) sourceUnfoldrM
870625 ]
871626 ]
627+ ]
872628
873629{-# INLINE benchK #-}
874630benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
875−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
631+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
876632
877−o_n_stack :: Int -> Int -> Int -> Benchmark
878−o_n_stack streamLen iterStreamLen maxIters =
879− bgroup (o_n_stack_prefix moduleName)
633+o_n_stack :: [Benchmark]
634+o_n_stack =
635+ [ bgroup (o_n_stack_prefix moduleName)
880636 [ bgroup "elimination"
881− [ benchFold "tail" tail (unfoldrM streamLen)
882− , benchFold "nullTail" nullTail (unfoldrM streamLen)
883− , benchFold "headTail" headTail (unfoldrM streamLen)
637+ [ benchFold "tail" tail sourceUnfoldrM
638+ , benchFold "nullTail" nullTail sourceUnfoldrM
639+ , benchFold "headTail" headTail sourceUnfoldrM
884640 ]
885641 , bgroup "transformation"
886642 [
887643 -- XXX why do these need so much stack
888− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
889− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
644+ benchFold "intersperse" (intersperse 1) (sourceUnfoldrMN value2)
645+ , benchFold "interspersePure" (intersperse 1) (sourceUnfoldrN value2)
890646 ]
891647 , bgroup "transformationX4"
892648 [
893− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
649+ benchFold "intersperse" (intersperse 4) (sourceUnfoldrMN value16)
894650 ]
895651 , 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)
652+ [ benchK "mapM" iterateMapM
653+ , benchK "scan(1/10)" iterateScan
654+ , benchK "filterEven" iterateFilterEven
655+ , benchK "takeAll" iterateTakeAll
656+ , benchK "dropOne" iterateDropOne
657+ , benchK "dropWhileFalse(1/10)" iterateDropWhileFalse
658+ , benchK "dropWhileTrue" iterateDropWhileTrue
903659 ]
904660 ]
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
661+ ]
908662
909−o_n_space :: Int -> Benchmark
910−o_n_space streamLen =
911− bgroup (o_n_space_prefix moduleName)
663+o_n_space :: [Benchmark]
664+o_n_space =
665+ [ bgroup (o_n_space_prefix moduleName)
912666 [ bgroup "elimination"
913− [ benchFold "toList" toList (unfoldrM streamLen)
667+ [ benchFold "toList" toList sourceUnfoldrM
914668 ]
915669 ]
670+ ]
916671
917672{-# INLINE benchList #-}
918673benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
919674benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
920675
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
676+o_1_space_list :: [Benchmark]
677+o_1_space_list =
678+ [ bgroup "list"
679+ [ bgroup "elimination"
680+ [ benchList "last" (\xs -> [List.last xs]) (sourceUnfoldrList value)
928681 ]
682+ , bgroup "nested"
683+ [ benchList "toNullAp" toNullApNestedList (sourceUnfoldrList value2)
684+ , benchList "toNull" toNullNestedList (sourceUnfoldrList value2)
685+ , benchList "toNull3" toNullNestedList3 (sourceUnfoldrList value3)
686+ , benchList "filterAllIn" filterAllInNestedList (sourceUnfoldrList value2)
687+ , benchList "filterAllOut" filterAllOutNestedList (sourceUnfoldrList value2)
688+ ]
689+ ]
690+ ]
929691
930− where
931−
932− streamLen = 100000
933− maxIters = 10000
934− iterStreamLen = 10
692+main :: IO ()
693+main = defaultMain $ concat
694+ [ o_1_space
695+ , [bgroup (o_1_space_prefix moduleName) o_1_space_list]
696+ , o_n_stack
697+ , o_n_heap
698+ , o_n_space
699+ ]
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.hs+31−814
@@ -1,856 +1,73 @@
11-- |
22-- Module : Streamly.Benchmark.Data.Fold
33-- Copyright : (c) 2018 Composewell
4+--
45-- License : MIT
56-- Maintainer : streamly@composewell.com
67
78{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−
11−#ifdef __HADDOCK_VERSION__
12−#undef INSPECTION
13−#endif
14−
15−#ifdef INSPECTION
16−{-# LANGUAGE TemplateHaskell #-}
17−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18−#endif
199
2010module Main (main) where
2111
2212import Control.DeepSeq (NFData(..))
23−import Control.Exception (SomeException, ErrorCall, try)
24−import Data.Char (ord)
25−import Data.Word (Word8)
26−import Streamly.Internal.Data.Unfold (Unfold)
27−import System.IO (Handle, hClose)
13+
2814import System.Random (randomRIO)
2915
16+import Gauge
17+
18+import Prelude hiding (concat)
19+
3020import qualified Prelude
31−import qualified Streamly.FileSystem.Handle as FH
32−import qualified Streamly.Internal.Data.Fold as FL
33−import qualified Streamly.Internal.Data.Unfold as UF
34−import qualified Streamly.Internal.Data.Unfold.Prelude as UF
35−import qualified Streamly.Internal.Data.Stream as S
36−import qualified Streamly.Internal.Data.Stream as D
37−import qualified Streamly.Internal.Data.StreamK as K
3821
39−import Test.Tasty.Bench hiding (env)
40−import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile)
4122import Streamly.Benchmark.Common
42−import Streamly.Benchmark.Common.Handle
43−
44−#ifdef INSPECTION
45−import Control.Monad.Catch (MonadCatch)
46−import Test.Inspection
47−#endif
23+import Streamly.Benchmark.Data.NestedUnfoldOps
4824
4925{-# INLINE benchIO #-}
5026benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
5127benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
5228
5329-------------------------------------------------------------------------------
54−-- Stream generation and elimination
55−-------------------------------------------------------------------------------
56−
57−-- generate numbers up to the argument value
58−{-# INLINE source #-}
59−source :: Monad m => Int -> Unfold m Int Int
60−source n = UF.second n UF.enumerateFromToIntegral
61−
62−-------------------------------------------------------------------------------
63−-- Benchmark helpers
64−-------------------------------------------------------------------------------
65−
66−{-# INLINE drainGeneration #-}
67−drainGeneration :: Monad m => Unfold m a b -> a -> m ()
68−drainGeneration unf seed = UF.fold FL.drain unf seed
69−
70−{-# INLINE drainTransformation #-}
71−drainTransformation ::
72− Monad m => Unfold m a b -> (Unfold m a b -> Unfold m c d) -> c -> m ()
73−drainTransformation unf f seed = drainGeneration (f unf) seed
74−
75−{-# INLINE drainTransformationDefault #-}
76−drainTransformationDefault ::
77− Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
78−drainTransformationDefault to =
79− drainTransformation (UF.second to UF.enumerateFromToIntegral)
80−
81−{-# INLINE drainProduct #-}
82−drainProduct ::
83− Monad m
84− => Unfold m a b
85− -> Unfold m c d
86− -> (Unfold m a b -> Unfold m c d -> Unfold m e f)
87− -> e
88− -> m ()
89−drainProduct unf1 unf2 f seed = drainGeneration (f unf1 unf2) seed
90−
91−{-# INLINE drainProductDefault #-}
92−drainProductDefault ::
93− Monad m
94− => Int
95− -> (Unfold m Int Int -> Unfold m Int Int -> Unfold m e f)
96− -> e
97− -> m ()
98−drainProductDefault to = drainProduct src src
99−
100− where
101−
102− src = UF.second to UF.enumerateFromToIntegral
103−
104−-------------------------------------------------------------------------------
105−-- Operations on input
106−-------------------------------------------------------------------------------
107−
108−{-# INLINE lmap #-}
109−lmap :: Monad m => Int -> Int -> m ()
110−lmap size start =
111− drainTransformationDefault (size + start) (UF.lmap (+ 1)) start
112−
113−{-# INLINE lmapM #-}
114−lmapM :: Monad m => Int -> Int -> m ()
115−lmapM size start =
116− drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
117−
118−{-# INLINE both #-}
119−both :: Monad m => Int -> Int -> m ()
120−both size start =
121− drainTransformationDefault (size + start) (UF.both start) undefined
122−
123−
124−{-# INLINE first #-}
125−first :: Monad m => Int -> Int -> m ()
126−first size start =
127− drainTransformation
128− (UF.take size UF.enumerateFromThenIntegral)
129− (UF.first start)
130− 1
131−
132−{-# INLINE second #-}
133−second :: Monad m => Int -> Int -> m ()
134−second size start =
135− drainTransformation
136− (UF.take size UF.enumerateFromThenIntegral)
137− (UF.second 1)
138− start
139−
140−{-# INLINE discardFirst #-}
141−discardFirst :: Monad m => Int -> Int -> m ()
142−discardFirst size start =
143− drainTransformationDefault (size + start) UF.discardFirst (start, start)
144−
145−{-# INLINE discardSecond #-}
146−discardSecond :: Monad m => Int -> Int -> m ()
147−discardSecond size start =
148− drainTransformationDefault (size + start) UF.discardSecond (start, start)
149−
150−{-# INLINE swap #-}
151−swap :: Monad m => Int -> Int -> m ()
152−swap size start =
153− drainTransformation
154− (UF.take size UF.enumerateFromThenIntegral)
155− UF.swap
156− (1, start)
157−
158−-------------------------------------------------------------------------------
159−-- Stream generation
160−-------------------------------------------------------------------------------
161−
162−{-# INLINE fromStream #-}
163−fromStream :: Int -> Int -> IO ()
164−fromStream size start =
165− drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)
166−
167−-- XXX INVESTIGATE: Although the performance of this should be equivalant to
168−-- fromStream, this is considerably worse. More than 4x worse.
169−{-# INLINE fromStreamK #-}
170−fromStreamK :: Monad m => Int -> Int -> m ()
171−fromStreamK size start = drainGeneration UF.fromStreamK (K.replicate size start)
172−
173−{-# INLINE fromStreamD #-}
174−fromStreamD :: Monad m => Int -> Int -> m ()
175−fromStreamD size start =
176− drainGeneration UF.fromStreamD (D.replicate size start)
177−
178−{-# INLINE _nilM #-}
179−_nilM :: Monad m => Int -> Int -> m ()
180−_nilM _ start = drainGeneration (UF.nilM return) start
181−
182−{-# INLINE consM #-}
183−consM :: Monad m => Int -> Int -> m ()
184−consM size start =
185− drainTransformationDefault (size + start) (UF.consM return) start
186−
187−{-# INLINE _functionM #-}
188−_functionM :: Monad m => Int -> Int -> m ()
189−_functionM _ start = drainGeneration (UF.functionM return) start
190−
191−{-# INLINE _function #-}
192−_function :: Monad m => Int -> Int -> m ()
193−_function _ start = drainGeneration (UF.function id) start
194−
195−{-# INLINE _identity #-}
196−_identity :: Monad m => Int -> Int -> m ()
197−_identity _ start = drainGeneration UF.identity start
198−
199−{-# INLINE _const #-}
200−_const :: Monad m => Int -> Int -> m ()
201−_const size start =
202− drainGeneration (UF.take size (UF.fromEffect (return start))) undefined
203−
204−{-# INLINE unfoldrM #-}
205−unfoldrM :: Monad m => Int -> Int -> m ()
206−unfoldrM size start = drainGeneration (UF.unfoldrM step) start
207−
208− where
209−
210− step i =
211− return
212− $ if i < start + size
213− then Just (i, i + 1)
214− else Nothing
215−
216−{-# INLINE fromList #-}
217−fromList :: Monad m => Int -> Int -> m ()
218−fromList size start = drainGeneration UF.fromList [start .. start + size]
219−
220−{-# INLINE fromListM #-}
221−fromListM :: Monad m => Int -> Int -> m ()
222−fromListM size start =
223− drainGeneration UF.fromListM (Prelude.map return [start .. start + size])
224−
225−{-# INLINE _fromSVar #-}
226−_fromSVar :: Int -> Int -> m ()
227−_fromSVar = undefined
228−
229−{-# INLINE _fromProducer #-}
230−_fromProducer :: Int -> Int -> m ()
231−_fromProducer = undefined
232−
233−{-# INLINE replicateM #-}
234−replicateM :: Monad m => Int -> Int -> m ()
235−replicateM size start = drainGeneration UF.replicateM (size, return start)
236−
237−{-# INLINE repeatM #-}
238−repeatM :: Monad m => Int -> Int -> m ()
239−repeatM size start = drainGeneration (UF.take size UF.repeatM) (return start)
240−
241−{-# INLINE iterateM #-}
242−iterateM :: Monad m => Int -> Int -> m ()
243−iterateM size start =
244− drainGeneration (UF.take size (UF.iterateM return)) (return start)
245−
246−{-# INLINE fromIndicesM #-}
247−fromIndicesM :: Monad m => Int -> Int -> m ()
248−fromIndicesM size start =
249− drainGeneration (UF.take size (UF.fromIndicesM return)) start
250−
251−{-# INLINE enumerateFromThenIntegral #-}
252−enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()
253−enumerateFromThenIntegral size start =
254− drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)
255−
256−{-# INLINE enumerateFromToIntegral #-}
257−enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
258−enumerateFromToIntegral size start =
259− drainGeneration
260− ( UF.second
261− (size + start)
262− UF.enumerateFromToIntegral
263− ) start
264−
265−{-# INLINE enumerateFromIntegral #-}
266−enumerateFromIntegral :: Monad m => Int -> Int -> m ()
267−enumerateFromIntegral size start =
268− drainGeneration (UF.take size UF.enumerateFromIntegral) start
269−
270−{-# INLINE enumerateFromStepNum #-}
271−enumerateFromStepNum :: Monad m => Int -> Int -> m ()
272−enumerateFromStepNum size start =
273− drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)
274−
275−{-# INLINE enumerateFromNum #-}
276−enumerateFromNum :: Monad m => Int -> Int -> m ()
277−enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start
278−
279−{-# INLINE enumerateFromToFractional #-}
280−enumerateFromToFractional :: Monad m => Int -> Int -> m ()
281−enumerateFromToFractional size start =
282− let intToDouble x = (fromInteger (fromIntegral x)) :: Double
283− in drainGeneration
284− ( UF.second
285− (intToDouble $ start + size)
286− UF.enumerateFromToFractional
287− )
288− (intToDouble start)
289−
290−-------------------------------------------------------------------------------
291−-- Stream transformation
292−-------------------------------------------------------------------------------
293−
294−{-# INLINE postscan #-}
295−postscan :: Monad m => Int -> Int -> m ()
296−postscan size start =
297− drainTransformationDefault (size + start) (UF.postscan FL.sum) start
298−
299−{-# INLINE map #-}
300−map :: Monad m => Int -> Int -> m ()
301−map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
302−
303−{-# INLINE mapM #-}
304−mapM :: Monad m => Int -> Int -> m ()
305−mapM size start =
306− drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
307−
308−{-# INLINE mapM2 #-}
309−mapM2 :: Monad m => Int -> Int -> m ()
310−mapM2 size start =
311− drainTransformationDefault
312− size
313− (UF.mapM2 (\a b -> return $ a + b))
314− start
315−
316−-------------------------------------------------------------------------------
317−-- Stream filtering
318−-------------------------------------------------------------------------------
319−
320−{-# INLINE takeWhileM #-}
321−takeWhileM :: Monad m => Int -> Int -> m ()
322−takeWhileM size start =
323− drainTransformationDefault
324− size
325− (UF.takeWhileM (\b -> return (b <= size + start)))
326− start
327−
328−{-# INLINE takeWhile #-}
329−takeWhile :: Monad m => Int -> Int -> m ()
330−takeWhile size start =
331− drainTransformationDefault
332− size
333− (UF.takeWhile (\b -> b <= size + start))
334− start
335−
336−{-# INLINE take #-}
337−take :: Monad m => Int -> Int -> m ()
338−take size start = drainTransformationDefault (size + start) (UF.take size) start
339−
340−{-# INLINE filter #-}
341−filter :: Monad m => Int -> Int -> m ()
342−filter size start =
343− drainTransformationDefault (size + start) (UF.filter (\_ -> True)) start
344−
345−{-# INLINE filterM #-}
346−filterM :: Monad m => Int -> Int -> m ()
347−filterM size start =
348− drainTransformationDefault
349− (size + start)
350− (UF.filterM (\_ -> (return True)))
351− start
352−
353−{-# INLINE _dropOne #-}
354−_dropOne :: Monad m => Int -> Int -> m ()
355−_dropOne size start =
356− drainTransformationDefault (size + start) (UF.drop 1) start
357−
358−{-# INLINE dropAll #-}
359−dropAll :: Monad m => Int -> Int -> m ()
360−dropAll size start =
361− drainTransformationDefault (size + start) (UF.drop (size + 1)) start
362−
363−{-# INLINE dropWhileTrue #-}
364−dropWhileTrue :: Monad m => Int -> Int -> m ()
365−dropWhileTrue size start =
366− drainTransformationDefault
367− (size + start)
368− (UF.dropWhileM (\_ -> return True))
369− start
370−
371−{-# INLINE dropWhileFalse #-}
372−dropWhileFalse :: Monad m => Int -> Int -> m ()
373−dropWhileFalse size start =
374− drainTransformationDefault
375− (size + start)
376− (UF.dropWhileM (\_ -> return False))
377− start
378−
379−{-# INLINE dropWhileMTrue #-}
380−dropWhileMTrue :: Monad m => Int -> Int -> m ()
381−dropWhileMTrue size start =
382− drainTransformationDefault
383− size
384− (UF.dropWhileM (\_ -> return True))
385− start
386−
387−{-# INLINE dropWhileMFalse #-}
388−dropWhileMFalse :: Monad m => Int -> Int -> m ()
389−dropWhileMFalse size start =
390− drainTransformationDefault
391− size
392− (UF.dropWhileM (\_ -> return False))
393− start
394−
395−-------------------------------------------------------------------------------
396−-- Stream combination
397−-------------------------------------------------------------------------------
398−
399−{-# INLINE zipWith #-}
400−zipWith :: Monad m => Int -> Int -> m ()
401−zipWith size start =
402− drainProductDefault (size + start) (UF.zipWith (+)) start
403−
404−{-# INLINE zipWithM #-}
405−zipWithM :: Monad m => Int -> Int -> m ()
406−zipWithM size start =
407− drainProductDefault
408− (size + start)
409− (UF.zipWithM (\a b -> return $ a + b))
410− start
411−
412−{-# INLINE teeZipWith #-}
413−teeZipWith :: Monad m => Int -> Int -> m ()
414−teeZipWith size start =
415− drainProductDefault (size + start) (UF.zipWith (+)) start
416−
417−-------------------------------------------------------------------------------
418−-- Applicative
419−-------------------------------------------------------------------------------
420−
421−nthRoot :: Double -> Int -> Int
422−nthRoot n value = round (fromIntegral value**(1/n))
423−
424−{-# INLINE toNullAp #-}
425−toNullAp :: Monad m => Int -> Int -> m ()
426−toNullAp value start =
427− let end = start + nthRoot 2 value
428− s = source end
429− -- in UF.fold ((+) <$> s <*> s) FL.drain start
430− in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start
431−
432−{-# INLINE _apDiscardFst #-}
433−_apDiscardFst :: Int -> Int -> m ()
434−_apDiscardFst = undefined
435−
436−{-# INLINE _apDiscardSnd #-}
437−_apDiscardSnd :: Int -> Int -> m ()
438−_apDiscardSnd = undefined
439−
440−-------------------------------------------------------------------------------
441−-- Monad
442−-------------------------------------------------------------------------------
443−
444−{-# INLINE concatMapM #-}
445−concatMapM :: Monad m => Int -> Int -> m ()
446−concatMapM value start =
447− val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start
448−
449− where
450−
451− val = nthRoot 2 value
452− unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
453− unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
454−
455−{-# INLINE toNull #-}
456−toNull :: Monad m => Int -> Int -> m ()
457−toNull value start =
458− let end = start + nthRoot 2 value
459− src = source end
460− {-
461− u = do
462− x <- src
463− y <- src
464− return (x + y)
465− -}
466− u = src `UF.bind` \x ->
467− src `UF.bind` \y ->
468− UF.fromPure (x + y)
469− in UF.fold FL.drain u start
470−
471−
472−{-# INLINE toNull3 #-}
473−toNull3 :: Monad m => Int -> Int -> m ()
474−toNull3 value start =
475− let end = start + nthRoot 3 value
476− src = source end
477− {-
478− u = do
479− x <- src
480− y <- src
481− z <- src
482− return (x + y + z)
483− -}
484− u = src `UF.bind` \x ->
485− src `UF.bind` \y ->
486− UF.fromPure (x + y)
487− in UF.fold FL.drain u start
488−
489−{-# INLINE toList #-}
490−toList :: Monad m => Int -> Int -> m [Int]
491−toList value start = do
492− let end = start + nthRoot 2 value
493− src = source end
494− {-
495− u = do
496− x <- src
497− y <- src
498− return (x + y)
499− -}
500− u = src `UF.bind` \x ->
501− src `UF.bind` \y ->
502− UF.fromPure (x + y)
503− in UF.fold FL.toList u start
504−
505−{-# INLINE toListSome #-}
506−toListSome :: Monad m => Int -> Int -> m [Int]
507−toListSome value start = do
508− let end = start + nthRoot 2 value
509− src = source end
510− {-
511− u = do
512− x <- src
513− y <- src
514− return (x + y)
515− -}
516− u = src `UF.bind` \x ->
517− src `UF.bind` \y ->
518− UF.fromPure (x + y)
519− in UF.fold FL.toList (UF.take 1000 u) start
520−
521−{-# INLINE filterAllOut #-}
522−filterAllOut :: Monad m => Int -> Int -> m ()
523−filterAllOut value start = do
524− let end = start + nthRoot 2 value
525− src = source end
526− {-
527− u = do
528− x <- src
529− y <- src
530− -}
531− u = src `UF.bind` \x ->
532− src `UF.bind` \y ->
533− let s = x + y
534− in if s < 0
535− then UF.fromPure s
536− else UF.nilM (return . const ())
537− in UF.fold FL.drain u start
538−
539−{-# INLINE filterAllIn #-}
540−filterAllIn :: Monad m => Int -> Int -> m ()
541−filterAllIn value start = do
542− let end = start + nthRoot 2 value
543− src = source end
544− {-
545− u = do
546− x <- src
547− y <- src
548− -}
549− u = src `UF.bind` \x ->
550− src `UF.bind` \y ->
551− let s = x + y
552− in if s > 0
553− then UF.fromPure s
554− else UF.nilM (return . const ())
555− in UF.fold FL.drain u start
556−
557−{-# INLINE filterSome #-}
558−filterSome :: Monad m => Int -> Int -> m ()
559−filterSome value start = do
560− let end = start + nthRoot 2 value
561− src = source end
562− {-
563− u = do
564− x <- src
565− y <- src
566− -}
567− u = src `UF.bind` \x ->
568− src `UF.bind` \y ->
569− let s = x + y
570− in if s > 1100000
571− then UF.fromPure s
572− else UF.nilM (return . const ())
573− in UF.fold FL.drain u start
574−
575−{-# INLINE breakAfterSome #-}
576−breakAfterSome :: Int -> Int -> IO ()
577−breakAfterSome value start =
578− let end = start + nthRoot 2 value
579− src = source end
580− {-
581− u = do
582− x <- src
583− y <- src
584− -}
585− u = src `UF.bind` \x ->
586− src `UF.bind` \y ->
587− let s = x + y
588− in if s > 1100000
589− then error "break"
590− else UF.fromPure s
591− in do
592− (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start
593− return ()
594−
595−-------------------------------------------------------------------------------
596−-- Benchmark ops
597−-------------------------------------------------------------------------------
598−
599−-- n * (n + 1) / 2 == linearCount
600−concatCount :: Int -> Int
601−concatCount linearCount =
602− round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
603−
604−{-# INLINE many #-}
605−many :: Monad m => Int -> Int -> m ()
606−many linearCount start = do
607− let end = start + concatCount linearCount
608− UF.fold FL.drain (UF.many (source end) (source end)) start
609−
610−-------------------------------------------------------------------------------
611−-- Benchmarks
30+-- Outer product
61231-------------------------------------------------------------------------------
61332
61433moduleName :: String
61534moduleName = "Data.Unfold"
61635
617−o_1_space_transformation_input :: Int -> [Benchmark]
618−o_1_space_transformation_input size =
619− [ bgroup
620− "transformation/input"
621− [ benchIO "lmap" $ lmap size
622− , benchIO "lmapM" $ lmapM size
623− , benchIO "both" $ both size
624− , benchIO "first" $ first size
625− , benchIO "second" $ second size
626− , benchIO "discardFirst" $ discardFirst size
627− , benchIO "discardSecond" $ discardSecond size
628− , benchIO "swap" $ swap size
629− ]
630− ]
631−
632−o_1_space_generation :: Int -> [Benchmark]
633−o_1_space_generation size =
634− [ bgroup
635− "generation"
636− [ benchIO "fromStream" $ fromStream size
637− , benchIO "fromStreamK" $ fromStreamK size
638− , benchIO "fromStreamD" $ fromStreamD size
639− -- Very small benchmarks, reporting in ns
640− -- , benchIO "nilM" $ nilM size
641− , benchIO "consM" $ consM size
642− -- , benchIO "functionM" $ functionM size
643− -- , benchIO "function" $ function size
644− -- , benchIO "identity" $ identity size
645− -- , benchIO "const" $ const size
646− , benchIO "unfoldrM" $ unfoldrM size
647− , benchIO "fromList" $ fromList size
648− , benchIO "fromListM" $ fromListM size
649− -- Unimplemented
650− -- , benchIO "fromSVar" $ fromSVar size
651− -- , benchIO "fromProducer" $ fromProducer size
652− , benchIO "replicateM" $ replicateM size
653− , benchIO "repeatM" $ repeatM size
654− , benchIO "iterateM" $ iterateM size
655− , benchIO "fromIndicesM" $ fromIndicesM size
656− , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size
657− , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
658− , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
659− , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
660− , benchIO "enumerateFromNum" $ enumerateFromNum size
661− , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
662− ]
663− ]
664−
665−o_1_space_transformation :: Int -> [Benchmark]
666−o_1_space_transformation size =
667− [ bgroup
668− "transformation"
669− [ benchIO "map" $ map size
670− , benchIO "mapM" $ mapM size
671− , benchIO "mapM2" $ mapM2 size
672− , benchIO "postscan" $ postscan size
673− ]
674− ]
675−
676−o_1_space_filtering :: Int -> [Benchmark]
677−o_1_space_filtering size =
678− [ bgroup
679− "filtering"
680− [ benchIO "takeWhileM" $ takeWhileM size
681− , benchIO "takeWhile" $ takeWhile size
682− , benchIO "take" $ take size
683− , benchIO "filter" $ filter size
684− , benchIO "filterM" $ filterM size
685− -- Very small benchmark, reporting in ns
686− -- , benchIO "dropOne" $ dropOne size
687− , benchIO "dropAll" $ dropAll size
688− , benchIO "dropWhileTrue" $ dropWhileTrue size
689− , benchIO "dropWhileFalse" $ dropWhileFalse size
690− , benchIO "dropWhileMTrue" $ dropWhileMTrue size
691− , benchIO "dropWhileMFalse" $ dropWhileMFalse size
692− ]
693− ]
694−
695−o_1_space_zip :: Int -> [Benchmark]
696−o_1_space_zip size =
697− [ bgroup
698− "zip"
699− [ benchIO "zipWithM" $ zipWithM size
700− , benchIO "zipWith" $ zipWith size
701− , benchIO "teeZipWith" $ teeZipWith size
702− ]
703− ]
704−
705−lf :: Word8
706−lf = fromIntegral (ord '\n')
707−
708−-- | Split on line feed.
709−foldManySepBy :: Handle -> IO Int
710−foldManySepBy =
711− let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.reader
712− in UF.fold FL.length u
713−
714−o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
715−o_1_space_nested env size =
716− [ bgroup
717− "nested"
718− [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
719− -- Unimplemented
720− -- , benchIO "apDiscardFst" $ apDiscardFst size
721− -- , benchIO "apDiscardSnd" $ apDiscardSnd size
722−
723− , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size
724− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size
725− , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size
726− , benchIO "breakAfterSome" $ breakAfterSome size
727− , benchIO "filterAllOut" $ filterAllOut size
728− , benchIO "filterAllIn" $ filterAllIn size
729− , benchIO "filterSome" $ filterSome size
730−
731− , benchIO "many" $ many size
732− , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
733− $ \inh _ -> foldManySepBy inh
734− ]
735− ]
736−
737−o_n_space_nested :: Int -> [Benchmark]
738−o_n_space_nested size =
739− [ bgroup
740− "nested"
741− [ benchIO "toList" $ toList size
742− , benchIO "toListSome" $ toListSome size
743− ]
36+o_1_space_serial :: Int -> [Benchmark]
37+o_1_space_serial value =
38+ [ bgroup "outer-product"
39+ [ benchIO "toNull" $ toNull value
40+ , benchIO "toNull3" $ toNull3 value
41+ , benchIO "concat" $ concat value
42+ , benchIO "filterAllOut" $ filterAllOut value
43+ , benchIO "filterAllIn" $ filterAllIn value
44+ , benchIO "filterSome" $ filterSome value
45+ , benchIO "breakAfterSome" $ breakAfterSome value
46+ ]
74447 ]
74548
746−-------------------------------------------------------------------------------
747−-- Unfold Exception Benchmarks
748−-------------------------------------------------------------------------------
749−-- | Send the file contents to /dev/null with exception handling
750−readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
751−readWriteOnExceptionUnfold inh devNull =
752− let readEx = UF.onException (\_ -> hClose inh) FH.reader
753− in S.fold (FH.write devNull) $ S.unfold readEx inh
754−
755−#ifdef INSPECTION
756−-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
757−-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
758−#endif
759−
760−-- | Send the file contents to /dev/null with exception handling
761−readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
762−readWriteHandleExceptionUnfold inh devNull =
763− let handler (_e :: SomeException) = hClose inh >> return 10
764− readEx = UF.handle (UF.functionM handler) FH.reader
765− in S.fold (FH.write devNull) $ S.unfold readEx inh
766−
767−#ifdef INSPECTION
768−-- hasNoTypeClasses started failing in GHC 9.4.4
769−-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
770−-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
771−#endif
772−
773−-- | Send the file contents to /dev/null with exception handling
774−readWriteFinally_Unfold :: Handle -> Handle -> IO ()
775−readWriteFinally_Unfold inh devNull =
776− let readEx = UF.finally_ (\_ -> hClose inh) FH.reader
777− in S.fold (FH.write devNull) $ S.unfold readEx inh
778−
779−#ifdef INSPECTION
780−#if __GLASGOW_HASKELL__ >= 906
781−inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]
782−#else
783−inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
784−#endif
785−-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
786−#endif
787−
788−readWriteFinallyUnfold :: Handle -> Handle -> IO ()
789−readWriteFinallyUnfold inh devNull =
790− let readEx = UF.finally (\_ -> hClose inh) FH.reader
791− in S.fold (FH.write devNull) $ S.unfold readEx inh
792−
793−-- | Send the file contents to /dev/null with exception handling
794−readWriteBracket_Unfold :: Handle -> Handle -> IO ()
795−readWriteBracket_Unfold inh devNull =
796− let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader
797− in S.fold (FH.write devNull) $ S.unfold readEx inh
798−
799−#ifdef INSPECTION
800−#if __GLASGOW_HASKELL__ >= 906
801−inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]
802−#else
803−inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
804−#endif
805−-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
806−#endif
807−
808−readWriteBracketUnfold :: Handle -> Handle -> IO ()
809−readWriteBracketUnfold inh devNull =
810− let readEx = UF.bracket return (\_ -> hClose inh) FH.reader
811− in S.fold (FH.write devNull) $ S.unfold readEx inh
812−
813−o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
814−o_1_space_copy_read_exceptions env =
815− [ bgroup "exceptions"
816− [ mkBenchSmall "UF.onException" env $ \inh _ ->
817− readWriteOnExceptionUnfold inh (nullH env)
818− , mkBenchSmall "UF.handle" env $ \inh _ ->
819− readWriteHandleExceptionUnfold inh (nullH env)
820− , mkBenchSmall "UF.finally_" env $ \inh _ ->
821− readWriteFinally_Unfold inh (nullH env)
822− , mkBenchSmall "UF.finally" env $ \inh _ ->
823− readWriteFinallyUnfold inh (nullH env)
824− , mkBenchSmall "UF.bracket_" env $ \inh _ ->
825− readWriteBracket_Unfold inh (nullH env)
826− , mkBenchSmall "UF.bracket" env $ \inh _ ->
827− readWriteBracketUnfold inh (nullH env)
49+o_n_space_serial :: Int -> [Benchmark]
50+o_n_space_serial value =
51+ [ bgroup "outer-product"
52+ [ benchIO "toList" $ toList value
53+ , benchIO "toListSome" $ toListSome value
82854 ]
82955 ]
83056
831−
83257-------------------------------------------------------------------------------
83358-- Driver
83459-------------------------------------------------------------------------------
83560
83661main :: IO ()
83762main = do
838− env <- mkHandleBenchEnv
839− runWithCLIOpts defaultStreamSize (allBenchmarks env)
63+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
64+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
84065
84166 where
84267
843− allBenchmarks env size =
844− [ bgroup (o_1_space_prefix moduleName)
845− $ Prelude.concat
846− [ o_1_space_transformation_input size
847− , o_1_space_generation size
848− , o_1_space_transformation size
849− , o_1_space_filtering size
850− , o_1_space_zip size
851− , o_1_space_nested env size
852− , o_1_space_copy_read_exceptions env
853− ]
854− , bgroup (o_n_space_prefix moduleName)
855− $ Prelude.concat [o_n_space_nested size]
68+ allBenchmarks value =
69+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
70+ [o_1_space_serial value]
71+ , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
72+ [o_n_space_serial value]
85673 ]
benchmark/Streamly/Benchmark/FileSystem/Handle.hs+75−6
@@ -1,7 +1,8 @@
11-- |
22-- Module : Streamly.Benchmark.FileSystem.Handle
33-- Copyright : (c) 2019 Composewell Technologies
4−-- License : BSD-3-Clause
4+--
5+-- License : BSD3
56-- Maintainer : streamly@composewell.com
67-- Stability : experimental
78-- Portability : GHC
@@ -17,14 +18,22 @@
1718{-# LANGUAGE TemplateHaskell #-}
1819{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
1920#endif
20−import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
21+
22+#if __GLASGOW_HASKELL__ >= 800
23+import System.Directory (getFileSize)
24+#endif
25+import System.Environment (lookupEnv)
26+import System.IO (openFile, IOMode(..))
27+import System.Process.Typed (shell, runProcess_)
28+import Prelude hiding (last, length)
2129
2230import qualified Handle.ReadWrite as RW
2331import qualified Handle.Read as RO
2432
25−import Test.Tasty.Bench hiding (env)
26−import Prelude hiding (last, length)
33+import Data.IORef
34+import Gauge hiding (env)
2735import Streamly.Benchmark.Common
36+import Handle.Common
2837
2938-------------------------------------------------------------------------------
3039--
@@ -37,10 +46,70 @@ moduleName = "FileSystem.Handle"
3746--
3847-------------------------------------------------------------------------------
3948
49+smallFileSize :: Int
50+smallFileSize = 10 * 1024 * 1024
51+
52+bigFileSize :: Int
53+bigFileSize = 100 * 1024 * 1024
54+
55+blockSize :: Int
56+blockSize = 32768
57+
58+blockCount :: Int -> Int
59+blockCount size = (size + blockSize - 1) `div` blockSize
60+
61+-------------------------------------------------------------------------------
62+--
63+-------------------------------------------------------------------------------
64+
4065main :: IO ()
4166main = do
42− env <- mkHandleBenchEnv
43− defaultMain (allBenchmarks env)
67+ (_, cfg, benches) <- parseCLIOpts defaultStreamSize
68+ r <- lookupEnv "Benchmark.FileSystem.Handle.InputFile"
69+ (small, big) <-
70+ case r of
71+ Just inFileName -> return (inFileName, inFileName)
72+ Nothing -> do
73+ -- XXX will this work on windows/msys?
74+ let cmd infile size =
75+ "mkdir -p " ++ scratchDir
76+ ++ "; test -e " ++ infile
77+ ++ " || { echo \"creating input file " ++ infile
78+ ++ "\" && dd if=/dev/random of=" ++ infile
79+ ++ " bs=" ++ show blockSize
80+ ++ " count=" ++ show (blockCount size)
81+ ++ ";}"
82+ runProcess_ (shell (cmd inFileSmall smallFileSize))
83+ runProcess_ (shell (cmd inFileBig bigFileSize))
84+ return (inFileSmall, inFileBig)
85+
86+ smallHandle <- openFile small ReadMode
87+ bigHandle <- openFile big ReadMode
88+ outHandle <- openFile outfile WriteMode
89+ devNull <- openFile "/dev/null" WriteMode
90+
91+#if __GLASGOW_HASKELL__ >= 800
92+ ssize <- fromIntegral <$> getFileSize small
93+ bsize <- fromIntegral <$> getFileSize big
94+#else
95+ let ssize = smallFileSize
96+ let bsize = bigFileSize
97+#endif
98+
99+ ref <- newIORef $ RefHandles
100+ { smallInH = smallHandle
101+ , bigInH = bigHandle
102+ , outputH = outHandle
103+ }
104+
105+ let env = BenchEnv
106+ { href = ref
107+ , smallSize = ssize
108+ , bigSize = bsize
109+ , nullH = devNull
110+ }
111+
112+ runMode (mode cfg) cfg benches (allBenchmarks env)
44113
45114 where
46115
benchmark/Streamly/Benchmark/FileSystem/Handle/Common.hsnew file+152
@@ -0,0 +1,152 @@
1+-- |
2+-- Module : Streamly.Benchmark.FileSystem.Handle
3+-- Copyright : (c) 2019 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+-- Stability : experimental
8+-- Portability : GHC
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
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 Handle.Common
23+ ( BenchEnv (..)
24+ , RefHandles (..)
25+ , scratchDir
26+ , inFileSmall
27+ , inFileBig
28+ , outfile
29+ , mkBench
30+ , mkBenchSmall
31+ , isSpace
32+ , isSp
33+ )
34+where
35+
36+import Control.DeepSeq (NFData(rnf))
37+import Data.Char (ord, chr)
38+import Data.Word (Word8)
39+import System.IO (openFile, IOMode(..), Handle, hClose)
40+
41+import Data.IORef
42+import Gauge hiding (env)
43+
44+scratchDir :: String
45+scratchDir = "benchmark-tmp"
46+
47+outfile :: String
48+outfile = scratchDir ++ "out.txt"
49+
50+inFileSmall :: String
51+inFileSmall = scratchDir ++ "in-10MB.txt"
52+
53+inFileBig :: String
54+inFileBig = scratchDir ++ "in-100MB.txt"
55+
56+data RefHandles = RefHandles
57+ { smallInH :: Handle
58+ , bigInH :: Handle
59+ , outputH :: Handle
60+ }
61+
62+data Handles = Handles !Handle !Handle
63+
64+instance NFData Handles where
65+ rnf _ = ()
66+
67+data BenchEnv = BenchEnv
68+ { href :: IORef RefHandles
69+ , smallSize :: Int
70+ , bigSize :: Int
71+ , nullH :: Handle
72+ }
73+
74+withScaling :: BenchEnv -> String -> String
75+withScaling env str =
76+ let factor = round (fromIntegral (bigSize env)
77+ / (fromIntegral (smallSize env) :: Double)) :: Int
78+ in if factor == 1
79+ then str
80+ else str ++ " (1/" ++ show factor ++ ")"
81+
82+mkBenchCommon ::
83+ NFData b
84+ => (RefHandles -> Handles)
85+ -> String
86+ -> BenchEnv
87+ -> (Handle -> Handle -> IO b)
88+ -> Benchmark
89+mkBenchCommon mkHandles name env action =
90+ bench name $ perRunEnv (do
91+ r <- readIORef $ href env
92+
93+ -- close old handles
94+ hClose $ smallInH r
95+ hClose $ bigInH r
96+ hClose $ outputH r
97+
98+ -- reopen
99+ smallInHandle <- openFile inFileSmall ReadMode
100+ bigInHandle <- openFile inFileBig ReadMode
101+ outHandle <- openFile outfile WriteMode
102+
103+ let refHandles = RefHandles
104+ { smallInH = smallInHandle
105+ , bigInH = bigInHandle
106+ , outputH = outHandle
107+ }
108+
109+ -- update
110+ writeIORef (href env) $ refHandles
111+ return $ mkHandles refHandles
112+ )
113+ (\(Handles h1 h2) -> action h1 h2)
114+
115+mkBench ::
116+ NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
117+mkBench name env action = mkBenchCommon useBigH name env action
118+
119+ where
120+
121+ useBigH (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh
122+
123+mkBenchSmall ::
124+ NFData b => String -> BenchEnv -> (Handle -> Handle -> IO b) -> Benchmark
125+mkBenchSmall name env action =
126+ mkBenchCommon useSmallH (withScaling env name) env action
127+
128+ where
129+
130+ useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
131+
132+foreign import ccall unsafe "u_iswspace"
133+ iswspace :: Int -> Int
134+
135+-- Code copied from base/Data.Char to INLINE it
136+{-# INLINE isSpace #-}
137+isSpace :: Char -> Bool
138+-- isSpace includes non-breaking space
139+-- The magic 0x377 isn't really that magical. As of 2014, all the codepoints
140+-- at or below 0x377 have been assigned, so we shouldn't have to worry about
141+-- any new spaces appearing below there. It would probably be best to
142+-- use branchless ||, but currently the eqLit transformation will undo that,
143+-- so we'll do it like this until there's a way around that.
144+isSpace c
145+ | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
146+ | otherwise = iswspace (ord c) /= 0
147+ where
148+ uc = fromIntegral (ord c) :: Word
149+
150+{-# INLINE isSp #-}
151+isSp :: Word8 -> Bool
152+isSp = isSpace . chr . fromIntegral
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+337−108
@@ -1,9 +1,8 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.FileSystem.Handle
53-- Copyright : (c) 2019 Composewell Technologies
6−-- License : BSD-3-Clause
4+--
5+-- License : BSD3
76-- Maintainer : streamly@composewell.com
87-- Stability : experimental
98-- Portability : GHC
@@ -24,36 +23,134 @@ module Handle.Read
2423 (allBenchmarks)
2524where
2625
26+import Data.Char (ord)
27+import Data.Functor.Identity (runIdentity)
2728import Data.Word (Word8)
2829import GHC.Magic (inline)
30+#if __GLASGOW_HASKELL__ >= 802
2931import GHC.Magic (noinline)
32+#else
33+#define noinline
34+#endif
3035import System.IO (Handle)
36+import Prelude hiding (last, length)
3137
32−import qualified Streamly.Data.Stream as Stream
33−import qualified Streamly.Data.Fold as Fold
38+import qualified Streamly.Data.Fold as FL
39+import qualified Streamly.Data.Unicode.Stream as SS
3440import qualified Streamly.FileSystem.Handle as FH
35−import qualified Streamly.Internal.Data.Array as A
36−import qualified Streamly.Internal.Data.Fold as FL
37−import qualified Streamly.Internal.Data.Stream as IP
41+-- import qualified Streamly.Internal.Data.Fold as IFL
42+import qualified Streamly.Internal.Data.Parser as PR
43+import qualified Streamly.Internal.Data.Stream.StreamD as D
44+import qualified Streamly.Internal.Data.Unicode.Stream as IUS
3845import qualified Streamly.Internal.FileSystem.Handle as IFH
39−import qualified Streamly.Internal.Unicode.Stream as IUS
40−import qualified Streamly.Data.Stream.Prelude as S
41−import qualified Streamly.Unicode.Stream as SS
46+import qualified Streamly.Internal.Memory.Array as A
47+import qualified Streamly.Internal.Memory.Array.Types as AT
48+import qualified Streamly.Internal.Memory.ArrayStream as AS
49+import qualified Streamly.Internal.Prelude as IP
50+import qualified Streamly.Prelude as S
4251
43−import Test.Tasty.Bench hiding (env)
44−import Prelude hiding (last, length)
45−import Streamly.Benchmark.Common.Handle
52+import Gauge hiding (env)
53+import Handle.Common
4654
4755#ifdef INSPECTION
48−import Streamly.Internal.Data.Stream (Step(..), FoldMany)
56+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), GroupState)
4957
50−import qualified Streamly.Internal.Data.MutArray as MutArray
51−import qualified Streamly.Internal.Data.Stream as D
5258import qualified Streamly.Internal.Data.Unfold as IUF
5359
5460import Test.Inspection
5561#endif
5662
63+-------------------------------------------------------------------------------
64+-- read chunked using toChunks
65+-------------------------------------------------------------------------------
66+
67+-- | Get the last byte from a file bytestream.
68+toChunksLast :: Handle -> IO (Maybe Word8)
69+toChunksLast inh = do
70+ let s = IFH.toChunks inh
71+ larr <- S.last s
72+ return $ case larr of
73+ Nothing -> Nothing
74+ Just arr -> A.readIndex arr (A.length arr - 1)
75+
76+#ifdef INSPECTION
77+inspect $ hasNoTypeClasses 'toChunksLast
78+inspect $ 'toChunksLast `hasNoType` ''Step
79+#endif
80+
81+-- | Count the number of bytes in a file.
82+toChunksSumLengths :: Handle -> IO Int
83+toChunksSumLengths inh =
84+ let s = IFH.toChunks inh
85+ in S.sum (S.map A.length s)
86+
87+#ifdef INSPECTION
88+inspect $ hasNoTypeClasses 'toChunksSumLengths
89+inspect $ 'toChunksSumLengths `hasNoType` ''Step
90+#endif
91+
92+-- | Count the number of lines in a file.
93+toChunksSplitOnSuffix :: Handle -> IO Int
94+toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
95+
96+#ifdef INSPECTION
97+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
98+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
99+#endif
100+
101+-- XXX use a word splitting combinator instead of splitOn and test it.
102+-- | Count the number of words in a file.
103+toChunksSplitOn :: Handle -> IO Int
104+toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
105+
106+#ifdef INSPECTION
107+inspect $ hasNoTypeClasses 'toChunksSplitOn
108+inspect $ 'toChunksSplitOn `hasNoType` ''Step
109+#endif
110+
111+-- | Sum the bytes in a file.
112+toChunksCountBytes :: Handle -> IO Word8
113+toChunksCountBytes inh = do
114+ let foldlArr' f z = runIdentity . S.foldl' f z . A.toStream
115+ let s = IFH.toChunks inh
116+ S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117+
118+#ifdef INSPECTION
119+inspect $ hasNoTypeClasses 'toChunksCountBytes
120+inspect $ 'toChunksCountBytes `hasNoType` ''Step
121+#endif
122+
123+toChunksDecodeUtf8ArraysLenient :: Handle -> IO ()
124+toChunksDecodeUtf8ArraysLenient =
125+ S.drain . IUS.decodeUtf8ArraysLenient . IFH.toChunks
126+
127+#ifdef INSPECTION
128+inspect $ hasNoTypeClasses 'toChunksDecodeUtf8ArraysLenient
129+-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
130+#endif
131+
132+o_1_space_read_chunked :: BenchEnv -> [Benchmark]
133+o_1_space_read_chunked env =
134+ -- read using toChunks instead of read
135+ [ bgroup "reduce/toChunks"
136+ [ mkBench "S.last" env $ \inH _ ->
137+ toChunksLast inH
138+ -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
139+ -- wc uses lseek to just determine the file size rather than reading
140+ -- and counting characters.
141+ , mkBench "S.sum . S.map A.length" env $ \inH _ ->
142+ toChunksSumLengths inH
143+ , mkBench "AS.splitOnSuffix" env $ \inH _ ->
144+ toChunksSplitOnSuffix inH
145+ , mkBench "AS.splitOn" env $ \inH _ ->
146+ toChunksSplitOn inH
147+ , mkBench "countBytes" env $ \inH _ ->
148+ toChunksCountBytes inH
149+ , mkBenchSmall "US.decodeUtf8ArraysLenient" env $ \inH _ ->
150+ toChunksDecodeUtf8ArraysLenient inH
151+ ]
152+ ]
153+
57154-- TBD reading with unfold
58155
59156-------------------------------------------------------------------------------
@@ -62,49 +159,49 @@ import Test.Inspection
62159
63160-- | Get the last byte from a file bytestream.
64161readLast :: Handle -> IO (Maybe Word8)
65−readLast = S.fold Fold.last . S.unfold FH.reader
162+readLast = S.last . S.unfold FH.read
66163
67164#ifdef INSPECTION
68165inspect $ hasNoTypeClasses 'readLast
69166inspect $ 'readLast `hasNoType` ''Step -- S.unfold
70−inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
71−inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
167+inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
168+inspect $ 'readLast `hasNoType` ''A.ReadUState -- FH.read/A.read
72169#endif
73170
74171-- assert that flattenArrays constructors are not present
75172-- | Count the number of bytes in a file.
76173readCountBytes :: Handle -> IO Int
77−readCountBytes = S.fold Fold.length . S.unfold FH.reader
174+readCountBytes = S.length . S.unfold FH.read
78175
79176#ifdef INSPECTION
80177inspect $ hasNoTypeClasses 'readCountBytes
81178inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
82−inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
83−inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
179+inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
180+inspect $ 'readCountBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
84181#endif
85182
86183-- | Count the number of lines in a file.
87184readCountLines :: Handle -> IO Int
88185readCountLines =
89− S.fold Fold.length
186+ S.length
90187 . IUS.lines FL.drain
91188 . SS.decodeLatin1
92− . S.unfold FH.reader
189+ . S.unfold FH.read
93190
94191#ifdef INSPECTION
95192inspect $ hasNoTypeClasses 'readCountLines
96193inspect $ 'readCountLines `hasNoType` ''Step
97−inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
194+inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
195+inspect $ 'readCountLines `hasNoType` ''A.ReadUState -- FH.read/A.read
99196#endif
100197
101198-- | Count the number of words in a file.
102199readCountWords :: Handle -> IO Int
103200readCountWords =
104− S.fold Fold.length
201+ S.length
105202 . IUS.words FL.drain
106203 . SS.decodeLatin1
107− . S.unfold FH.reader
204+ . S.unfold FH.read
108205
109206#ifdef INSPECTION
110207inspect $ hasNoTypeClasses 'readCountWords
@@ -113,13 +210,13 @@ inspect $ hasNoTypeClasses 'readCountWords
113210
114211-- | Sum the bytes in a file.
115212readSumBytes :: Handle -> IO Word8
116−readSumBytes = S.fold Fold.sum . S.unfold FH.reader
213+readSumBytes = S.sum . S.unfold FH.read
117214
118215#ifdef INSPECTION
119216inspect $ hasNoTypeClasses 'readSumBytes
120217inspect $ 'readSumBytes `hasNoType` ''Step
121−inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
122−inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
218+inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
219+inspect $ 'readSumBytes `hasNoType` ''A.ReadUState -- FH.read/A.read
123220#endif
124221
125222-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
@@ -133,24 +230,24 @@ inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
133230-- fusion-plugin to propagate INLINE phase information such that this problem
134231-- does not occur.
135232readDrain :: Handle -> IO ()
136−readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh
233+readDrain inh = S.drain $ S.unfold FH.read inh
137234
138235-- XXX investigate why we need an INLINE in this case (GHC)
139236{-# INLINE readDecodeLatin1 #-}
140237readDecodeLatin1 :: Handle -> IO ()
141238readDecodeLatin1 inh =
142− S.fold Fold.drain
239+ S.drain
143240 $ SS.decodeLatin1
144− $ S.unfold FH.reader inh
241+ $ S.unfold FH.read inh
145242
146−readDecodeUtf8 :: Handle -> IO ()
147−readDecodeUtf8 inh =
148− S.fold Fold.drain
149− $ SS.decodeUtf8
150− $ S.unfold FH.reader inh
243+readDecodeUtf8Lax :: Handle -> IO ()
244+readDecodeUtf8Lax inh =
245+ S.drain
246+ $ SS.decodeUtf8Lax
247+ $ S.unfold FH.read inh
151248
152249#ifdef INSPECTION
153−inspect $ hasNoTypeClasses 'readDecodeUtf8
250+inspect $ hasNoTypeClasses 'readDecodeUtf8Lax
154251-- inspect $ 'readDecodeUtf8Lax `hasNoType` ''Step
155252#endif
156253
@@ -172,12 +269,12 @@ o_1_space_reduce_read env =
172269 readCountBytes inh
173270 , mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
174271 readCountLines inh
175− , mkBench "US.words . SS.decodeLatin1" env $ \inh _ ->
272+ , mkBenchSmall "US.words . SS.decodeLatin1" env $ \inh _ ->
176273 readCountWords inh
177274
178275 -- read with utf8 decoding
179− , mkBenchSmall "SS.decodeUtf8" env $ \inh _ ->
180− readDecodeUtf8 inh
276+ , mkBenchSmall "SS.decodeUtf8Lax" env $ \inh _ ->
277+ readDecodeUtf8Lax inh
181278 ]
182279 ]
183280
@@ -186,25 +283,25 @@ o_1_space_reduce_read env =
186283-------------------------------------------------------------------------------
187284
188285-- | Count the number of lines in a file.
189−getChunksConcatUnfoldCountLines :: Handle -> IO Int
190−getChunksConcatUnfoldCountLines inh =
191− S.fold Fold.length
286+toChunksConcatUnfoldCountLines :: Handle -> IO Int
287+toChunksConcatUnfoldCountLines inh =
288+ S.length
192289 $ IUS.lines FL.drain
193290 $ SS.decodeLatin1
194291 -- XXX replace with toBytes
195− $ S.unfoldMany A.reader (IFH.readChunks inh)
292+ $ S.concatUnfold A.read (IFH.toChunks inh)
196293
197294#ifdef INSPECTION
198−inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines
199−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step
200−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
295+inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
296+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
297+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
201298#endif
202299
203300o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
204301o_1_space_reduce_toBytes env =
205302 [ bgroup "reduce/toBytes"
206303 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
207− getChunksConcatUnfoldCountLines inh
304+ toChunksConcatUnfoldCountLines inh
208305 ]
209306 ]
210307
@@ -213,93 +310,225 @@ o_1_space_reduce_toBytes env =
213310-------------------------------------------------------------------------------
214311
215312chunksOfSum :: Int -> Handle -> IO Int
216−chunksOfSum n inh =
217− S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh)
218−
219−foldManyPostChunksOfSum :: Int -> Handle -> IO Int
220−foldManyPostChunksOfSum n inh =
221− S.fold Fold.length
222− $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh)
313+chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
223314
224−foldManyChunksOfSum :: Int -> Handle -> IO Int
225−foldManyChunksOfSum n inh =
226− S.fold Fold.length
227− $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh)
315+parseManyChunksOfSum :: Int -> Handle -> IO Int
316+parseManyChunksOfSum n inh =
317+ S.length $ IP.parseMany (PR.take n FL.sum) (S.unfold FH.read inh)
228318
229319-- XXX investigate why we need an INLINE in this case (GHC)
230320-- Even though allocations remain the same in both cases inlining improves time
231321-- by 4x.
232322-- | Slice in chunks of size n and get the count of chunks.
233−{-# INLINE groupsOf #-}
234−groupsOf :: Int -> Handle -> IO Int
235−groupsOf n inh =
323+{-# INLINE chunksOf #-}
324+chunksOf :: Int -> Handle -> IO Int
325+chunksOf n inh =
236326 -- writeNUnsafe gives 2.5x boost here over writeN.
237− S.fold Fold.length
238− $ IP.groupsOf n (A.writeNUnsafe n) (S.unfold FH.reader inh)
327+ -- XXX replace with S.arraysOf
328+ S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
239329
240330#ifdef INSPECTION
241−inspect $ hasNoTypeClasses 'groupsOf
242−inspect $ 'groupsOf `hasNoType` ''Step
243−inspect $ 'groupsOf `hasNoType` ''FoldMany
244−inspect $ 'groupsOf `hasNoType` ''MutArray.ArrayUnsafe -- AT.writeNUnsafe
245− -- FH.read/A.read
246−inspect $ 'groupsOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
331+inspect $ hasNoTypeClasses 'chunksOf
332+inspect $ 'chunksOf `hasNoType` ''Step
333+inspect $ 'chunksOf `hasNoType` ''GroupState
334+inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
335+inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
336+inspect $ 'chunksOf `hasNoType` ''A.ReadUState -- FH.read/A.read
247337#endif
248338
249−{-# INLINE chunksOf #-}
250−chunksOf :: Int -> Handle -> IO Int
251−chunksOf n inh =
252− S.fold Fold.length $ Stream.chunksOf n (S.unfold FH.reader inh)
339+-- This is to make sure that the concatMap in FH.read, groupsOf and foldlM'
340+-- together can fuse.
341+--
342+-- | Slice in chunks of size n and get the count of chunks.
343+_chunksOfD :: Int -> Handle -> IO Int
344+_chunksOfD n inh =
345+ D.foldlM' (\i _ -> return $ i + 1) (return 0)
346+ $ D.groupsOf n (AT.writeNUnsafe n)
347+ $ D.fromStreamK (S.unfold FH.read inh)
348+
349+#ifdef INSPECTION
350+inspect $ hasNoTypeClasses '_chunksOfD
351+inspect $ '_chunksOfD `hasNoType` ''Step
352+inspect $ '_chunksOfD `hasNoType` ''GroupState
353+inspect $ '_chunksOfD `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
354+inspect $ '_chunksOfD `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
355+inspect $ '_chunksOfD `hasNoType` ''A.ReadUState -- FH.read/A.read
356+#endif
253357
254358o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
255359o_1_space_reduce_read_grouped env =
256360 [ bgroup "reduce/read/chunks"
257− [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $
361+ [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
258362 \inh _ ->
259363 chunksOfSum (bigSize env) inh
260− , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->
364+ , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
261365 chunksOfSum 1 inh
262366
263367 -- XXX investigate why we need inline/noinline in these cases (GHC)
264368 -- Chunk using parsers
265− , mkBench
266− ("S.foldManyPost (FL.take " ++ show (bigSize env) ++ " FL.sum)")
267− env
268− $ \inh _ -> noinline foldManyPostChunksOfSum (bigSize env) inh
269− , mkBench
270− "S.foldManyPost (FL.take 1 FL.sum)"
271− env
272− $ \inh _ -> inline foldManyPostChunksOfSum 1 inh
273− , mkBench
274− ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")
275− env
276− $ \inh _ -> noinline foldManyChunksOfSum (bigSize env) inh
277− , mkBench
278− "S.foldMany (FL.take 1 FL.sum)"
279− env
280− $ \inh _ -> inline foldManyChunksOfSum 1 inh
369+ , mkBenchSmall ("S.parseMany (PR.take " ++ show (bigSize env) ++ " FL.sum)")
370+ env $ \inh _ ->
371+ noinline parseManyChunksOfSum (bigSize env) inh
372+ , mkBench "S.parseMany (PR.take 1 FL.sum)" env $ \inh _ ->
373+ inline parseManyChunksOfSum 1 inh
281374
282375 -- folding chunks to arrays
283− , mkBenchSmall "S.groupsOf 1" env $ \inh _ ->
284− groupsOf 1 inh
285− , mkBench "S.groupsOf 10" env $ \inh _ ->
286− groupsOf 10 inh
287− , mkBench "S.groupsOf 1000" env $ \inh _ ->
288− groupsOf 1000 inh
289−
290− -- chunksOf may use a different impl than groupsOf
291− , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
376+ , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
292377 chunksOf 1 inh
293− , mkBench "S.chunksOf 10" env $ \inh _ ->
378+ , mkBench "S.arraysOf 10" env $ \inh _ ->
294379 chunksOf 10 inh
295− , mkBench "S.chunksOf 1000" env $ \inh _ ->
380+ , mkBench "S.arraysOf 1000" env $ \inh _ ->
296381 chunksOf 1000 inh
297382 ]
298383 ]
299384
385+-------------------------------------------------------------------------------
386+-- reduce with splitting transformations
387+-------------------------------------------------------------------------------
388+
389+lf :: Word8
390+lf = fromIntegral (ord '\n')
391+
392+toarr :: String -> A.Array Word8
393+toarr = A.fromList . map (fromIntegral . ord)
394+
395+-- | Split on line feed.
396+splitOn :: Handle -> IO Int
397+splitOn inh =
398+ (S.length $ S.splitOn (== lf) FL.drain
399+ $ S.unfold FH.read inh) -- >>= print
400+
401+#ifdef INSPECTION
402+inspect $ hasNoTypeClasses 'splitOn
403+inspect $ 'splitOn `hasNoType` ''Step
404+inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
405+inspect $ 'splitOn `hasNoType` ''A.ReadUState -- FH.read/A.read
406+#endif
407+
408+-- | Split suffix on line feed.
409+splitOnSuffix :: Handle -> IO Int
410+splitOnSuffix inh =
411+ (S.length $ S.splitOnSuffix (== lf) FL.drain
412+ $ S.unfold FH.read inh) -- >>= print
413+
414+#ifdef INSPECTION
415+inspect $ hasNoTypeClasses 'splitOnSuffix
416+inspect $ 'splitOnSuffix `hasNoType` ''Step
417+inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
418+inspect $ 'splitOnSuffix `hasNoType` ''A.ReadUState -- FH.read/A.read
419+#endif
420+
421+-- | Split on line feed.
422+parseManySepBy :: Handle -> IO Int
423+parseManySepBy inh =
424+ (S.length $ IP.parseMany (PR.sliceSepBy (== lf) FL.drain)
425+ (S.unfold FH.read inh)) -- >>= print
426+
427+-- | Words by space
428+wordsBy :: Handle -> IO Int
429+wordsBy inh =
430+ (S.length $ S.wordsBy isSp FL.drain
431+ $ S.unfold FH.read inh) -- >>= print
432+
433+#ifdef INSPECTION
434+inspect $ hasNoTypeClasses 'wordsBy
435+inspect $ 'wordsBy `hasNoType` ''Step
436+inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
437+inspect $ 'wordsBy `hasNoType` ''A.ReadUState -- FH.read/A.read
438+#endif
439+
440+-- | Split on a word8 sequence.
441+splitOnSeq :: String -> Handle -> IO Int
442+splitOnSeq str inh =
443+ (S.length $ IP.splitOnSeq (toarr str) FL.drain
444+ $ S.unfold FH.read inh) -- >>= print
445+
446+#ifdef INSPECTION
447+-- inspect $ hasNoTypeClasses 'splitOnSeq
448+-- inspect $ 'splitOnSeq `hasNoType` ''Step
449+#endif
450+
451+-- | Split on suffix sequence.
452+splitOnSuffixSeq :: String -> Handle -> IO Int
453+splitOnSuffixSeq str inh =
454+ (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain
455+ $ S.unfold FH.read inh) -- >>= print
456+
457+#ifdef INSPECTION
458+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq
459+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
460+#endif
461+
462+o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
463+o_1_space_reduce_read_split env =
464+ [ bgroup "reduce/read"
465+ [ mkBench "S.parseMany (PR.sliceSepBy (== lf) FL.drain)" env
466+ $ \inh _ -> parseManySepBy inh
467+ , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->
468+ wordsBy inh
469+ , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->
470+ splitOn inh
471+ , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->
472+ splitOnSuffix inh
473+ , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->
474+ splitOnSeq "" inh
475+ , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->
476+ splitOnSuffixSeq "" inh
477+ , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->
478+ splitOnSeq "\n" inh
479+ , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->
480+ splitOnSuffixSeq "\n" inh
481+ , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->
482+ splitOnSeq "a" inh
483+ , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
484+ splitOnSeq "\r\n" inh
485+ , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
486+ splitOnSuffixSeq "\r\n" inh
487+ , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
488+ splitOnSeq "aa" inh
489+ , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
490+ splitOnSeq "aaaa" inh
491+ , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->
492+ splitOnSeq "abcdefgh" inh
493+ , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->
494+ splitOnSeq "abcdefghi" inh
495+ , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->
496+ splitOnSeq "catcatcatcatcat" inh
497+ , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
498+ env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh
499+ , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
500+ env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
501+ ]
502+ ]
503+
504+-- | Split on a character sequence.
505+splitOnSeqUtf8 :: String -> Handle -> IO Int
506+splitOnSeqUtf8 str inh =
507+ (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
508+ $ IUS.decodeUtf8ArraysLenient
509+ $ IFH.toChunks inh) -- >>= print
510+
511+o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
512+o_1_space_reduce_toChunks_split env =
513+ [ bgroup "reduce/toChunks"
514+ [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "
515+ ++ ". US.decodeUtf8ArraysLenient") env $ \inh _ ->
516+ splitOnSeqUtf8 "abcdefgh" inh
517+ , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
518+ env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh
519+ ]
520+ ]
521+
522+-------------------------------------------------------------------------------
523+--
524+-------------------------------------------------------------------------------
525+
300526allBenchmarks :: BenchEnv -> [Benchmark]
301527allBenchmarks env = Prelude.concat
302− [ o_1_space_reduce_read env
528+ [ o_1_space_read_chunked env
529+ , o_1_space_reduce_read env
303530 , o_1_space_reduce_toBytes env
304531 , o_1_space_reduce_read_grouped env
532+ , o_1_space_reduce_read_split env
533+ , o_1_space_reduce_toChunks_split env
305534 ]
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+467−85
@@ -1,9 +1,8 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.FileSystem.Handle
53-- Copyright : (c) 2019 Composewell Technologies
6−-- License : BSD3-3-Clause
4+--
5+-- License : BSD3
76-- Maintainer : streamly@composewell.com
87-- Stability : experimental
98-- Portability : GHC
@@ -24,25 +23,33 @@ module Handle.ReadWrite
2423 (allBenchmarks)
2524where
2625
27−import System.IO (Handle)
26+import Control.Exception (SomeException)
27+import System.IO (Handle, hClose)
2828import Prelude hiding (last, length)
29−import Streamly.Internal.System.IO (defaultChunkSize)
3029
30+import qualified Streamly.Data.Fold as FL
31+import qualified Streamly.Data.Unicode.Stream as SS
3132import qualified Streamly.FileSystem.Handle as FH
3233import qualified Streamly.Internal.Data.Unfold as IUF
34+import qualified Streamly.Internal.Data.Unicode.Stream as IUS
3335import qualified Streamly.Internal.FileSystem.Handle as IFH
34−import qualified Streamly.Data.Array as A
35−import qualified Streamly.Data.Stream.Prelude as S
36+import qualified Streamly.Internal.Memory.ArrayStream as AS
37+import qualified Streamly.Internal.Memory.Unicode.Array as IUA
38+import qualified Streamly.Internal.Prelude as IP
39+import qualified Streamly.Memory.Array as A
40+import qualified Streamly.Prelude as S
3641
37−import Test.Tasty.Bench hiding (env)
38−import Streamly.Benchmark.Common.Handle
42+import Gauge hiding (env)
43+import Handle.Common
3944
4045#ifdef INSPECTION
41−import Streamly.Internal.Data.Stream (Step(..))
46+import Foreign.Storable (Storable)
47+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
4248
43−import qualified Streamly.Internal.Data.Stream as D
44−import qualified Streamly.Internal.Data.Tuple.Strict as Strict
45−import qualified Streamly.Internal.Data.MutArray as MutArray
49+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
50+import qualified Streamly.Internal.Data.Strict as Strict
51+import qualified Streamly.Internal.Memory.Array as A
52+import qualified Streamly.Internal.Memory.Array.Types as AT
4653
4754import Test.Inspection
4855#endif
@@ -53,20 +60,116 @@ import Test.Inspection
5360
5461-- | Copy file
5562copyChunks :: Handle -> Handle -> IO ()
56−copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh
63+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
5764
5865#ifdef INSPECTION
5966inspect $ hasNoTypeClasses 'copyChunks
6067inspect $ 'copyChunks `hasNoType` ''Step
6168#endif
6269
70+-- | Copy file
71+copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
72+copyCodecUtf8ArraysLenient inh outh =
73+ S.fold (FH.write outh)
74+ $ SS.encodeUtf8
75+ $ IUS.decodeUtf8ArraysLenient
76+ $ IFH.toChunks inh
77+
78+#ifdef INSPECTION
79+inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
80+-- inspect $ 'copyCodecUtf8ArraysLenient `hasNoType` ''Step
81+#endif
82+
6383o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
6484o_1_space_copy_chunked env =
65− [ bgroup "copy/getChunks"
85+ [ bgroup "copy/toChunks"
6686 [ mkBench "toNull" env $ \inH _ ->
6787 copyChunks inH (nullH env)
6888 , mkBench "raw" env $ \inH outH ->
6989 copyChunks inH outH
90+ , mkBenchSmall "decodeEncodeUtf8Lenient" env $ \inH outH ->
91+ copyCodecUtf8ArraysLenient inH outH
92+ ]
93+ ]
94+
95+-- TBD reading with unfold
96+
97+-------------------------------------------------------------------------------
98+-- Exceptions readChunks
99+-------------------------------------------------------------------------------
100+
101+-- | Send the file contents to /dev/null with exception handling
102+readChunksOnException :: Handle -> Handle -> IO ()
103+readChunksOnException inh devNull =
104+ let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
105+ in IUF.fold readEx (IFH.writeChunks devNull) inh
106+
107+#ifdef INSPECTION
108+inspect $ hasNoTypeClasses 'readChunksOnException
109+-- inspect $ 'readChunksOnException `hasNoType` ''Step
110+#endif
111+
112+-- | Send the file contents to /dev/null with exception handling
113+readChunksBracket :: Handle -> Handle -> IO ()
114+readChunksBracket inh devNull =
115+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
116+ in IUF.fold readEx (IFH.writeChunks devNull) inh
117+
118+#ifdef INSPECTION
119+inspect $ hasNoTypeClasses 'readChunksBracket
120+-- inspect $ 'readChunksBracket `hasNoType` ''Step
121+#endif
122+
123+readChunksBracketIO :: Handle -> Handle -> IO ()
124+readChunksBracketIO inh devNull =
125+ let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.readChunks
126+ in IUF.fold readEx (IFH.writeChunks devNull) inh
127+
128+o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
129+o_1_space_copy_exceptions_readChunks env =
130+ [ bgroup "copy/readChunks/exceptions"
131+ [ mkBench "UF.onException" env $ \inH _ ->
132+ readChunksOnException inH (nullH env)
133+ , mkBench "UF.bracket" env $ \inH _ ->
134+ readChunksBracket inH (nullH env)
135+ , mkBench "UF.bracketIO" env $ \inH _ ->
136+ readChunksBracketIO inH (nullH env)
137+ ]
138+ ]
139+
140+-------------------------------------------------------------------------------
141+-- Exceptions toChunks
142+-------------------------------------------------------------------------------
143+
144+-- | Send the file contents to /dev/null with exception handling
145+toChunksBracket :: Handle -> Handle -> IO ()
146+toChunksBracket inh devNull =
147+ let readEx = S.bracket
148+ (return ())
149+ (\_ -> hClose inh)
150+ (\_ -> IFH.toChunks inh)
151+ in S.fold (IFH.writeChunks devNull) $ readEx
152+
153+#ifdef INSPECTION
154+inspect $ hasNoTypeClasses 'toChunksBracket
155+-- inspect $ 'toChunksBracket `hasNoType` ''Step
156+#endif
157+
158+toChunksBracketIO :: Handle -> Handle -> IO ()
159+toChunksBracketIO inh devNull =
160+ let readEx = IP.bracketIO
161+ (return ())
162+ (\_ -> hClose inh)
163+ (\_ -> IFH.toChunks inh)
164+ in S.fold (IFH.writeChunks devNull) $ readEx
165+
166+o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
167+o_1_space_copy_exceptions_toChunks env =
168+ [ bgroup "copy/toChunks/exceptions"
169+ [ mkBench "S.bracket" env $ \inH _ ->
170+ toChunksBracket inH (nullH env)
171+ , mkBench "S.bracketIO" env $ \inH _ ->
172+ toChunksBracketIO inH (nullH env)
70173 ]
71174 ]
72175
@@ -76,15 +179,62 @@ o_1_space_copy_chunked env =
76179
77180-- | Copy file
78181copyStream :: Handle -> Handle -> IO ()
79−copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.reader inh)
182+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
80183
81184#ifdef INSPECTION
82185inspect $ hasNoTypeClasses 'copyStream
83186inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
84−inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
86− -- FH.read/A.read
87−inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
187+inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
188+inspect $ 'copyStream `hasNoType` ''A.ReadUState -- FH.read/A.read
189+inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
190+inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf
191+#endif
192+
193+-- | Copy file
194+copyStreamLatin1 :: Handle -> Handle -> IO ()
195+copyStreamLatin1 inh outh =
196+ S.fold (FH.write outh)
197+ $ SS.encodeLatin1
198+ $ SS.decodeLatin1
199+ $ S.unfold FH.read inh
200+
201+#ifdef INSPECTION
202+inspect $ hasNoTypeClasses 'copyStreamLatin1
203+inspect $ 'copyStreamLatin1 `hasNoType` ''Step
204+inspect $ 'copyStreamLatin1 `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
205+inspect $ 'copyStreamLatin1 `hasNoType` ''A.ReadUState -- FH.read/A.read
206+inspect $ 'copyStreamLatin1 `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
207+inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- FH.write/lchunksOf
208+#endif
209+
210+-- | Copy file
211+_copyStreamUtf8 :: Handle -> Handle -> IO ()
212+_copyStreamUtf8 inh outh =
213+ S.fold (FH.write outh)
214+ $ SS.encodeUtf8
215+ $ SS.decodeUtf8
216+ $ S.unfold FH.read inh
217+
218+#ifdef INSPECTION
219+inspect $ hasNoTypeClasses '_copyStreamUtf8
220+-- inspect $ '_copyStreamUtf8 `hasNoType` ''Step
221+-- inspect $ '_copyStreamUtf8 `hasNoType` ''AT.FlattenState
222+-- inspect $ '_copyStreamUtf8 `hasNoType` ''D.ConcatMapUState
223+#endif
224+
225+-- | Copy file
226+copyStreamUtf8Lax :: Handle -> Handle -> IO ()
227+copyStreamUtf8Lax inh outh =
228+ S.fold (FH.write outh)
229+ $ SS.encodeUtf8
230+ $ SS.decodeUtf8Lax
231+ $ S.unfold FH.read inh
232+
233+#ifdef INSPECTION
234+inspect $ hasNoTypeClasses 'copyStreamUtf8Lax
235+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''Step
236+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''AT.FlattenState
237+-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
88238#endif
89239
90240o_1_space_copy_read :: BenchEnv -> [Benchmark]
@@ -94,6 +244,15 @@ o_1_space_copy_read env =
94244 copyStream inh (nullH env)
95245 , mkBench "rawToFile" env $ \inh outh ->
96246 copyStream inh outh
247+ -- This needs an ascii file, as decode just errors out.
248+ , mkBench "SS.encodeLatin1 . SS.decodeLatin1" env $ \inh outh ->
249+ copyStreamLatin1 inh outh
250+#ifdef DEVBUILD
251+ , mkBench "copyUtf8" env $ \inh outh ->
252+ _copyStreamUtf8 inh outh
253+#endif
254+ , mkBenchSmall "SS.encodeUtf8 . SS.decodeUtf8Lax" env $ \inh outh ->
255+ copyStreamUtf8Lax inh outh
97256 ]
98257 ]
99258
@@ -103,101 +262,319 @@ o_1_space_copy_read env =
103262
104263-- | Send the file contents to /dev/null
105264readFromBytesNull :: Handle -> Handle -> IO ()
106−readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh
265+readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh
107266
108267#ifdef INSPECTION
109268inspect $ hasNoTypeClasses 'readFromBytesNull
110269inspect $ 'readFromBytesNull `hasNoType` ''Step
111−inspect $ 'readFromBytesNull `hasNoType` ''MutArray.SpliceState
112−inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
113−inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
270+inspect $ 'readFromBytesNull `hasNoType` ''AT.SpliceState
271+inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
272+inspect $ 'readFromBytesNull `hasNoType` ''D.GroupState
114273#endif
115274
116−-- | Send the file contents ('defaultChunkSize') to /dev/null
117−readWithFromBytesNull :: Handle -> Handle -> IO ()
118−readWithFromBytesNull inh devNull =
119− IFH.putBytes devNull
120− $ S.unfold FH.readerWith (defaultChunkSize, inh)
275+o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
276+o_1_space_copy_fromBytes env =
277+ [ bgroup "copy/fromBytes"
278+ [ mkBench "rawToNull" env $ \inh _ ->
279+ readFromBytesNull inh (nullH env)
280+ ]
281+ ]
282+
283+-------------------------------------------------------------------------------
284+-- unfold exceptions
285+-------------------------------------------------------------------------------
286+
287+-- | Send the file contents to /dev/null with exception handling
288+readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
289+readWriteOnExceptionUnfold inh devNull =
290+ let readEx = IUF.onException (\_ -> hClose inh) FH.read
291+ in S.fold (FH.write devNull) $ S.unfold readEx inh
292+
293+#ifdef INSPECTION
294+inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
295+-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
296+#endif
297+
298+-- | Send the file contents to /dev/null with exception handling
299+readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
300+readWriteHandleExceptionUnfold inh devNull =
301+ let handler (_e :: SomeException) = hClose inh >> return 10
302+ readEx = IUF.handle (IUF.singletonM handler) FH.read
303+ in S.fold (FH.write devNull) $ S.unfold readEx inh
121304
122305#ifdef INSPECTION
123−inspect $ hasNoTypeClasses 'readWithFromBytesNull
124−inspect $ 'readWithFromBytesNull `hasNoType` ''Step
125−inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.SpliceState
126−inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
127−inspect $ 'readWithFromBytesNull `hasNoType` ''D.FoldMany
306+inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
307+-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
128308#endif
129309
130−-- | Send the chunk content ('defaultChunkSize') to /dev/null
131−-- Implicitly benchmarked via 'readFromBytesNull'
132−_readChunks :: Handle -> Handle -> IO ()
133−_readChunks inh devNull = IUF.fold fld unf inh
310+-- | Send the file contents to /dev/null with exception handling
311+readWriteFinallyUnfold :: Handle -> Handle -> IO ()
312+readWriteFinallyUnfold inh devNull =
313+ let readEx = IUF.finally (\_ -> hClose inh) FH.read
314+ in S.fold (FH.write devNull) $ S.unfold readEx inh
134315
135− where
316+#ifdef INSPECTION
317+inspect $ hasNoTypeClasses 'readWriteFinallyUnfold
318+-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
319+#endif
136320
137− fld = FH.write devNull
138− unf = IUF.many A.reader FH.chunkReader
321+readWriteFinallyIOUnfold :: Handle -> Handle -> IO ()
322+readWriteFinallyIOUnfold inh devNull =
323+ let readEx = IUF.finallyIO (\_ -> hClose inh) FH.read
324+ in S.fold (FH.write devNull) $ S.unfold readEx inh
139325
140−-- | Send the chunk content to /dev/null
141−-- Implicitly benchmarked via 'readWithFromBytesNull'
142−_readChunksWith :: Handle -> Handle -> IO ()
143−_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
326+-- | Send the file contents to /dev/null with exception handling
327+readWriteBracketUnfold :: Handle -> Handle -> IO ()
328+readWriteBracketUnfold inh devNull =
329+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.read
330+ in S.fold (FH.write devNull) $ S.unfold readEx inh
144331
145− where
332+#ifdef INSPECTION
333+inspect $ hasNoTypeClasses 'readWriteBracketUnfold
334+-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
335+#endif
146336
147− fld = FH.write devNull
148− unf = IUF.many A.reader FH.chunkReaderWith
337+readWriteBracketIOUnfold :: Handle -> Handle -> IO ()
338+readWriteBracketIOUnfold inh devNull =
339+ let readEx = IUF.bracketIO return (\_ -> hClose inh) FH.read
340+ in S.fold (FH.write devNull) $ S.unfold readEx inh
341+
342+o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
343+o_1_space_copy_read_exceptions env =
344+ [ bgroup "copy/read/exceptions"
345+ [ mkBenchSmall "UF.onException" env $ \inh _ ->
346+ readWriteOnExceptionUnfold inh (nullH env)
347+ , mkBenchSmall "UF.handle" env $ \inh _ ->
348+ readWriteHandleExceptionUnfold inh (nullH env)
349+ , mkBenchSmall "UF.finally" env $ \inh _ ->
350+ readWriteFinallyUnfold inh (nullH env)
351+ , mkBenchSmall "UF.finallyIO" env $ \inh _ ->
352+ readWriteFinallyIOUnfold inh (nullH env)
353+ , mkBenchSmall "UF.bracket" env $ \inh _ ->
354+ readWriteBracketUnfold inh (nullH env)
355+ , mkBenchSmall "UF.bracketIO" env $ \inh _ ->
356+ readWriteBracketIOUnfold inh (nullH env)
357+ ]
358+ ]
149359
150−o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
151−o_1_space_copy_fromBytes env =
152− [ bgroup "copy/putBytes"
153− [ mkBench "rawToNull" env $ \inh _ ->
154− readFromBytesNull inh (nullH env)
155− , mkBench "FH.readWith" env $ \inh _ ->
156− readWithFromBytesNull inh (nullH env)
360+-------------------------------------------------------------------------------
361+-- stream exceptions
362+-------------------------------------------------------------------------------
363+
364+-- | Send the file contents to /dev/null with exception handling
365+readWriteOnExceptionStream :: Handle -> Handle -> IO ()
366+readWriteOnExceptionStream inh devNull =
367+ let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
368+ in S.fold (FH.write devNull) $ readEx
369+
370+-- | Send the file contents to /dev/null with exception handling
371+readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
372+readWriteHandleExceptionStream inh devNull =
373+ let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
374+ readEx = S.handle handler (S.unfold FH.read inh)
375+ in S.fold (FH.write devNull) $ readEx
376+
377+-- | Send the file contents to /dev/null with exception handling
378+readWriteFinallyStream :: Handle -> Handle -> IO ()
379+readWriteFinallyStream inh devNull =
380+ let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
381+ in S.fold (FH.write devNull) readEx
382+
383+readWriteFinallyIOStream :: Handle -> Handle -> IO ()
384+readWriteFinallyIOStream inh devNull =
385+ let readEx = IP.finallyIO (hClose inh) (S.unfold FH.read inh)
386+ in S.fold (FH.write devNull) readEx
387+
388+-- | Send the file contents to /dev/null with exception handling
389+fromToBytesBracketStream :: Handle -> Handle -> IO ()
390+fromToBytesBracketStream inh devNull =
391+ let readEx = S.bracket (return ()) (\_ -> hClose inh)
392+ (\_ -> IFH.toBytes inh)
393+ in IFH.fromBytes devNull $ readEx
394+
395+#ifdef INSPECTION
396+inspect $ hasNoTypeClasses 'fromToBytesBracketStream
397+-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step
398+#endif
399+
400+fromToBytesBracketIOStream :: Handle -> Handle -> IO ()
401+fromToBytesBracketIOStream inh devNull =
402+ let readEx = IP.bracketIO (return ()) (\_ -> hClose inh)
403+ (\_ -> IFH.toBytes inh)
404+ in IFH.fromBytes devNull $ readEx
405+
406+o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
407+o_1_space_copy_stream_exceptions env =
408+ [ bgroup "copy/read/exceptions"
409+ [ mkBenchSmall "S.onException" env $ \inh _ ->
410+ readWriteOnExceptionStream inh (nullH env)
411+ , mkBenchSmall "S.handle" env $ \inh _ ->
412+ readWriteHandleExceptionStream inh (nullH env)
413+ , mkBenchSmall "S.finally" env $ \inh _ ->
414+ readWriteFinallyStream inh (nullH env)
415+ , mkBenchSmall "S.finallyIO" env $ \inh _ ->
416+ readWriteFinallyIOStream inh (nullH env)
417+ ]
418+ , bgroup "copy/fromToBytes/exceptions"
419+ [ mkBenchSmall "S.bracket" env $ \inh _ ->
420+ fromToBytesBracketStream inh (nullH env)
421+ , mkBenchSmall "S.bracketIO" env $ \inh _ ->
422+ fromToBytesBracketIOStream inh (nullH env)
157423 ]
158424 ]
159425
160−-- | Send the file contents ('defaultChunkSize') to /dev/null
161−writeReadWith :: Handle -> Handle -> IO ()
162−writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
426+-------------------------------------------------------------------------------
427+-- copy with group/ungroup transformations
428+-------------------------------------------------------------------------------
429+
430+-- | Lines and unlines
431+copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
432+copyChunksSplitInterposeSuffix inh outh =
433+ S.fold (IFH.write outh)
434+ $ AS.interposeSuffix 10
435+ $ AS.splitOnSuffix 10
436+ $ IFH.toChunks inh
437+
438+#ifdef INSPECTION
439+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
440+-- inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
441+#endif
442+
443+-- | Words and unwords
444+copyChunksSplitInterpose :: Handle -> Handle -> IO ()
445+copyChunksSplitInterpose inh outh =
446+ S.fold (IFH.write outh)
447+ $ AS.interpose 32
448+ -- XXX this is not correct word splitting combinator
449+ $ AS.splitOn 32
450+ $ IFH.toChunks inh
451+
452+#ifdef INSPECTION
453+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
454+-- inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
455+#endif
456+
457+o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
458+o_1_space_copy_toChunks_group_ungroup env =
459+ [ bgroup "copy/toChunks/group-ungroup"
460+ [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->
461+ copyChunksSplitInterposeSuffix inh outh
462+ , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->
463+ copyChunksSplitInterpose inh outh
464+ ]
465+ ]
163466
164− where
467+-------------------------------------------------------------------------------
468+-- copy with group/ungroup transformations
469+-------------------------------------------------------------------------------
165470
166− fld = FH.writeWith defaultChunkSize devNull
167− unf = FH.readerWith
471+linesUnlinesCopy :: Handle -> Handle -> IO ()
472+linesUnlinesCopy inh outh =
473+ S.fold (FH.write outh)
474+ $ SS.encodeLatin1
475+ $ IUS.unlines IUF.fromList
476+ $ S.splitOnSuffix (== '\n') FL.toList
477+ $ SS.decodeLatin1
478+ $ S.unfold FH.read inh
479+
480+linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
481+linesUnlinesArrayWord8Copy inh outh =
482+ S.fold (FH.write outh)
483+ $ IP.interposeSuffix 10 A.read
484+ $ S.splitOnSuffix (== 10) A.write
485+ $ S.unfold FH.read inh
486+
487+-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
488+-- | Lines and unlines
489+linesUnlinesArrayCharCopy :: Handle -> Handle -> IO ()
490+linesUnlinesArrayCharCopy inh outh =
491+ S.fold (FH.write outh)
492+ $ SS.encodeLatin1
493+ $ IUA.unlines
494+ $ IUA.lines
495+ $ SS.decodeLatin1
496+ $ S.unfold FH.read inh
168497
169498#ifdef INSPECTION
170−inspect $ hasNoTypeClasses 'writeReadWith
171−inspect $ 'writeReadWith `hasNoType` ''Step
172−inspect $ 'writeReadWith `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
173−inspect $ 'writeReadWith `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
174− -- FH.read/A.read
499+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
500+-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
175501#endif
176502
177−-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
178−writeRead :: Handle -> Handle -> IO ()
179−writeRead inh devNull = IUF.fold fld unf inh
503+-- XXX to write this we need to be able to map decodeUtf8 on the A.read fold.
504+-- For that we have to write decodeUtf8 as a Pipe.
505+{-
506+{-# INLINE linesUnlinesArrayUtf8Copy #-}
507+linesUnlinesArrayUtf8Copy :: Handle -> Handle -> IO ()
508+linesUnlinesArrayUtf8Copy inh outh =
509+ S.fold (FH.write outh)
510+ $ SS.encodeLatin1
511+ $ IP.intercalate (A.fromList [10]) (pipe SS.decodeUtf8P A.read)
512+ $ S.splitOnSuffix (== '\n') (IFL.lmap SS.encodeUtf8 A.write)
513+ $ SS.decodeLatin1
514+ $ S.unfold FH.read inh
515+-}
516+
517+-- | Word, unwords and copy
518+wordsUnwordsCopyWord8 :: Handle -> Handle -> IO ()
519+wordsUnwordsCopyWord8 inh outh =
520+ S.fold (FH.write outh)
521+ $ IP.interposeSuffix 32 IUF.fromList
522+ $ S.wordsBy isSp FL.toList
523+ $ S.unfold FH.read inh
180524
181− where
525+#ifdef INSPECTION
526+inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
527+-- inspect $ 'wordsUnwordsCopyWord8 `hasNoType` ''Step
528+#endif
182529
183− fld = FH.write devNull
184− unf = FH.reader
530+-- | Word, unwords and copy
531+wordsUnwordsCopy :: Handle -> Handle -> IO ()
532+wordsUnwordsCopy inh outh =
533+ S.fold (FH.write outh)
534+ $ SS.encodeLatin1
535+ $ IUS.unwords IUF.fromList
536+ -- XXX This pipeline does not fuse with wordsBy but fuses with splitOn
537+ -- with -funfolding-use-threshold=300. With wordsBy it does not fuse
538+ -- even with high limits for inlining and spec-constr ghc options. With
539+ -- -funfolding-use-threshold=400 it performs pretty well and there
540+ -- is no evidence in the core that a join point involving Step
541+ -- constructors is not getting inlined. Not being able to fuse at all in
542+ -- this case could be an unknown issue, need more investigation.
543+ $ S.wordsBy isSpace FL.toList
544+ -- -- $ S.splitOn isSpace FL.toList
545+ $ SS.decodeLatin1
546+ $ S.unfold FH.read inh
185547
186548#ifdef INSPECTION
187−inspect $ hasNoTypeClasses 'writeRead
188−inspect $ 'writeRead `hasNoType` ''Step
189−inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
190−inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
191− -- FH.read/A.read
549+-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
550+-- inspect $ 'wordsUnwordsCopy `hasNoType` ''Step
192551#endif
193552
194−o_1_space_copy :: BenchEnv -> [Benchmark]
195−o_1_space_copy env =
196− [ bgroup "copy"
197− [ mkBench "FH.write . FH.read" env $ \inh _ ->
198− writeRead inh (nullH env)
199− , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->
200− writeReadWith inh (nullH env)
553+wordsUnwordsCharArrayCopy :: Handle -> Handle -> IO ()
554+wordsUnwordsCharArrayCopy inh outh =
555+ S.fold (FH.write outh)
556+ $ SS.encodeLatin1
557+ $ IUA.unwords
558+ $ IUA.words
559+ $ SS.decodeLatin1
560+ $ S.unfold FH.read inh
561+
562+o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
563+o_1_space_copy_read_group_ungroup env =
564+ [ bgroup "copy/read/group-ungroup"
565+ [ mkBenchSmall "US.unlines . S.splitOnSuffix ([Word8])" env
566+ $ \inh outh -> linesUnlinesCopy inh outh
567+ , mkBenchSmall "S.interposeSuffix . S.splitOnSuffix(Array Word8)" env
568+ $ \inh outh -> linesUnlinesArrayWord8Copy inh outh
569+ , mkBenchSmall "UA.unlines . UA.lines (Array Char)" env
570+ $ \inh outh -> linesUnlinesArrayCharCopy inh outh
571+
572+ , mkBenchSmall "S.interposeSuffix . S.wordsBy ([Word8])" env
573+ $ \inh outh -> wordsUnwordsCopyWord8 inh outh
574+ , mkBenchSmall "US.unwords . S.wordsBy ([Char])" env
575+ $ \inh outh -> wordsUnwordsCopy inh outh
576+ , mkBenchSmall "UA.unwords . UA.words (Array Char)" env
577+ $ \inh outh -> wordsUnwordsCharArrayCopy inh outh
201578 ]
202579 ]
203580
@@ -208,7 +585,12 @@ o_1_space_copy env =
208585allBenchmarks :: BenchEnv -> [Benchmark]
209586allBenchmarks env = Prelude.concat
210587 [ o_1_space_copy_chunked env
588+ , o_1_space_copy_exceptions_readChunks env
589+ , o_1_space_copy_exceptions_toChunks env
211590 , o_1_space_copy_read env
212591 , o_1_space_copy_fromBytes env
213− , o_1_space_copy env
592+ , o_1_space_copy_read_exceptions env
593+ , o_1_space_copy_stream_exceptions env
594+ , o_1_space_copy_toChunks_group_ungroup env
595+ , o_1_space_copy_read_group_ungroup env
214596 ]
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+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/Streamly/Benchmark/Prelude/Ahead.hs+29−33
@@ -1,21 +1,19 @@
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
97
108import Prelude hiding (mapM)
119
12−import Streamly.Prelude (fromAhead, fromSerial, ahead, maxBuffer, maxThreads)
10+import Streamly (aheadly, serially, ahead, maxBuffer, maxThreads)
1311import qualified Streamly.Prelude as S
1412
1513import Streamly.Benchmark.Common
1614import Streamly.Benchmark.Prelude
1715
18−import Test.Tasty.Bench
16+import Gauge
1917
2018moduleName :: String
2119moduleName = "Prelude.Ahead"
@@ -29,13 +27,13 @@ moduleName = "Prelude.Ahead"
2927o_1_space_generation :: Int -> [Benchmark]
3028o_1_space_generation value =
3129 [ bgroup "generation"
32− [ benchIOSrc fromAhead "unfoldr" (sourceUnfoldr value)
33− , benchIOSrc fromAhead "unfoldrM" (sourceUnfoldrM value)
34− , benchIOSrc fromAhead "fromFoldable" (sourceFromFoldable value)
35− , benchIOSrc fromAhead "fromFoldableM" (sourceFromFoldableM value)
36− , benchIOSrc fromAhead "unfoldrM maxThreads 1"
30+ [ benchIOSrc aheadly "unfoldr" (sourceUnfoldr value)
31+ , benchIOSrc aheadly "unfoldrM" (sourceUnfoldrM value)
32+ , benchIOSrc aheadly "fromFoldable" (sourceFromFoldable value)
33+ , benchIOSrc aheadly "fromFoldableM" (sourceFromFoldableM value)
34+ , benchIOSrc aheadly "unfoldrM maxThreads 1"
3735 (maxThreads 1 . sourceUnfoldrM value)
38− , benchIOSrc fromAhead "unfoldrM maxBuffer 1 (x/10 ops)"
36+ , benchIOSrc aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
3937 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
4038 ]
4139 ]
@@ -43,9 +41,9 @@ o_1_space_generation value =
4341o_1_space_mapping :: Int -> [Benchmark]
4442o_1_space_mapping value =
4543 [ bgroup "mapping"
46− [ benchIOSink value "map" $ mapN fromAhead 1
47− , benchIOSink value "fmap" $ fmapN fromAhead 1
48− , benchIOSink value "mapM" $ mapM fromAhead 1 . fromSerial
44+ [ benchIOSink value "map" $ mapN aheadly 1
45+ , benchIOSink value "fmap" $ fmapN aheadly 1
46+ , benchIOSink value "mapM" $ mapM aheadly 1 . serially
4947 ]
5048 ]
5149
@@ -53,17 +51,13 @@ o_1_space_concatFoldable :: Int -> [Benchmark]
5351o_1_space_concatFoldable value =
5452 [ bgroup
5553 "concat-foldable"
56− [ benchIOSrc fromAhead "foldMapWith (<>) (List)"
54+ [ benchIOSrc aheadly "foldMapWith (<>) (List)"
5755 (sourceFoldMapWith value)
58− , benchIOSrc fromAhead "foldMapWith (<>) (Stream)"
56+ , benchIOSrc aheadly "foldMapWith (<>) (Stream)"
5957 (sourceFoldMapWithStream value)
60− , benchIOSrc fromAhead "foldMapWithM (<>) (List)"
58+ , benchIOSrc aheadly "foldMapWithM (<>) (List)"
6159 (sourceFoldMapWithM value)
62− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
63− (concatFoldableWith value)
64− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
65− (concatForFoldableWith value)
66− , benchIOSrc fromAhead "foldMapM (List)" (sourceFoldMapM value)
60+ , benchIOSrc aheadly "foldMapM (List)" (sourceFoldMapM value)
6761 ]
6862 ]
6963
@@ -72,7 +66,7 @@ o_1_space_concatMap value =
7266 value2 `seq`
7367 [ bgroup "concat"
7468 -- This is for comparison with foldMapWith
75− [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
69+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
7670 (S.concatMapWith ahead id . sourceConcatMapId value)
7771
7872 , benchIO "concatMapWith (n of 1)"
@@ -95,13 +89,13 @@ o_1_space_concatMap value =
9589o_1_space_outerProduct :: Int -> [Benchmark]
9690o_1_space_outerProduct value =
9791 [ bgroup "monad-outer-product"
98− [ benchIO "toNullAp" $ toNullAp value fromAhead
99− , benchIO "toNull" $ toNullM value fromAhead
100− , benchIO "toNull3" $ toNullM3 value fromAhead
101− , benchIO "filterAllOut" $ filterAllOutM value fromAhead
102− , benchIO "filterAllIn" $ filterAllInM value fromAhead
103− , benchIO "filterSome" $ filterSome value fromAhead
104− , benchIO "breakAfterSome" $ breakAfterSome value fromAhead
92+ [ benchIO "toNullAp" $ toNullAp value aheadly
93+ , benchIO "toNull" $ toNullM value aheadly
94+ , benchIO "toNull3" $ toNullM3 value aheadly
95+ , benchIO "filterAllOut" $ filterAllOutM value aheadly
96+ , benchIO "filterAllIn" $ filterAllInM value aheadly
97+ , benchIO "filterSome" $ filterSome value aheadly
98+ , benchIO "breakAfterSome" $ breakAfterSome value aheadly
10599
106100 ]
107101 ]
@@ -109,8 +103,8 @@ o_1_space_outerProduct value =
109103o_n_space_outerProduct :: Int -> [Benchmark]
110104o_n_space_outerProduct value =
111105 [ bgroup "monad-outer-product"
112− [ benchIO "toList" $ toListM value fromAhead
113− , benchIO "toListSome" $ toListSome value fromAhead
106+ [ benchIO "toList" $ toListM value aheadly
107+ , benchIO "toListSome" $ toListSome value aheadly
114108 ]
115109 ]
116110
@@ -119,7 +113,9 @@ o_n_space_outerProduct value =
119113-------------------------------------------------------------------------------
120114
121115main :: IO ()
122−main = runWithCLIOpts defaultStreamSize allBenchmarks
116+main = do
117+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
118+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
123119
124120 where
125121
benchmark/Streamly/Benchmark/Prelude/Async.hs+33−47
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -9,14 +7,14 @@
97
108import Prelude hiding (mapM)
119
12−import Streamly.Prelude (fromAsync, async, maxBuffer, maxThreads, fromSerial)
10+import Streamly (asyncly, async, maxBuffer, maxThreads, serially)
1311import qualified Streamly.Prelude as S
14−import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform
12+import qualified Streamly.Internal.Data.Stream.StreamK.Type as Internal
1513
1614import Streamly.Benchmark.Common
1715import Streamly.Benchmark.Prelude
1816
19−import Test.Tasty.Bench
17+import Gauge
2018
2119moduleName :: String
2220moduleName = "Prelude.Async"
@@ -29,14 +27,14 @@ o_1_space_generation :: Int -> [Benchmark]
2927o_1_space_generation value =
3028 -- These basically test the performance of consMAsync
3129 [ bgroup "generation"
32− [ benchIOSrc fromAsync "unfoldr" (sourceUnfoldr value)
33− , benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)
34− , benchIOSrc fromAsync "fromListM" (sourceFromListM value)
35− , benchIOSrc fromAsync "fromFoldable (List)" (sourceFromFoldable value)
36− , benchIOSrc fromAsync "fromFoldableM (List)" (sourceFromFoldableM value)
37− , benchIOSrc fromAsync "unfoldrM maxThreads 1"
30+ [ benchIOSrc asyncly "unfoldr" (sourceUnfoldr value)
31+ , benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
32+ , benchIOSrc asyncly "fromListM" (sourceFromListM value)
33+ , benchIOSrc asyncly "fromFoldable (List)" (sourceFromFoldable value)
34+ , benchIOSrc asyncly "fromFoldableM (List)" (sourceFromFoldableM value)
35+ , benchIOSrc asyncly "unfoldrM maxThreads 1"
3836 (maxThreads 1 . sourceUnfoldrM value)
39− , benchIOSrc fromAsync "unfoldrM maxBuffer 1 (x/10 ops)"
37+ , benchIOSrc asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
4038 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
4139 ]
4240 ]
@@ -49,30 +47,22 @@ o_1_space_generation value =
4947foldrSShared :: Int -> Int -> IO ()
5048foldrSShared count n =
5149 S.drain
52− $ fromAsync
53− $ Transform.foldrSShared (\x xs -> S.consM (return x) xs) S.nil
54− $ fromSerial
50+ $ asyncly
51+ $ Internal.foldrSShared (\x xs -> S.consM (return x) xs) S.nil
52+ $ serially
5553 $ sourceUnfoldrM count n
5654
5755o_1_space_mapping :: Int -> [Benchmark]
5856o_1_space_mapping value =
5957 [ bgroup "mapping"
60− [ benchIOSink value "map" $ mapN fromAsync 1
61− , benchIOSink value "fmap" $ fmapN fromAsync 1
58+ [ benchIOSink value "map" $ mapN asyncly 1
59+ , benchIOSink value "fmap" $ fmapN asyncly 1
6260 , benchIOSrc1 "foldrSShared" (foldrSShared value)
6361 -- This basically tests the performance of consMAsync
64− , benchIOSink value "mapM" $ mapM fromAsync 1 . fromSerial
62+ , benchIOSink value "mapM" $ mapM asyncly 1 . serially
6563 ]
6664 ]
6765
68−-------------------------------------------------------------------------------
69−-- Size conserving transformations (reordering, buffering, etc.)
70−-------------------------------------------------------------------------------
71−
72−o_n_heap_buffering :: Int -> [Benchmark]
73−o_n_heap_buffering value =
74− [bgroup "buffered" [benchIOSink value "mkAsync" (mkAsync fromAsync)]]
75−
7666-------------------------------------------------------------------------------
7767-- Joining
7868-------------------------------------------------------------------------------
@@ -118,17 +108,13 @@ o_1_space_joining value =
118108o_1_space_concatFoldable :: Int -> [Benchmark]
119109o_1_space_concatFoldable value =
120110 [ bgroup "concat-foldable"
121− [ benchIOSrc fromAsync "foldMapWith (<>) (List)"
111+ [ benchIOSrc asyncly "foldMapWith (<>) (List)"
122112 (sourceFoldMapWith value)
123− , benchIOSrc fromAsync "foldMapWith (<>) (Stream)"
113+ , benchIOSrc asyncly "foldMapWith (<>) (Stream)"
124114 (sourceFoldMapWithStream value)
125− , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
115+ , benchIOSrc asyncly "foldMapWithM (<>) (List)"
126116 (sourceFoldMapWithM value)
127− , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"
128− (concatFoldableWith value)
129− , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"
130− (concatForFoldableWith value)
131− , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
117+ , benchIOSrc asyncly "foldMapM (List)" (sourceFoldMapM value)
132118 ]
133119 ]
134120
@@ -138,7 +124,7 @@ o_1_space_concatMap value =
138124 value2 `seq`
139125 [ bgroup "concat"
140126 -- This is for comparison with foldMapWith
141− [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
127+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
142128 (S.concatMapWith async id . sourceConcatMapId value)
143129
144130 , benchIO "concatMapWith (n of 1)"
@@ -161,13 +147,13 @@ o_1_space_concatMap value =
161147o_1_space_outerProduct :: Int -> [Benchmark]
162148o_1_space_outerProduct value =
163149 [ bgroup "monad-outer-product"
164− [ benchIO "toNullAp" $ toNullAp value fromAsync
165− , benchIO "toNull" $ toNullM value fromAsync
166− , benchIO "toNull3" $ toNullM3 value fromAsync
167− , benchIO "filterAllOut" $ filterAllOutM value fromAsync
168− , benchIO "filterAllIn" $ filterAllInM value fromAsync
169− , benchIO "filterSome" $ filterSome value fromAsync
170− , benchIO "breakAfterSome" $ breakAfterSome value fromAsync
150+ [ benchIO "toNullAp" $ toNullAp value asyncly
151+ , benchIO "toNull" $ toNullM value asyncly
152+ , benchIO "toNull3" $ toNullM3 value asyncly
153+ , benchIO "filterAllOut" $ filterAllOutM value asyncly
154+ , benchIO "filterAllIn" $ filterAllInM value asyncly
155+ , benchIO "filterSome" $ filterSome value asyncly
156+ , benchIO "breakAfterSome" $ breakAfterSome value asyncly
171157
172158 ]
173159 ]
@@ -175,8 +161,8 @@ o_1_space_outerProduct value =
175161o_n_space_outerProduct :: Int -> [Benchmark]
176162o_n_space_outerProduct value =
177163 [ bgroup "monad-outer-product"
178− [ benchIO "toList" $ toListM value fromAsync
179− , benchIO "toListSome" $ toListSome value fromAsync
164+ [ benchIO "toList" $ toListM value asyncly
165+ , benchIO "toListSome" $ toListSome value asyncly
180166 ]
181167 ]
182168
@@ -185,8 +171,9 @@ o_n_space_outerProduct value =
185171-------------------------------------------------------------------------------
186172
187173main :: IO ()
188−main = runWithCLIOpts defaultStreamSize allBenchmarks
189−
174+main = do
175+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
176+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
190177
191178 where
192179
@@ -199,6 +186,5 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
199186 , o_1_space_outerProduct value
200187 , o_1_space_joining value
201188 ]
202− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering value)
203189 , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct value)
204190 ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+19−28
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# LANGUAGE CPP #-}
31{-# LANGUAGE RankNTypes #-}
42-- |
53-- Module : Main
@@ -10,12 +8,9 @@
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,8 +28,8 @@ 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)
31+ $ maxBuffer buflen
32+ $ maxThreads (-1)
3833 $ S.fromFoldableM $ fmap work [1..tcount]
3934
4035-- | Run @threads@ concurrently, each producing streams of @elems@ elements
@@ -53,33 +48,32 @@ concated
5348concated buflen threads d elems t =
5449 let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)
5550 in S.drain
56− $ S.adapt
57− $ S.maxThreads (-1)
58− $ S.maxBuffer buflen
51+ $ adapt
52+ $ maxThreads (-1)
53+ $ maxBuffer buflen
5954 $ S.concatMapWith t work
6055 $ S.replicate threads elems
6156
6257appendGroup :: 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
58+appendGroup buflen threads delay =
59+ [ -- bench "serial" $ nfIO $ append buflen threads delay serially
60+ bench "ahead" $ nfIO $ append buflen threads delay aheadly
61+ , bench "async" $ nfIO $ append buflen threads delay asyncly
62+ , bench "wAsync" $ nfIO $ append buflen threads delay wAsyncly
63+ , bench "parallel" $ nfIO $ append buflen threads delay parallely
6964 ]
7065
7166concatGroup :: 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
67+concatGroup buflen threads delay n =
68+ [ bench "serial" $ nfIO $ concated buflen threads delay n serial
69+ , bench "ahead" $ nfIO $ concated buflen threads delay n ahead
70+ , bench "async" $ nfIO $ concated buflen threads delay n async
71+ , bench "wAsync" $ nfIO $ concated buflen threads delay n wAsync
72+ , bench "parallel" $ nfIO $ concated buflen threads delay n parallel
7873 ]
7974
8075main :: IO ()
8176main =
82−#ifdef MIN_VERSION_gauge
8377 defaultMainWith (defaultConfig
8478 { timeLimit = Just 0
8579 , minSamples = Just 1
@@ -87,9 +81,6 @@ main =
8781 , includeFirstIter = True
8882 , quickMode = True
8983 })
90−#else
91− defaultMain
92−#endif
9384
9485 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
9586 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
benchmark/Streamly/Benchmark/Prelude/Merge.hsdeleted−298
@@ -1,298 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−-- |
4−-- Module : Main
5−-- Copyright : (c) 2018 Composewell Technologies
6−--
7−-- License : BSD3
8−-- Maintainer : streamly@composewell.com
9−
10−{-# LANGUAGE BangPatterns #-}
11−{-# LANGUAGE CPP #-}
12−{-# LANGUAGE FlexibleContexts #-}
13−{-# LANGUAGE ScopedTypeVariables #-}
14−{-# LANGUAGE RankNTypes #-}
15−
16−#ifdef __HADDOCK_VERSION__
17−#undef INSPECTION
18−#endif
19−
20−#ifdef INSPECTION
21−{-# LANGUAGE TemplateHaskell #-}
22−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23−#endif
24−
25−import Streamly.Internal.Data.Stream.IsStream (SerialT)
26−import qualified Data.List as List
27−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
28−-- import qualified Streamly.Internal.Data.Unfold as Unfold
29−
30−import Streamly.Benchmark.Common
31−import Streamly.Benchmark.Prelude
32−
33−import Test.Tasty.Bench
34−
35−#ifdef INSPECTION
36−import GHC.Types (SPEC(..))
37−import Test.Inspection
38−
39−import qualified Streamly.Internal.Data.Stream as D
40−#endif
41−
42−moduleName :: String
43−moduleName = "Prelude.Merge"
44−
45−-------------------------------------------------------------------------------
46−-- Merging
47−-------------------------------------------------------------------------------
48−
49−{-# INLINE mergeWith #-}
50−mergeWith ::
51− ( (Int -> Int -> Ordering)
52− -> SerialT IO Int
53− -> SerialT IO Int
54− -> SerialT IO Int
55− )
56− -> (Int -> Int -> Ordering)
57− -> Int -> Int -> IO ()
58−mergeWith g cmp count n =
59− Stream.drain
60− $ g
61− cmp
62− (sourceUnfoldrM count n)
63− (sourceUnfoldrM count (n + 1))
64−
65−{-# INLINE mergeWithM #-}
66−mergeWithM ::
67− ( (Int -> Int -> IO Ordering)
68− -> SerialT IO Int
69− -> SerialT IO Int
70− -> SerialT IO Int
71− )
72− -> (Int -> Int -> Ordering)
73− -> Int -> Int -> IO ()
74−mergeWithM g cmp count n =
75− Stream.drain
76− $ g
77− (\a b -> return $ cmp a b)
78− (sourceUnfoldrM count n)
79− (sourceUnfoldrM count (n + 1))
80−
81−{-# INLINE mergeBy #-}
82−mergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
83−mergeBy = mergeWith Stream.mergeBy
84−
85−{-# INLINE mergeByM #-}
86−mergeByM :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
87−mergeByM = mergeWithM Stream.mergeByM
88−
89−{-# INLINE mergeByMFused #-}
90−mergeByMFused :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
91−mergeByMFused = mergeWithM Stream.mergeByMFused
92−
93−#ifdef INSPECTION
94−inspect $ hasNoTypeClasses 'mergeBy
95−inspect $ 'mergeBy `hasNoType` ''SPEC
96−inspect $ 'mergeBy `hasNoType` ''D.Step
97−
98−inspect $ hasNoTypeClasses 'mergeByM
99−inspect $ 'mergeByM `hasNoType` ''SPEC
100−inspect $ 'mergeByM `hasNoType` ''D.Step
101−
102−{-# INLINE _mergeByMFusedCheck #-}
103−_mergeByMFusedCheck :: IO ()
104−_mergeByMFusedCheck = mergeWithM Stream.mergeByMFused compare 0 0
105−
106−inspect $ hasNoTypeClasses '_mergeByMFusedCheck
107−inspect $ '_mergeByMFusedCheck `hasNoType` ''SPEC
108−inspect $ '_mergeByMFusedCheck `hasNoType` ''D.Step
109−#endif
110−
111−{-# INLINE concatPairsWithMergeBy #-}
112−concatPairsWithMergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
113−concatPairsWithMergeBy cmp = concatPairsWith (Stream.mergeBy cmp)
114−
115−{-# INLINE concatPairsWithMergeByFused #-}
116−concatPairsWithMergeByFused ::
117− (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
118−concatPairsWithMergeByFused cmp =
119− concatPairsWith (Stream.mergeByMFused (\x y -> return $ cmp x y))
120−
121−-------------------------------------------------------------------------------
122−-- Interleaving
123−-------------------------------------------------------------------------------
124−
125−o_1_space_joining :: Int -> [Benchmark]
126−o_1_space_joining value =
127− [ bgroup "joining (2 of n/2)"
128− [ benchIOSrc1
129− "mergeBy compare"
130− (mergeBy compare (value `div` 2))
131− , benchIOSrc1
132− "mergeByM compare"
133− (mergeByM compare (value `div` 2))
134− , benchIOSrc1
135− "mergeByMFused compare"
136− (mergeByMFused compare (value `div` 2))
137−
138− , benchIOSrc1
139− "mergeBy (flip compare)"
140− (mergeBy (flip compare) (value `div` 2))
141− , benchIOSrc1
142− "mergeByM (flip compare)"
143− (mergeByM (flip compare) (value `div` 2))
144− , benchIOSrc1
145− "mergeByMFused (flip compare)"
146− (mergeByMFused (flip compare) (value `div` 2))
147−
148− , benchIOSrc1
149− "concatPairsWithMergeBy compare"
150− (concatPairsWithMergeBy compare 2 (value `div` 2))
151− , benchIOSrc1
152− "concatPairsWithMergeBy (flip compare)"
153− (concatPairsWithMergeBy (flip compare) 2 (value `div` 2))
154−
155− , benchIOSrc1
156− "concatPairsWithMergeByFused compare"
157− (concatPairsWithMergeByFused compare 2 (value `div` 2))
158− , benchIOSrc1
159− "concatPairsWithMergeByFused (flip compare)"
160− (concatPairsWithMergeByFused (flip compare) 2 (value `div` 2))
161− ]
162− ]
163−
164−-------------------------------------------------------------------------------
165−-- Concat
166−-------------------------------------------------------------------------------
167−
168−{-
169−{-# INLINE sourceUnfoldrMUF #-}
170−-- (count, value)
171−sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int
172−sourceUnfoldrMUF count = UF.unfoldrM step
173− where
174− step (cnt, start) =
175− return $
176− if cnt > start + count
177− then Nothing
178− else Just (cnt, (cnt + 1, start))
179−
180−{-# INLINE unfoldManyMergeBy #-}
181−unfoldManyMergeBy :: Int -> Int -> Int -> IO ()
182−unfoldManyMergeBy outer inner n =
183− S.drain $ (Internal.unfoldManyMergeBy compare)
184− -- (UF.lmap return (UF.replicateM inner))
185− (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
186− (sourceUnfoldrM outer n)
187−
188−#ifdef INSPECTION
189−inspect $ hasNoTypeClasses 'unfoldManyMergeBy
190−-- inspect $ 'unfoldManyMergeBy `hasNoType` ''SPEC
191−-- inspect $ 'unfoldManyMergeBy `hasNoType`
192−-- ''D.ConcatUnfoldMergeState
193−#endif
194−-}
195−
196−{-# INLINE sortBy #-}
197−sortBy :: (Int -> Int -> Ordering) -> SerialT IO Int -> IO ()
198−sortBy cmp = Stream.drain . Stream.sortBy cmp
199−
200−{-
201−-- For fair comparison with concatPairs, removed sorted segmentation
202−{-# INLINE listSortBy #-}
203−listSortBy :: (a -> a -> Ordering) -> [a] -> [a]
204−listSortBy cmp = mergeAll . sequences
205− where
206− sequences = fmap (: [])
207−
208− mergeAll [x] = x
209− mergeAll xs = mergeAll (mergePairs xs)
210−
211− mergePairs (a:b:xs) = let !x = merge a b
212− in x : mergePairs xs
213− mergePairs xs = xs
214−
215− merge as@(a:as') bs@(b:bs')
216− | a `cmp` b == GT = b:merge as bs'
217− | otherwise = a:merge as' bs
218− merge [] bs = bs
219− merge as [] = as
220−-}
221−
222−o_n_heap_concat :: Int -> [Benchmark]
223−o_n_heap_concat value =
224− [ bgroup "concatPairsWith"
225− [ benchIOSrc1
226− "concatPairsWithMergeBy compare (n of 1)"
227− (concatPairsWithMergeBy compare value 1)
228− , benchIOSrc1
229− "concatPairsWithMergeBy compare (sqrtVal of sqrtVal)"
230− (concatPairsWithMergeBy compare sqrtVal sqrtVal)
231−
232− , benchIOSrc1
233− "concatPairsWithMergeBy (flip compare) (n of 1)"
234− (concatPairsWithMergeBy (flip compare) value 1)
235− , benchIOSrc1
236− "concatPairsWithMergeBy (flip compare) (sqrtVal of sqrtVal)"
237− (concatPairsWithMergeBy (flip compare) sqrtVal sqrtVal)
238−
239− , benchIOSrc1
240− "concatPairsWithMergeByFused compare (n of 1)"
241− (concatPairsWithMergeByFused compare value 1)
242− , benchIOSrc1
243− "concatPairsWithMergeByFused compare (sqrtVal of sqrtVal)"
244− (concatPairsWithMergeByFused compare sqrtVal sqrtVal)
245− ]
246− -- TODO: change sourceUnfoldrM to generate alternating bigger and lower
247− -- numbers to simulate a random input for a worst case sort benchmark. We
248− -- can use 0 and value as two ints in the state and alternate each in the
249− -- output streams, incrementing the lower number of decrementing the higher
250− -- number.
251− , bgroup "sorting"
252− [ benchIOSink value "sortBy compare" (sortBy compare)
253− , benchIOSink value "sortBy (flip compare)" (sortBy (flip compare))
254− , benchIOSink value "sortBy compare randomized"
255− (sortBy compare . Stream.map (\x -> if even x then x + 2 else x))
256− {-
257− , bench "sortByLists compare"
258− $ nf (\x -> listSortBy compare [1..x]) value
259− , bench "sortByLists (flip compare)"
260− $ nf (\x -> listSortBy (flip compare) [1..x]) value
261− , bench "sortByLists compare randomized"
262− $ nf (\x -> listSortBy compare
263− (map (\n -> if even n then n + 2 else n) [1..x])
264− )
265− value
266− -}
267− , bench "sortByLists compare"
268− $ nf (\x -> List.sortBy compare [1..x]) value
269− , bench "sortByLists (flip compare)"
270− $ nf (\x -> List.sortBy (flip compare) [1..x]) value
271− , bench "sortByLists compare randomized"
272− $ nf (\x -> List.sortBy compare
273− (map (\n -> if even n then n + 2 else n) [1..x])
274− )
275− value
276− ]
277− ]
278−
279− where
280−
281− sqrtVal = round $ sqrt (fromIntegral value :: Double)
282−
283−-------------------------------------------------------------------------------
284−-- Main
285−-------------------------------------------------------------------------------
286−
287−-- In addition to gauge options, the number of elements in the stream can be
288−-- passed using the --stream-size option.
289−--
290−main :: IO ()
291−main = runWithCLIOpts defaultStreamSize allBenchmarks
292−
293− where
294−
295− allBenchmarks size =
296− [ bgroup (o_1_space_prefix moduleName) (o_1_space_joining size)
297− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
298− ]
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+35−70
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -11,18 +9,18 @@
119
1210import Prelude hiding (mapM)
1311
14−import Data.Function ((&))
15−import Streamly.Prelude
16− ( SerialT, fromParallel, parallel, fromSerial, maxBuffer, maxThreads)
12+import Streamly (SerialT, parallely, parallel, serially, maxBuffer, maxThreads)
1713
14+import qualified Streamly as S
1815import qualified Streamly.Prelude as S
1916import qualified Streamly.Internal.Data.Fold as FL
20−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
17+import qualified Streamly.Internal.Data.Stream.Parallel as Par
18+import qualified Streamly.Internal.Prelude as Internal
2119
2220import Streamly.Benchmark.Common
2321import Streamly.Benchmark.Prelude
2422
25−import Test.Tasty.Bench
23+import Gauge
2624
2725moduleName :: String
2826moduleName = "Prelude.Parallel"
@@ -59,21 +57,13 @@ parAppMap src = S.drain $ S.map (+1) S.|$ src
5957parAppSum :: S.MonadAsync m => SerialT m Int -> m ()
6058parAppSum src = (S.sum S.|$. src) >>= \x -> seq x (return ())
6159
62−{-# INLINE (|&) #-}
63−(|&) :: S.MonadAsync m => SerialT m Int -> m ()
64−(|&) src = src S.|& S.map (+ 1) & S.drain
65−
66−{-# INLINE (|&.) #-}
67−(|&.) :: S.MonadAsync m => SerialT m Int -> m ()
68−(|&.) src = (src S.|&. S.sum) >>= \x -> seq x (return ())
69−
7060-------------------------------------------------------------------------------
7161-- Tapping
7262-------------------------------------------------------------------------------
7363
7464{-# INLINE tapAsyncS #-}
7565tapAsyncS :: S.MonadAsync m => Int -> SerialT m Int -> m ()
76−tapAsyncS n = composeN n $ Internal.tapAsyncK S.sum
66+tapAsyncS n = composeN n $ Par.tapAsync S.sum
7767
7868{-# INLINE tapAsync #-}
7969tapAsync :: S.MonadAsync m => Int -> SerialT m Int -> m ()
@@ -82,15 +72,13 @@ tapAsync n = composeN n $ Internal.tapAsync FL.sum
8272o_1_space_merge_app_tap :: Int -> [Benchmark]
8373o_1_space_merge_app_tap value =
8474 [ bgroup "merge-app-tap"
85− [ benchIOSrc fromSerial "mergeAsyncBy (2,x/2)"
75+ [ benchIOSrc serially "mergeAsyncBy (2,x/2)"
8676 (mergeAsyncBy (value `div` 2))
87− , benchIOSrc fromSerial "mergeAsyncByM (2,x/2)"
77+ , benchIOSrc serially "mergeAsyncByM (2,x/2)"
8878 (mergeAsyncByM (value `div` 2))
8979 -- Parallel stages in a pipeline
9080 , benchIOSink value "parAppMap" parAppMap
9181 , benchIOSink value "parAppSum" parAppSum
92− , benchIOSink value "(|&)" (|&)
93− , benchIOSink value "(|&.)" (|&.)
9482 , benchIOSink value "tapAsync" (tapAsync 1)
9583 , benchIOSink value "tapAsyncS" (tapAsyncS 1)
9684 ]
@@ -104,13 +92,13 @@ o_n_heap_generation :: Int -> [Benchmark]
10492o_n_heap_generation value =
10593 [ bgroup
10694 "generation"
107− [ benchIOSrc fromParallel "unfoldr" (sourceUnfoldr value)
108− , benchIOSrc fromParallel "unfoldrM" (sourceUnfoldrM value)
109− , benchIOSrc fromParallel "fromFoldable" (sourceFromFoldable value)
110− , benchIOSrc fromParallel "fromFoldableM" (sourceFromFoldableM value)
111− , benchIOSrc fromParallel "unfoldrM maxThreads 1"
95+ [ benchIOSrc parallely "unfoldr" (sourceUnfoldr value)
96+ , benchIOSrc parallely "unfoldrM" (sourceUnfoldrM value)
97+ , benchIOSrc parallely "fromFoldable" (sourceFromFoldable value)
98+ , benchIOSrc parallely "fromFoldableM" (sourceFromFoldableM value)
99+ , benchIOSrc parallely "unfoldrM maxThreads 1"
112100 (maxThreads 1 . sourceUnfoldrM value)
113− , benchIOSrc fromParallel "unfoldrM maxBuffer 1 (x/10 ops)"
101+ , benchIOSrc parallely "unfoldrM maxBuffer 1 (x/10 ops)"
114102 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
115103 ]
116104 ]
@@ -122,27 +110,9 @@ o_n_heap_generation value =
122110o_n_heap_mapping :: Int -> [Benchmark]
123111o_n_heap_mapping value =
124112 [ bgroup "mapping"
125− [ benchIOSink value "map" $ mapN fromParallel 1
126− , benchIOSink value "fmap" $ fmapN fromParallel 1
127− , benchIOSink value "mapM" $ mapM fromParallel 1 . fromSerial
128− ]
129− ]
130−
131−
132−-------------------------------------------------------------------------------
133−-- Joining
134−-------------------------------------------------------------------------------
135−
136−{-# INLINE parallel2 #-}
137−parallel2 :: Int -> Int -> IO ()
138−parallel2 count n =
139− S.drain $
140− (sourceUnfoldrM count n) `parallel` (sourceUnfoldrM count (n + 1))
141−
142−o_1_space_joining :: Int -> [Benchmark]
143−o_1_space_joining value =
144− [ bgroup "joining"
145− [ benchIOSrc1 "parallel (2 of n/2)" (parallel2 (value `div` 2))
113+ [ benchIOSink value "map" $ mapN parallely 1
114+ , benchIOSink value "fmap" $ fmapN parallely 1
115+ , benchIOSink value "mapM" $ mapM parallely 1 . serially
146116 ]
147117 ]
148118
@@ -154,17 +124,13 @@ o_n_heap_concatFoldable :: Int -> [Benchmark]
154124o_n_heap_concatFoldable value =
155125 [ bgroup
156126 "concat-foldable"
157− [ benchIOSrc fromParallel "foldMapWith (<>) (List)"
127+ [ benchIOSrc parallely "foldMapWith (<>) (List)"
158128 (sourceFoldMapWith value)
159− , benchIOSrc fromParallel "foldMapWith (<>) (Stream)"
129+ , benchIOSrc parallely "foldMapWith (<>) (Stream)"
160130 (sourceFoldMapWithStream value)
161− , benchIOSrc fromParallel "foldMapWithM (<>) (List)"
131+ , benchIOSrc parallely "foldMapWithM (<>) (List)"
162132 (sourceFoldMapWithM value)
163− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
164− (concatFoldableWith value)
165− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
166− (concatForFoldableWith value)
167− , benchIOSrc fromParallel "foldMapM (List)" (sourceFoldMapM value)
133+ , benchIOSrc parallely "foldMapM (List)" (sourceFoldMapM value)
168134 ]
169135 ]
170136
@@ -173,7 +139,7 @@ o_n_heap_concat value =
173139 value2 `seq`
174140 [ bgroup "concat"
175141 -- This is for comparison with foldMapWith
176− [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
142+ [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
177143 (S.concatMapWith parallel id . sourceConcatMapId value)
178144
179145 , benchIO "concatMapWith (n of 1)"
@@ -196,22 +162,22 @@ o_n_heap_concat value =
196162o_n_heap_outerProduct :: Int -> [Benchmark]
197163o_n_heap_outerProduct value =
198164 [ bgroup "monad-outer-product"
199− [ benchIO "toNullAp" $ toNullAp value fromParallel
200− , benchIO "toNull" $ toNullM value fromParallel
201− , benchIO "toNull3" $ toNullM3 value fromParallel
202− , benchIO "filterAllOut" $ filterAllOutM value fromParallel
203− , benchIO "filterAllIn" $ filterAllInM value fromParallel
204− , benchIO "filterSome" $ filterSome value fromParallel
205− , benchIO "breakAfterSome" $ breakAfterSome value fromParallel
165+ [ benchIO "toNullAp" $ toNullAp value parallely
166+ , benchIO "toNull" $ toNullM value parallely
167+ , benchIO "toNull3" $ toNullM3 value parallely
168+ , benchIO "filterAllOut" $ filterAllOutM value parallely
169+ , benchIO "filterAllIn" $ filterAllInM value parallely
170+ , benchIO "filterSome" $ filterSome value parallely
171+ , benchIO "breakAfterSome" $ breakAfterSome value parallely
206172 ]
207173 ]
208174
209175o_n_space_outerProduct :: Int -> [Benchmark]
210176o_n_space_outerProduct value =
211177 [ bgroup "monad-outer-product"
212− [ benchIO "toList" $ toListM value fromParallel
178+ [ benchIO "toList" $ toListM value parallely
213179 -- XXX disabled due to a bug for now
214− -- , benchIO "toListSome" $ toListSome value fromParallel
180+ -- , benchIO "toListSome" $ toListSome value parallely
215181 ]
216182 ]
217183
@@ -220,15 +186,14 @@ o_n_space_outerProduct value =
220186-------------------------------------------------------------------------------
221187
222188main :: IO ()
223−main = runWithCLIOpts defaultStreamSize allBenchmarks
189+main = do
190+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
191+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
224192
225193 where
226194
227195 allBenchmarks value =
228− [ bgroup (o_1_space_prefix moduleName) $ concat
229− [ o_1_space_merge_app_tap value
230− , o_1_space_joining value
231− ]
196+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_merge_app_tap value)
232197 , bgroup (o_n_heap_prefix moduleName) $ concat
233198 [ o_n_heap_generation value
234199 , o_n_heap_mapping value
benchmark/Streamly/Benchmark/Prelude/Rate.hs+39−76
@@ -1,6 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−
41-- |
52-- Module : Main
63-- Copyright : (c) 2018 Composewell Technologies
@@ -8,13 +5,14 @@
85-- License : BSD3
96-- Maintainer : streamly@composewell.com
107
11−import Streamly.Prelude (fromAsync, fromAhead, maxThreads, IsStream, MonadAsync)
12−import qualified Streamly.Prelude as S
8+import Streamly (asyncly, aheadly, maxThreads)
9+
10+import qualified Streamly as S
1311
1412import Streamly.Benchmark.Common
1513import Streamly.Benchmark.Prelude
1614
17−import Test.Tasty.Bench
15+import Gauge
1816
1917moduleName :: String
2018moduleName = "Prelude.Rate"
@@ -23,76 +21,36 @@ moduleName = "Prelude.Rate"
2321-- Average Rate
2422-------------------------------------------------------------------------------
2523
26−{-# INLINE rateNothing #-}
27−rateNothing :: (MonadAsync m, IsStream t) => Int -> Int -> t m Int
28−rateNothing value = S.rate Nothing . sourceUnfoldrM value
29−
30−{-# INLINE avgRate #-}
31−avgRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int
32−avgRate value rate_ = S.avgRate rate_ . sourceUnfoldrM value
33−
34−{-# INLINE avgRateThreads1 #-}
35−avgRateThreads1 :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int
36−avgRateThreads1 value rate_ =
37− maxThreads 1 . S.avgRate rate_ . sourceUnfoldrM value
38−
39−{-# INLINE minRate #-}
40−minRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int
41−minRate value rate_ = S.minRate rate_ . sourceUnfoldrM value
42−
43−{-# INLINE maxRate #-}
44−maxRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int
45−maxRate value rate_ = S.minRate rate_ . sourceUnfoldrM value
46−
47−{-# INLINE constRate #-}
48−constRate :: (MonadAsync m, IsStream t) => Int -> Double -> Int -> t m Int
49−constRate value rate_ = S.constRate rate_ . sourceUnfoldrM value
50−
5124-- XXX arbitrarily large rate should be the same as rate Nothing
52−o_1_space_async :: Int -> [Benchmark]
53−o_1_space_async value =
54− [ bgroup
55− "asyncly"
56− [ bgroup
57− "avgRate"
58− -- benchIO "unfoldr" $ toNull fromAsync
59− -- benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)
60− [ benchIOSrc fromAsync "Nothing" $ rateNothing value
61− , benchIOSrc fromAsync "1M" $ avgRate value 1000000
62− , benchIOSrc fromAsync "3M" $ avgRate value 3000000
63− , benchIOSrc fromAsync "10M/maxThreads1"
64− $ avgRateThreads1 value 10000000
65− , benchIOSrc fromAsync "10M" $ avgRate value 10000000
66− , benchIOSrc fromAsync "20M" $ avgRate value 20000000
67− ]
68− , bgroup
69− "minRate"
70− [ benchIOSrc fromAsync "1M" $ minRate value 1000000
71− , benchIOSrc fromAsync "10M" $ minRate value 10000000
72− , benchIOSrc fromAsync "20M" $ minRate value 20000000
73− ]
74− , bgroup
75− "maxRate"
76− [ -- benchIOSrc fromAsync "10K" $ maxRate value 10000
77− benchIOSrc fromAsync "10M" $ maxRate value 10000000
78− ]
79− , bgroup
80− "constRate"
81− [ -- benchIOSrc fromAsync "10K" $ constRate value 10000
82− benchIOSrc fromAsync "1M" $ constRate value 1000000
83− , benchIOSrc fromAsync "10M" $ constRate value 10000000
84− ]
85− ]
25+o_1_space_async_avgRate :: Int -> [Benchmark]
26+o_1_space_async_avgRate value =
27+ [ bgroup "asyncly"
28+ [ bgroup "avgRate"
29+ -- benchIO "unfoldr" $ toNull asyncly
30+ -- benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
31+ [ benchIOSrc asyncly "unfoldrM/Nothing"
32+ (S.rate Nothing . sourceUnfoldrM value)
33+ , benchIOSrc asyncly "unfoldrM/1,000,000"
34+ (S.avgRate 1000000 . sourceUnfoldrM value)
35+ , benchIOSrc asyncly "unfoldrM/3,000,000"
36+ (S.avgRate 3000000 . sourceUnfoldrM value)
37+ , benchIOSrc asyncly "unfoldrM/10,000,000/maxThreads1"
38+ (maxThreads 1 . S.avgRate 10000000 . sourceUnfoldrM value)
39+ , benchIOSrc asyncly "unfoldrM/10,000,000"
40+ (S.avgRate 10000000 . sourceUnfoldrM value)
41+ , benchIOSrc asyncly "unfoldrM/20,000,000"
42+ (S.avgRate 20000000 . sourceUnfoldrM value)
43+ ]
44+ ]
8645 ]
8746
88−o_1_space_ahead :: Int -> [Benchmark]
89−o_1_space_ahead value =
90− [ bgroup
91− "aheadly"
92− [ benchIOSrc fromAhead "avgRate/1M" $ avgRate value 1000000
93− , benchIOSrc fromAhead "minRate/1M" $ minRate value 1000000
94− , benchIOSrc fromAhead "maxRate/1M" $ maxRate value 1000000
95− , benchIOSrc fromAsync "constRate/1M" $ constRate value 1000000
47+o_1_space_ahead_avgRate :: Int -> [Benchmark]
48+o_1_space_ahead_avgRate value =
49+ [ bgroup "aheadly"
50+ [ bgroup "avgRate"
51+ [ benchIOSrc aheadly "unfoldrM/1,000,000"
52+ (S.avgRate 1000000 . sourceUnfoldrM value)
53+ ]
9654 ]
9755 ]
9856
@@ -101,10 +59,15 @@ o_1_space_ahead value =
10159-------------------------------------------------------------------------------
10260
10361main :: IO ()
104−main = runWithCLIOpts defaultStreamSize allBenchmarks
62+main = do
63+ (value, cfg, benches) <- parseCLIOpts defaultStreamSize
64+ value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
10565
10666 where
10767
10868 allBenchmarks value =
109− [ bgroup (o_1_space_prefix moduleName)
110− $ concat [o_1_space_async value, o_1_space_ahead value]]
69+ [ bgroup (o_1_space_prefix moduleName) $ concat
70+ [ o_1_space_async_avgRate value
71+ , o_1_space_ahead_avgRate value
72+ ]
73+ ]
benchmark/Streamly/Benchmark/Prelude/Serial.hsnew file+1829

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/WAsync.hs+29−71

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/WSerial.hs+69−219

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+19−34

This diff is too big to show here.

benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+28−72

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.hs+17−65

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.hs+56−138

This diff is too big to show here.

benchmark/streamly-benchmarks.cabal+164−485

This diff is too big to show here.

bin/bench-exec-one.shnew file+163

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+11

This diff is too big to show here.

cabal.project.coverage+13−8

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+1309−1283

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/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/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.

docs/User/Project/CONTRIBUTORS.md → credits/CONTRIBUTORS.mdrenamed+2−58

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/paths.rst → design/paths.rstrenamed+2−25

This diff is too big to show here.

docs/Developer/unicode.md → design/unicode.mdrenamed

The content is the same.

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

This diff is too big to show here.

docs/User/HowTo/optimizing.md → docs/Build.mdrenamed+91−10

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/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/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/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/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+22

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/Rate.hsnew file+11

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+38

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+629

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+644

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+276

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+43

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+62

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FD.hs → src/Streamly/FileSystem/FD.hsrenamed+70−89

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FDIO.hs → src/Streamly/FileSystem/FDIO.hsrenamed+15−6

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/System/IOVec/Type.hsc → src/Streamly/FileSystem/IOVec.hscrenamed+8−7

This diff is too big to show here.

core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hsrenamed+5−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+1−1

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hsnew file+400

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Pinned.hsnew file+108

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Types.hsnew file+176

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/TypesInclude.hsnew file+694

This diff is too big to show here.

src/Streamly/Internal/Data/Array/PrimInclude.hsnew file+185

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+1648

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+590

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+193

This diff is too big to show here.

src/Streamly/Internal/Data/Parser.hsnew file+1105

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserD.hsnew file+731

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Tee.hs → src/Streamly/Internal/Data/Parser/ParserD/Tee.hsrenamed+22−89

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserD/Types.hsnew file+637

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserK/Types.hsnew file+213

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Pipe/Type.hs → src/Streamly/Internal/Data/Pipe/Types.hsrenamed+6−3

This diff is too big to show here.

src/Streamly/Internal/Data/SVar.hs+2040−119

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+34−48

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray/Type.hs → src/Streamly/Internal/Data/SmallArray/Types.hsrenamed+76−9

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Ahead.hs+122−172

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Async.hs+232−307

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs → src/Streamly/Internal/Data/Stream/Combinators.hsrenamed+15−33

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+51−97

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Instances.hs+27−22

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+289−260

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar.hs+233−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+251−218

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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+178−94

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+7−5

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/TimeSpec.hsc → src/Streamly/Internal/Data/Time/TimeSpec.hscrenamed+10−6

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hsrenamed+4−12

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/Streamly/Internal/Data/Time/Clock/config-clock.h → src/Streamly/Internal/Data/Time/config-clock.hrenamed+1−1

This diff is too big to show here.

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+1098

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+27

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Zipper.hsnew file+343

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hsrenamed+99−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+173−281

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hsrenamed+290−331

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Memory/Mutable/Array/Types.hsnew file+1440

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Network/Inet/TCP.hs+153−194

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+288−229

This diff is too big to show here.

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

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/Array/Prim/Pinned.hsnew file+84

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+8−54

This diff is too big to show here.

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

This diff is too big to show here.

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

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+56−94

This diff is too big to show here.

src/Streamly/Prelude.hs+205−646

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−11

This diff is too big to show here.

streamly.cabal+831−386

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+1167

This diff is too big to show here.

test/Streamly/Test/Prelude/Rate.hs → test/MaxRate.hsrenamed+38−60

This diff is too big to show here.

test/Prop.hsnew file+1406

This diff is too big to show here.

test/Streamly/Test/Data/List.hs → test/PureStreams.hsrenamed+26−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+210

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+215

This diff is too big to show here.

test/Streamly/Test/Internal/Data/Parser.hsnew file+502

This diff is too big to show here.

test/Streamly/Test/Internal/Data/Parser/ParserD.hsnew file+540

This diff is too big to show here.

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

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+132

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/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.