on 9c04f40 help sign in
499 files changed+37863−80224
since splitsnapshots
unifiedsplit
.circleci/config.yml+277−76 .github/workflows/haskell.yml+106−165 .github/workflows/packdiff.yml−39 .github/workflows/regression-check.yml−165 .gitignore−4 .hlint.ignore+23−12 .hlint.yaml+8−13 .packcheck.ignore+1−14 CHANGELOG.md−1 CONTRIBUTING.md+272−1 docs/User/Project/Changelog.md → Changelog.md+5−134 LICENSE+254 README.md+651−1 appveyor.yml+2−4 benchmark/NanoBenchmarks.hs+22−27 benchmark/README.md+313−1 benchmark/Streamly/Benchmark/Data/Array.hs+134−69 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 → benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hs+45−81 benchmark/Streamly/Benchmark/Data/ArrayOps.hs+246 benchmark/Streamly/Benchmark/Data/Fold.hs+138−297 benchmark/Streamly/Benchmark/Data/Fold/Window.hs−191 benchmark/Streamly/Benchmark/Data/MutArray.hs−300 benchmark/Streamly/Benchmark/Data/Parser.hs+193−642 benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs+412 benchmark/Streamly/Benchmark/Data/Parser/ParserK.hs+163 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/Generate.hs−278 benchmark/Streamly/Benchmark/Data/Stream/Lift.hs−146 benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs−588 benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs+5−46 benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs+4−6 benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+33−61 benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs−938 benchmark/Streamly/Benchmark/Data/Unfold.hs+60−89 benchmark/Streamly/Benchmark/FileSystem/Handle.hs+5−1 benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+62−66 benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+48−45 benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+6−11 benchmark/Streamly/Benchmark/Prelude/Ahead.hs+1−3 benchmark/Streamly/Benchmark/Prelude/Async.hs+3−5 benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+1−2 benchmark/Streamly/Benchmark/Prelude/Merge.hs+2−4 benchmark/Streamly/Benchmark/Prelude/Parallel.hs+1−3 benchmark/Streamly/Benchmark/Prelude/Rate.hs+1−2 benchmark/Streamly/Benchmark/Prelude/Serial.hs+53 benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hs+121−183 benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs+70−124 benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hs+179 benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hs+123 benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hs+463 benchmark/Streamly/Benchmark/Data/Stream/Expand.hs → benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hs+134−254 benchmark/Streamly/Benchmark/Data/Stream/Split.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs+12−25 benchmark/Streamly/Benchmark/Data/Stream/Transform.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hs+164−284 benchmark/Streamly/Benchmark/Prelude/WAsync.hs+1−3 benchmark/Streamly/Benchmark/Prelude/WSerial.hs+2−4 benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+2−11 benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+2−4 benchmark/Streamly/Benchmark/Unicode/Char.hs+10−18 benchmark/Streamly/Benchmark/Unicode/Parser.hs−107 benchmark/Streamly/Benchmark/Unicode/Stream.hs+30−77 benchmark/Streamly/Benchmark/Unicode/Utf8.hs+3−3 benchmark/bench-report/BenchReport.hs+273 benchmark/bench-report/bench-report.cabal+23 benchmark/bench-report/bin/bench-runner.sh+673 benchmark/bench-report/bin/build-lib.sh+213 targets/cabal.project → benchmark/bench-report/cabal.project benchmark/bench-report/default.nix+50 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+12−11 benchmark/lib/Streamly/Benchmark/Common/Handle.hs+4−15 benchmark/lib/Streamly/Benchmark/Prelude.hs+5−57 benchmark/streamly-benchmarks.cabal+180−408 bin/bench-config.sh+160 bin/bench.sh+15 bin/mk-hscope.sh+1−1 bin/repl−3 bin/run-ci.sh+29−29 bin/run-repl-quick.sh−113 bin/targets.sh+120 bin/test.sh+247 cabal.project−1 cabal.project.O0+3−8 cabal.project.Werror−4 cabal.project.Werror-nocode−8 cabal.project.coverage−4 cabal.project.doctest+3−14 cabal.project.ghc-head+41−21 cabal.project.packdiff−9 cabal.project.report−30 cabal.project.streamly−10 configure+237−9 configure.ac+5−1 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/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/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/Stream.hs−383 core/src/Streamly/Internal/Data/Builder.hs−82 core/src/Streamly/Internal/Data/Fold.hs−33 core/src/Streamly/Internal/Data/Fold/Combinators.hs−2452 core/src/Streamly/Internal/Data/Fold/Container.hs−783 core/src/Streamly/Internal/Data/Fold/Type.hs−2099 core/src/Streamly/Internal/Data/Fold/Window.hs−357 core/src/Streamly/Internal/Data/IsMap.hs−60 core/src/Streamly/Internal/Data/List.hs−234 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/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/Ring/Generic.hs−185 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/Generate.hs−1191 core/src/Streamly/Internal/Data/Stream/Lift.hs−129 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/Unbox.hs−908 core/src/Streamly/Internal/Data/Unbox/TH.hs−498 core/src/Streamly/Internal/FileSystem/Path.hs−515 core/src/Streamly/Internal/Unicode/Array.hs−104 core/src/Streamly/Internal/Unicode/Parser.hs−627 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/config.h.in−57 core/src/inline.hs−27 core/streamly-core.cabal−534 default.nix+18−32 docs/Developer/MAINTAINING.md → dev/MAINTAINING.md+26−130 docs/Developer/ci-tests.md → dev/ci-tests.md+6−16 docs/Developer/container-api.md → dev/container-api.md docs/Developer/cps-vs-direct.rst → dev/cps-vs-direct.rst docs/Developer/dfa-bytes.png → dev/dfa-bytes.png docs/Developer/dfa-classes.png → dev/dfa-classes.png docs/Developer/dfa-rearr.png → dev/dfa-rearr.png docs/Developer/linked-lists.md → dev/linked-lists.md docs/Developer/module-organization.md → dev/module-organization.md+4−4 docs/Developer/optimization-guidelines.md → dev/optimization-guidelines.md+1−13 docs/Developer/overview.md → dev/overview.md docs/Developer/paths.rst → dev/paths.rst+2−25 docs/Developer/related-packages.md → dev/related-packages.md docs/Developer/resources.md → dev/resources.md docs/Developer/roadmap.md → dev/roadmap.md docs/Developer/unicode.md → dev/unicode.md docs/Developer/utf8-decoder.md → dev/utf8-decoder.md+3−3 docs/User/Project/ApiChangelogs/0.8.3.txt → docs/API-changelog.txt+4−4 docs/User/Project/CONTRIBUTORS.md → docs/CONTRIBUTORS.md−24 docs/User/Tutorials/ConcurrentStreams.hs → docs/ConcurrentStreams.hs+33−23 docs/User/Project/Credits.md → docs/Credits.md docs/Developer/Benchmarks.md−342 docs/Developer/Contributing.md−271 docs/Developer/Github.link−1 docs/Developer/Tests.md−139 docs/Documentation.md−5 docs/User/Explanatory/Overview.md → docs/Overview.md+2−2 docs/User/Tutorials/ReactiveProgramming.hs → docs/ReactiveProgramming.hs+3−5 docs/User/Project/Roadmap.link → docs/Roadmap.link docs/User/Tutorials/Tutorial.hs → docs/Tutorial.hs+69−48 docs/User/Explanatory/design.md−42 docs/User/HowTo/Examples.link−1 docs/User/HowTo/faq.md−94 docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt−175 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/Upgrading-0.8-to-0.9.md−384 docs/User/Tutorials/Examples.link−1 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/HowTo/Compiling.md → docs/building.md+45−54 docs/faq.md+70 docs/getting-started.md+296 docs/User/HowTo/interoperation.md → docs/interoperation.md docs/User/Explanatory/monad-transformers.md → docs/monad-transformers.md docs/User/HowTo/optimizing.md → docs/optimizing.md docs/User/Explanatory/performance.md → docs/performance.md docs/User/resources.md → docs/resources.md docs/User/Explanatory/streaming-pradigms.rst → docs/streaming-pradigms.rst docs/streamly-docs.cabal+7−23 docs/User/HowTo/streamly-vs-async.md → docs/streamly-vs-async.md+1−3 docs/User/HowTo/streamly-vs-list-time.svg → docs/streamly-vs-list-time.svg docs/User/HowTo/streamly-vs-lists.md → docs/streamly-vs-lists.md+2−4 docs/User/Explanatory/unified-abstractions.md → docs/unified-abstractions.md+8−11 hie.yaml+38−81 core/jsbits/clock.js → jsbits/clock.js src/Streamly.hs+690 core/src/Streamly/Console/Stdio.hs → src/Streamly/Console/Stdio.hs+4−3 src/Streamly/Data/Array.hs+43 src/Streamly/Data/Array/Foreign.hs+3−44 src/Streamly/Data/Fold.hs+289 src/Streamly/Data/Fold/Prelude.hs−65 src/Streamly/Data/Fold/Tee.hs+28−3 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+152 src/Streamly/Data/Unicode/Stream.hs+99 core/src/Streamly/FileSystem/Handle.hs → src/Streamly/FileSystem/Handle.hs+13−34 core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hs+31−2 core/src/Streamly/Internal/Console/Stdio.hs → src/Streamly/Internal/Console/Stdio.hs+45−44 src/Streamly/Internal/Control/Concurrent.hs+67−44 core/src/Streamly/Internal/Control/Exception.hs → src/Streamly/Internal/Control/Exception.hs+13−1 src/Streamly/Internal/Control/ForkLifted.hs−66 core/src/Streamly/Internal/Control/Monad.hs → src/Streamly/Internal/Control/Monad.hs src/Streamly/Internal/Data/Array.hs+315 src/Streamly/Internal/Data/Array/Foreign.hs+596 src/Streamly/Internal/Data/Array/Foreign/Mut.hs+86 src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hs+2160 src/Streamly/Internal/Data/Array/Foreign/Type.hs+808 src/Streamly/Internal/Data/Array/Prim.hs+110 src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs+94 src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs+413 src/Streamly/Internal/Data/Array/Prim/Pinned.hs+108 src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs+176 src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs+127 src/Streamly/Internal/Data/Array/Prim/Type.hs+98 src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs+703 src/Streamly/Internal/Data/Array/PrimInclude.hs+184 core/src/Streamly/Internal/Data/Fold/Chunked.hs → src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hs+90−133 src/Streamly/Internal/Data/Array/Stream/Foreign.hs+859 src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hs+238 core/src/Streamly/Internal/Data/Binary/Parser.hs → src/Streamly/Internal/Data/Binary/Decode.hs+43−164 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 core/src/Streamly/Internal/Data/Either/Strict.hs → src/Streamly/Internal/Data/Either/Strict.hs−2 src/Streamly/Internal/Data/Fold.hs+1743 src/Streamly/Internal/Data/Fold/Async.hs+10−23 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+7−8 core/src/Streamly/Internal/Data/Fold/Step.hs → src/Streamly/Internal/Data/Fold/Step.hs+2−2 core/src/Streamly/Internal/Data/Fold/Tee.hs → src/Streamly/Internal/Data/Fold/Tee.hs+6−33 src/Streamly/Internal/Data/Fold/Type.hs+1416 core/src/Streamly/Internal/Data/IOFinalizer.hs → src/Streamly/Internal/Data/IOFinalizer.hs+22−20 src/Streamly/Internal/Data/IOFinalizer/Lifted.hs−74 core/src/Streamly/Internal/Data/IORef/Unboxed.hs → src/Streamly/Internal/Data/IORef/Prim.hs+35−36 src/Streamly/Internal/Data/IsMap/HashMap.hs−42 src/Streamly/Internal/Data/List.hs+193 core/src/Streamly/Internal/Data/Maybe/Strict.hs → src/Streamly/Internal/Data/Maybe/Strict.hs+3−12 src/Streamly/Internal/Data/Parser.hs+1180 src/Streamly/Internal/Data/Parser/ParserD.hs+1251 core/src/Streamly/Internal/Data/Parser/Tee.hs → src/Streamly/Internal/Data/Parser/ParserD/Tee.hs+6−10 core/src/Streamly/Internal/Data/Parser/Type.hs → src/Streamly/Internal/Data/Parser/ParserD/Type.hs+320−622 src/Streamly/Internal/Data/Parser/ParserK/Type.hs+494 src/Streamly/Internal/Data/Pipe.hs+1968 core/src/Streamly/Internal/Data/Pipe/Type.hs → src/Streamly/Internal/Data/Pipe/Type.hs+3 core/src/Streamly/Internal/Data/Producer.hs → src/Streamly/Internal/Data/Producer.hs+13−6 core/src/Streamly/Internal/Data/Producer/Source.hs → src/Streamly/Internal/Data/Producer/Source.hs+36−101 core/src/Streamly/Internal/Data/Producer/Type.hs → src/Streamly/Internal/Data/Producer/Type.hs+1−1 core/src/Streamly/Internal/Data/Refold/Type.hs → src/Streamly/Internal/Data/Refold/Type.hs+8−5 src/Streamly/Internal/Data/Ring.hs+44 core/src/Streamly/Internal/Data/Ring.hs → src/Streamly/Internal/Data/Ring/Foreign.hs+53−164 src/Streamly/Internal/Data/SVar.hs+4−4 src/Streamly/Internal/Data/SVar/Dispatch.hs+6−3 core/src/Streamly/Internal/Data/SVar/Type.hs → src/Streamly/Internal/Data/SVar/Type.hs+1−10 src/Streamly/Internal/Data/Sink.hs+245 src/Streamly/Internal/Data/Sink/Type.hs+24 src/Streamly/Internal/Data/SmallArray.hs+25−26 src/Streamly/Internal/Data/SmallArray/Type.hs+75−8 src/Streamly/Internal/Data/Stream/Ahead.hs+23−47 src/Streamly/Internal/Data/Stream/Async.hs+29−62 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/Instances.hs+16−9 src/Streamly/Internal/Data/Stream/IsStream.hs+5−25 src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs+2−4 src/Streamly/Internal/Data/Stream/IsStream/Common.hs+55−96 src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+82−71 src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs+2−15 src/Streamly/Internal/Data/Stream/IsStream/Exception.hs+19−31 src/Streamly/Internal/Data/Stream/IsStream/Expand.hs+101−87 src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+72−32 src/Streamly/Internal/Data/Stream/IsStream/Lift.hs+10−8 src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+310−346 src/Streamly/Internal/Data/Stream/IsStream/Top.hs+108−240 src/Streamly/Internal/Data/Stream/IsStream/Transform.hs+187−111 src/Streamly/Internal/Data/Stream/IsStream/Type.hs+86−171 src/Streamly/Internal/Data/Stream/Lifted.hs−335 src/Streamly/Internal/Data/Stream/MkType.hs−641 src/Streamly/Internal/Data/Stream/Parallel.hs+32−60 src/Streamly/Internal/Data/Stream/Prelude.hs+45−7 src/Streamly/Internal/Data/Stream/PreludeCommon.hs+139 src/Streamly/Internal/Data/Stream/SVar.hs−18 src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs+8−14 src/Streamly/Internal/Data/Stream/SVar/Generate.hs+12−15 src/Streamly/Internal/Data/Stream/Serial.hs+105−83 src/Streamly/Internal/Data/Stream/StreamD.hs+36 src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+511 core/src/Streamly/Internal/Data/Stream/Exception.hs → src/Streamly/Internal/Data/Stream/StreamD/Exception.hs+141−228 src/Streamly/Internal/Data/Stream/StreamD/Generate.hs+406 src/Streamly/Internal/Data/Stream/StreamD/Lift.hs+112 core/src/Streamly/Internal/Data/Stream/Nesting.hs → src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+321−922 core/src/Streamly/Internal/Data/Stream/Step.hs → src/Streamly/Internal/Data/Stream/StreamD/Step.hs+2−2 src/Streamly/Internal/Data/Stream/StreamD/Transform.hs+1238 src/Streamly/Internal/Data/Stream/StreamD/Type.hs+1006 src/Streamly/Internal/Data/Stream/StreamDK.hs+156 core/src/Streamly/Internal/Data/StreamK/Alt.hs → src/Streamly/Internal/Data/Stream/StreamDK/Type.hs+3−143 src/Streamly/Internal/Data/Stream/StreamK.hs+967 src/Streamly/Internal/Data/Stream/StreamK/Type.hs+1320 src/Streamly/Internal/Data/Stream/Time.hs−950 src/Streamly/Internal/Data/Stream/Zip.hs+91−39 src/Streamly/Internal/Data/Stream/ZipAsync.hs−134 src/Streamly/Internal/Data/Time.hs+74 src/Streamly/Internal/Data/Time/Clock.hs+80 core/src/Streamly/Internal/Data/Time/Clock/Darwin.c → src/Streamly/Internal/Data/Time/Clock/Darwin.c core/src/Streamly/Internal/Data/Time/Clock/Type.hsc → src/Streamly/Internal/Data/Time/Clock/Type.hsc+1−1 core/src/Streamly/Internal/Data/Time/Clock/Windows.c → src/Streamly/Internal/Data/Time/Clock/Windows.c core/src/Streamly/Internal/Data/Time/Clock/config-clock.h → src/Streamly/Internal/Data/Time/Clock/config-clock.h core/src/Streamly/Internal/Data/Time/TimeSpec.hsc → src/Streamly/Internal/Data/Time/TimeSpec.hsc+3 core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hs+7−8 core/src/Streamly/Internal/Data/Tuple/Strict.hs → src/Streamly/Internal/Data/Tuple/Strict.hs−11 core/src/Streamly/Internal/Data/Unfold.hs → src/Streamly/Internal/Data/Unfold.hs+329−252 core/src/Streamly/Internal/Data/Unfold/Enumeration.hs → src/Streamly/Internal/Data/Unfold/Enumeration.hs+34−4 src/Streamly/Internal/Data/Unfold/Exception.hs−214 src/Streamly/Internal/Data/Unfold/Prelude.hs−17 src/Streamly/Internal/Data/Unfold/SVar.hs+6−3 core/src/Streamly/Internal/Data/Unfold/Type.hs → src/Streamly/Internal/Data/Unfold/Type.hs+80−302 core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hs+84−191 src/Streamly/Internal/FileSystem/Event.hs+4−7 src/Streamly/Internal/FileSystem/Event/Darwin.hs+77−70 src/Streamly/Internal/FileSystem/Event/Linux.hs+135−108 src/Streamly/Internal/FileSystem/Event/Windows.hs+61−64 src/Streamly/Internal/FileSystem/FD.hs+64−71 src/Streamly/Internal/FileSystem/FDIO.hs+7 core/src/Streamly/Internal/FileSystem/File.hs → src/Streamly/Internal/FileSystem/File.hs+148−216 core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hs+242−209 src/Streamly/Internal/Foreign/Malloc.hs+49 src/Streamly/Internal/Network/Inet/TCP.hs+128−166 src/Streamly/Internal/Network/Socket.hs+249−184 core/src/Streamly/Internal/System/IO.hs → src/Streamly/Internal/System/IO.hs+2−4 src/Streamly/Internal/System/IOVec.hs+8−14 src/Streamly/Internal/Unicode/Array/Char.hs+92 src/Streamly/Internal/Unicode/Array/Prim/Pinned.hs+91 src/Streamly/Internal/Unicode/Char.hs+12−21 src/Streamly/Internal/Unicode/Char/Parser.hs+187 core/src/Streamly/Internal/Unicode/Stream.hs → src/Streamly/Internal/Unicode/Stream.hs+284−384 src/Streamly/Internal/Unicode/Utf8.hs+9−15 src/Streamly/Memory/Array.hs+74 src/Streamly/Network/Inet/TCP.hs+6−45 src/Streamly/Network/Socket.hs+51−84 src/Streamly/Prelude.hs+8−14 core/src/Streamly/Unicode/Stream.hs → src/Streamly/Unicode/Stream.hs+17−20 src/assert.hs−6 src/config.h.in+38 src/inline.hs+2−2 stack.yaml+2−3 streamly.cabal+292−286 targets/Targets.hs−213 targets/default.nix−163 targets/streamly-targets.cabal−12 test/README.md+158−1 test/Streamly/Test/Data/Array.hs+6−232 test/Streamly/Test/Data/Array/Common.hs+25−17 test/Streamly/Test/Data/Array/CommonImports.hs+4−4 test/Streamly/Test/Data/Array/Foreign.hs+120 test/Streamly/Test/Data/Array/Generic.hs → test/Streamly/Test/Data/Array/Prim.hs+12−22 test/Streamly/Test/Data/Array/Prim/Pinned.hs+55 test/Streamly/Test/Data/Array/Stream.hs−113 test/Streamly/Test/Data/Array/Stream/Foreign.hs+72 test/Streamly/Test/Data/Fold.hs+161−205 test/Streamly/Test/Data/Fold/Window.hs−67 test/Streamly/Test/Data/List.hs+27−20 test/Streamly/Test/Data/MutArray.hs−152 test/Streamly/Test/Data/Parser.hs+194−764 test/Streamly/Test/Data/ParserK.hs → test/Streamly/Test/Data/Parser/ParserD.hs+92−156 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+1−3 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+35−38 test/Streamly/Test/FileSystem/Event/Common.hs+6−10 test/Streamly/Test/FileSystem/Event/Darwin.hs+1−1 test/Streamly/Test/FileSystem/Event/Linux.hs+4−17 test/Streamly/Test/FileSystem/Event/Windows.hs+2−2 test/Streamly/Test/FileSystem/Handle.hs+35−31 test/Streamly/Test/Network/Inet/TCP.hs+18−25 test/Streamly/Test/Network/Socket.hs+27−36 test/Streamly/Test/Prelude.hs+3−2 test/Streamly/Test/Prelude/Ahead.hs+4−3 test/Streamly/Test/Prelude/Async.hs+4−24 test/Streamly/Test/Prelude/Concurrent.hs+4−3 test/Streamly/Test/Prelude/Fold.hs+1−3 test/Streamly/Test/Prelude/Parallel.hs+4−3 test/Streamly/Test/Prelude/Rate.hs+1−3 test/Streamly/Test/Prelude/Serial.hs+120−159 test/Streamly/Test/Prelude/Top.hs−224 test/Streamly/Test/Prelude/WAsync.hs+4−54 test/Streamly/Test/Prelude/WSerial.hs+4−3 test/Streamly/Test/Prelude/ZipAsync.hs+1−3 test/Streamly/Test/Prelude/ZipSerial.hs+4−3 test/Streamly/Test/Serialize/Serializable.hs−237 test/Streamly/Test/Unicode/Char.hs+16−13 test/Streamly/Test/Unicode/Parser.hs−231 test/Streamly/Test/Unicode/Stream.hs+30−34 test/lib/Streamly/Test/Common.hs+3−4 test/lib/Streamly/Test/Prelude/Common.hs+48−29 test/streamly-tests.cabal+40−201 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+277−76
@@ -1,7 +1,7 @@
11version: 2.1
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
@@ -24,6 +22,7 @@ env: &env
2422 # DISABLE_DOCS: "y"
2523 # DISABLE_SDIST_BUILD: "y"
2624 # DISABLE_DIST_CHECKS: "y"
25+ ENABLE_INSTALL: "y"
2726
2827 # ------------------------------------------------------------------------
2928 # stack options
@@ -39,12 +38,15 @@ env: &env
3938 # cabal options
4039 # ------------------------------------------------------------------------
4140 CABAL_CHECK_RELAX: "y"
41+ CABAL_NO_SANDBOX: "y"
42+ CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
4243 CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
4344
4445 # ------------------------------------------------------------------------
4546 # Where to find the required tools
4647 # ------------------------------------------------------------------------
47− PATH: /sbin:/usr/sbin:/bin:/usr/bin
48+ PATH: /opt/ghc/bin:/opt/ghcjs/bin:/sbin:/usr/sbin:/bin:/usr/bin
49+ TOOLS_DIR: /opt
4850
4951 # ------------------------------------------------------------------------
5052 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
@@ -57,15 +59,15 @@ env: &env
5759 # If you have not committed packcheck.sh in your repo at PACKCHECK
5860 # then it is automatically pulled from this URL.
5961 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
60− PACKCHECK_GITHUB_COMMIT: "f6cfd7b7a33b4bf6fd63cce6a3fb3d26f5031403"
62+ PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
6163
6264executors:
6365 amd64-executor:
6466 docker:
65− - image: ubuntu:latest
67+ - image: ubuntu:xenial
6668 x86-executor:
6769 docker:
68− - image: i386/ubuntu:focal
70+ - image: i386/ubuntu:eoan
6971
7072#-----------------------------------------------------------------------------
7173# Common utility stuff, not to be modified usually
@@ -77,50 +79,38 @@ preinstall: &preinstall
7779 # required for https/cache save and restore
7880 apt-get install -y ca-certificates
7981
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.
83− # 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
88−
89− # required for outbound https for stack and for stack setup
90− apt-get install -y netbase xz-utils make
91− apt-get install -y zlib1g-dev
82+ # required to (re)generate the configure script
83+ apt-get install -y autoconf
9284
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
85+ # For ghc and cabal-install packages from hvr's ppa
86+ # gnupg is required for apt-key to work
87+ apt-get install -y gnupg
88+ apt-get install -y apt-transport-https
89+ apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
90+ apt-get install -y software-properties-common
91+ add-apt-repository -y ppa:hvr/ghc
92+ # echo "deb http://downloads.haskell.org/debian stretch main" >> /etc/apt/sources.list
93+ echo "deb-src http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main" >> /etc/apt/sources.list
94+ apt-get update
9995
100− # libgmp required by ghc for linking
101− apt-get install -y libgmp-dev
102− apt-get install -y libtinfo-dev
96+ # required for packcheck
97+ apt-get install -y curl
10398
104− # Required by cabal when git URL is specified in project file
99+ # required for circleci.
100+ apt-get install -y libcurl4-gnutls-dev
105101 apt-get install -y git
102+ apt-get install -y libtinfo-dev
106103
107− # Required for and by packcheck
108− apt-get install -y curl
104+ # required for outbound https for stack and for stack setup
105+ apt-get install -y netbase xz-utils make
109106
107+project-preinstall: &project-preinstall
108+ run: |
110109 # 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
110+ CURL=$(which curl)
111+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
112+ if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi;
113+ chmod +x $PACKCHECK
124114
125115restore: &restore
126116 # Needs to happen after installing ca-certificates
@@ -136,72 +126,269 @@ save: &save
136126 save_cache:
137127 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
138128 paths:
139− - ~/.local
140129 - ~/.cabal
130+ - ~/.ghc
131+ - ~/.local
141132 - ~/.stack
142− - ~/.ghcup
143133
144134#-----------------------------------------------------------------------------
145135# Build matrix
146136#-----------------------------------------------------------------------------
147137
148138jobs:
139+ cabal-ghc-8_10_4:
140+ <<: *env
141+ executor: amd64-executor
142+ steps:
143+ - *preinstall
144+ - checkout
145+ - *project-preinstall
146+ - *restore
147+ - run:
148+ environment:
149+ DISABLE_TEST: "yes"
150+ DISABLE_BENCH: "yes"
151+ DISABLE_DIST_CHECKS: "yes"
152+ command: |
153+ apt-get install -y ghc-8.10.4
154+ apt-get install -y cabal-install-3.4
155+ bash -c "$PACKCHECK cabal"
156+ - *save
157+ stack-ghc-8_8:
158+ <<: *env
159+ executor: amd64-executor
160+ steps:
161+ - *preinstall
162+ - checkout
163+ - *project-preinstall
164+ - *restore
165+ - run:
166+ name: GHC 8.8 + stack lts-16.12
167+ environment:
168+ BUILD: "stack"
169+ RESOLVER: "lts-16.12"
170+ SDIST_OPTIONS: "--ignore-check"
171+ STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
172+ command: |
173+ apt-get build-dep -y ghc-8.8.4
174+ apt-get install -y cabal-install-3.2
175+ bash -c "$PACKCHECK $BUILD"
176+ - *save
149177 cabal-ghc-8_6_5:
150178 <<: *env
151179 executor: amd64-executor
152180 steps:
181+ - *preinstall
153182 - checkout
183+ - *project-preinstall
154184 - *restore
185+ - run: |
186+ apt-get install -y ghc-8.6.3
187+ apt-get install -y cabal-install-2.4
188+ bash -c "$PACKCHECK cabal-v2"
189+ - *save
190+ cabal-ghc-8_4_4:
191+ <<: *env
192+ executor: x86-executor
193+ steps:
155194 - *preinstall
195+ - checkout
196+ - *project-preinstall
197+ - *restore
198+ - run:
199+ name: GHC 8.4.4 + x86 + debug
200+ environment:
201+ BUILD: "cabal-v2"
202+ GHCVER: "8.4.4"
203+ CABAL_BUILD_OPTIONS: "--flag debug --flag limit-build-mem"
204+ command: |
205+ apt-get install -y ghc-8.4.4
206+ apt-get install -y cabal-install-3.2
207+ bash -c "$PACKCHECK $BUILD"
208+ - *save
209+ cabal-ghc-8_2_2:
210+ <<: *env
211+ executor: amd64-executor
212+ steps:
213+ - *preinstall
214+ - checkout
215+ - *project-preinstall
216+ - *restore
156217 - run:
157218 environment:
158− GHCVER: "8.6.5"
159− CABAL_VERSION: "3.6.2.0"
160− CABAL_PROJECT: "cabal.project"
219+ BUILD: "cabal-v2"
220+ DISABLE_TEST: "yes"
221+ DISABLE_BENCH: "yes"
222+ DISABLE_DOCS: "yes"
161223 DISABLE_SDIST_BUILD: "yes"
162− CABAL_BUILD_OPTIONS: "--flag debug --flag -opt"
224+ DISABLE_DIST_CHECKS: "yes"
163225 command: |
164− bash -c "$PACKCHECK cabal"
226+ apt-get install -y ghc-8.2.2
227+ apt-get install -y cabal-install-3.2
228+ bash -c "$PACKCHECK $BUILD"
165229 - *save
166− cabal-ghc-9_8_1-docspec:
230+ cabal-ghc-8_0_2:
167231 <<: *env
168232 executor: amd64-executor
169233 steps:
234+ - *preinstall
170235 - checkout
236+ - *project-preinstall
171237 - *restore
172− - *preinstall
173238 - run:
174239 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"
240+ BUILD: "cabal-v2"
241+ DISABLE_TEST: "yes"
242+ DISABLE_BENCH: "yes"
243+ DISABLE_DOCS: "yes"
244+ DISABLE_SDIST_BUILD: "yes"
245+ DISABLE_DIST_CHECKS: "yes"
185246 command: |
186− bash -c "$PACKCHECK cabal"
247+ apt-get install -y ghc-8.0.2
248+ apt-get install -y cabal-install-3.2
249+ bash -c "$PACKCHECK $BUILD"
187250 - *save
188− hlint-trailing-spaces:
251+ cabal-ghc-7_10_3:
189252 <<: *env
190253 executor: amd64-executor
191254 steps:
255+ - *preinstall
192256 - checkout
257+ - *project-preinstall
193258 - *restore
259+ - run: |
260+ apt-get install -y ghc-7.10.3
261+ apt-get install -y cabal-install-2.4
262+ bash -c "$PACKCHECK cabal-v2"
263+ - *save
264+ stack-ghc-8_4:
265+ <<: *env
266+ executor: amd64-executor
267+ steps:
194268 - *preinstall
269+ - checkout
270+ - *project-preinstall
271+ - *restore
272+ - run: |
273+ bash -c "$PACKCHECK stack RESOLVER=lts-12"
274+ - *save
275+ stack-ghc-8_2:
276+ <<: *env
277+ executor: amd64-executor
278+ steps:
279+ - *preinstall
280+ - checkout
281+ - *project-preinstall
282+ - *restore
283+ - run: |
284+ bash -c "$PACKCHECK stack RESOLVER=lts-11"
285+ - *save
286+ cabal-ghcjs-8_4:
287+ <<: *env
288+ executor: amd64-executor
289+ steps:
290+ - *preinstall
291+ - checkout
292+ - *project-preinstall
293+ - *restore
195294 - run:
196− name: hlint and trailing spaces
295+ name: GHCJS 8.4+no-test+no-docs
197296 environment:
297+ BUILD: cabal-v2
298+ ENABLE_GHCJS: "yes"
299+ DISABLE_TEST: "yes"
300+ ENABLE_INSTALL: ""
301+ DISABLE_DOCS: "yes"
198302 DISABLE_SDIST_BUILD: "yes"
199− HLINT_VERSION: 3.6.1
303+ command: |
304+ add-apt-repository -y ppa:hvr/ghcjs
305+ add-apt-repository -y 'deb https://deb.nodesource.com/node_11.x xenial main'
306+ curl -sSL https://deb.nodesource.com/gpgkey/nodesource.gpg.key | apt-key add -
307+ apt-get update
308+ apt-get install -y cabal-install-3.2
309+ apt-get install -y nodejs
310+ apt-get install -y ghcjs-8.4
311+ cabal user-config update -a "jobs: 1"
312+ bash -c "$PACKCHECK $BUILD"
313+ - *save
314+ coveralls-ghc-8_2_2:
315+ <<: *env
316+ executor: amd64-executor
317+ steps:
318+ - *preinstall
319+ - checkout
320+ - *project-preinstall
321+ - *restore
322+ - run:
323+ environment:
324+ BUILD: cabal
325+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test test"
326+ GHC_OPTIONS: "-DCOVERAGE_BUILD"
327+ command: |
328+ apt-get install -y ghc-8.2.2
329+ apt-get install -y cabal-install-2.4
330+ bash -c "$PACKCHECK cabal-v1"
331+ - *save
332+ coveralls-ghc-8_8_3:
333+ <<: *env
334+ executor: amd64-executor
335+ steps:
336+ - *preinstall
337+ - checkout
338+ - *project-preinstall
339+ - *restore
340+ - run:
341+ environment:
342+ BUILD: cabal-v2
343+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test"
344+ CABAL_PROJECT: "cabal.project.coverage"
345+ CABAL_BUILD_TARGETS: ""
346+ command: |
347+ apt-get install -y ghc-8.8.3
348+ apt-get install -y cabal-install-3.0
349+ bash -c "$PACKCHECK cabal-v2"
350+ no_output_timeout: 25m
351+ - *save
352+ coveralls-ghc-8_10_2:
353+ <<: *env
354+ executor: amd64-executor
355+ steps:
356+ - *preinstall
357+ - checkout
358+ - *project-preinstall
359+ - *restore
360+ - run:
361+ name: Build and test with inspection, coverage, Werror
362+ command: |
363+ apt-get install -y ghc-8.10.2
364+ apt-get install -y cabal-install-3.2
365+ # Run tests with coverage
366+ cabal update
367+ cabal user-config update -a "jobs: 1"
368+ bin/test.sh --coverage --raw
369+ # Upload results to coveralls.io
370+ PATH=$HOME/.cabal/bin:$PATH
371+ export PATH
372+ which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
373+ hpc-coveralls --repo-token="$REPO_TOKEN" --coverage-mode=StrictlyFullLines
374+ no_output_timeout: 25m
375+ - *save
376+ hlint-src:
377+ <<: *env
378+ executor: amd64-executor
379+ steps:
380+ - *preinstall
381+ - checkout
382+ - *project-preinstall
383+ - *restore
384+ - run:
385+ name: Hlint src
386+ environment:
387+ BUILD: cabal-v2
200388 HLINT_OPTIONS: lint
201− HLINT_TARGETS: core/src src test benchmark
389+ HLINT_TARGETS: src test benchmark
202390 command: |
203− bash -c "$PACKCHECK hlint" || exit 1
204− echo "Checking trailing spaces..."
391+ bash -c "$PACKCHECK $BUILD" || exit 1
205392 count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
206393 exit $count
207394 - *save
@@ -210,9 +397,23 @@ workflows:
210397 version: 2
211398 build:
212399 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
400+ - cabal-ghc-8_10_4:
401+ name: GHC 8.10.4 + sdist + no-test + no-bench
402+ #- cabal-ghc-8.6.5
403+ #- cabal-ghc-8_4_4:
404+ # name: GHC 8.4.4 + x86 + debug
405+ - cabal-ghc-8_2_2:
406+ name: GHC 8.2.2 + no-test + no-bench + no-docs
407+ - cabal-ghc-8_0_2:
408+ name: GHC 8.0.2 + no-test + no-bench + no-docs
409+ #- cabal-ghc-7.10.3
410+ - cabal-ghcjs-8_4:
411+ name: GHCJS 8.4 + no-test + no-docs
412+ #- stack-ghc-8.4
413+ #- stack-ghc-8.2
414+ #- coveralls-ghc-8.2.2
415+ #- coveralls-ghc-8.8.3
416+ #- coveralls-ghc-8_10_2:
417+ # name: GHC 8.10.2 + inspection + coverage + Werror
418+ - hlint-src:
419+ name: Hlint src + Trailing Spaces
.github/workflows/haskell.yml+106−165
@@ -8,22 +8,14 @@ on:
88
99jobs:
1010 build:
11− name: GHC ${{matrix.name}}
11+ name: GHC ${{ matrix.name }}
1212 env:
1313 # packcheck environment variables
1414 LC_ALL: C.UTF-8
1515 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 }}
2116 GHCVER: ${{ matrix.ghc_version }}
22− CABALVER: ${{ matrix.cabal_version }}
2317 DISABLE_DOCS: ${{ matrix.disable_docs }}
24− ENABLE_DOCSPEC: ${{ matrix.enable_docspec }}
2518 DISABLE_TEST: ${{ matrix.disable_test }}
26− DISABLE_BENCH: ${{ matrix.disable_bench }}
2719 DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
2820 SDIST_OPTIONS: ${{ matrix.sdist_options }}
2921 DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
@@ -45,192 +37,153 @@ jobs:
4537 STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
4638
4739 # packcheck location and revision
48− PACKCHECK: "./packcheck.sh"
40+ PACKCHECK_LOCAL_PATH: "./packcheck.sh"
4941 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
50− PACKCHECK_GITHUB_COMMIT: "v0.7.0"
42+ PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
5143
5244 # Pull token from "secrets" setting of the github repo
5345 COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
5446 COVERAGE: ${{ matrix.coverage }}
55−
56− # hlint
57− HLINT_VERSION: 3.6.1
58− HLINT_OPTIONS: "lint"
59− HLINT_TARGETS: "core/src src test benchmark"
60−
61− # Subdir
62− SUBDIR: ${{ matrix.subdir }}
47+ DOCTEST: ${{ matrix.doctest }}
6348
6449 runs-on: ${{ matrix.runner }}
65− continue-on-error: ${{ matrix.ignore_error }}
6650 strategy:
67− fail-fast: true
51+ fail-fast: false
6852 matrix:
69− # The order is important to optimize fail-fast.
7053 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.
54+ - 9.2.1
55+ - 9.0.1
56+ - 8.10.7+stack
57+ - 8.10.7+macOS
58+ - 8.10.7+linux+coverage+cabal
59+ - 8.10.7+docspec
60+ - 8.8.4
61+ - 8.8.4+inspection+fusion-plugin+Werror
62+ - 8.6.5+fusion-plugin
63+ - 8.6.5+streamk
64+ - 8.4.4+debug
7865 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
66+ - name: 9.2.1
67+ ghc_version: 9.2.1
68+ build: cabal-v2
69+ cabal_build_options: "--allow-newer=hsc2hs"
9570 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
10071 runner: ubuntu-latest
101− build: cabal
102− cabal_version: 3.10.1.0
72+ cabal_version: 3.6
73+ - name: 9.0.1
74+ ghc_version: 9.0.1
75+ build: cabal-v2
76+ cabal_build_options: "--allow-newer=hsc2hs"
10377 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
16678 runner: ubuntu-latest
79+ cabal_version: 3.4
80+ - name: 8.10.7+stack
16781 build: stack
168− resolver: lts-20.13
82+ resolver: lts-18.18
16983 stack_yaml: stack.yaml
17084 sdist_options: "--ignore-check"
17185 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
86+ runner: ubuntu-latest
87+ cabal_version: 3.4
88+ - name: 8.10.7+macOS
89+ ghc_version: 8.10.7
90+ build: cabal-v2
91+ disable_sdist_build: "y"
92+ runner: macos-latest
93+ cabal_version: 3.4
94+ - name: 8.10.7+linux+coverage+cabal
95+ ghc_version: 8.10.7
96+ coverage: "y"
97+ runner: ubuntu-latest
98+ cabal_version: 3.4
99+ - name: 8.8.4+inspection+fusion-plugin+Werror
181100 ghc_version: 8.8.4
101+ build: cabal-v2
102+ cabal_project: cabal.project.Werror
103+ cabal_build_options: "--flag fusion-plugin --flag inspection"
182104 runner: ubuntu-latest
105+ cabal_version: 3.4
106+ - name: 8.8.4
107+ ghc_version: 8.8.4
183108 build: cabal
184− cabal_version: 3.6.2.0
185109 cabal_project: cabal.project
186− disable_sdist_build: "y"
187− ignore_error: false
188− - name: 8.6.5-debug-unoptimized
110+ cabal_build_options: "--flag -opt"
111+ runner: ubuntu-latest
112+ cabal_version: 3.4
113+ - name: 8.6.5+streamk
189114 ghc_version: 8.6.5
115+ build: cabal-v2
116+ cabal_project: cabal.project
117+ cabal_build_options: "--flag streamk --flag -opt"
190118 runner: ubuntu-latest
191− build: cabal
192− cabal_version: 3.6.2.0
119+ cabal_version: 3.4
120+ - name: 8.6.5+fusion-plugin
121+ ghc_version: 8.6.5
122+ build: cabal-v2
123+ cabal_project: cabal.project
124+ cabal_build_options: "--flag fusion-plugin"
125+ # haddock generation does not work with 8.6.5+fusion-plugin
126+ disable_docs: "y"
127+ runner: ubuntu-latest
128+ cabal_version: 3.4
129+ - name: 8.4.4+debug
130+ ghc_version: 8.4.4
131+ build: cabal-v2
193132 cabal_project: cabal.project
194133 cabal_build_options: "--flag debug --flag -opt"
195− disable_sdist_build: "y"
196− ignore_error: false
197− - name: hlint
198− build: hlint
199134 runner: ubuntu-latest
200− ignore_error: true
135+ cabal_version: 3.4
136+ - name: 8.10.7+docspec
137+ ghc_version: 8.10.7
138+ doctest: "y"
139+ runner: ubuntu-latest
140+ cabal_version: 3.4
201141
202142 steps:
203143 - uses: actions/checkout@v2
204144
145+ - uses: haskell/actions/setup@v1
146+ with:
147+ ghc-version: ${{ matrix.ghc_version }}
148+ cabal-version: ${{ matrix.cabal_version }}
149+
205150 - uses: actions/cache@v1
206− name: Cache common directories
151+ name: Cache ~/.cabal
207152 with:
208− path: |
209− ~/.local
210− ~/.cabal
211− ~/.stack
212− ~/.ghcup
153+ path: ~/.cabal
213154 # Bump the key version to clear the cache
214− key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v2
155+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v1
215156
216157 - name: Download packcheck
217158 run: |
218− if test ! -e "$PACKCHECK"
159+ # Get packcheck if needed
160+ CURL=$(which curl)
161+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
162+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
163+ chmod +x $PACKCHECK_LOCAL_PATH
164+
165+ - name: Run tests
166+ run: |
167+ if test -n "$DOCTEST"
219168 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"
169+ mkdir -p $HOME/.cabal/bin
170+ curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz > cabal-docspec.xz
171+ echo '0829bd034fba901cbcfe491d98ed8b28fd54f9cb5c91fa8e1ac62dc4413c9562 cabal-docspec.xz' | sha256sum -c -
172+ xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec
173+ rm -f cabal-docspec.xz
174+ chmod a+x $HOME/.cabal/bin/cabal-docspec
175+ cabal update
176+ cabal build all
177+ $HOME/.cabal/bin/cabal-docspec --version
178+ $HOME/.cabal/bin/cabal-docspec --timeout 60 --check-properties --property-variables xs
179+ elif test -z "$COVERAGE"
228180 then
229− chmod +x $PACKCHECK
181+ export TOOLS_DIR=/opt
182+ # /usr/local/opt/curl/bin for macOS
183+ export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
184+ bash -c "$PACKCHECK_LOCAL_PATH $BUILD"
230185 fi
231186
232− - name: Run tests
233− run: |
234187 if test -n "$COVERAGE"
235188 then
236189 # Run tests with coverage
@@ -243,16 +196,4 @@ jobs:
243196 bin/test.sh --coverage --raw
244197 # XXX Uncomment this and fix it properly later
245198 # 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"
258199 fi
.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−4
@@ -2,10 +2,6 @@
22.stack-work/
33dist/
44dist-newstyle*/
5−.cabal.nix
6−autom4te.cache/
7−benchmark/bench-report/bin/bench-report
8−charts/
95
106# Local GHC and Cabal related files
117.ghc.environment*
.hlint.ignore+23−12
@@ -1,40 +1,51 @@
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/Prelude.hs
2+src/Streamly/Internal/Data/Stream/PreludeCommon.hs
63src/Streamly/Internal/Data/Stream/Serial.hs
74src/Streamly/Internal/Data/Stream/Zip.hs
5+src/Streamly/Internal/Data/Stream/StreamK/Type.hs
6+src/Streamly/Internal/Data/Pipe/Type.hs
7+src/Streamly/Internal/Data/SmallArray/Type.hs
8+src/Streamly/Internal/Unicode/Stream.hs
9+src/Streamly/Internal/Data/Array/Prim/Type.hs
10+src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs
11+src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs
12+src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs
13+src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs
14+src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs
815test/Streamly/Test/Data/Array.hs
16+test/Streamly/Test/Data/Array/Prim.hs
17+test/Streamly/Test/Data/Array/Prim/Pinned.hs
18+test/Streamly/Test/Data/Array/Foreign.hs
919test/Streamly/Test/Data/Parser.hs
10−test/Streamly/Test/Data/ParserK.hs
20+test/Streamly/Test/Data/Parser/ParserD.hs
1121test/Streamly/Test/Data/SmallArray.hs
1222test/Streamly/Test/Data/Unfold.hs
1323test/Streamly/Test/FileSystem/Event.hs
1424test/Streamly/Test/Prelude/Concurrent.hs
15−test/Streamly/Test/Data/Stream/Concurrent.hs
16−test/lib/Streamly/Test/Prelude/Common.hs
1725test/Streamly/Test/Prelude/Fold.hs
1826test/Streamly/Test/Prelude/Rate.hs
1927test/Streamly/Test/Prelude/Serial.hs
2028test/Streamly/Test/Unicode/Stream.hs
21−test/Streamly/Test/Data/Unbox.hs
2229benchmark/lib/Streamly/Benchmark/Common.hs
2330benchmark/lib/Streamly/Benchmark/Common/Handle.hs
2431benchmark/lib/Streamly/Benchmark/Prelude.hs
2532benchmark/NanoBenchmarks.hs
2633benchmark/Streamly/Benchmark/Data/Array.hs
34+benchmark/Streamly/Benchmark/Data/ArrayOps.hs
35+benchmark/Streamly/Benchmark/Data/NestedUnfoldOps.hs
2736benchmark/Streamly/Benchmark/Data/Parser.hs
28−benchmark/Streamly/Benchmark/Data/ParserK.hs
37+benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs
2938benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
3039benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
3140benchmark/Streamly/Benchmark/Data/Unfold.hs
3241benchmark/Streamly/Benchmark/FileSystem/Handle.hs
3342benchmark/Streamly/Benchmark/Prelude/Async.hs
34−benchmark/Streamly/Benchmark/Prelude/Concurrent.hs
3543benchmark/Streamly/Benchmark/Prelude/Merge.hs
3644benchmark/Streamly/Benchmark/Prelude/Parallel.hs
3745benchmark/Streamly/Benchmark/Prelude/Rate.hs
46+benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
47+benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs
48+benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs
3849benchmark/Streamly/Benchmark/Prelude/WAsync.hs
3950benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
40−benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
51+benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
.hlint.yaml+8−13
@@ -24,24 +24,19 @@
2424- ignore: {name: "Use uncurry"}
2525- ignore: {name: "Redundant $!"}
2626- ignore: {name: "Use fmap"}
27−- ignore: {name: "Use ++"}
2827
2928# 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}
29+- ignore: {name: "Use ++", within: Serial.Transformation}
30+- ignore: {name: "Use mapM", within: Serial.Transformation}
31+- ignore: {name: "Use traverse", within: Serial.Transformation}
32+
33+- ignore: {name: "Redundant <*", within: Serial.NestedStream}
34+- ignore: {name: "Use ++", within: Serial.NestedStream}
35+- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
3536
3637# Specify additional command line arguments
3738#
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− ]
39+- arguments: [--cpp-include=src, --cpp-include=test, --cpp-define=CABAL_OS_LINUX]
4540
4641
4742# Control which extensions/flags/modules/functions can be used
.packcheck.ignore+1−14
@@ -1,36 +1,23 @@
11.circleci/config.yml
22.ghci
33.github/workflows/haskell.yml
4−.github/workflows/regression-check.yml
5−.github/workflows/packdiff.yml
64.gitignore
75.hlint.ignore
86.hlint.yaml
97.packcheck.ignore
108appveyor.yml
11−benchmark/bench-runner/default.nix
12−benchmark/bench-runner/cabal.project
9+benchmark/bench-report/default.nix
1310bin/ghc.sh
14−bin/repl
1511bin/run-ci.sh
16−bin/run-repl-quick.sh
1712cabal.project
1813cabal.project.coverage
1914cabal.project.doctest
2015cabal.project.ghc-head
2116cabal.project.hpc-coveralls
2217cabal.project.O0
23−cabal.project.report
24−cabal.project.packdiff
25−cabal.project.streamly
2618cabal.project.Werror
2719cabal.project.Werror-nocode
28−core/
2920default.nix
3021examples/README.md
3122hie.yaml
3223stack.yaml
33−targets/default.nix
34−targets/cabal.project
35−test/test-runner/default.nix
36−test/test-runner/cabal.project
CHANGELOG.mddeleted−1
@@ -1 +0,0 @@
1−docs/User/Project/Changelog.md
CONTRIBUTING.mdmode 120000 → 100644+272−1
@@ -1 +0,0 @@
1−docs/Developer/Contributing.md
@@ -0,0 +1,272 @@
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+## Picking Issues to Work on
13+
14+Beginners are encouraged to pick up issues that are marked `help wanted`. It is
15+a good idea to update the issue expressing your intent so that others do not
16+duplicate the effort and people with a background on the issue can help.
17+
18+## Build and test
19+
20+Some common commands:
21+
22+```
23+$ cabal repl
24+$ cabal build
25+$ cabal build --disable-optimization --flags -opt
26+$ bin/test.sh --quick
27+$ bin/bench.sh --quick # For nix use "--use-nix"
28+$ bin/run-ci --targets help # Only supported with nix
29+$ cabal haddock
30+$ cabal-docspec --timeout 60 --check-properties --property-variables xs
31+```
32+
33+The `bin/test.sh` and `bin/bench.sh` are custom scripts to perform test
34+and benchmarking tasks conveniently. They support running a group of
35+tests or benchmarks, coverage, using correct optimization flags for
36+benchmarking, benchmark comparison reports etc. Use the `--help` option
37+to see how to use these. See [benchmark/README.md](benchmark/README.md)
38+and [test/README.md](test/README.md) for more details.
39+
40+You can also run tests or benchmarks directly for example:
41+
42+```
43+$ cabal test --disable-optimization --flags -opt --test-show-details=streaming --test-option=--color streamly-tests
44+```
45+
46+To view haddock docs open the link printed at the end of the haddock
47+command, in your browser.
48+
49+Nix users: There is a `default.nix` available which can be used to start
50+a nix-shell and then use the above commands as usual. nix-shell started
51+by `default.nix` creates a `.cabal.nix` for cabal configuration and sets
52+`CABAL_DIR` environment variable to point to that. Therefore, `~/.cabal`
53+would not be used.
54+
55+## Contributing A Change
56+
57+If the feature makes significant changes to design, we encourage you to open an
58+issue as early as possible so that you do not have to redo much work because of
59+changes in design decisions. However, if you are confident, you can still go
60+ahead and take that risk as the maintainers are supposed to be reasonable
61+people.
62+
63+### Pull Requests (PR)
64+
65+Please feel free to [send a pull
66+request (PR)](https://github.com/composewell/streamly/pulls) whether it is a
67+single letter typo fix or a complex change. We will accept any PR that makes a
68+net positive change to the package. We encourage you to provide a complete,
69+consistent change with test, documentation and benchmarks. You can contact the
70+[maintainers](https://gitter.im/composewell/streamly) for any help or
71+collaboration needed in that regard. However, if due to lack of time you are
72+not able to complete the PR, you are still welcome to submit it, maintainers
73+will try their best to actively contribute and pick up your change as long as
74+the change is approved.
75+
76+### Pull Request (PR) Checklist
77+
78+Here is a quick checklist for a PR, for details please see the next section:
79+
80+* PR contains one logical changeset
81+* Each commit in the PR consists of a logical change
82+* Commits are rebased/squashed/fixup/reordered as needed
83+* Stylistic changes to irrelevant parts of the code are separated in
84+ independent commits.
85+* Code is formatted as per the style of the file or that of other files
86+* Compiler warnings are fixed
87+* Reasonable hlint suggestions are accepted
88+* Tests are added to cover the changed parts
89+* All [tests](test) pass
90+* [Performance benchmarks](benchmark) are added, where applicable
91+* No significant regressions are reported by [performance benchmarks](benchmark/README.md)
92+* Haddock documentation is added to user visible APIs and data types
93+* Tutorial module, [README](README.md), and [guides](docs) are updated if
94+ necessary.
95+* [Changelog](Changelog.md) is updated if needed
96+* The code conforms to the license, it is not stolen, credit is given,
97+ copyright notices are retained, original license is included if needed.
98+
99+### Structuring Pull Requests
100+
101+__Lean PR:__ Please keep the reviewer in mind when sending pull
102+requests. Use one PR for each logical changeset. A lean and thin
103+PR with one independent logical change is more likely to be reviewed and
104+merged quickly than a big monolithic PR with several unrelated changes.
105+
106+__PR Dependencies:__ If your change depends on an earlier PR you can
107+create a branch from the old PR's branch, and raise a new PR targeting
108+to merge into the old PR branch. Do not push the commits to the same PR
109+just because the commit depends on that PR.
110+
111+__Commits:__ You are encouraged to group a logically related set of
112+changes into a single commit. When the overall changeset is largish you
113+can divide it into multiple smaller commits, with each commit having
114+a logically grouped changeset and the title summarizing the logical
115+grouping. Always keep in mind a logical division helps reviewers
116+understand and review your code quickly, easier history tracking and
117+when required clean reversal changes.
118+
119+__Functional Changes:__ Keep the reviewer in mind when making
120+changes. Please resist the temptation to make style related changes to
121+surrounding code unless you are changing that code anyway . Whenever
122+possible, try to separate unrelated refactoring changes which do not
123+affect functionality in separate commits so that it is easier for the
124+reviewer to verify functional changes.
125+
126+__Style Changes:__ Make sure that your IDE/Editor is not automatically
127+making sweeping style changes to all the files you are editing. That
128+makes separating the signal from the noise very difficult and makes
129+everything harder. If you would like to make style related changes
130+then please send a separate PR with just those changes and no other
131+functionality changes.
132+
133+__Rebasing:__ If your commits reflect how you fixed intermediate
134+problems during testing or made random changes at different times you
135+may have to squash your changes (`git rebase -i`) into a single commit
136+or logically related set of commits.
137+
138+### Resolving Conflicts
139+
140+If during the course of development or before you send the PR you find that
141+your changes are conflicting with the master branch then use `git rebase
142+master` to rebase your changes on top of master. DO NOT MERGE MASTER INTO YOUR
143+BRANCH.
144+
145+### Testing
146+
147+It is a good idea to include tests for the changes where applicable. See
148+the existing tests in the [test](test) directory. Also see the
149+[test/README](test/README) for more details on how to run the tests.
150+
151+### Documentation
152+
153+For user visible APIs, it is a good idea to provide haddock documentation that
154+is easily understood by the end programmer and does not sound highfalutin,
155+and preferably with examples. If your change affects the tutorial or needs to
156+be mentioned in the tutorial then please update the tutorial. Check if the
157+additional [guides](docs) are affected or need to updated.
158+
159+### Performance Benchmarks
160+
161+It is a good idea to run performance benchmarks to see if your change affects
162+any of the existing performance benchmarks. If you introduced something new
163+then you may want to add benchmarks to check if it performs as well as expected
164+by the programmers to deem it usable.
165+
166+See the [README](benchmark/README) file in the `benchmark` directory for more
167+details on how to run the benchmarks.
168+
169+The first level of check is the regression in "allocations", this is
170+the most stable measure of regression. "bytesCopied" is another stable
171+measure, it gives an idea of the amount of long lived data being copied
172+across generations of GC.
173+
174+The next measure to look at is "cpuTime" this may have some variance
175+from run to run because of factors like cpu frequency scaling, load on
176+the system or the number of context switches etc. However, the variance
177+would usually be within 5-10%, anything more than that is likely to be a
178+red flag.
179+
180+Quite often an increase in "cpuTime" would correspond to an increase
181+in "allocations". Increase in "allocations" indicates an inefficiency
182+in computing due to too much GC activity e.g. due to lack of
183+fusion. However, it is also possible for the cpu time to go up without
184+the allocations going up, this indicates an inefficiency in processing
185+in general or more CPU being used for the same task. It could be because
186+of inefficient code generation, branch mis-predictions or lack of cache
187+locality etc.
188+
189+For concurrent benchmarks we can compare "cpuTime" and "time" to check
190+the degree of concurrency and total efficiency.
191+
192+### Changelog
193+
194+Any new changes that affect the user of the library in some way must be
195+documented under `Unreleased` section at the top of the `Changelog`. The
196+changes in the changelog must be organized in the following categories, in that
197+order:
198+
199+* Breaking Changes
200+* Enhancements
201+* Bug Fixes
202+* Deprecations
203+
204+If there are very few changes then you can just prefix a bullet with these
205+annotations. If there are many changes make sections to group them. A section
206+can be absent if there is nothing to add in it.
207+
208+If you make changes that are incompatible with the released versions
209+of the library please indicate that in the `Changelog` as `Breaking Changes`
210+and also write short notes regarding what the programmers need to do to adapt
211+their existing code to the new change.
212+
213+### Licensing
214+
215+If you have copied code from elsewhere you need to conform to the
216+licensing terms of the original code. Usually you would need to add a
217+copyright notice in the source header, and include the license of the
218+original code as per the terms of the license. If the code you are
219+copying does not have an associated license please do not use it.
220+
221+## Developer documentation
222+
223+* Use https://streamly.composewell.com/ for searching in reference docs
224+* Build haddock docs for latest reference docs
225+* See [the dev directory](dev) for design guidelines and dev documents.
226+
227+## Coding Guidelines
228+
229+### Coding Style
230+
231+Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).
232+
233+### Type variable ordering
234+
235+Ordering of variables in `forall` may be important in type applications. In
236+streams, we usually declare them in this order `t m a`.
237+
238+Use the same order in constraints as well
239+
240+Example,
241+
242+```
243+func :: forall m a. (MonadIO m, Storable a) => ...
244+```
245+
246+### StreamD coding style
247+
248+Some conventions that we follow in the StreamD code are illustrated by the
249+following example:
250+
251+```
252+mapM f (Stream step1 state1) = Stream step state
253+ where
254+
255+ step gst st = do
256+ r <- step1 (adaptState gst) st
257+ case r of
258+ Yield x s -> f x >>= \a -> return $ Yield a s
259+ Skip s -> return $ Skip s
260+ Stop -> return Stop
261+```
262+
263+* For the input streams use numbering for `step` and `state` e.g.
264+ step1/state1. For the output stream use `step` and `state`.
265+* For state argument of `step`, use `st`.
266+* For result of executing a `step` use `r` or `res`
267+* For the yielded element use `x`
268+* For the yielded state use `s`
269+
270+In general, the rule is - the shorter the scope of a variable the shorter its
271+name can be. For example, `s` has the shortest scope in the above code, `st`
272+has a bigger scope and `state` has the biggest scope.
docs/User/Project/Changelog.md → Changelog.mdrenamed+5−134
@@ -2,142 +2,13 @@
22
33<!-- See rendered changelog at https://streamly.composewell.com -->
44
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−
1345## 0.8.1.1 (Dec 2021)
1356
1367* Disable building FileSystem.Events where FS Events isn't supported.
1378
1389## 0.8.1 (Nov 2021)
13910
140−See ApiChangelogs/0.8.3.txt for new APIs introduced.
11+See docs/API-changelog.txt for new APIs introduced.
14112
14213### Bug Fixes
14314
@@ -147,11 +18,11 @@ See ApiChangelogs/0.8.3.txt for new APIs introduced.
14718 * Fix potentially writing beyond allocated memory when shrinking. Likely
14819 cause of [#944](https://github.com/composewell/streamly/issues/944).
14920 * Fix potentially writing beyond allocated memory when writing the last
150− element. Likely cause of
21+ element. Likely cause of
15122 [#944](https://github.com/composewell/streamly/issues/944).
15223 * Fix missing pointer touch could potentially cause use of freed memory.
15324 * Fix unnecessary additional allocation due to a bug
154−* Fix a bug in classifySessionsBy, see
25+* Fix a bug in classifySessionsBy, see
15526 [PR #1311](https://github.com/composewell/streamly/pull/1311). The bug
15627 could cause premature ejection of a session when input events with the
15728 same key are split into multiple sessions.
@@ -165,7 +36,7 @@ See ApiChangelogs/0.8.3.txt for new APIs introduced.
16536
16637## 0.8.0 (Jun 2021)
16738
168−See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of signature
39+See [API Changelog](docs/API-changelog.txt) for a complete list of signature
16940changes and new APIs introduced.
17041
17142### Breaking changes
@@ -204,7 +75,7 @@ changes and new APIs introduced.
20475
20576### Enhancements
20677
207−* See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of new
78+* See [API Changelog](docs/API-changelog.txt) for a complete list of new
20879 modules and APIs introduced.
20980* The Fold type is now more powerful, the new termination behavior allows
21081 to express basic parsing of streams using folds.
LICENSE+254
@@ -26,6 +26,172 @@ CAUSED 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.
2828
29+-------------------------------------------------------------------------------
30+base-4.12.0.0 (http://hackage.haskell.org/package/base-4.12.0.0)
31+-------------------------------------------------------------------------------
32+This library (libraries/base) is derived from code from several
33+sources:
34+
35+ * Code from the GHC project which is largely (c) The University of
36+ Glasgow, and distributable under a BSD-style license (see below),
37+
38+ * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
39+ and freely redistributable (but see the full license for
40+ restrictions).
41+
42+ * Code from the Haskell Foreign Function Interface specification,
43+ which is (c) Manuel M. T. Chakravarty and freely redistributable
44+ (but see the full license for restrictions).
45+
46+The full text of these licenses is reproduced below. All of the
47+licenses are BSD-style or compatible.
48+
49+The Glasgow Haskell Compiler License
50+
51+Copyright 2004, The University Court of the University of Glasgow.
52+All rights reserved.
53+
54+Redistribution and use in source and binary forms, with or without
55+modification, are permitted provided that the following conditions are met:
56+
57+- Redistributions of source code must retain the above copyright notice,
58+this list of conditions and the following disclaimer.
59+
60+- Redistributions in binary form must reproduce the above copyright notice,
61+this list of conditions and the following disclaimer in the documentation
62+and/or other materials provided with the distribution.
63+
64+- Neither name of the University nor the names of its contributors may be
65+used to endorse or promote products derived from this software without
66+specific prior written permission.
67+
68+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
69+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
70+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
71+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
72+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
73+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
74+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
75+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
76+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
77+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
78+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
79+DAMAGE.
80+
81+Code derived from the document "Report on the Programming Language
82+Haskell 98", is distributed under the following license:
83+
84+ Copyright (c) 2002 Simon Peyton Jones
85+
86+ The authors intend this Report to belong to the entire Haskell
87+ community, and so we grant permission to copy and distribute it for
88+ any purpose, provided that it is reproduced in its entirety,
89+ including this Notice. Modified versions of this Report may also be
90+ copied and distributed for any purpose, provided that the modified
91+ version is clearly presented as such, and that it does not claim to
92+ be a definition of the Haskell 98 Language.
93+
94+Code derived from the document "The Haskell 98 Foreign Function
95+Interface, An Addendum to the Haskell 98 Report" is distributed under
96+the following license:
97+
98+ Copyright (c) 2002 Manuel M. T. Chakravarty
99+
100+ The authors intend this Report to belong to the entire Haskell
101+ community, and so we grant permission to copy and distribute it for
102+ any purpose, provided that it is reproduced in its entirety,
103+ including this Notice. Modified versions of this Report may also be
104+ copied and distributed for any purpose, provided that the modified
105+ version is clearly presented as such, and that it does not claim to
106+ be a definition of the Haskell 98 Foreign Function Interface.
107+
108+-------------------------------------------------------------------------------
109+bjoern-2008-2009 (http://bjoern.hoehrmann.de/utf-8/decoder/dfa/)
110+-------------------------------------------------------------------------------
111+Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>
112+
113+Permission is hereby granted, free of charge, to any person obtaining a copy of
114+this software and associated documentation files (the "Software"), to deal in
115+the Software without restriction, including without limitation the rights to
116+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
117+of the Software, and to permit persons to whom the Software is furnished to do
118+so, subject to the following conditions:
119+
120+The above copyright notice and this permission notice shall be included in all
121+copies or substantial portions of the Software.
122+
123+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
124+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
125+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
126+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
127+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
128+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
129+SOFTWARE.
130+
131+-------------------------------------------------------------------------------
132+clock-0.7.2 (http://hackage.haskell.org/package/clock-0.7.2)
133+-------------------------------------------------------------------------------
134+Copyright (c) 2009-2012, Cetin Sert
135+Copyright (c) 2010, Eugene Kirpichov
136+
137+All rights reserved.
138+
139+Redistribution and use in source and binary forms, with or without
140+modification, are permitted provided that the following conditions are
141+met:
142+
143+ * Redistributions of source code must retain the above copyright
144+ notice, this list of conditions and the following disclaimer.
145+
146+ * Redistributions in binary form must reproduce the above
147+ copyright notice, this list of conditions and the following
148+ disclaimer in the documentation and/or other materials provided
149+ with the distribution.
150+
151+ * The names of contributors may not be used to endorse or promote
152+ products derived from this software without specific prior
153+ written permission.
154+
155+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
156+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
157+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
158+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
159+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
160+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
161+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
162+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
163+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
164+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
165+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
166+
167+-------------------------------------------------------------------------------
168+foldl-1.4.5 (http://hackage.haskell.org/package/foldl-1.4.5)
169+-------------------------------------------------------------------------------
170+Copyright (c) 2013 Gabriel Gonzalez
171+All rights reserved.
172+
173+Redistribution and use in source and binary forms, with or without modification,
174+are permitted provided that the following conditions are met:
175+ * Redistributions of source code must retain the above copyright notice,
176+ this list of conditions and the following disclaimer.
177+ * Redistributions in binary form must reproduce the above copyright notice,
178+ this list of conditions and the following disclaimer in the documentation
179+ and/or other materials provided with the distribution.
180+ * Neither the name of Gabriel Gonzalez nor the names of other contributors
181+ may be used to endorse or promote products derived from this software
182+ without specific prior written permission.
183+
184+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
185+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
186+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
187+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
188+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
189+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
190+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
191+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
192+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
193+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
194+
29195-------------------------------------------------------------------------------
30196fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
31197-------------------------------------------------------------------------------
@@ -93,3 +259,91 @@ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
93259THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
94260(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
95261OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
262+
263+-------------------------------------------------------------------------------
264+primitive-0.7.0.0 (https://hackage.haskell.org/package/primitive-0.7.0.0)
265+-------------------------------------------------------------------------------
266+Copyright (c) 2008-2009, Roman Leshchinskiy
267+All rights reserved.
268+
269+Redistribution and use in source and binary forms, with or without
270+modification, are permitted provided that the following conditions are met:
271+
272+- Redistributions of source code must retain the above copyright notice,
273+this list of conditions and the following disclaimer.
274+
275+- Redistributions in binary form must reproduce the above copyright notice,
276+this list of conditions and the following disclaimer in the documentation
277+and/or other materials provided with the distribution.
278+
279+- Neither name of the University nor the names of its contributors may be
280+used to endorse or promote products derived from this software without
281+specific prior written permission.
282+
283+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
284+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
285+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
286+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
287+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
288+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
289+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
290+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
291+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
292+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
293+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
294+DAMAGE.
295+
296+-------------------------------------------------------------------------------
297+transient-0.5.5 (http://hackage.haskell.org/package/transient-0.5.5)
298+-------------------------------------------------------------------------------
299+Copyright © 2014-2016 Alberto G. Corona <https://github.com/agocorona>
300+
301+Permission is hereby granted, free of charge, to any person obtaining a copy of
302+this software and associated documentation files (the "Software"), to deal in
303+the Software without restriction, including without limitation the rights to
304+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
305+the Software, and to permit persons to whom the Software is furnished to do so,
306+subject to the following conditions:
307+
308+The above copyright notice and this permission notice shall be included in all
309+copies or substantial portions of the Software.
310+
311+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
312+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
313+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
314+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
315+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
316+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
317+
318+-------------------------------------------------------------------------------
319+vector-0.12.0.2 (http://hackage.haskell.org/package/vector-0.12.0.2)
320+-------------------------------------------------------------------------------
321+Copyright (c) 2008-2012, Roman Leshchinskiy
322+All rights reserved.
323+
324+Redistribution and use in source and binary forms, with or without
325+modification, are permitted provided that the following conditions are met:
326+
327+- Redistributions of source code must retain the above copyright notice,
328+this list of conditions and the following disclaimer.
329+
330+- Redistributions in binary form must reproduce the above copyright notice,
331+this list of conditions and the following disclaimer in the documentation
332+and/or other materials provided with the distribution.
333+
334+- Neither name of the University nor the names of its contributors may be
335+used to endorse or promote products derived from this software without
336+specific prior written permission.
337+
338+THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
339+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
340+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
341+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
342+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
343+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
344+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
345+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
346+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
347+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
348+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
349+DAMAGE.
README.mdmode 120000 → 100644+651−1
@@ -1 +0,0 @@
1−docs/User/Project/README.md
@@ -0,0 +1,651 @@
1+# [Streamly][]: Idiomatic Haskell with the Performance of C
2+
3+[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)
4+[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)
5+
6+Streamly is a Haskell library that provides the building blocks to build
7+safe, scalable, modular and high performance software. Streamly offers:
8+
9+* The type safety of Haskell.
10+* The performance of C programs.
11+* Powerful abstractions for structuring your code.
12+* Idiomatic functional programming.
13+* Declarative concurrency for the seamless use of multiprocessing hardware.
14+
15+## About This Document
16+
17+This guide introduces programming with [Streamly][] using a few practical
18+examples:
19+
20+* We will start with a simple program that [counts the number of words
21+ in a text](#modular-word-counting). We will then transform this program
22+ into a [concurrent](#concurrent-word-counting) program that can efficiently
23+ use multiprocessing hardware.
24+* Next, we will create a [concurrent network
25+ server](#a-concurrent-network-server). We then show
26+ how to write a network server that [merges multiple
27+ streams](#merging-incoming-streams) concurrently.
28+* Our third example shows how to list a directory tree concurrently,
29+ by reading [multiple directories in
30+ parallel](#listing-directories-recursivelyconcurrently).
31+* Finally, we will look at how to [rate limit](#rate-limiting) stream
32+ processing.
33+
34+The guide then looks at how Streamly achieves its
35+[performance](#performance). It [concludes](#notes) with a brief
36+discussion about Streamly's design philosophy, and with suggestions for
37+further reading.
38+
39+## Getting Started
40+
41+### Installing Streamly
42+
43+If you wish to follow along with this guide, you will need to have
44+[Streamly][] installed.
45+
46+Please see the [Getting Started With The Streamly Package](docs/getting-started.md)
47+guide for instructions on how to install [Streamly][].
48+
49+If you wish to run benchmarks, please be sure to build your
50+application using the instructions in the [Build Guide](docs/building.md).
51+
52+### An overview of the types used in these examples
53+
54+As an expository device, we have indicated the types at the intermediate
55+stages of stream computations as comments in the examples below.
56+The meaning of these types are:
57+
58+* A `SerialT IO a` is a serial stream of values of type `a` in the IO Monad.
59+* An `AsyncT IO a` is a concurrent (asynchronous) stream of values of type
60+ `a` in the IO Monad.
61+* An `Unfold IO a b` is a representation of a function that converts a seed
62+ value of type `a` into a stream of values of type `b` in the IO Monad.
63+* A `Fold IO a b` is a representation of a function that converts a stream of
64+ type `a` to a final accumulator of type `b` in the IO Monad.
65+
66+### A Note on Module Naming
67+
68+Some of the examples below use modules from the `Internal` Streamly package
69+hierarchy. These are not really internal to the library. We classify
70+`Streamly` modules into two categories:
71+
72+* _Released modules and APIs_: These modules and APIs are
73+ stable. Significant changes to these modules and APIs will cause
74+ Streamly's version number to change according to the package versioning
75+ policy.
76+* _Pre-release modules and APIs_: These modules and APIs have not been
77+ formally released yet. They may change in the near future, and such
78+ changes will not necessarily be reflected in Streamly's package
79+ version number. As yet unreleased modules and APIs reside in the
80+ `Internal` namespace.
81+
82+Please use a minor release upper bound to adhere to the Haskell PVP when
83+using the pre-release (internal) modules.
84+
85+## The Examples
86+
87+### Modular Word Counting
88+
89+A `Fold` in Streamly is a composable stream consumer. For our first
90+example, we will use `Fold`s to count the number of bytes, words and lines
91+present in a file. We will then compose individual `Fold`s together to
92+count words, bytes and lines at the same time.
93+
94+Please see the file [WordCountModular.hs][] for the complete example
95+program, including the imports that we have omitted here.
96+
97+#### Count Bytes (wc -c)
98+
99+We start with a code fragment that counts the number of bytes in a file:
100+
101+```haskell
102+import qualified Streamly.Data.Fold as Fold
103+import qualified Streamly.Internal.FileSystem.File as File
104+import qualified Streamly.Prelude as Stream
105+
106+wcb :: String -> IO Int
107+wcb file =
108+ File.toBytes file -- SerialT IO Word8
109+ & Stream.fold Fold.length -- IO Int
110+```
111+
112+### Count Lines (wc -l)
113+
114+The next code fragment shows how to count the number of lines in a file:
115+
116+```haskell
117+-- ASCII character 10 is a newline.
118+countl :: Int -> Word8 -> Int
119+countl n ch = if ch == 10 then n + 1 else n
120+
121+-- The fold accepts a stream of `Word8` and returns a line count (`Int`).
122+nlines :: Monad m => Fold m Word8 Int
123+nlines = Fold.foldl' countl 0
124+
125+wcl :: String -> IO Int
126+wcl file =
127+ File.toBytes file -- SerialT IO Word8
128+ & Stream.fold nlines -- IO Int
129+```
130+
131+### Count Words (wc -w)
132+
133+Our final code fragment counts the number of whitespace-separated words
134+in a stream:
135+
136+```haskell
137+countw :: (Int, Bool) -> Word8 -> (Int, Bool)
138+countw (n, wasSpace) ch =
139+ if isSpace $ chr $ fromIntegral ch
140+ then (n, True)
141+ else (if wasSpace then n + 1 else n, False)
142+
143+-- The fold accepts a stream of `Word8` and returns a word count (`Int`).
144+nwords :: Monad m => Fold m Word8 Int
145+nwords = fst <$> Fold.foldl' countw (0, True)
146+
147+wcw :: String -> IO Int
148+wcw file =
149+ File.toBytes file -- SerialT IO Word8
150+ & Stream.fold nwords -- IO Int
151+```
152+
153+### Counting Bytes, Words and Lines Together
154+
155+By using the `Tee` combinator we can compose the three folds that count
156+bytes, lines and words individually into a single fold that counts all
157+three at once. The applicative instance of `Tee` distributes its input
158+to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and
159+then combines the outputs from the folds using the supplied combiner
160+function (`(,,)`).
161+
162+```haskell
163+import qualified Streamly.Internal.Data.Fold.Tee as Tee
164+
165+-- The fold accepts a stream of `Word8` and returns the three counts.
166+countAll :: Fold IO Word8 (Int, Int, Int)
167+countAll = Tee.toFold $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords
168+
169+wc :: String -> IO (Int, Int, Int)
170+wc file =
171+ File.toBytes file -- SerialT IO Word8
172+ & Stream.fold countAll -- IO (Int, Int, Int)
173+```
174+
175+This example demonstrates the excellent modularity offered by
176+[Streamly][]'s simple and concise API. Experienced Haskellers will
177+notice that we have not used bytestrings&mdash;we instead used a stream of
178+`Word8` values, simplifying our program.
179+
180+### The Performance of Word Counting
181+
182+We compare two equivalent implementations: one using [Streamly][],
183+and the other using C.
184+
185+The performance of the [Streamly word counting
186+implementation][WordCount.hs] is:
187+
188+```
189+$ time WordCount-hs gutenberg-500MB.txt
190+11242220 97050938 574714449 gutenberg-500MB.txt
191+
192+real 0m1.825s
193+user 0m1.697s
194+sys 0m0.128s
195+```
196+
197+The performance of an equivalent [wc implementation in C][WordCount.c] is:
198+
199+```
200+$ time WordCount-c gutenberg-500MB.txt
201+11242220 97050938 574714449 gutenberg-500MB.txt
202+
203+real 0m2.100s
204+user 0m1.935s
205+sys 0m0.165s
206+```
207+
208+### Concurrent Word Counting
209+
210+In our next example we show how the task of counting words, lines,
211+and bytes could be done in parallel on multiprocessor hardware.
212+
213+To count words in parallel we first divide the stream into chunks
214+(arrays), do the counting within each chunk, and then add all the
215+counts across chunks. We use the same code as above except that we use
216+arrays for our input data.
217+
218+Please see the file [WordCountParallel.hs][] for the complete working
219+code for this example, including the imports that we have omitted below.
220+
221+The `countArray` function counts the line, word, char counts in one chunk:
222+
223+```haskell
224+import qualified Streamly.Data.Array.Foreign as Array
225+
226+countArray :: Array Word8 -> IO Counts
227+countArray arr =
228+ Stream.unfold Array.read arr -- SerialT IO Word8
229+ & Stream.decodeLatin1 -- SerialT IO Char
230+ & Stream.foldl' count (Counts 0 0 0 True) -- IO Counts
231+```
232+
233+Here the function `count` and the `Counts` data type are defined in the
234+`WordCount` helper module defined in [WordCount.hs][].
235+
236+When combining the counts in two contiguous chunks, we need to check
237+whether the first element of the next chunk is a whitespace character
238+in order to determine if the same word continues in the next chunk or
239+whether the chunk starts with a new word. The `partialCounts` function
240+adds a `Bool` flag to `Counts` returned by `countArray` to indicate
241+whether the first character in the chunk is a space.
242+
243+```haskell
244+partialCounts :: Array Word8 -> IO (Bool, Counts)
245+partialCounts arr = do
246+ let r = Array.getIndex arr 0
247+ case r of
248+ Just x -> do
249+ counts <- countArray arr
250+ return (isSpace (chr (fromIntegral x)), counts)
251+ Nothing -> return (False, Counts 0 0 0 True)
252+```
253+
254+`addCounts` then adds the counts from two consecutive chunks:
255+
256+```haskell
257+addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)
258+addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =
259+ let wcount =
260+ if not ws1 && not sp2 -- No space between two chunks.
261+ then w1 + w2 - 1
262+ else w1 + w2
263+ in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)
264+```
265+
266+To count in parallel we now only need to divide the stream into arrays,
267+apply our counting function to each array, and then combine the counts
268+from each chunk.
269+
270+```haskell
271+wc :: String -> IO (Bool, Counts)
272+wc file = do
273+ Stream.unfold File.readChunks file -- AheadT IO (Array Word8)
274+ & Stream.mapM partialCounts -- AheadT IO (Bool, Counts)
275+ & Stream.maxThreads numCapabilities -- AheadT IO (Bool, Counts)
276+ & Stream.fromAhead -- SerialT IO (Bool, Counts)
277+ & Stream.foldl' addCounts (False, Counts 0 0 0 True) -- IO (Bool, Counts)
278+```
279+
280+Please note that the only difference between a concurrent and a
281+non-concurrent program lies in the use of the `Stream.fromAhead`
282+combinator. If we remove the call to `Stream.fromAhead`, we would
283+still have a perfectly valid and performant serial program. Notice
284+how succinctly and idiomatically we have expressed the concurrent word
285+counting problem.
286+
287+A benchmark with 2 CPUs:
288+
289+```
290+$ time WordCount-hs-parallel gutenberg-500MB.txt
291+11242220 97050938 574714449 gutenberg-500MB.txt
292+
293+real 0m1.284s
294+user 0m1.952s
295+sys 0m0.140s
296+```
297+
298+These example programs have assumed ASCII encoded input data. For UTF-8
299+streams, we have a [concurrent wc implementation][WordCountUTF8.hs]
300+with UTF-8 decoding. This concurrent implementation performs as well
301+as the standard `wc` program in serial benchmarks. In concurrent mode
302+[Streamly][]'s implementation can utilise multiple processing cores if
303+these are present, and can thereby run much faster than the standard
304+binary.
305+
306+Streamly provides concurrency facilities similar
307+to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and
308+[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative
309+style of expression. With Streamly you can write concurrent programs
310+with ease, with support for different types of concurrent scheduling.
311+
312+### A Concurrent Network Server
313+
314+We now move to a slightly more complicated example: we simulate a
315+dictionary lookup server which can serve word meanings to multiple
316+clients concurrently. This example demonstrates the use of the concurrent
317+`mapM` combinator.
318+
319+Please see the file [WordServer.hs][] for the complete code for this
320+example, including the imports that we have omitted below.
321+
322+```haskell
323+import qualified Streamly.Data.Fold as Fold
324+import qualified Streamly.Network.Inet.TCP as TCP
325+import qualified Streamly.Network.Socket as Socket
326+import qualified Streamly.Unicode.Stream as Unicode
327+
328+-- Simulate network/db query by adding a delay.
329+fetch :: String -> IO (String, String)
330+fetch w = threadDelay 1000000 >> return (w,w)
331+
332+-- Read lines of whitespace separated list of words from a socket, fetch the
333+-- meanings of each word concurrently and return the meanings separated by
334+-- newlines, in same order as the words were received. Repeat until the
335+-- connection is closed.
336+lookupWords :: Socket -> IO ()
337+lookupWords sk =
338+ Stream.unfold Socket.read sk -- SerialT IO Word8
339+ & Unicode.decodeLatin1 -- SerialT IO Char
340+ & Stream.wordsBy isSpace Fold.toList -- SerialT IO String
341+ & Stream.fromSerial -- AheadT IO String
342+ & Stream.mapM fetch -- AheadT IO (String, String)
343+ & Stream.fromAhead -- SerialT IO (String, String)
344+ & Stream.map show -- SerialT IO String
345+ & Stream.intersperse "\n" -- SerialT IO String
346+ & Unicode.encodeStrings Unicode.encodeLatin1 -- SerialT IO (Array Word8)
347+ & Stream.fold (Socket.writeChunks sk) -- IO ()
348+
349+serve :: Socket -> IO ()
350+serve sk = finally (lookupWords sk) (close sk)
351+
352+-- | Run a server on port 8091. Accept and handle connections concurrently. The
353+-- connection handler is "serve" (i.e. lookupWords). You can use "telnet" or
354+-- "nc" as a client to try it out.
355+main :: IO ()
356+main =
357+ Stream.unfold TCP.acceptOnPort 8091 -- SerialT IO Socket
358+ & Stream.fromSerial -- AsyncT IO ()
359+ & Stream.mapM serve -- AsyncT IO ()
360+ & Stream.fromAsync -- SerialT IO ()
361+ & Stream.drain -- IO ()
362+```
363+
364+### Merging Incoming Streams
365+
366+In the next example, we show how to merge logs coming from multiple
367+nodes in your network. These logs are merged at line boundaries and
368+the merged logs are written to a file or to a network destination.
369+This example uses the `concatMapWith` combinator to merge multiple
370+streams concurrently.
371+
372+Please see the file [MergeServer.hs][] for the complete working code,
373+including the imports that we have omitted below.
374+
375+```haskell
376+import qualified Streamly.Data.Unfold as Unfold
377+import qualified Streamly.Network.Socket as Socket
378+
379+-- | Read a line stream from a socket.
380+-- Note: lines are buffered, and we could add a limit to the
381+-- buffering for safety.
382+readLines :: Socket -> SerialT IO (Array Char)
383+readLines sk =
384+ Stream.unfold Socket.read sk -- SerialT IO Word8
385+ & Unicode.decodeLatin1 -- SerialT IO Char
386+ & Stream.splitWithSuffix (== '\n') Array.write -- SerialT IO String
387+
388+recv :: Socket -> SerialT IO (Array Char)
389+recv sk = Stream.finally (liftIO $ close sk) (readLines sk)
390+
391+-- | Starts a server at port 8091 listening for lines with space separated
392+-- words. Multiple clients can connect to the server and send streams of lines.
393+-- The server handles all the connections concurrently, merges the incoming
394+-- streams at line boundaries and writes the merged stream to a file.
395+server :: Handle -> IO ()
396+server file =
397+ Stream.unfold TCP.acceptOnPort 8090 -- SerialT IO Socket
398+ & Stream.concatMapWith Stream.parallel recv -- SerialT IO (Array Char)
399+ & Stream.unfoldMany Array.read -- SerialT IO Char
400+ & Unicode.encodeLatin1 -- SerialT IO Word8
401+ & Stream.fold (Handle.write file) -- IO ()
402+
403+main :: IO ()
404+main = withFile "output.txt" AppendMode server
405+```
406+
407+### Listing Directories Recursively/Concurrently
408+
409+Our next example lists a directory tree recursively, reading
410+multiple directories concurrently.
411+
412+This example uses the tree traversing combinator `iterateMapLeftsWith`.
413+This combinator maps a stream generator on the `Left` values in its
414+input stream (directory names in this case), feeding the resulting `Left`
415+values back to the input, while it lets the `Right` values (file names
416+in this case) pass through to the output. The `Stream.ahead` stream
417+joining combinator then makes it iterate on the directories concurrently.
418+
419+Please see the file [ListDir.hs][] for the complete working code,
420+including the imports that we have omitted below.
421+
422+```haskell
423+import Streamly.Internal.Data.Stream.IsStream (iterateMapLeftsWith)
424+
425+import qualified Streamly.Prelude as Stream
426+import qualified Streamly.Internal.FileSystem.Dir as Dir (toEither)
427+
428+-- Lists a directory as a stream of (Either Dir File).
429+listDir :: String -> SerialT IO (Either String String)
430+listDir dir =
431+ Dir.toEither dir -- SerialT IO (Either String String)
432+ & Stream.map (bimap mkAbs mkAbs) -- SerialT IO (Either String String)
433+
434+ where mkAbs x = dir ++ "/" ++ x
435+
436+-- | List the current directory recursively using concurrent processing.
437+main :: IO ()
438+main = do
439+ hSetBuffering stdout LineBuffering
440+ let start = Stream.fromPure (Left ".")
441+ Stream.iterateMapLeftsWith Stream.ahead listDir start
442+ & Stream.mapM_ print
443+```
444+
445+### Rate Limiting
446+
447+For bounded concurrent streams, a stream yield rate can be specified
448+easily. For example, to print "tick" once every second you can simply
449+write:
450+
451+```haskell
452+main :: IO ()
453+main =
454+ Stream.repeatM (pure "tick") -- AsyncT IO String
455+ & Stream.timestamped -- AsyncT IO (AbsTime, String)
456+ & Stream.avgRate 1 -- AsyncT IO (AbsTime, String)
457+ & Stream.fromAsync -- SerialT IO (AbsTime, String)
458+ & Stream.mapM_ print -- IO ()
459+```
460+
461+Please see the file [Rate.hs][] for the complete working code.
462+
463+The concurrency of the stream is automatically controlled to match the
464+specified rate. [Streamly][]'s rate control works precisely even at
465+throughputs as high as millions of yields per second.
466+
467+For more sophisticated rate control needs please see the Streamly [reference
468+documentation][Streamly].
469+
470+### Reactive Programming
471+
472+Streamly supports reactive (time domain) programming because of its
473+support for declarative concurrency. Please see the `Streamly.Prelude`
474+module for time-specific combinators like `intervalsOf`, and
475+folds like `takeInterval` in `Streamly.Internal.Data.Fold`.
476+Please also see the pre-release sampling combinators in the
477+`Streamly.Internal.Data.Stream.IsStream.Top` module for `throttle` and
478+`debounce` like operations.
479+
480+The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate
481+reactive programming using [Streamly][].
482+
483+### More Examples
484+
485+If you would like to view more examples, please visit the [Streamly
486+Examples][streamly-examples] web page.
487+
488+### Further Reading
489+
490+* [Streaming Benchmarks][streaming-benchmarks]
491+* [Concurrency Benchmarks][concurrency-benchmarks]
492+* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)
493+* [Other Guides](docs/)
494+* [Streamly Homepage][Streamly]
495+
496+## Performance
497+
498+As you have seen in the word count example above, [Streamly][] offers
499+highly modular abstractions for building programs while also offering
500+the performance close to an equivalent (imperative) C program.
501+
502+Streamly offers excellent performance even for byte-at-a-time stream
503+operations using efficient abstractions like `Unfold`s and terminating
504+`Fold`s. Byte-at-a-time stream operations can simplify programming
505+because the developer does not have to deal explicitly with chunking
506+and re-combining data.
507+
508+Streamly exploits GHC's stream fusion optimizations (`case-of-case` and
509+`spec-constr`) aggressively to achieve C-like speed, while also offering
510+highly modular abstractions to developers.
511+
512+[Streamly][] will usually perform very well without any
513+compiler plugins. However, we have fixed some deficiencies
514+that we had noticed in GHC's optimizer using a [compiler
515+plugin](https://github.com/composewell/fusion-plugin). We hope to fold
516+these optimizations into GHC in the future; until then we recommend that
517+you use this plugin for applications that are performance sensitive.
518+
519+### Benchmarks
520+
521+We measured several Haskell streaming implementations
522+using various micro-benchmarks. Please see the [streaming
523+benchmarks][streaming-benchmarks] page for a detailed comparison of
524+Streamly against other streaming libraries.
525+
526+Our results show that [Streamly][] is the fastest effectful streaming
527+implementation on almost all the measured microbenchmarks. In many cases
528+it runs up to 100x faster, and in some cases even 1000x faster than
529+some of the tested alternatives. In some composite operation benchmarks
530+[Streamly][] turns out to be significantly faster than Haskell's list
531+implementation.
532+
533+*Note*: If you can write a program in some other way or with some other
534+language that runs significantly faster than what [Streamly][] offers,
535+please let us know and we will improve.
536+
537+## Notes
538+
539+Streamly comes equipped with a very powerful set of abstractions to
540+accomplish many kinds of programming tasks: it provides support for
541+programming with streams and arrays, for reading and writing from the
542+file system and from the network, for time domain programming (reactive
543+programming), and for reacting to file system events using `fsnotify`.
544+
545+Please view [Streamly's documentation][Streamly] for more information
546+about Streamly's features.
547+
548+### Concurrency
549+
550+Streamly uses lock-free synchronization for achieving concurrent
551+operation with low overheads. The number of tasks performed concurrently
552+are determined automatically based on the rate at which a consumer
553+is consuming the results. In other words, you do not need to manage
554+thread pools or decide how many threads to use for a particular task.
555+For CPU-bound tasks Streamly will try to keep the number of threads
556+close to the number of CPUs available; for IO-bound tasks it will utilize
557+more threads.
558+
559+The parallelism available during program execution can be utilized with
560+very little overhead even where the task size is very
561+small, because Streamly will automatically switch between
562+serial or batched execution of tasks on the same CPU depending
563+on whichever is more efficient. Please see our [concurrency
564+benchmarks][concurrency-benchmarks] for more detailed performance
565+measurements, and for a comparison with the `async` package.
566+
567+### Design Goals
568+
569+Our goals for [Streamly][] from the very beginning have been:
570+
571+1. To achieve simplicity by unifying abstractions.
572+2. To offer high performance.
573+
574+These goals are hard to achieve simultaneously because they are usually
575+inversely related. We have spent many years trying to get the abstractions
576+right without compromising performance.
577+
578+`Unfold` is an example of an abstraction that we have created to achieve
579+high performance when mapping streams on streams. `Unfold` allows stream
580+generation to be optimized well by the compiler through stream fusion.
581+A `Fold` with termination capability is another example which modularizes
582+stream elimination operations through stream fusion. Terminating folds
583+can perform many simple parsing tasks that do not require backtracking.
584+In Streamly, `Parser`s are a natural extension to terminating `Fold`s;
585+`Parser`s add the ability to backtrack to `Fold`s. Unification leads
586+to simpler abstractions and lower cognitive overheads while also not
587+compromising performance.
588+
589+## Credits
590+
591+The following authors/libraries have influenced or inspired this library in a
592+significant way:
593+
594+ * Roman Leshchinskiy ([vector](http://hackage.haskell.org/package/vector))
595+ * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))
596+ * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient))
597+
598+Please see the [`credits`](./credits/README.md) directory for a full
599+list of contributors, credits and licenses.
600+
601+## Licensing
602+
603+Streamly is an [open source](https://github.com/composewell/streamly)
604+project available under a liberal [BSD-3-Clause license][LICENSE]
605+
606+## Contributing to Streamly
607+
608+As an open project we welcome contributions:
609+
610+* [Streamly Contributor's Guide][CONTRIBUTING.md]
611+* [Contact the streamly development team](mailto:streamly@composewell.com)
612+
613+## Getting Support
614+
615+Professional support is available for [Streamly][]: please contact
616+[support@composewell.com](mailto:support@composewell.com).
617+
618+You can also join our [community chat
619+channel](https://gitter.im/composewell/streamly) on Gitter.
620+
621+<!--
622+Link References.
623+-->
624+
625+[Streamly]: https://streamly.composewell.com/
626+[streamly-examples]: https://github.com/composewell/streamly-examples
627+[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks
628+[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks
629+
630+<!--
631+Keep all the unstable links here so that they can be updated to stable
632+links (for online docs) before we release.
633+-->
634+
635+<!-- examples -->
636+[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs
637+[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs
638+[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c
639+[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs
640+[WordCountUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountUTF8.hs
641+[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs
642+[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs
643+[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs
644+[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs
645+[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs
646+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs
647+
648+<!-- local files -->
649+[LICENSE]: LICENSE
650+[CONTRIBUTING.md]: CONTRIBUTING.md
651+[docs]: docs/
appveyor.yml+2−4
@@ -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,9 +34,9 @@ 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-18.18"
4240 STACK_ROOT: "c:\\sr"
4341 STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
4442 STACK_YAML: "stack.yaml"
benchmark/NanoBenchmarks.hs+22−27
@@ -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.Prelude (SerialT)
10+import Streamly.Internal.Data.SVar (MonadAsync)
1411
15−import qualified Streamly.Data.Array as A
12+import qualified Streamly.Data.Array.Foreign 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
1916import qualified Streamly.Internal.Data.Stream.IsStream 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+313−1
@@ -1 +0,0 @@
1−../docs/Developer/Benchmarks.md
@@ -0,0 +1,313 @@
1+# Benchmarking
2+
3+## Benchmark Drivers
4+
5+Two benchmark drivers are supported:
6+
7+* `tasty-bench` (default)
8+* `gauge` (enabled by `--use-gauge` build flag)
9+
10+## Build and run benchmarks directly
11+
12+The benchmark executables are `tasty-bench` executables unless you have
13+passed `--use-gauge` cabal flag when building in which case it is a
14+`gauge` executable.
15+
16+```
17+$ cabal run bench:Prelude.Serial # run selected
18+$ cabal run bench:Prelude.Serial -- --help # help on arguments
19+$ cabal run bench:Prelude.Serial -- --stdev 100000 # specify arguments
20+$ cabal run bench:Prelude.Serial --flag fusion-plugin # with fusion-plugin
21+
22+$ cabal build bench:Prelude.Serial # build selected
23+$ cabal build --enable-benchmarks streamly-benchmarks # build all
24+$ cabal build --enable-benchmarks all # build all, alternate method
25+
26+$ cabal build --flag "-opt" ... # disable optimization, faster build
27+```
28+
29+## Building and Running Benchmarks with bench.sh
30+
31+`<streamly repo>/bin/bench.sh` script is the top level driver for
32+running benchmarks. It runs the requested benchmarks and then creates a
33+report from the results using the `bench-show` package.
34+
35+IMPORTANT NOTE: The first time you run this script it may take a long
36+time because it has to build the `bench-report` executable which has a
37+lot of dependencies. If you are using nix then use `--use-nix` flag
38+for the first time so that the `bench-report` executable is built using
39+nix. That can save a lot of time compiling it. However, once it is built
40+it will be cached in the `bin` directory of the repo and used from
41+there every time. You can also build it manually from the cabal file in
42+`benchmark/bench-report` and install it in the `bin` directory.
43+
44+## bench.sh: Quick start
45+
46+Useful commands:
47+
48+```
49+$ bin/bench.sh --help
50+$ bin/bench.sh --quick # run all the benchmark suites
51+$ bin/bench.sh --benchmarks help # Show available benchmark suites
52+$ bin/bench.sh --benchmarks serial_grp # Run all serial benchmark suites
53+$ bin/bench.sh --benchmarks "Prelude.Serial Data.Parser" # run selected suites
54+$ bin/bench.sh --no-measure # don't run benchmarks just show previous results
55+
56+# Run all O(1) space complexity benchmarks in `Prelude.Serial` suite
57+$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space
58+
59+# Run a specific benchmark in `Prelude.Serial` suite
60+$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space.generation.unfoldr
61+```
62+
63+Note: `bench.sh` enables fusion-plugin by default.
64+
65+## Comparing results with baseline
66+
67+```
68+# Checkout baseline commit
69+$ bin/bench.sh --quick
70+
71+# Checkout commit with new changes
72+$ bin/bench.sh --quick --append
73+
74+# To add another result to comparisons just repeat the above command on
75+# desired commit
76+```
77+
78+## Comparing benchmark suites
79+
80+First see the available benchmark suites:
81+
82+```
83+$ bin/bench.sh --benchmarks help
84+```
85+
86+You will see some benchmark suites end with `_cmp`, these are comparison
87+groups. If you run a comparison group benchmark, comparison of all the
88+benchmark suites in that group will be shown in the end. For example to compare
89+all array benchmark suites:
90+
91+```
92+$ bin/bench.sh --benchmarks array_cmp
93+```
94+
95+## Reporting without measuring
96+
97+You can use the `--no-measure` option to report the already measured results in
98+the benchmarks results file. A results file may collect an arbitrary number of
99+results by running with `--append` multiple times. Each benchmark has its own
100+results file, for example the `Prelude.Serial` benchmark has the results file at
101+`charts/Prelude.Serial/results.csv`.
102+
103+You can also manually edit the file to remove a set of results if you like or
104+to append results from previously saved results or from some other results
105+file. After editing you can run `bench.sh` with the `--no-measure` option to
106+see the reports corresponding to the results.
107+
108+## Additional benchmark configuration
109+
110+### Stream size
111+
112+You can specify the stream size (default is 100000) to be used for
113+benchmarking:
114+
115+```
116+$ cabal run bench:Prelude.Serial -- --stream-size 1000000
117+```
118+
119+### External input file
120+
121+In the `FileSystem.Handle` benchmark you can specify the input file as an
122+environment variable:
123+
124+```
125+$ export Benchmark_FileSystem_Handle_InputFile=./gutenberg-500.txt
126+$ cabal run FileSystem.Handle -- FileSystem.Handle/o-1-space/reduce/read/S.splitOnSeq
127+```
128+
129+The automatic tests do not test unicode input, this option is useful to specify
130+a unicode text file manually.
131+
132+## Benchmarking notes
133+
134+We run each benchmark in an isolated process to minimize interference
135+of benchmarks and to be able to control the RTS memory restrictions per
136+benchmark.
137+
138+### Gotchas
139+
140+Gauge forces a GC before and after the measurement. However, we have observed
141+that sometimes the GC stats may not be accurate when the number of iterations
142+in the measurement is small (e.g. 1 iteration). In such cases usually the
143+number of GCs and GC times would also be 0.
144+
145+## Diagnosing Performance Issues
146+
147+### Reproducible comparison
148+
149+When comparing different compilers we need to make sure that we are
150+using exactly the same versions of the libraries for apples to apples
151+comparison. We have seen cases where a change in the "random" library
152+caused allocations regressions in the new version of compiler because of
153+the way in which the benchmark code was generated due to the change.
154+
155+When it is required to reproduce benchmark results precisely across
156+different systems, it is recommended that you create and use a cabal
157+freeze file so that the versions of all libraries are pinned.
158+
159+### Identifying issues
160+
161+There are two ways to find problematic code:
162+
163+1. Run performance benchmarks using `bench.sh`, select the benchmarks
164+ that are taking more than expected time.
165+2. When making a new change, compare with the baseline and select benchmarks
166+ with the most regression reported by `bench.sh`.
167+
168+Number of allocations are the most stable measure that do not vary from
169+run to run. `cpuTime` and `bytesCopied` may vary. When comparing two
170+runs for regression the first thing to look at is the difference in
171+allocations. Also note that allocations may vary from run to run for
172+concurrent benchmarks.
173+
174+The next thing to look at is cpuTime. Please note that cpuTime may
175+fluctuate quite a bit, you may want to run the relevant benchmarks
176+without the --quick mode for confirming and make sure no other load is
177+running on the system when measuring.
178+
179+Usually the increase is cpuTime is proportional to the increase in
180+allocations but sometimes it may increase independently because more cpu
181+instructions are being executed. TBD - we should count the instructions
182+instead.
183+
184+### Inspection Testing
185+
186+Before you proceed make sure have to run the benchmarks with
187+`inspection` flag on. It may catch any obvious issues or regressions.
188+
189+```
190+$ cabal build --flag inspection --flag fusion-plugin --enable-benchmarks streamly-benchmarks
191+```
192+
193+### Compiling with diagnostics
194+
195+1. Comment out all other benchmarks in the given benchmark suite, and
196+ keep only the one you are examining.
197+2. Edit the file and add the following line on top:
198+
199+```
200+{-# OPTIONS_GHC
201+ -ddump-simpl
202+ -ddump-to-file
203+ -dsuppress-all
204+ -Wmissed-specialisations
205+ -Wall-missed-specialisations
206+ -fplugin-opt=Fusion.Plugin:verbose=2
207+ -fplugin-opt=Fusion.Plugin:dump-core
208+#-}
209+```
210+3. Build the benchmark suite with fusion-plugin enabled:
211+
212+```
213+$ cabal build bench:Prelude.Serial --flag fusion-plugin
214+```
215+
216+See the `.dump-simpl` file in the cabal build directory. You can find it
217+like this:
218+
219+```
220+$ find dist-newstyle/ -name "*.dump-simpl"
221+```
222+
223+Make sure you are looking into the right build dir (`--build-dir` may change
224+`dist-newstyle` to something else), and check in the appropriate GHC
225+version dir.
226+
227+### Compiling standalone example
228+
229+Sometimes you may want to create a separate program from the benchmark code
230+removing the benchmarking harness to simplify and isolate the code for better
231+reasoning and simpler core.
232+
233+Add the following GHC options at the top of your file, say, example.hs:
234+
235+```
236+{-# OPTIONS_GHC
237+ -ddump-simpl
238+ -ddump-to-file
239+ -dsuppress-all
240+ -Wmissed-specialisations
241+ -Wall-missed-specialisations
242+ -fplugin Fusion.Plugin
243+ -fplugin-opt=Fusion.Plugin:verbose=2
244+ -fplugin-opt=Fusion.Plugin:dump-core
245+#-}
246+```
247+
248+Do not include the optimization options in OPTIONS_GHC pragma, instead, specify
249+them on the command line. This is to avoid optimization failing if you import
250+another module which is not compiled with the same optimization options.
251+
252+```
253+$ cabal build # build and write ghc environment file
254+$ ghc -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 example.hs
255+```
256+
257+To pinpoint where the optimization is going wrong you can examine the
258+plugin generated core files for each optimization pass. The files are
259+numbered for each optimization pass. You can compare successive files
260+using side-by-side diff and see what the compiler is doing between each
261+pass.
262+
263+### Diagnosing the Problem
264+
265+#### Specialization Issues
266+
267+Look for missed specialization messages. When you are comparing against a
268+baseline, check if something that was specialized before is no longer
269+specialized.
270+
271+In the core you have to look for type class dictionaries e.g.
272+
273+```
274+exc_r6DD = \ @s_a6ai -> try $fMonadCatchIO $fExceptionSomeException
275+```
276+
277+Search for `$f` in the core.
278+
279+#### Fusion Issues
280+
281+Look for unfused function warnings emitted by fusion-plugin. You may
282+want to take a look at the unfused constructors or functions that
283+fusion-plugin is warning about. Beware that:
284+
285+* fusion-plugin emits warnings for unfused stuff in intermediate functions as
286+ well, those should be ignored.
287+* the constructors may remain genuinely unfused unless the loop is
288+ closed. So you should look at the warnings in the file where the loop is
289+ closed and everything is supposed to be fused.
290+
291+Also, look at the core for unfused constructors. At times you may need
292+to look for the boxed primitive type constructors e.g. W8# or I#, these
293+may not be eliminated, usually, due to strictness issues.
294+
295+Often it is useful to diff and compare the core without the problem and
296+the core with the problem especially in cases when the problem is due to
297+GHC version changes, or smaller changes in the code.
298+
299+Note, some operations are inherently fusion breaking, those cannot fuse,
300+they are usually annotated so in their documentation.
301+
302+### Resolving the problem
303+
304+Review the problematic code, see [the optimization
305+guide](dev/optimization-guidelines.md) for common problems and how to
306+solve those. If no obvious issues are found on review, then generate and
307+examine the core.
308+
309+You may want to add the `Fuse` annotation on some of those constructors
310+to make the code fuse. Please note that unnecessary `Fuse` annotations
311+may cause unnecessary inlining. Also, make sure that the constructor you
312+are adding fuse annotation is not shared by any other code where you may
313+not want inlining/fusion.
benchmark/Streamly/Benchmark/Data/Array.hs+134−69
@@ -1,112 +1,138 @@
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 #-}
9+{-# LANGUAGE FlexibleContexts #-}
510
6−#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
11+import Control.DeepSeq (NFData(..))
12+import System.Random (randomRIO)
713
8−import Control.DeepSeq (deepseq)
14+import qualified Streamly.Benchmark.Data.ArrayOps as Ops
15+import qualified Streamly.Data.Array.Foreign as A
916
17+#ifdef DATA_ARRAY
1018import qualified Streamly.Internal.Data.Array as IA
11−import qualified GHC.Exts as GHC
12−
13−-- import qualified Streamly.Data.Array as A
14−import qualified Streamly.Internal.Data.Array as A
19+#else
20+import qualified Streamly.Internal.Data.Array.Foreign as IA
21+#endif
22+import qualified Streamly.Prelude as S
1523
16−type Stream = A.Array
24+import Gauge
25+import Streamly.Benchmark.Common hiding (benchPureSrc)
26+import qualified Streamly.Benchmark.Prelude as P
1727
18−#include "Streamly/Benchmark/Data/Array/Common.hs"
28+#ifdef MEMORY_ARRAY
29+import qualified GHC.Exts as GHC
30+#endif
1931
20−instance NFData (A.Array a) where
21− {-# INLINE rnf #-}
22− rnf _ = ()
32+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
33+import Control.DeepSeq (deepseq)
34+#endif
2335
2436-------------------------------------------------------------------------------
25−-- Benchmark helpers
37+--
2638-------------------------------------------------------------------------------
2739
40+#ifdef MEMORY_ARRAY
2841-- Drain a source that generates a pure array
2942{-# INLINE benchPureSrc #-}
30−benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
43+benchPureSrc :: String -> (Int -> Ops.Stream a) -> Benchmark
3144benchPureSrc name src = benchPure name src id
45+#endif
46+
47+{-# INLINE benchIO #-}
48+benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
49+benchIO name src f = bench name $ nfIO $
50+ randomRIO (1,1) >>= src >>= return . f
3251
3352-- Drain a source that generates an array in the IO monad
3453{-# 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−-}
54+benchIOSrc ::
55+#if !defined(DATA_ARRAY_PRIM) \
56+ && !defined(DATA_ARRAY_PRIM_PINNED) \
57+ && !defined(MEMORY_ARRAY)
58+ NFData a =>
6459#endif
60+ String -> (Int -> IO (Ops.Stream a)) -> Benchmark
61+benchIOSrc name src = benchIO name src id
6562
66−{-# INLINE sourceIsList #-}
67−sourceIsList :: Int -> Int -> Stream Int
68−sourceIsList value n = GHC.fromList [n..n+value]
63+{-# INLINE benchPureSink #-}
64+benchPureSink :: NFData b => Int -> String -> (Ops.Stream Int -> b) -> Benchmark
65+benchPureSink value name f = benchIO name (Ops.sourceIntFromTo value) f
6966
70−{-# INLINE sourceIsString #-}
71−sourceIsString :: Int -> Int -> Stream P.Char
72−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
67+{-# INLINE benchIO' #-}
68+benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
69+benchIO' name src f = bench name $ nfIO $
70+ randomRIO (1,1) >>= src >>= f
7371
74−{-# INLINE sourceIntFromToFromStream #-}
75−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
76−sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
77−
78−-------------------------------------------------------------------------------
79−-- Bench groups
80−-------------------------------------------------------------------------------
72+{-# INLINE benchIOSink #-}
73+benchIOSink :: NFData b => Int -> String -> (Ops.Stream Int -> IO b) -> Benchmark
74+benchIOSink value name f = benchIO' name (Ops.sourceIntFromTo value) f
8175
8276o_1_space_generation :: Int -> [Benchmark]
8377o_1_space_generation value =
8478 [ bgroup
8579 "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)
80+ [ benchIOSrc "writeN . intFromTo" (Ops.sourceIntFromTo value)
81+#ifndef DATA_SMALLARRAY
82+ , benchIOSrc "write . intFromTo" (Ops.sourceIntFromToFromStream value)
83+#endif
84+ , benchIOSrc
85+ "fromList . intFromTo"
86+ (Ops.sourceIntFromToFromList value)
87+ , benchIOSrc "writeN . unfoldr" (Ops.sourceUnfoldr value)
88+ , benchIOSrc "writeN . fromList" (Ops.sourceFromList value)
89+#ifdef MEMORY_ARRAY
90+ , benchPureSrc "writeN . IsList.fromList" (Ops.sourceIsList value)
9091 , benchPureSrc
9192 "writeN . IsString.fromString"
92− (sourceIsString value)
93−
93+ (Ops.sourceIsString value)
94+#endif
95+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
96+#ifdef DATA_SMALLARRAY
97+ , let testStr =
98+ "fromListN " ++
99+ show (value + 1) ++
100+ "[1" ++ concat (replicate value ",1") ++ "]"
101+#else
102+ , let testStr = mkListString value
103+#endif
104+ in testStr `deepseq` (bench "read" $ nf Ops.readInstance testStr)
105+#endif
106+ , benchPureSink value "show" Ops.showInstance
94107 ]
95108 ]
96109
97110o_1_space_elimination :: Int -> [Benchmark]
98111o_1_space_elimination value =
99112 [ bgroup "elimination"
100− [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
113+ [ benchPureSink value "id" id
114+ , benchPureSink value "==" Ops.eqInstance
115+ , benchPureSink value "/=" Ops.eqInstanceNotEq
116+ , benchPureSink value "<" Ops.ordInstance
117+ , benchPureSink value "min" Ops.ordInstanceMin
118+#ifdef MEMORY_ARRAY
119+ -- length is used to check for foldr/build fusion
120+ , benchPureSink value "length . IsList.toList" (length . GHC.toList)
121+#endif
122+ , benchIOSink value "foldl'" Ops.pureFoldl'
123+ , benchIOSink value "read" Ops.unfoldReadDrain
124+ , benchIOSink value "toStreamRev" Ops.toStreamRevDrain
101125 , benchFold "writeLastN.1"
102126 (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
103127 , benchFold "writeLastN.10"
104128 (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
129+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
105130#ifdef DEVBUILD
106131{-
107− benchPureSink value "foldable/foldl'" foldableFoldl'
108− , benchPureSink value "foldable/sum" foldableSum
132+ , benchPureSink value "foldable/foldl'" Ops.foldableFoldl'
133+ , benchPureSink value "foldable/sum" Ops.foldableSum
109134-}
135+#endif
110136#endif
111137 ]
112138 ]
@@ -118,14 +144,49 @@ o_n_heap_serial value =
118144 -- Converting the stream to an array
119145 benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
120146 (P.sourceUnfoldrM value)
147+ , benchFold "writeN" (S.fold (A.writeN value))
148+ (P.sourceUnfoldrM value)
121149 ]
122150 ]
123151
152+o_1_space_transformation :: Int -> [Benchmark]
153+o_1_space_transformation value =
154+ [ bgroup "transformation"
155+ [ benchIOSink value "scanl'" (Ops.scanl' value 1)
156+ , benchIOSink value "scanl1'" (Ops.scanl1' value 1)
157+ , benchIOSink value "map" (Ops.map value 1)
158+ ]
159+ ]
160+
161+o_1_space_transformationX4 :: Int -> [Benchmark]
162+o_1_space_transformationX4 value =
163+ [ bgroup "transformationX4"
164+ [ benchIOSink value "scanl'" (Ops.scanl' value 4)
165+ , benchIOSink value "scanl1'" (Ops.scanl1' value 4)
166+ , benchIOSink value "map" (Ops.map value 4)
167+ ]
168+ ]
169+
124170moduleName :: String
171+#ifdef DATA_SMALLARRAY
172+moduleName = "Data.SmallArray"
173+#elif defined(MEMORY_ARRAY)
174+moduleName = "Data.Array.Foreign"
175+#elif defined(DATA_ARRAY_PRIM)
176+moduleName = "Data.Array.Prim"
177+#elif defined(DATA_ARRAY_PRIM_PINNED)
178+moduleName = "Data.Array.Prim.Pinned"
179+#else
125180moduleName = "Data.Array"
181+#endif
126182
183+#ifdef DATA_SMALLARRAY
184+defStreamSize :: Int
185+defStreamSize = 128
186+#else
127187defStreamSize :: Int
128188defStreamSize = defaultStreamSize
189+#endif
129190
130191main :: IO ()
131192main = runWithCLIOpts defStreamSize allBenchmarks
@@ -133,8 +194,12 @@ main = runWithCLIOpts defStreamSize allBenchmarks
133194 where
134195
135196 allBenchmarks size =
136− [ bgroup (o_1_space_prefix moduleName) $
137− o_1_space_generation size ++ o_1_space_elimination size
197+ [ bgroup (o_1_space_prefix moduleName) $ concat
198+ [ o_1_space_generation size
199+ , o_1_space_elimination size
200+ , o_1_space_transformation size
201+ , o_1_space_transformationX4 size
202+ ]
138203 , bgroup (o_n_space_prefix moduleName) $
139204 o_n_heap_serial size
140− ] ++ commonBenchmarks size
205+ ]
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.hs → benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hsrenamed+45−81
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.Data.ParserD
53-- Copyright : (c) 2020 Composewell Technologies
@@ -26,35 +24,31 @@ module Main
2624 ) where
2725
2826import Control.DeepSeq (NFData(..))
29−import Control.Monad (void, when)
30−import Control.Monad.Catch (MonadCatch)
27+import Control.Monad (void)
28+import Control.Monad.Catch (MonadThrow)
3129import Data.Functor.Identity (runIdentity)
32−import Data.Maybe (isJust)
3330import Data.Word (Word8)
34−import Streamly.Internal.Data.Stream (Stream)
35−import Streamly.Internal.Data.StreamK (StreamK)
3631import System.IO (Handle)
3732import System.Random (randomRIO)
3833import Prelude hiding ()
3934
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
35+import qualified Streamly.Prelude as Stream
36+import qualified Streamly.Internal.Data.Array.Foreign as Array
37+import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
4338import 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
39+import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
40+import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)
4741import qualified Streamly.Internal.FileSystem.Handle as Handle
4842import qualified Streamly.Internal.Unicode.Stream as Unicode
4943
50−import Test.Tasty.Bench hiding (env)
44+import Gauge hiding (env)
45+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
5146import Streamly.Benchmark.Common
5247import Streamly.Benchmark.Common.Handle
53−import Control.Monad.IO.Class (MonadIO)
5448
5549#ifdef INSPECTION
56−import Streamly.Internal.Data.MutByteArray (Unbox)
57−import Streamly.Internal.Data.Stream (Step(..))
50+import Foreign.Storable (Storable)
51+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
5852import Test.Inspection
5953#endif
6054
@@ -65,7 +59,7 @@ import Test.Inspection
6559-- XXX these can be moved to the common module
6660
6761{-# INLINE sourceUnfoldrM #-}
68−sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
62+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
6963sourceUnfoldrM value n = Stream.unfoldrM step n
7064 where
7165 step cnt =
@@ -76,7 +70,7 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
7670{-# INLINE benchIO #-}
7771benchIO
7872 :: NFData b
79− => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
73+ => String -> (Int -> t IO a) -> (t IO a -> IO b) -> Benchmark
8074benchIO name src sink =
8175 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
8276
@@ -87,11 +81,11 @@ benchIO name src sink =
8781-- | Get the last byte from a file bytestream.
8882toChunksLast :: Handle -> IO (Maybe Word8)
8983toChunksLast inh = do
90− let s = Handle.readChunks inh
84+ let s = Handle.toChunks inh
9185 larr <- Stream.last s
9286 return $ case larr of
9387 Nothing -> Nothing
94− Just arr -> Array.getIndex (Array.length arr - 1) arr
88+ Just arr -> Array.getIndex arr (Array.length arr - 1)
9589
9690#ifdef INSPECTION
9791inspect $ hasNoTypeClasses 'toChunksLast
@@ -101,8 +95,8 @@ inspect $ 'toChunksLast `hasNoType` ''Step
10195-- | Count the number of bytes in a file.
10296toChunksSumLengths :: Handle -> IO Int
10397toChunksSumLengths inh =
104− let s = Handle.readChunks inh
105− in Stream.fold Fold.sum (Stream.map Array.length s)
98+ let s = Handle.toChunks inh
99+ in Stream.sum (Stream.map Array.length s)
106100
107101#ifdef INSPECTION
108102inspect $ hasNoTypeClasses 'toChunksSumLengths
@@ -112,8 +106,8 @@ inspect $ 'toChunksSumLengths `hasNoType` ''Step
112106-- | Sum the bytes in a file.
113107toChunksCountBytes :: Handle -> IO Word8
114108toChunksCountBytes inh = do
115− let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
116− let s = Handle.readChunks inh
109+ let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream
110+ let s = Handle.toChunks inh
117111 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118112
119113#ifdef INSPECTION
@@ -123,7 +117,7 @@ inspect $ 'toChunksCountBytes `hasNoType` ''Step
123117
124118toChunksDecodeUtf8Arrays :: Handle -> IO ()
125119toChunksDecodeUtf8Arrays =
126− Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
120+ Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
127121
128122#ifdef INSPECTION
129123inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
@@ -137,9 +131,7 @@ inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
137131-- | Count the number of lines in a file.
138132toChunksSplitOnSuffix :: Handle -> IO Int
139133toChunksSplitOnSuffix =
140− Stream.fold Fold.length
141− . ArrayStream.splitOnSuffix 10
142− . Handle.readChunks
134+ Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
143135
144136#ifdef INSPECTION
145137inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
@@ -149,10 +141,7 @@ inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
149141-- XXX use a word splitting combinator instead of splitOn and test it.
150142-- | Count the number of words in a file.
151143toChunksSplitOn :: Handle -> IO Int
152−toChunksSplitOn =
153− Stream.fold Fold.length
154− . ArrayStream.splitOn 32
155− . Handle.readChunks
144+toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks
156145
157146#ifdef INSPECTION
158147inspect $ hasNoTypeClasses 'toChunksSplitOn
@@ -190,11 +179,12 @@ o_1_space_read_chunked env =
190179copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
191180copyChunksSplitInterposeSuffix inh outh =
192181 Stream.fold (Handle.write outh)
193− $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
194− $ Handle.readChunks inh
182+ $ ArrayStream.interposeSuffix 10
183+ $ ArrayStream.splitOnSuffix 10
184+ $ Handle.toChunks inh
195185
196186#ifdef INSPECTION
197−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
187+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
198188inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
199189#endif
200190
@@ -203,12 +193,13 @@ inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
203193copyChunksSplitInterpose :: Handle -> Handle -> IO ()
204194copyChunksSplitInterpose inh outh =
205195 Stream.fold (Handle.write outh)
196+ $ ArrayStream.interpose 32
206197 -- XXX this is not correct word splitting combinator
207− $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
208− $ Handle.readChunks inh
198+ $ ArrayStream.splitOn 32
199+ $ Handle.toChunks inh
209200
210201#ifdef INSPECTION
211−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
202+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
212203inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
213204#endif
214205
@@ -227,53 +218,30 @@ o_1_space_copy_toChunks_group_ungroup env =
227218-------------------------------------------------------------------------------
228219
229220{-# INLINE drainWhile #-}
230−drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
231−drainWhile p = Parser.takeWhile p Fold.drain
221+drainWhile :: MonadThrow m => (a -> Bool) -> ParserD.Parser m a ()
222+drainWhile p = ParserD.takeWhile p Fold.drain
232223
233224-------------------------------------------------------------------------------
234225-- Folds and parsers
235226-------------------------------------------------------------------------------
236227
237228{-# 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
229+fold :: SerialT IO (Array.Array Int) -> IO ()
230+fold s = void $ ArrayStream.fold Fold.drain s
231+
232+{-# INLINE parseArray #-}
233+parseArray :: Int -> SerialT IO (Array.Array Int) -> IO ()
234+parseArray value s = void $ ArrayStream.parse (drainWhile (< value)) s
259235
260236o_1_space_serial_array ::
261237 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
262238o_1_space_serial_array bound arraysSmall arraysBig =
263239 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
264240 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265− , benchIO
266− "foldBreak (recursive, small arrays)"
267− (\_ -> Stream.fromList arraysSmall)
268− (foldBreak . StreamK.fromStream)
269241 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
270− $ parse bound
242+ $ parseArray bound
271243 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
272− $ parse bound
273− , benchIO
274− "parseBreak (recursive, small arrays)"
275− (\_ -> Stream.fromList arraysSmall)
276− (parseBreak . StreamK.fromStream)
244+ $ parseArray bound
277245 ]
278246
279247-------------------------------------------------------------------------------
@@ -281,7 +249,7 @@ o_1_space_serial_array bound arraysSmall arraysBig =
281249-------------------------------------------------------------------------------
282250
283251moduleName :: String
284−moduleName = "Data.Array.Stream"
252+moduleName = "Data.Array.Stream.Foreign"
285253
286254main :: IO ()
287255main = do
@@ -290,14 +258,10 @@ main = do
290258
291259 where
292260
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)
261+ alloc value = do
262+ small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0
263+ big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0
264+ return (small, big)
301265
302266 allBenchmarks env arrays value =
303267 let (arraysSmall, arraysBig) = arrays
benchmark/Streamly/Benchmark/Data/ArrayOps.hsnew file+246
@@ -0,0 +1,246 @@
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_ARRAY_PRIM
16+-- DATA_ARRAY_PRIM_PINNED
17+-- DATA_SMALLARRAY
18+
19+module Streamly.Benchmark.Data.ArrayOps where
20+
21+import Control.Monad.IO.Class (MonadIO)
22+import Prelude (Bool, Int, Maybe(..), ($), (+), (.), (==), (>), undefined)
23+
24+import qualified Prelude as P
25+import qualified Streamly.Prelude as S
26+
27+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
28+#ifdef DEVBUILD
29+{-
30+import qualified Data.Foldable as F
31+-}
32+#endif
33+#endif
34+
35+#ifdef DATA_SMALLARRAY
36+import qualified Streamly.Internal.Data.SmallArray as A
37+type Stream = A.SmallArray
38+#elif defined(MEMORY_ARRAY)
39+import qualified GHC.Exts as GHC
40+import qualified Streamly.Data.Array.Foreign as A
41+import qualified Streamly.Internal.Data.Array.Foreign as A
42+type Stream = A.Array
43+#elif defined(DATA_ARRAY_PRIM)
44+import qualified Streamly.Internal.Data.Array.Prim as A
45+type Stream = A.Array
46+#elif defined(DATA_ARRAY_PRIM_PINNED)
47+import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
48+type Stream = A.Array
49+#elif defined(DATA_ARRAY)
50+import qualified Streamly.Internal.Data.Array as A
51+type Stream = A.Array
52+#endif
53+
54+-------------------------------------------------------------------------------
55+-- Benchmark ops
56+-------------------------------------------------------------------------------
57+
58+-------------------------------------------------------------------------------
59+-- Stream generation and elimination
60+-------------------------------------------------------------------------------
61+
62+-------------------------------------------------------------------------------
63+-- CPP Common to:
64+-- MEMORY_ARRAY
65+-- DATA_ARRAY
66+-- DATA_ARRAY_PRIM
67+-- DATA_ARRAY_PRIM_PINNED
68+-- DATA_SMALLARRAY
69+-------------------------------------------------------------------------------
70+
71+{-# INLINE sourceUnfoldr #-}
72+sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
73+sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n
74+ where
75+ step cnt =
76+ if cnt > n + value
77+ then Nothing
78+ else (Just (cnt, cnt + 1))
79+
80+{-# INLINE sourceIntFromTo #-}
81+sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
82+sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
83+
84+{-# INLINE sourceFromList #-}
85+sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
86+sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]
87+
88+-- Different defination of sourceIntFromToFromList for DATA_SMALLARRAY
89+-- CPP:
90+{-# INLINE sourceIntFromToFromList #-}
91+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
92+#ifndef DATA_SMALLARRAY
93+sourceIntFromToFromList value n = P.return $ A.fromList $ [n..n + value]
94+#else
95+sourceIntFromToFromList value n = P.return $ A.fromListN value $ [n..n + value]
96+#endif
97+
98+-------------------------------------------------------------------------------
99+-- CPP Common to:
100+-- MEMORY_ARRAY
101+-- DATA_ARRAY
102+-- DATA_ARRAY_PRIM
103+-- DATA_ARRAY_PRIM_PINNED
104+-------------------------------------------------------------------------------
105+
106+-- CPP:
107+#ifndef DATA_SMALLARRAY
108+{-# INLINE sourceIntFromToFromStream #-}
109+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
110+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
111+#endif
112+
113+-------------------------------------------------------------------------------
114+-- CPP Common to:
115+-- MEMORY_ARRAY
116+-------------------------------------------------------------------------------
117+
118+-- CPP:
119+#ifdef MEMORY_ARRAY
120+{-# INLINE sourceIsList #-}
121+sourceIsList :: Int -> Int -> Stream Int
122+sourceIsList value n = GHC.fromList [n..n+value]
123+
124+{-# INLINE sourceIsString #-}
125+sourceIsString :: Int -> Int -> Stream P.Char
126+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
127+#endif
128+
129+-------------------------------------------------------------------------------
130+-- Transformation
131+-------------------------------------------------------------------------------
132+
133+-------------------------------------------------------------------------------
134+-- CPP Common to:
135+-- MEMORY_ARRAY
136+-- DATA_ARRAY
137+-- DATA_ARRAY_PRIM
138+-- DATA_ARRAY_PRIM_PINNED
139+-- DATA_SMALLARRAY
140+-------------------------------------------------------------------------------
141+
142+{-# INLINE composeN #-}
143+composeN :: P.Monad m
144+ => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
145+composeN n f x =
146+ case n of
147+ 1 -> f x
148+ 2 -> f x P.>>= f
149+ 3 -> f x P.>>= f P.>>= f
150+ 4 -> f x P.>>= f P.>>= f P.>>= f
151+ _ -> undefined
152+
153+{-# INLINE scanl' #-}
154+{-# INLINE scanl1' #-}
155+{-# INLINE map #-}
156+
157+scanl' , scanl1', map
158+ :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
159+
160+
161+{-# INLINE onArray #-}
162+onArray
163+ :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)
164+ -> Stream Int
165+ -> m (Stream Int)
166+onArray value f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
167+
168+scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0
169+scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)
170+map value n = composeN n $ onArray value $ S.map (+1)
171+-- map n = composeN n $ A.map (+1)
172+
173+{-# INLINE eqInstance #-}
174+eqInstance :: Stream Int -> Bool
175+eqInstance src = src == src
176+
177+{-# INLINE eqInstanceNotEq #-}
178+eqInstanceNotEq :: Stream Int -> Bool
179+eqInstanceNotEq src = src P./= src
180+
181+{-# INLINE ordInstance #-}
182+ordInstance :: Stream Int -> Bool
183+ordInstance src = src P.< src
184+
185+{-# INLINE ordInstanceMin #-}
186+ordInstanceMin :: Stream Int -> Stream Int
187+ordInstanceMin src = P.min src src
188+
189+{-# INLINE showInstance #-}
190+showInstance :: Stream Int -> P.String
191+showInstance src = P.show src
192+
193+{-# INLINE pureFoldl' #-}
194+pureFoldl' :: MonadIO m => Stream Int -> m Int
195+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
196+
197+-------------------------------------------------------------------------------
198+-- CPP Common to:
199+-- MEMORY_ARRAY
200+-- DATA_ARRAY
201+-- DATA_SMALLARRAY
202+-------------------------------------------------------------------------------
203+
204+-- CPP:
205+#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
206+{-# INLINE readInstance #-}
207+readInstance :: P.String -> Stream Int
208+readInstance str =
209+ let r = P.reads str
210+ in case r of
211+ [(x,"")] -> x
212+ _ -> P.error "readInstance: no parse"
213+
214+#ifdef DEVBUILD
215+{-
216+{-# INLINE foldableFoldl' #-}
217+foldableFoldl' :: Stream Int -> Int
218+foldableFoldl' = F.foldl' (+) 0
219+
220+{-# INLINE foldableSum #-}
221+foldableSum :: Stream Int -> Int
222+foldableSum = P.sum
223+-}
224+#endif
225+#endif
226+
227+-------------------------------------------------------------------------------
228+-- Elimination
229+-------------------------------------------------------------------------------
230+
231+-------------------------------------------------------------------------------
232+-- CPP Common to:
233+-- MEMORY_ARRAY
234+-- DATA_ARRAY
235+-- DATA_ARRAY_PRIM
236+-- DATA_ARRAY_PRIM_PINNED
237+-- DATA_SMALLARRAY
238+-------------------------------------------------------------------------------
239+
240+{-# INLINE unfoldReadDrain #-}
241+unfoldReadDrain :: MonadIO m => Stream Int -> m ()
242+unfoldReadDrain = S.drain . S.unfold A.read
243+
244+{-# INLINE toStreamRevDrain #-}
245+toStreamRevDrain :: MonadIO m => Stream Int -> m ()
246+toStreamRevDrain = S.drain . A.toStreamRev
benchmark/Streamly/Benchmark/Data/Fold.hs+138−297
@@ -6,51 +6,35 @@
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(..))
13+import Data.Functor.Identity (Identity)
2614import Data.Map.Strict (Map)
27−import Data.Hashable (Hashable)
28−import Data.HashMap.Strict (HashMap)
29−import Data.IntMap.Strict (IntMap)
3015import Data.Monoid (Last(..), Sum(..))
3116import System.Random (randomRIO)
3217
33−import Streamly.Internal.Data.Stream (Stream)
18+import Streamly.Prelude (SerialT)
3419import Streamly.Internal.Data.Fold (Fold(..))
35−import Streamly.Internal.Data.IsMap.HashMap ()
36−import Streamly.Internal.Data.MutArray (MutArray)
3720
21+import qualified Data.Map.Strict as Map
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
24+import qualified Streamly.Internal.Data.Sink as Sink
25+import qualified Streamly.Internal.Data.Stream.IsStream as IP
26+import qualified Streamly.Prelude as S
4327
44−import Test.Tasty.Bench
28+import Gauge
4529import Streamly.Benchmark.Common
46−import Prelude hiding (all, any, take, unzip, sequence_, filter)
30+import Prelude hiding (all, any, take, unzip, sequence_)
4731
4832-- We need a monadic bind here to make sure that the function f does not get
4933-- completely optimized out by the compiler in some cases.
5034
5135{-# INLINE sourceUnfoldrM #-}
52−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
53−sourceUnfoldrM value n = Stream.unfoldrM step n
36+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
37+sourceUnfoldrM value n = S.unfoldrM step n
5438 where
5539 step cnt =
5640 if cnt > n + value
@@ -58,14 +42,14 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
5842 else return (Just (cnt, cnt + 1))
5943
6044{-# INLINE source #-}
61−source :: Monad m => Int -> Int -> Stream m Int
45+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
6246source = sourceUnfoldrM
6347
6448-- | Takes a fold method, and uses it with a default source.
6549{-# INLINE benchIOSink #-}
6650benchIOSink
67− :: NFData b
68− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
51+ :: (S.IsStream t, NFData b)
52+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
6953benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
7054
7155-------------------------------------------------------------------------------
@@ -73,16 +57,16 @@ benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source va
7357-------------------------------------------------------------------------------
7458
7559{-# INLINE any #-}
76−any :: (Monad m, Ord a) => a -> Stream m a -> m Bool
77−any value = Stream.fold (FL.any (> value))
60+any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
61+any value = IP.fold (FL.any (> value))
7862
7963{-# INLINE all #-}
80−all :: (Monad m, Ord a) => a -> Stream m a -> m Bool
81−all value = Stream.fold (FL.all (<= value))
64+all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
65+all value = IP.fold (FL.all (<= value))
8266
8367{-# INLINE take #-}
84−take :: Monad m => Int -> Stream m a -> m ()
85−take value = Stream.fold (FL.take value FL.drain)
68+take :: Monad m => Int -> SerialT m a -> m ()
69+take value = IP.fold (FL.take value FL.drain)
8670
8771{-# INLINE sequence_ #-}
8872sequence_ :: Monad m => Int -> Fold m a ()
@@ -94,80 +78,55 @@ sequence_ value =
9478 {-# INLINE f #-}
9579 f m k = FL.concatMap (const k) m
9680
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−
11681-------------------------------------------------------------------------------
11782-- Splitting by serial application
11883-------------------------------------------------------------------------------
11984
12085{-# INLINE takeEndBy_ #-}
121−takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()
122−takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)
86+takeEndBy_ :: Monad m => Int -> SerialT m Int -> m ()
87+takeEndBy_ value = IP.fold (FL.takeEndBy_ (>= value) FL.drain)
12388
12489{-# INLINE many #-}
125−many :: Monad m => Stream m Int -> m ()
126−many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)
90+many :: Monad m => SerialT m Int -> m ()
91+many = IP.fold (FL.many (FL.take 1 FL.drain) FL.drain)
12792
12893{-# INLINE splitAllAny #-}
129−splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool)
94+splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)
13095splitAllAny value =
131− Stream.fold
132− (FL.splitWith (,)
96+ IP.fold
97+ (FL.serialWith (,)
13398 (FL.all (<= (value `div` 2)))
13499 (FL.any (> value))
135100 )
136101
137−{-# INLINE split_ #-}
138−split_ :: Monad m => Int -> Stream m Int -> m Bool
139−split_ value =
140− Stream.fold
141− (FL.split_
102+{-# INLINE serial_ #-}
103+serial_ :: Monad m => Int -> SerialT m Int -> m Bool
104+serial_ value =
105+ IP.fold
106+ (FL.serial_
142107 (FL.all (<= (value `div` 2)))
143108 (FL.any (> value))
144109 )
145110
146111{-# INLINE shortest #-}
147−shortest :: Monad m => Stream m Int -> m (Either Int Int)
148−shortest = Stream.fold (FL.shortest FL.sum FL.length)
112+shortest :: Monad m => SerialT m Int -> m (Either Int Int)
113+shortest = IP.fold (FL.shortest FL.sum FL.length)
149114
150115{-# 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
116+longest :: Monad m => SerialT m Int -> m (Either Int Int)
117+longest = IP.fold (FL.longest FL.sum FL.length)
159118
160119-------------------------------------------------------------------------------
161120-- Distributing by parallel application
162121-------------------------------------------------------------------------------
163122
164123{-# INLINE teeSumLength #-}
165−teeSumLength :: Monad m => Stream m Int -> m (Int, Int)
166−teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)
124+teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
125+teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)
167126
168127{-# INLINE teeAllAny #-}
169−teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)
170−teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
128+teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)
129+teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
171130
172131 where
173132
@@ -175,16 +134,16 @@ teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
175134 any_ = FL.any (> value)
176135
177136{-# INLINE teeWithFst #-}
178−teeWithFst :: Monad m => Stream m Int -> m (Int, Int)
179−teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)
137+teeWithFst :: Monad m => SerialT m Int -> m (Int, Int)
138+teeWithFst = IP.fold (FL.teeWithFst (,) FL.sum FL.length)
180139
181140{-# INLINE teeWithMin #-}
182−teeWithMin :: Monad m => Stream m Int -> m (Int, Int)
183−teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)
141+teeWithMin :: Monad m => SerialT m Int -> m (Int, Int)
142+teeWithMin = IP.fold (FL.teeWithMin (,) FL.sum FL.length)
184143
185144{-# INLINE distribute #-}
186−distribute :: Monad m => Stream m Int -> m [Int]
187−distribute = Stream.fold (FL.distribute [FL.sum, FL.length])
145+distribute :: Monad m => SerialT m Int -> m [Int]
146+distribute = IP.fold (FL.distribute [FL.sum, FL.length])
188147
189148-------------------------------------------------------------------------------
190149-- Partitioning
@@ -195,99 +154,61 @@ oddEven :: Int -> Either Int Int
195154oddEven x = if odd x then Left x else Right x
196155
197156{-# 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)
157+partition :: Monad m => SerialT m Int -> m (Int, Int)
158+partition = IP.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
200159
201160{-# INLINE partitionByFstM #-}
202−partitionByFstM :: Monad m => Stream m Int -> m (Int, Int)
161+partitionByFstM :: Monad m => SerialT m Int -> m (Int, Int)
203162partitionByFstM =
204− Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
163+ IP.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
205164
206165{-# INLINE partitionByMinM #-}
207−partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)
166+partitionByMinM :: Monad m => SerialT m Int -> m (Int, Int)
208167partitionByMinM =
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)
168+ IP.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
169+
170+{-# INLINE demuxWith #-}
171+demuxWith ::
172+ (Monad m, Ord k)
173+ => (a -> (k, a'))
174+ -> Map k (Fold m a' b)
175+ -> SerialT m a
176+ -> m (Map k b)
177+demuxWith f mp = S.fold (FL.demuxWith f mp)
178+
179+{-# INLINE demuxDefaultWith #-}
180+demuxDefaultWith ::
181+ (Monad m, Ord k, Num b)
182+ => (a -> (k, b))
183+ -> Map k (Fold m b b)
184+ -> SerialT m a
185+ -> m (Map k b, b)
186+demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.lmap snd FL.sum))
187+
188+{-# INLINE classifyWith #-}
189+classifyWith ::
190+ (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)
191+classifyWith f = S.fold (FL.classifyWith f FL.sum)
260192
261193-------------------------------------------------------------------------------
262194-- unzip
263195-------------------------------------------------------------------------------
264196
265197{-# 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)
198+unzip :: Monad m => SerialT m Int -> m (Int, Int)
199+unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
268200
269201{-# INLINE unzipWithFstM #-}
270−unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
202+unzipWithFstM :: Monad m => SerialT m Int -> m (Int, Int)
271203unzipWithFstM = do
272− let f a = return (a + 1, a)
273− Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
204+ let f = \a -> return (a + 1, a)
205+ IP.fold (FL.unzipWithFstM f FL.sum FL.length)
274206
275207{-# INLINE unzipWithMinM #-}
276−unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
208+unzipWithMinM :: Monad m => SerialT m Int -> m (Int, Int)
277209unzipWithMinM = 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))
210+ let f = \a -> return (a + 1, a)
211+ IP.fold (FL.unzipWithMinM f FL.sum FL.length)
291212
292213-------------------------------------------------------------------------------
293214-- Benchmarks
@@ -296,113 +217,92 @@ unfoldMany val =
296217moduleName :: String
297218moduleName = "Data.Fold"
298219
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−
307220o_1_space_serial_elimination :: Int -> [Benchmark]
308221o_1_space_serial_elimination value =
309222 [ 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)
223+ [ benchIOSink value "drain" (S.fold FL.drain)
224+ , benchIOSink value "drainBy" (S.fold (FL.drainBy return))
225+ , benchIOSink value "drainN" (S.fold (FL.drainN value))
226+ , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
227+ , benchIOSink value "last" (S.fold FL.last)
228+ , benchIOSink value "length" (S.fold FL.length)
229+ , benchIOSink value "sum" (S.fold FL.sum)
230+ , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))
231+ , benchIOSink value "product" (S.fold FL.product)
232+ , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
233+ , benchIOSink value "maximum" (S.fold FL.maximum)
234+ , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
235+ , benchIOSink value "minimum" (S.fold FL.minimum)
324236 , benchIOSink
325237 value
326238 "mean"
327− (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))
239+ (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))
328240 , benchIOSink
329241 value
330242 "variance"
331− (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))
243+ (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))
332244 , benchIOSink
333245 value
334246 "stdDev"
335− (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))
247+ (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))
336248 , benchIOSink
337249 value
338250 "mconcat"
339− (Stream.fold FL.mconcat . fmap (Last . Just))
251+ (S.fold FL.mconcat . S.map (Last . Just))
340252 , benchIOSink
341253 value
342254 "foldMap"
343− (Stream.fold (FL.foldMap (Last . Just)))
255+ (S.fold (FL.foldMap (Last . Just)))
344256 , benchIOSink
345257 value
346258 "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))))
259+ (S.fold (FL.foldMapM (return . Last . Just)))
260+ , benchIOSink value "index" (S.fold (FL.index (value + 1)))
261+ , benchIOSink value "head" (S.fold FL.head)
262+ , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
351263 , benchIOSink
352264 value
353265 "lookup"
354− (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
266+ (S.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
355267 , benchIOSink
356268 value
357269 "findIndex"
358− (Stream.fold (FL.findIndex (== (value + 1))))
270+ (S.fold (FL.findIndex (== (value + 1))))
359271 , benchIOSink
360272 value
361273 "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)))
274+ (S.fold (FL.elemIndex (value + 1)))
275+ , benchIOSink value "null" (S.fold FL.null)
276+ , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
277+ , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
366278 , benchIOSink value "all" $ all value
367279 , benchIOSink value "any" $ any value
368280 , benchIOSink value "take" $ take value
369281 , 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)))
282+ , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))
283+ , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))
372284 ]
373285 ]
374286
375287o_1_space_serial_transformation :: Int -> [Benchmark]
376288o_1_space_serial_transformation value =
377289 [ bgroup "transformation"
378− [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))
290+ [ benchIOSink value "map" (S.fold (FL.lmap (+ 1) FL.drain))
379291 , let f x = if even x then Just x else Nothing
380292 fld = FL.mapMaybe f FL.drain
381− in benchIOSink value "mapMaybe" (Stream.fold fld)
293+ in benchIOSink value "mapMaybe" (S.fold fld)
382294 , benchIOSink
383295 value
384296 "rsequence"
385− (Stream.fold (FL.rmapM id (return <$> FL.drain)))
386− , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))
297+ (S.fold (FL.rmapM id (return <$> FL.drain)))
298+ , benchIOSink value "rmapM" (S.fold (FL.rmapM return FL.drain))
387299 , benchIOSink
388300 value
389301 "pipe-mapM"
390− (Stream.fold
302+ (S.fold
391303 (FL.transform
392304 (Pipe.mapM (\x -> return $ x + 1))
393305 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)
406306 ]
407307 ]
408308
@@ -410,15 +310,10 @@ o_1_space_serial_composition :: Int -> [Benchmark]
410310o_1_space_serial_composition value =
411311 [ bgroup
412312 "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
313+ [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
314+ , benchIOSink value "serial_ (all, any)" $ serial_ value
419315 , benchIOSink value "tee (all, any)" $ teeAllAny value
420316 , benchIOSink value "many drain (take 1)" many
421− , bench "unfoldMany" $ unfoldMany value
422317 , benchIOSink value "shortest (sum, length)" shortest
423318 , benchIOSink value "longest (sum, length)" longest
424319 , benchIOSink value "tee (sum, length)" teeSumLength
@@ -431,12 +326,23 @@ o_1_space_serial_composition value =
431326 , benchIOSink value "unzip (sum, length)" unzip
432327 , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
433328 , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
329+ , benchIOSink value "demuxDefaultWith [sum, length] sum"
330+ $ demuxDefaultWith fn mp
331+ , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
332+ , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)
434333 ]
435334 ]
436335
336+ where
337+
338+ -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.
339+ fn x = (x `mod` 3, x)
340+
341+ mp = Map.fromList [(0, FL.sum), (1, FL.length)]
342+
437343o_n_space_serial :: Int -> [Benchmark]
438344o_n_space_serial value =
439− [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))
345+ [ benchIOSink value "sequence_/100" $ S.fold (sequence_ (value `div` 100))
440346 ]
441347
442348o_n_heap_serial :: Int -> [Benchmark]
@@ -445,71 +351,23 @@ o_n_heap_serial value =
445351 -- Left folds for building a structure are inherently non-streaming
446352 -- as the structure cannot be lazily consumed until fully built.
447353 [
448− benchIOSink value "toList" (Stream.fold FL.toList)
449− , benchIOSink value "toListRev" (Stream.fold FL.toListRev)
354+ benchIOSink value "toList" (S.fold FL.toList)
355+ , benchIOSink value "toListRev" (S.fold FL.toListRev)
450356 , benchIOSink value "toStream"
451− (Stream.fold FL.toStream
452− :: Stream IO a -> IO (Stream Identity a))
357+ (S.fold FL.toStream
358+ :: SerialT IO a -> IO (SerialT Identity a))
453359 , 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)
360+ (S.fold FL.toStreamRev
361+ :: SerialT IO a -> IO (SerialT Identity a))
492362 ]
493363 ]
494364
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−
505365-------------------------------------------------------------------------------
506366-- Driver
507367-------------------------------------------------------------------------------
508368
509369main :: IO ()
510−main = do
511−#ifndef FUSION_CHECK
512− runWithCLIOpts defaultStreamSize allBenchmarks
370+main = runWithCLIOpts defaultStreamSize allBenchmarks
513371
514372 where
515373
@@ -522,20 +380,3 @@ main = do
522380 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
523381 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
524382 ]
525−#else
526− -- Enable FUSION_CHECK macro at the beginning of the file
527− -- Enable one benchmark below, and run the benchmark
528− -- Check the .dump-simpl output
529− let value = 100000
530− let input = source value 1
531− let getKey buckets = (`mod` buckets)
532− let getFold k =
533− return $ case k of
534− 0 -> FL.sum
535− 1 -> FL.length
536− _ -> FL.length
537−
538− -- demuxToMap (getKey 64) (getFold . getKey 64) input
539− toIntMapIO (getKey 64) input
540− return ()
541−#endif
benchmark/Streamly/Benchmark/Data/Fold/Window.hsdeleted−191
@@ -1,191 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−module Main (main) where
4−
5−import Control.DeepSeq (NFData)
6−import Streamly.Data.Fold (Fold)
7−import Streamly.Internal.Data.Stream (Stream)
8−import System.Random (randomRIO)
9−
10−import qualified Streamly.Data.Fold as Fold
11−import qualified Streamly.Internal.Data.Fold as Window
12−import qualified Streamly.Internal.Data.Ring as Ring
13−import qualified Streamly.Internal.Data.Stream as Stream
14−
15−import Streamly.Benchmark.Common
16−import Test.Tasty.Bench
17−
18−{-# INLINE source #-}
19−source :: (Monad m, Num a, Stream.Enumerable a) =>
20− Int -> a -> Stream m a
21−source len from =
22− Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)
23−
24−{-# INLINE sourceDescending #-}
25−sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>
26− Int -> a -> Stream m a
27−sourceDescending len from =
28− Stream.enumerateFromThenTo
29− (from + fromIntegral len)
30− (from + fromIntegral (len - 1))
31− from
32−
33−{-# INLINE sourceDescendingInt #-}
34−sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int
35−sourceDescendingInt = sourceDescending
36−
37−{-# INLINE benchWith #-}
38−benchWith :: (Num a, NFData b) =>
39− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
40−benchWith src len name f =
41− bench name
42− $ nfIO
43− $ randomRIO (1, 1 :: Int) >>= Stream.fold f . src len . fromIntegral
44−
45−{-# INLINE benchWithFold #-}
46−benchWithFold :: NFData a => Int -> String -> Fold IO Double a -> Benchmark
47−benchWithFold = benchWith source
48−
49−{-# INLINE benchWithFoldInt #-}
50−benchWithFoldInt :: Int -> String -> Fold IO Int Int -> Benchmark
51−benchWithFoldInt = benchWith source
52−
53−{-# INLINE benchScanWith #-}
54−benchScanWith :: Num a =>
55− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
56−benchScanWith src len name f =
57− bench name
58− $ nfIO
59− $ randomRIO (1, 1 :: Int)
60− >>= Stream.fold Fold.drain
61− . Stream.postscan f
62− . src len
63− . fromIntegral
64−
65−{-# INLINE benchWithPostscan #-}
66−benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark
67−benchWithPostscan = benchScanWith source
68−
69−o_1_space_folds :: Int -> [Benchmark]
70−o_1_space_folds numElements =
71− [ bgroup "fold"
72− [ benchWithFold numElements "minimum (window size 100)"
73− (Window.windowMinimum 100)
74− , benchWithFold numElements "minimum (window size 1000)"
75− (Window.windowMinimum 1000)
76− , benchWith sourceDescendingInt numElements
77− "minimum descending (window size 1000)"
78− (Window.windowMinimum 1000)
79−
80− , benchWithFold numElements "maximum (window size 100)"
81− (Window.windowMaximum 100)
82− , benchWithFold numElements "maximum (window size 1000)"
83− (Window.windowMaximum 1000)
84− , benchWith sourceDescendingInt numElements
85− "maximum descending (window size 1000)"
86− (Window.windowMaximum 1000)
87−
88− , benchWithFold numElements "range (window size 100)"
89− (Window.windowRange 100)
90− , benchWithFold numElements "range (window size 1000)"
91− (Window.windowRange 1000)
92− , benchWith sourceDescendingInt numElements
93− "range descending (window size 1000)"
94− (Window.windowRange 1000)
95−
96− , benchWithFoldInt numElements "sumInt (window size 100)"
97− (Ring.slidingWindow 100 Window.windowSumInt)
98− , benchWithFoldInt numElements "sum for Int (window size 100)"
99− (Ring.slidingWindow 100 Window.windowSum)
100− , benchWithFold numElements "sum (window size 100)"
101− (Ring.slidingWindow 100 Window.windowSum)
102− , benchWithFold numElements "sum (window size 1000)"
103− (Ring.slidingWindow 1000 Window.windowSum)
104− , benchWithFold numElements "sum (entire stream)"
105− (Window.cumulative Window.windowSum)
106− , benchWithFold numElements "sum (Data.Fold)"
107− Fold.sum
108−
109− , benchWithFold numElements "mean (window size 100)"
110− (Ring.slidingWindow 100 Window.windowMean)
111− , benchWithFold numElements "mean (window size 1000)"
112− (Ring.slidingWindow 1000 Window.windowMean)
113− , benchWithFold numElements "mean (entire stream)"
114− (Window.cumulative Window.windowMean)
115− , benchWithFold numElements "mean (Data.Fold)"
116− Fold.mean
117−
118− , benchWithFold numElements "powerSum 2 (window size 100)"
119− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
120− , benchWithFold numElements "powerSum 2 (entire stream)"
121− (Window.cumulative (Window.windowPowerSum 2))
122−
123− ]
124− ]
125−
126−o_1_space_scans :: Int -> [Benchmark]
127−o_1_space_scans numElements =
128− [ bgroup "scan"
129− [ benchWithPostscan numElements "minimum (window size 10)"
130− (Window.windowMinimum 10)
131− -- Below window size 30 the linear search based impl performs better
132− -- than the dequeue based implementation.
133− , benchWithPostscan numElements "minimum (window size 30)"
134− (Window.windowMinimum 30)
135− , benchWithPostscan numElements "minimum (window size 1000)"
136− (Window.windowMinimum 1000)
137− , benchScanWith sourceDescendingInt numElements
138− "minimum descending (window size 1000)"
139− (Window.windowMinimum 1000)
140−
141− , benchWithPostscan numElements "maximum (window size 10)"
142− (Window.windowMaximum 10)
143− , benchWithPostscan numElements "maximum (window size 30)"
144− (Window.windowMaximum 30)
145− , benchWithPostscan numElements "maximum (window size 1000)"
146− (Window.windowMaximum 1000)
147− , benchScanWith sourceDescendingInt numElements
148− "maximum descending (window size 1000)"
149− (Window.windowMaximum 1000)
150−
151− , benchWithPostscan numElements "range (window size 10)"
152− (Window.windowRange 10)
153− , benchWithPostscan numElements "range (window size 30)"
154− (Window.windowRange 30)
155− , benchWithPostscan numElements "range (window size 1000)"
156− (Window.windowRange 1000)
157− , benchScanWith sourceDescendingInt numElements
158− "range descending (window size 1000)"
159− (Window.windowRange 1000)
160−
161− , benchWithPostscan numElements "sum (window size 100)"
162− (Ring.slidingWindow 100 Window.windowSum)
163− , benchWithPostscan numElements "sum (window size 1000)"
164− (Ring.slidingWindow 1000 Window.windowSum)
165−
166− , benchWithPostscan numElements "mean (window size 100)"
167− (Ring.slidingWindow 100 Window.windowMean)
168− , benchWithPostscan numElements "mean (window size 1000)"
169− (Ring.slidingWindow 1000 Window.windowMean)
170−
171− , benchWithPostscan numElements "powerSum 2 (window size 100)"
172− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
173− , benchWithPostscan numElements "powerSum 2 (window size 1000)"
174− (Ring.slidingWindow 1000 (Window.windowPowerSum 2))
175− ]
176− ]
177−
178−moduleName :: String
179−moduleName = "Data.Fold.Window"
180−
181−main :: IO ()
182−main = runWithCLIOpts defaultStreamSize allBenchmarks
183−
184− where
185−
186− allBenchmarks value =
187− [ bgroup (o_1_space_prefix moduleName) $ concat
188− [ o_1_space_folds value
189− , o_1_space_scans value
190− ]
191− ]
benchmark/Streamly/Benchmark/Data/MutArray.hsdeleted−300
@@ -1,300 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4−-- |
5−-- Module : Streamly.Benchmark.Data.Array.Unboxed.Mut
6−-- Copyright : (c) 2021 Composewell Technologies
7−-- License : BSD-3-Clause
8−-- Maintainer : streamly@composewell.com
9−
10−{-# LANGUAGE CPP #-}
11−{-# LANGUAGE FlexibleContexts #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad.IO.Class (MonadIO)
25−import Data.Functor ((<&>))
26−import System.Random (randomRIO)
27−import Prelude
28− ( IO
29− , Int
30− , Integral(..)
31− , Maybe(..)
32− , Monad(..)
33− , Num(..)
34− , Ord(..)
35− , String
36− , ($)
37− , (.)
38− , (||)
39− , concat
40− , const
41− , fmap
42− , id
43− , undefined
44− )
45−import Streamly.Internal.Data.MutArray (MutArray)
46−
47−import qualified Streamly.Internal.Data.Array as Array
48−import qualified Streamly.Internal.Data.MutArray as MArray
49−import qualified Streamly.Internal.Data.Fold as Fold
50−import qualified Streamly.Internal.Data.Stream as Stream
51−
52−import Test.Tasty.Bench
53−import Streamly.Benchmark.Common hiding (benchPureSrc)
54−
55−type Stream = MutArray
56−
57−instance NFData (MutArray a) where
58− {-# INLINE rnf #-}
59− rnf _ = ()
60−
61−-------------------------------------------------------------------------------
62−-- Benchmark helpers
63−-------------------------------------------------------------------------------
64−
65−{-# INLINE benchIO #-}
66−benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
67−benchIO name src f = bench name $ nfIO $
68− (randomRIO (1,1) >>= src) <&> f
69−
70−{-# INLINE benchPureSink #-}
71−benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
72−benchPureSink value name = benchIO name (sourceIntFromTo value)
73−
74−{-# INLINE benchIO' #-}
75−benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
76−benchIO' name src f = bench name $ nfIO $
77− randomRIO (1,1) >>= src >>= f
78−
79−{-# INLINE benchIOSink #-}
80−benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
81−benchIOSink value name = benchIO' name (sourceIntFromTo value)
82−
83−-- Drain a source that generates an array in the IO monad
84−{-# INLINE benchIOSrc #-}
85−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
86−benchIOSrc name src = benchIO name src id
87−
88−drain :: Monad m => Stream.Stream m a -> m ()
89−drain = Stream.fold Fold.drain
90−
91−-------------------------------------------------------------------------------
92−-- Bench Ops
93−-------------------------------------------------------------------------------
94−
95−{-# INLINE sourceUnfoldr #-}
96−sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
97−sourceUnfoldr value n =
98− Stream.fold (MArray.writeN value) $ Stream.unfoldr step n
99−
100− where
101−
102− step cnt =
103− if cnt > n + value
104− then Nothing
105− else Just (cnt, cnt + 1)
106−
107−{-# INLINE sourceIntFromTo #-}
108−sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
109−sourceIntFromTo value n =
110− Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)
111−
112−{-# INLINE sourceFromList #-}
113−sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
114−sourceFromList value n =
115− Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]
116−
117−{-# INLINE sourceIntFromToFromList #-}
118−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
119−sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]
120−
121−{-# INLINE sourceIntFromToFromStream #-}
122−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
123−sourceIntFromToFromStream value n =
124− Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)
125−
126−{-# INLINE sourceUnfoldrM #-}
127−sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int
128−sourceUnfoldrM value n = Stream.unfoldrM step n
129− where
130− step cnt =
131− if cnt > n + value
132− then return Nothing
133− else return (Just (cnt, cnt + 1))
134−
135−-------------------------------------------------------------------------------
136−-- Transformation
137−-------------------------------------------------------------------------------
138−
139−{-# INLINE composeN #-}
140−composeN :: Monad m
141− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
142−composeN n f x =
143− case n of
144− 1 -> f x
145− 2 -> f x >>= f
146− 3 -> f x >>= f >>= f
147− 4 -> f x >>= f >>= f >>= f
148− _ -> undefined
149−
150−{-# INLINE scanl' #-}
151−scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
152−scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)
153−
154−{-# INLINE scanl1' #-}
155−scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
156−scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
157−
158−{-# INLINE map #-}
159−map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
160−map value n = composeN n $ onArray value $ fmap (+ 1)
161−
162−{-# INLINE onArray #-}
163−onArray
164− :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
165− -> Stream Int
166− -> m (Stream Int)
167−onArray value f arr =
168− Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr
169−
170−-------------------------------------------------------------------------------
171−-- Elimination
172−-------------------------------------------------------------------------------
173−
174−{-# INLINE unfoldReadDrain #-}
175−unfoldReadDrain :: MonadIO m => Stream Int -> m ()
176−unfoldReadDrain = drain . Stream.unfold MArray.reader
177−
178−{-# INLINE unfoldReadRevDrain #-}
179−unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()
180−unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev
181−
182−{-# INLINE toStreamDRevDrain #-}
183−toStreamDRevDrain :: MonadIO m => Stream Int -> m ()
184−toStreamDRevDrain = drain . MArray.readRev
185−
186−{-# INLINE toStreamDDrain #-}
187−toStreamDDrain :: MonadIO m => Stream Int -> m ()
188−toStreamDDrain = drain . MArray.read
189−
190−{-# INLINE unfoldFold #-}
191−unfoldFold :: MonadIO m => Stream Int -> m Int
192−unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader
193−
194−-------------------------------------------------------------------------------
195−-- Bench groups
196−-------------------------------------------------------------------------------
197−
198−o_1_space_generation :: Int -> [Benchmark]
199−o_1_space_generation value =
200− [ bgroup
201− "generation"
202− [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
203− , benchIOSrc
204− "fromList . intFromTo"
205− (sourceIntFromToFromList value)
206− , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
207− , benchIOSrc "writeN . fromList" (sourceFromList value)
208− , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
209− ]
210− ]
211−
212−o_1_space_elimination :: Int -> [Benchmark]
213−o_1_space_elimination value =
214− [ bgroup "elimination"
215− [ benchPureSink value "id" id
216− , benchIOSink value "foldl'" unfoldFold
217− , benchIOSink value "read" unfoldReadDrain
218− , benchIOSink value "readRev" unfoldReadRevDrain
219− , benchIOSink value "toStream" toStreamDDrain
220− , benchIOSink value "toStreamRev" toStreamDRevDrain
221− ]
222− ]
223−
224−o_n_heap_serial :: Int -> [Benchmark]
225−o_n_heap_serial value =
226− [ bgroup "elimination"
227− [
228− -- Converting the stream to an array
229− benchFold "writeN" (Stream.fold (MArray.writeN value))
230− (sourceUnfoldrM value)
231− ]
232− ]
233−
234−o_1_space_transformation :: Int -> [Benchmark]
235−o_1_space_transformation value =
236− [ bgroup "transformation"
237− [ benchIOSink value "scanl'" (scanl' value 1)
238− , benchIOSink value "scanl1'" (scanl1' value 1)
239− , benchIOSink value "map" (map value 1)
240− ]
241− ]
242−
243−o_1_space_transformationX4 :: Int -> [Benchmark]
244−o_1_space_transformationX4 value =
245− [ bgroup "transformationX4"
246− [ benchIOSink value "scanl'" (scanl' value 4)
247− , benchIOSink value "scanl1'" (scanl1' value 4)
248− , benchIOSink value "map" (map value 4)
249− ]
250− ]
251−
252−o_1_space_serial_marray ::
253− Int -> (MutArray Int, Array.Array Int) -> [Benchmark]
254−o_1_space_serial_marray value ~(array, indices) =
255− [ benchIO' "partitionBy (< 0)" (const (return array))
256− $ MArray.partitionBy (< 0)
257− , benchIO' "partitionBy (> 0)" (const (return array))
258− $ MArray.partitionBy (> 0)
259− , benchIO' "partitionBy (< value/2)" (const (return array))
260− $ MArray.partitionBy (< (value `div` 2))
261− , benchIO' "partitionBy (> value/2)" (const (return array))
262− $ MArray.partitionBy (> (value `div` 2))
263− , benchIO' "strip (< value/2 || > value/2)" (const (return array))
264− $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
265− , benchIO' "strip (> 0)" (const (return array))
266− $ MArray.strip (> 0)
267− , benchIO' "modifyIndices (+ 1)" (const (return indices))
268− $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))
269− . Stream.unfold Array.reader
270− ]
271−
272−-------------------------------------------------------------------------------
273−-- Driver
274−-------------------------------------------------------------------------------
275−
276−moduleName :: String
277−moduleName = "Data.MutArray"
278−
279−main :: IO ()
280−main = do
281− runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
282−
283− where
284−
285− alloc value = do
286− marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
287− indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
288− return (marr, indices)
289−
290− allBenchmarks array value =
291− [ bgroup (o_1_space_prefix moduleName)
292− $ concat
293− [ o_1_space_serial_marray value array
294− , o_1_space_generation value
295− , o_1_space_elimination value
296− , o_1_space_transformation value
297− , o_1_space_transformationX4 value
298− ]
299− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
300− ]
benchmark/Streamly/Benchmark/Data/Parser.hs+193−642
@@ -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
@@ -14,42 +7,43 @@
147
158{-# LANGUAGE CPP #-}
169{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# OPTIONS_GHC -Wno-orphans #-}
1910
2011module Main
2112 (
2213 main
2314 ) where
2415
25−import Control.Applicative ((<|>))
2616import Control.DeepSeq (NFData(..))
27−import Data.Function ((&))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
2819import Data.Functor (($>))
20+import Data.Maybe (fromMaybe)
2921import Data.Monoid (Sum(..))
3022import GHC.Magic (inline)
23+#if __GLASGOW_HASKELL__ >= 802
3124import GHC.Magic (noinline)
25+#else
26+#define noinline
27+#endif
3228import System.IO (Handle)
3329import 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)
30+import Prelude
31+ hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)
4032
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
4333import qualified Data.Traversable as TR
34+import qualified Data.Foldable as F
35+import qualified Control.Applicative as AP
4436import qualified Streamly.FileSystem.Handle as Handle
45−import qualified Streamly.Internal.Data.Array as Array
46−import qualified Streamly.Internal.Data.Fold as Fold
37+import qualified Streamly.Prelude as S
38+import qualified Streamly.Internal.Data.Array.Foreign as Array
39+import qualified Streamly.Internal.Data.Fold as FL
4740import qualified Streamly.Internal.Data.Parser as PR
48−import qualified Streamly.Data.Stream as Stream
41+import qualified Streamly.Internal.Data.Stream.IsStream as IP
4942import qualified Streamly.Internal.Data.Producer as Producer
50−import qualified Streamly.Internal.Data.Stream as Stream
43+import qualified Streamly.Internal.Data.Producer.Source as Source
5144
52−import Test.Tasty.Bench hiding (env)
45+import Gauge hiding (env)
46+import Streamly.Prelude (SerialT)
5347import Streamly.Benchmark.Common
5448import Streamly.Benchmark.Common.Handle
5549
@@ -60,59 +54,19 @@ import Streamly.Benchmark.Common.Handle
6054-- XXX these can be moved to the common module
6155
6256{-# INLINE sourceUnfoldrM #-}
63−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
64−sourceUnfoldrM value n = Stream.unfoldrM step n
57+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
58+sourceUnfoldrM value n = S.unfoldrM step n
6559 where
6660 step cnt =
6761 if cnt > n + value
6862 then return Nothing
6963 else return (Just (cnt, cnt + 1))
7064
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−
11165-- | Takes a fold method, and uses it with a default source.
11266{-# INLINE benchIOSink #-}
11367benchIOSink
114− :: NFData b
115− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
68+ :: (S.IsStream t, NFData b)
69+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
11670benchIOSink value name f =
11771 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
11872
@@ -120,452 +74,199 @@ benchIOSink value name f =
12074-- Parsers
12175-------------------------------------------------------------------------------
12276
77+{-# INLINE next #-}
78+next :: MonadCatch m => Int -> SerialT m Int -> m (Maybe Int)
79+next value = IP.parse p
80+ where
81+ p = do
82+ m <- PR.next
83+ case m of
84+ Just i -> if i >= value then pure m else p
85+ Nothing -> pure Nothing
86+
12387{-# INLINE takeBetween #-}
124−takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())
125−takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)
88+takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()
89+takeBetween value = IP.parse (PR.takeBetween 0 value FL.drain)
12690
12791{-# 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)
92+takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
93+takeEQ value = IP.parse (PR.takeEQ value FL.drain)
13494
135−{-# INLINE dropWhile #-}
136−dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
137−dropWhile value = Stream.parse (PR.dropWhile (<= value))
95+{-# INLINE drainWhile #-}
96+drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
97+drainWhile value = IP.parse (PR.drainWhile (<= value))
13898
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))
99+{-# INLINE sliceBeginWith #-}
100+sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
101+sliceBeginWith value stream = do
102+ stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream
103+ let stream2 = value `S.cons` stream1
104+ IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2
163105
164106{-# 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))
107+takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
108+takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
171109
172110{-# 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))
111+takeP :: MonadCatch m => Int -> SerialT m a -> m ()
112+takeP value = IP.parse (PR.takeP value (PR.fromFold FL.drain))
175113
176114{-# INLINE groupBy #-}
177−groupBy :: Monad m => Stream m Int -> m (Either ParseError ())
178−groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)
115+groupBy :: MonadCatch m => SerialT m Int -> m ()
116+groupBy = IP.parse (PR.groupBy (<=) FL.drain)
179117
180118{-# INLINE groupByRolling #-}
181−groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())
182−groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)
119+groupByRolling :: MonadCatch m => SerialT m Int -> m ()
120+groupByRolling = IP.parse (PR.groupByRolling (<=) FL.drain)
183121
184122{-# 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
123+wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()
124+wordBy value = IP.parse (PR.wordBy (>= value) FL.drain)
241125
242126{-# 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)
127+manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
128+manyWordByEven = IP.parse (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
245129
246130{-# INLINE many #-}
247−many :: Monad m => Stream m Int -> m (Either ParseError Int)
248−many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
131+many :: MonadCatch m => SerialT m Int -> m Int
132+many = IP.parse (PR.many (PR.satisfy (> 0)) FL.length)
249133
250134{-# INLINE manyAlt #-}
251−manyAlt :: Monad m => Stream m Int -> m Int
135+manyAlt :: MonadCatch m => SerialT m Int -> m Int
252136manyAlt xs = do
253− x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
137+ x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
254138 return $ Prelude.length x
255139
256140{-# INLINE some #-}
257−some :: Monad m => Stream m Int -> m (Either ParseError Int)
258−some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
141+some :: MonadCatch m => SerialT m Int -> m Int
142+some = IP.parse (PR.some (PR.satisfy (> 0)) FL.length)
259143
260144{-# INLINE someAlt #-}
261−someAlt :: Monad m => Stream m Int -> m Int
145+someAlt :: MonadCatch m => SerialT m Int -> m Int
262146someAlt xs = do
263− x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
147+ x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
264148 return $ Prelude.length x
265149
266150{-# INLINE manyTill #-}
267−manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
151+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
268152manyTill value =
269− Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)
153+ IP.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) FL.length)
270154
271−{-# INLINE splitAp2 #-}
272−splitAp2 :: Monad m
273− => Int -> Stream m Int -> m (Either ParseError ((), ()))
274−splitAp2 value =
275− Stream.parse
155+{-# INLINE splitAp #-}
156+splitAp :: MonadCatch m
157+ => Int -> SerialT m Int -> m ((), ())
158+splitAp value =
159+ IP.parse
276160 ((,)
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)
161+ <$> PR.drainWhile (<= (value `div` 2))
162+ <*> PR.drainWhile (<= value)
307163 )
308164
309165{-# INLINE splitApBefore #-}
310−splitApBefore :: Monad m
311− => Int -> Stream m Int -> m (Either ParseError ())
166+splitApBefore :: MonadCatch m
167+ => Int -> SerialT m Int -> m ()
312168splitApBefore value =
313− Stream.parse
314− ( PR.dropWhile (<= (value `div` 2))
315− *> PR.dropWhile (<= value)
169+ IP.parse
170+ ( PR.drainWhile (<= (value `div` 2))
171+ *> PR.drainWhile (<= value)
316172 )
317173
318174{-# INLINE splitApAfter #-}
319−splitApAfter :: Monad m
320− => Int -> Stream m Int -> m (Either ParseError ())
175+splitApAfter :: MonadCatch m
176+ => Int -> SerialT m Int -> m ()
321177splitApAfter value =
322− Stream.parse
323− ( PR.dropWhile (<= (value `div` 2))
324− <* PR.dropWhile (<= value)
178+ IP.parse
179+ ( PR.drainWhile (<= (value `div` 2))
180+ <* PR.drainWhile (<= value)
325181 )
326182
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))
183+{-# INLINE serialWith #-}
184+serialWith :: MonadCatch m
185+ => Int -> SerialT m Int -> m ((), ())
186+serialWith value =
187+ IP.parse
188+ (PR.serialWith (,)
189+ (PR.drainWhile (<= (value `div` 2)))
190+ (PR.drainWhile (<= value))
335191 )
336192
337193{-# INLINE split_ #-}
338−split_ :: Monad m
339− => Int -> Stream m Int -> m (Either ParseError ())
194+split_ :: MonadCatch m
195+ => Int -> SerialT m Int -> m ()
340196split_ value =
341− Stream.parse
197+ IP.parse
342198 (PR.split_
343− (PR.dropWhile (<= (value `div` 2)))
344− (PR.dropWhile (<= value))
199+ (PR.drainWhile (<= (value `div` 2)))
200+ (PR.drainWhile (<= value))
345201 )
346202
347−-- XXX dropWhile with applicative does not fuse
348−-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
349−{-# INLINE takeWhileFail #-}
350−takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
351−takeWhileFail predicate (Fold fstep finitial _ ffinal) =
352− Parser step initial extract
353−
354− where
355−
356− initial = do
357− res <- finitial
358− return $ case res of
359− Fold.Partial s -> IPartial s
360− Fold.Done b -> IDone b
361−
362− step s a =
363− if predicate a
364− then do
365− fres <- fstep s a
366− return
367− $ case fres of
368− Fold.Partial s1 -> Partial 0 s1
369− Fold.Done b -> Done 0 b
370− else return $ Error "fail"
371−
372− extract s = fmap (Done 0) (ffinal s)
373−
374−{-# INLINE alt2 #-}
375−alt2 :: Monad m
376− => Int -> Stream m Int -> m (Either ParseError ())
377−alt2 value =
378− Stream.parse
379− (PR.alt
380− (takeWhileFail (<= (value `div` 2)) Fold.drain)
381− (PR.dropWhile (<= value))
382− )
383−
384−{-# INLINE alt4 #-}
385−alt4 :: Monad m
386− => Int -> Stream m Int -> m (Either ParseError ())
387−alt4 value =
388− Stream.parse
389− ( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain
390− <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain
391− <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain
392− <|> PR.dropWhile (<= value)
393− )
394−
395−{-# INLINE alt8 #-}
396−alt8 :: Monad m
397− => Int -> Stream m Int -> m (Either ParseError ())
398−alt8 value =
399− Stream.parse
400− ( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain
401− <|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain
402− <|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain
403− <|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain
404− <|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain
405− <|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain
406− <|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain
407− <|> PR.dropWhile (<= value)
408− )
409−
410−{-# INLINE alt16 #-}
411−alt16 :: Monad m
412− => Int -> Stream m Int -> m (Either ParseError ())
413−alt16 value =
414− Stream.parse
415− ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
416− <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
417− <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
418− <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
419− <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
420− <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
421− <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
422− <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
423− <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
424− <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
425− <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
426− <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
427− <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
428− <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
429− <|> PR.dropWhile (<= value)
430− )
203+{-# INLINE sliceSepByP #-}
204+sliceSepByP :: MonadCatch m
205+ => Int -> SerialT m Int -> m()
206+sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
431207
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−{-
504208{-# INLINE teeAllAny #-}
505−teeAllAny :: Monad m
506− => Int -> Stream m Int -> m ((), ())
209+teeAllAny :: MonadCatch m
210+ => Int -> SerialT m Int -> m ((), ())
507211teeAllAny value =
508− Stream.parse
212+ IP.parse
509213 (PR.teeWith (,)
510− (PR.dropWhile (<= value))
511− (PR.dropWhile (<= value))
214+ (PR.drainWhile (<= value))
215+ (PR.drainWhile (<= value))
512216 )
513217
514218{-# INLINE teeFstAllAny #-}
515−teeFstAllAny :: Monad m
516− => Int -> Stream m Int -> m ((), ())
219+teeFstAllAny :: MonadCatch m
220+ => Int -> SerialT m Int -> m ((), ())
517221teeFstAllAny value =
518− Stream.parse
222+ IP.parse
519223 (PR.teeWithFst (,)
520− (PR.dropWhile (<= value))
521− (PR.dropWhile (<= value))
224+ (PR.drainWhile (<= value))
225+ (PR.drainWhile (<= value))
522226 )
523227
524228{-# INLINE shortestAllAny #-}
525−shortestAllAny :: Monad m
526− => Int -> Stream m Int -> m (Either ParseError ())
229+shortestAllAny :: MonadCatch m
230+ => Int -> SerialT m Int -> m ()
527231shortestAllAny value =
528− Stream.parse
232+ IP.parse
529233 (PR.shortest
530− (PR.dropWhile (<= value))
531− (PR.dropWhile (<= value))
234+ (PR.drainWhile (<= value))
235+ (PR.drainWhile (<= value))
532236 )
533237
534238{-# INLINE longestAllAny #-}
535−longestAllAny :: Monad m
536− => Int -> Stream m Int -> m (Either ParseError ())
239+longestAllAny :: MonadCatch m
240+ => Int -> SerialT m Int -> m ()
537241longestAllAny value =
538− Stream.parse
242+ IP.parse
539243 (PR.longest
540− (PR.dropWhile (<= value))
541− (PR.dropWhile (<= value))
244+ (PR.drainWhile (<= value))
245+ (PR.drainWhile (<= value))
542246 )
543−-}
247+
248+parseManyChunksOfSum :: Int -> Handle -> IO Int
249+parseManyChunksOfSum n inh =
250+ S.length
251+ $ IP.parseMany
252+ (PR.fromFold $ FL.take n FL.sum)
253+ (S.unfold Handle.read inh)
544254
545255-------------------------------------------------------------------------------
546−-- Spanning
256+-- Parsing with unfolds
547257-------------------------------------------------------------------------------
548258
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)
259+{-# INLINE parseManyUnfoldArrays #-}
260+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
261+parseManyUnfoldArrays count arrays = do
262+ let src = Source.source (Just (Producer.OuterLoop arrays))
263+ let parser = PR.fromFold (FL.take count FL.drain)
264+ let readSrc =
265+ Source.producer
266+ $ Producer.concat Producer.fromList Array.producer
267+ let streamParser =
268+ Producer.simplify (Source.parseMany parser readSrc)
269+ S.drain $ S.unfold streamParser src
569270
570271-------------------------------------------------------------------------------
571272-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -576,129 +277,63 @@ parseManyChunksOfSum n inh =
576277-- not have to rely on it.
577278--
578279{-# INLINE lookAhead #-}
579−lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
280+lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
580281lookAhead value =
581− Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
582−
583−-- XXX The timing of this increased 3x after the stepify extract changes.
584−{-# INLINE sequenceA_ #-}
585−sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
586−sequenceA_ value =
587− Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
282+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
588283
589−-- quadratic complexity
590284{-# INLINE sequenceA #-}
591−sequenceA :: Monad m => Int -> Stream m Int -> m Int
285+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
592286sequenceA value xs = do
593− x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
287+ x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
594288 return $ length x
595289
596−-- quadratic complexity
290+{-# INLINE sequenceA_ #-}
291+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
292+sequenceA_ value =
293+ IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
294+
597295{-# INLINE sequence #-}
598−sequence :: Monad m => Int -> Stream m Int -> m Int
296+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
599297sequence value xs = do
600− x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
298+ x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
601299 return $ length x
602300
603301{-# 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
302+sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
303+sequence_ value =
304+ IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))
607305
608− where
609−
610− {-# INLINE f #-}
611− f m k = m >>= (\_ -> k)
612−
613−-- choice using the "Alternative" instance with direct style parser type has
614−-- quadratic performance complexity.
615−--
616306{-# INLINE choiceAsum #-}
617−choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
307+choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
618308choiceAsum value =
619− Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
309+ IP.parse (asum (replicate value (PR.satisfy (< 0)))
620310 AP.<|> PR.satisfy (> 0))
621311
622−{-
623312{-# INLINE choice #-}
624−choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
313+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
625314choice value =
626− Stream.parse
315+ IP.parse
627316 (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
645317
646318-------------------------------------------------------------------------------
647319-- Stream transformation
648320-------------------------------------------------------------------------------
649321
650322{-# INLINE parseMany #-}
651−parseMany :: Monad m => Int -> Stream m Int -> m ()
323+parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()
652324parseMany 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
325+ S.drain
326+ . S.map getSum
327+ . IP.parseMany (PR.fromFold $ FL.take n FL.mconcat)
328+ . S.map Sum
686329
687330{-# INLINE parseIterate #-}
688−parseIterate :: Monad m => Int -> Stream m Int -> m ()
331+parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()
689332parseIterate 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
333+ S.drain
334+ . S.map getSum
335+ . IP.parseIterate (PR.fromFold . FL.take n . FL.sconcat) (Sum 0)
336+ . S.map Sum
702337
703338-------------------------------------------------------------------------------
704339-- Benchmarks
@@ -707,95 +342,42 @@ concatSequence =
707342moduleName :: String
708343moduleName = "Data.Parser"
709344
710−instance NFData ParseError where
711− {-# INLINE rnf #-}
712− rnf (ParseError x) = rnf x
713−
714345o_1_space_serial :: Int -> [Benchmark]
715346o_1_space_serial value =
716− [ benchIOSink value "takeBetween" $ takeBetween value
347+ [ benchIOSink value "next" $ next value
348+ , benchIOSink value "takeBetween" $ takeBetween value
349+ , benchIOSink value "takeEQ" $ takeEQ value
717350 , benchIOSink value "takeWhile" $ takeWhile value
718− , benchIOSink value "takeWhileP" $ takeWhileP value
719351 , benchIOSink value "takeP" $ takeP value
720− , benchIOSink value "dropWhile" $ dropWhile value
721− , benchIOSink value "takeStartBy" $ takeStartBy value
722− , benchIOSink value "takeEndBy_" $ takeEndBy_ value
352+ , benchIOSink value "drainWhile" $ drainWhile value
353+ , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
723354 , benchIOSink value "groupBy" $ groupBy
724355 , benchIOSink value "groupByRolling" $ groupByRolling
725356 , 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
357+ , benchIOSink value "splitAp" $ splitAp value
736358 , benchIOSink value "splitApBefore" $ splitApBefore value
737359 , 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
360+ , benchIOSink value "serialWith" $ serialWith value
361+ , benchIOSink value "sliceSepByP" $ sliceSepByP value
751362 , benchIOSink value "many" many
752363 , benchIOSink value "many (wordBy even)" $ manyWordByEven
753364 , benchIOSink value "some" some
754365 , 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− {-
774366 , benchIOSink value "tee" $ teeAllAny value
775367 , benchIOSink value "teeFst" $ teeFstAllAny value
776368 , benchIOSink value "shortest" $ shortestAllAny value
777369 , benchIOSink value "longest" $ longestAllAny value
778− -}
779− , benchIOSink value "streamEqBy" (streamEqBy value)
370+ , benchIOSink value "parseMany (take 1)" (parseMany 1)
371+ , benchIOSink value "parseMany (take all)" (parseMany value)
372+ , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
373+ , benchIOSink value "parseIterate (take all)" (parseIterate value)
780374 ]
781375
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−
794376o_1_space_filesystem :: BenchEnv -> [Benchmark]
795377o_1_space_filesystem env =
796− [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env
378+ [ mkBench ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") env
797379 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
798− , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env
380+ , mkBench "S.parseMany (FL.take 1 FL.sum)" env
799381 $ \inh _ -> inline parseManyChunksOfSum 1 inh
800382 ]
801383
@@ -810,38 +392,26 @@ o_1_space_serial_unfold bound arrays =
810392o_n_heap_serial :: Int -> [Benchmark]
811393o_n_heap_serial value =
812394 [
813− benchIOSink value "takeEQ" $ takeEQ value
814− , benchIOSink value "takeGE" $ takeGE value
815−
816395 -- lookahead benchmark holds the entire input till end
817− , benchIOSink value "lookAhead" $ lookAhead value
396+ benchIOSink value "lookAhead" $ lookAhead value
818397
819− -- o-n-heap because of backtracking
820− , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
821− $ takeFramedByEsc_ value
398+ -- accumulates the results in a list
399+ , benchIOSink value "sequence" $ sequence value
400+ , benchIOSink value "sequenceA" $ sequenceA value
822401
402+ -- XXX why should this take O(n) heap, it discards the results?
403+ , benchIOSink value "sequence_" $ sequence_ value
404+ , benchIOSink value "sequenceA_" $ sequenceA_ value
823405 -- non-linear time complexity (parserD)
824406 , benchIOSink value "split_" $ split_ value
825− -- XXX Takes lot of space when run on a long stream, why?
826− , benchIOSink value "monad16" $ monad16 value
407+ -- XXX why O(n) heap?
408+ , benchIOSink value "choice (asum)" $ choiceAsum value
409+ , benchIOSink value "choice" $ choice value
827410
828411 -- These show non-linear time complexity.
829412 -- They accumulate the results in a list.
830− , benchIOSink value "sepBy1" sepBy1
831413 , benchIOSink value "manyAlt" manyAlt
832414 , 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)
845415 ]
846416
847417-------------------------------------------------------------------------------
@@ -850,13 +420,12 @@ o_n_space_serial value =
850420
851421main :: IO ()
852422main = do
853−#ifndef FUSION_CHECK
854423 env <- mkHandleBenchEnv
855424 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
856425
857426 where
858427
859− alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
428+ alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
860429
861430 allBenchmarks env arrays value =
862431 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
@@ -866,22 +435,4 @@ main = do
866435 , bgroup (o_1_space_prefix moduleName)
867436 (o_1_space_serial_unfold value arrays)
868437 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
869− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
870438 ]
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+412
@@ -0,0 +1,412 @@
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+{-# LANGUAGE ScopedTypeVariables #-}
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, MonadThrow)
19+import Data.Foldable (asum)
20+import Data.Functor (($>))
21+import Data.Maybe (fromMaybe)
22+import System.Random (randomRIO)
23+import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span)
24+
25+import qualified Data.Traversable as TR
26+import qualified Data.Foldable as F
27+import qualified Control.Applicative as AP
28+import qualified Streamly.Prelude as S
29+import qualified Streamly.Internal.Data.Array.Foreign as Array
30+import qualified Streamly.Internal.Data.Fold as FL
31+import qualified Streamly.Internal.Data.Parser.ParserD as PR
32+import qualified Streamly.Internal.Data.Producer as Producer
33+import qualified Streamly.Internal.Data.Producer.Source as Source
34+import qualified Streamly.Internal.Data.Stream.IsStream as IP
35+
36+import Gauge
37+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
38+import Streamly.Benchmark.Common
39+
40+-------------------------------------------------------------------------------
41+-- Utilities
42+-------------------------------------------------------------------------------
43+
44+-- XXX these can be moved to the common module
45+
46+{-# INLINE sourceUnfoldrM #-}
47+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
48+sourceUnfoldrM value n = S.unfoldrM step n
49+ where
50+ step cnt =
51+ if cnt > n + value
52+ then return Nothing
53+ else return (Just (cnt, cnt + 1))
54+
55+-- | Takes a fold method, and uses it with a default source.
56+{-# INLINE benchIOSink #-}
57+benchIOSink
58+ :: (IsStream t, NFData b)
59+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
60+benchIOSink value name f =
61+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
62+
63+-- Make the input unsorted.
64+{-# INLINE benchIOSinkRandom #-}
65+benchIOSinkRandom
66+ :: (IsStream t, NFData b)
67+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
68+benchIOSinkRandom value name f =
69+ bench name $ nfIO $ randomRIO (1,1)
70+ >>= f
71+ . S.map (\x -> if even x then x + 2 else x)
72+ . sourceUnfoldrM value
73+
74+-------------------------------------------------------------------------------
75+-- Parsers
76+-------------------------------------------------------------------------------
77+
78+{-# INLINE drainWhile #-}
79+drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
80+drainWhile p = PR.takeWhile p FL.drain
81+
82+{-# INLINE sliceBeginWith #-}
83+sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
84+sliceBeginWith value stream = do
85+ stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream
86+ let stream2 = value `S.cons` stream1
87+ IP.parseD (PR.sliceBeginWith (== value) FL.drain) stream2
88+
89+{-# INLINE takeWhile #-}
90+takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
91+takeWhile value = IP.parseD (drainWhile (<= value))
92+
93+{-# INLINE takeP #-}
94+takeP :: MonadThrow m => Int -> SerialT m a -> m ()
95+takeP value = IP.parseD (PR.takeP value (PR.fromFold FL.drain))
96+
97+{-# INLINE groupBy #-}
98+groupBy :: MonadThrow m => SerialT m Int -> m ()
99+groupBy = IP.parseD (PR.groupBy (<=) FL.drain)
100+
101+{-# INLINE groupByRolling #-}
102+groupByRolling :: MonadThrow m => SerialT m Int -> m ()
103+groupByRolling = IP.parseD (PR.groupByRolling (<=) FL.drain)
104+
105+{-# INLINE wordBy #-}
106+wordBy :: MonadThrow m => Int -> SerialT m Int -> m ()
107+wordBy value = IP.parseD (PR.wordBy (>= value) FL.drain)
108+
109+{-# INLINE manyWordByEven #-}
110+manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
111+manyWordByEven =
112+ IP.parseD (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
113+
114+{-# INLINE many #-}
115+many :: MonadCatch m => SerialT m Int -> m Int
116+many = IP.parseD (PR.many (PR.satisfy (> 0)) FL.length)
117+
118+{-# INLINE manyAlt #-}
119+manyAlt :: MonadCatch m => SerialT m Int -> m Int
120+manyAlt xs = do
121+ x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
122+ return $ Prelude.length x
123+
124+{-# INLINE some #-}
125+some :: MonadCatch m => SerialT m Int -> m Int
126+some = IP.parseD (PR.some (PR.satisfy (> 0)) FL.length)
127+
128+{-# INLINE someAlt #-}
129+someAlt :: MonadCatch m => SerialT m Int -> m Int
130+someAlt xs = do
131+ x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
132+ return $ Prelude.length x
133+
134+{-#INLINE sliceSepByP #-}
135+sliceSepByP :: MonadCatch m => Int -> SerialT m Int -> m ()
136+sliceSepByP value = IP.parseD (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
137+
138+{-# INLINE manyTill #-}
139+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
140+manyTill value =
141+ let p = PR.satisfy (> 0)
142+ pcond = PR.satisfy (== value)
143+ in IP.parseD (PR.manyTill FL.length p pcond)
144+
145+{-# INLINE serialWith #-}
146+serialWith :: MonadThrow m
147+ => Int -> SerialT m Int -> m ((), ())
148+serialWith value =
149+ IP.parseD
150+ ((,)
151+ <$> drainWhile (<= (value `div` 2))
152+ <*> drainWhile (<= value)
153+ )
154+
155+{-# INLINE teeAllAny #-}
156+teeAllAny :: MonadThrow m
157+ => Int -> SerialT m Int -> m ((), ())
158+teeAllAny value =
159+ IP.parseD
160+ (PR.teeWith (,)
161+ (drainWhile (<= value))
162+ (drainWhile (<= value))
163+ )
164+
165+{-# INLINE teeFstAllAny #-}
166+teeFstAllAny :: MonadThrow m
167+ => Int -> SerialT m Int -> m ((), ())
168+teeFstAllAny value =
169+ IP.parseD
170+ (PR.teeWithFst (,)
171+ (drainWhile (<= value))
172+ (drainWhile (<= value))
173+ )
174+
175+{-# INLINE shortestAllAny #-}
176+shortestAllAny :: MonadThrow m
177+ => Int -> SerialT m Int -> m ()
178+shortestAllAny value =
179+ IP.parseD
180+ (PR.shortest
181+ (drainWhile (<= value))
182+ (drainWhile (<= value))
183+ )
184+
185+{-# INLINE longestAllAny #-}
186+longestAllAny :: MonadCatch m
187+ => Int -> SerialT m Int -> m ()
188+longestAllAny value =
189+ IP.parseD
190+ (PR.longest
191+ (drainWhile (<= value))
192+ (drainWhile (<= value))
193+ )
194+
195+-------------------------------------------------------------------------------
196+-- Spanning
197+-------------------------------------------------------------------------------
198+
199+{-# INLINE span #-}
200+span :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
201+span value = IP.parseD (PR.span (<= (value `div` 2)) FL.drain FL.drain)
202+
203+{-# INLINE spanBy #-}
204+spanBy :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
205+spanBy value =
206+ IP.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) FL.drain FL.drain)
207+
208+{-# INLINE spanByRolling #-}
209+spanByRolling :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
210+spanByRolling value =
211+ IP.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) FL.drain FL.drain)
212+
213+-------------------------------------------------------------------------------
214+-- Nested
215+-------------------------------------------------------------------------------
216+
217+{-# INLINE parseMany #-}
218+parseMany :: MonadThrow m => Int -> SerialT m Int -> m ()
219+parseMany value = IP.drain . IP.parseManyD (drainWhile (<= value + 1))
220+
221+{-# INLINE parseManyGroups #-}
222+parseManyGroups :: MonadThrow m => Bool -> SerialT m Int -> m ()
223+parseManyGroups b = IP.drain . IP.parseManyD (PR.groupBy (\_ _ -> b) FL.drain)
224+
225+{-# INLINE parseManyGroupsRolling #-}
226+parseManyGroupsRolling :: MonadThrow m => Bool -> SerialT m Int -> m ()
227+parseManyGroupsRolling b =
228+ IP.drain . IP.parseManyD (PR.groupByRolling (\_ _ -> b) FL.drain)
229+
230+{-# INLINE parseManyGroupsRollingEither #-}
231+parseManyGroupsRollingEither :: (MonadThrow m, MonadCatch m) =>
232+ (Int -> Int -> Bool) -> SerialT m Int -> m ()
233+parseManyGroupsRollingEither cmp =
234+ IP.drain
235+ . IP.parseManyD (PR.groupByRollingEither cmp FL.drain FL.drain)
236+
237+-------------------------------------------------------------------------------
238+-- Parsing with unfolds
239+-------------------------------------------------------------------------------
240+
241+{-# INLINE parseManyUnfoldArrays #-}
242+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
243+parseManyUnfoldArrays count arrays = do
244+ let src = Source.source (Just (Producer.OuterLoop arrays))
245+ let parser = PR.fromFold (FL.take count FL.drain)
246+ let readSrc =
247+ Source.producer
248+ $ Producer.concat Producer.fromList Array.producer
249+ let streamParser =
250+ Producer.simplify (Source.parseManyD parser readSrc)
251+ S.drain $ S.unfold streamParser src
252+
253+-------------------------------------------------------------------------------
254+-- Parsers in which -fspec-constr-recursive=16 is problematic
255+-------------------------------------------------------------------------------
256+
257+-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
258+-- We need to fix GHC so that we can have better control over that option or do
259+-- not have to rely on it.
260+--
261+{-# INLINE lookAhead #-}
262+lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
263+lookAhead value =
264+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
265+
266+{-# INLINE sequenceA_ #-}
267+sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
268+sequenceA_ value =
269+ IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
270+
271+-- quadratic complexity
272+{-# INLINE sequenceA #-}
273+sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
274+sequenceA value xs = do
275+ x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
276+ return $ length x
277+
278+-- quadratic complexity
279+{-# INLINE sequence #-}
280+sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
281+sequence value xs = do
282+ x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
283+ return $ length x
284+
285+{-# INLINE sequence_ #-}
286+sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
287+sequence_ value xs =
288+ IP.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 FL.drain))) xs
289+
290+ where
291+
292+ {-# INLINE f #-}
293+ f m k = m >>= (\_ -> k)
294+
295+-- choice using the "Alternative" instance with direct style parser type has
296+-- quadratic performance complexity.
297+--
298+{-# INLINE choiceAsum #-}
299+choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
300+choiceAsum value =
301+ IP.parseD (asum (replicate value (PR.satisfy (< 0)))
302+ AP.<|> PR.satisfy (> 0))
303+
304+{-# INLINE choice #-}
305+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
306+choice value =
307+ IP.parseD
308+ (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
309+
310+-------------------------------------------------------------------------------
311+-- Benchmarks
312+-------------------------------------------------------------------------------
313+
314+moduleName :: String
315+moduleName = "Data.Parser.ParserD"
316+
317+o_1_space_serial :: Int -> [Benchmark]
318+o_1_space_serial value =
319+ [ benchIOSink value "takeWhile" $ takeWhile value
320+ , benchIOSink value "takeP" $ takeP value
321+ , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
322+ , benchIOSink value "groupBy" $ groupBy
323+ , benchIOSink value "groupByRolling" $ groupByRolling
324+ , benchIOSink value "wordBy" $ wordBy value
325+ , benchIOSink value "serialWith" $ serialWith value
326+ , benchIOSink value "many" many
327+ , benchIOSink value "many (wordBy even)" $ manyWordByEven
328+ , benchIOSink value "some" some
329+ , benchIOSink value "sliceSepByP" $ sliceSepByP value
330+ , benchIOSink value "manyTill" $ manyTill value
331+ , benchIOSink value "tee (all,any)" $ teeAllAny value
332+ , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
333+ , benchIOSink value "shortest (all,any)" $ shortestAllAny value
334+ , benchIOSink value "longest (all,any)" $ longestAllAny value
335+ ]
336+
337+o_1_space_serial_spanning :: Int -> [Benchmark]
338+o_1_space_serial_spanning value =
339+ [ benchIOSink value "span" $ span value
340+ , benchIOSink value "spanBy" $ spanBy value
341+ , benchIOSink value "spanByRolling" $ spanByRolling value
342+ ]
343+
344+o_1_space_serial_nested :: Int -> [Benchmark]
345+o_1_space_serial_nested value =
346+ [ benchIOSink value "parseMany" $ parseMany value
347+ , benchIOSink value "parseMany groupBy (bound groups)"
348+ $ parseManyGroups False
349+ , benchIOSink value "parseMany groupRollingBy (bound groups)"
350+ $ parseManyGroupsRolling False
351+ , benchIOSink value "parseMany groupBy (1 group)" $ parseManyGroups True
352+ , benchIOSink value "parseMany groupRollingBy (1 group)"
353+ $ parseManyGroupsRolling True
354+ , benchIOSink value "parseMany groupRollingByEither (Left)"
355+ $ parseManyGroupsRollingEither (<)
356+ , benchIOSink value "parseMany groupRollingByEither (Right)"
357+ $ parseManyGroupsRollingEither (>)
358+ , benchIOSinkRandom value "parseMany groupRollingByEither (Alternating)"
359+ $ parseManyGroupsRollingEither (>)
360+ ]
361+
362+o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]
363+o_1_space_serial_unfold bound arrays =
364+ [ bench "parseMany/Unfold/1000 arrays/1 parse"
365+ $ nfIO $ parseManyUnfoldArrays bound arrays
366+ , bench "parseMany/Unfold/1000 arrays/100000 parses"
367+ $ nfIO $ parseManyUnfoldArrays 1 arrays
368+ ]
369+
370+o_n_heap_serial :: Int -> [Benchmark]
371+o_n_heap_serial value =
372+ [
373+ -- lookahead benchmark holds the entire input till end
374+ benchIOSink value "lookAhead" $ lookAhead value
375+
376+ -- These show non-linear time complexity
377+ -- They accumulate the results in a list.
378+ , benchIOSink value "manyAlt" manyAlt
379+ , benchIOSink value "someAlt" someAlt
380+ ]
381+
382+-- accumulate results in a list in IO
383+o_n_space_serial :: Int -> [Benchmark]
384+o_n_space_serial value =
385+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
386+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
387+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)
388+ , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
389+ , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
390+ , benchIOSink value "choice/100" $ choice (value `div` 100)
391+ ]
392+
393+-------------------------------------------------------------------------------
394+-- Driver
395+-------------------------------------------------------------------------------
396+
397+main :: IO ()
398+main = runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
399+
400+ where
401+
402+ alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
403+
404+ allBenchmarks arraysSmall value =
405+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
406+ , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)
407+ , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)
408+ , bgroup (o_1_space_prefix moduleName)
409+ (o_1_space_serial_unfold value arraysSmall)
410+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
411+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
412+ ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hsnew file+163
@@ -0,0 +1,163 @@
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+
11+module Main
12+ (
13+ main
14+ ) where
15+
16+import Control.DeepSeq (NFData(..))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
19+import System.Random (randomRIO)
20+import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21+
22+import qualified Control.Applicative as AP
23+import qualified Data.Foldable as F
24+import qualified Data.Traversable as TR
25+import qualified Streamly.Prelude as S
26+import qualified Streamly.Internal.Data.Fold as FL
27+import qualified Streamly.Internal.Data.Parser.ParserK.Type as PR
28+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
29+import qualified Streamly.Internal.Data.Stream.IsStream as IP
30+
31+import Gauge
32+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
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 :: (IsStream t, 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+#ifdef FROM_PARSERK
63+#define PARSE_OP (IP.parseD . PR.fromParserK)
64+#else
65+#define PARSE_OP IP.parseK
66+#endif
67+
68+{-# INLINE satisfy #-}
69+satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
70+satisfy = PR.toParserK . PRD.satisfy
71+
72+{-# INLINE takeWhile #-}
73+takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
74+takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
75+
76+{-# INLINE takeWhileK #-}
77+takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
78+takeWhileK value = PARSE_OP (takeWhile (<= value))
79+
80+{-# INLINE splitApp #-}
81+splitApp :: MonadCatch m
82+ => Int -> SerialT m Int -> m ((), ())
83+splitApp value =
84+ PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
85+
86+{-# INLINE sequenceA #-}
87+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
88+sequenceA value xs = do
89+ let parser = satisfy (> 0)
90+ list = Prelude.replicate value parser
91+ x <- PARSE_OP (TR.sequenceA list) xs
92+ return $ Prelude.length x
93+
94+{-# INLINE sequenceA_ #-}
95+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
96+sequenceA_ value xs = do
97+ let parser = satisfy (> 0)
98+ list = Prelude.replicate value parser
99+ PARSE_OP (F.sequenceA_ list) xs
100+
101+{-# INLINE sequence #-}
102+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
103+sequence value xs = do
104+ let parser = satisfy (> 0)
105+ list = Prelude.replicate value parser
106+ x <- PARSE_OP (TR.sequence list) xs
107+ return $ Prelude.length x
108+
109+{-# INLINE manyAlt #-}
110+manyAlt :: MonadCatch m => SerialT m Int -> m Int
111+manyAlt xs = do
112+ x <- PARSE_OP (AP.many (satisfy (> 0))) xs
113+ return $ Prelude.length x
114+
115+{-# INLINE someAlt #-}
116+someAlt :: MonadCatch m => SerialT m Int -> m Int
117+someAlt xs = do
118+ x <- PARSE_OP (AP.some (satisfy (> 0))) xs
119+ return $ Prelude.length x
120+
121+{-# INLINE choice #-}
122+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
123+choice value =
124+ PARSE_OP (asum (replicate value (satisfy (< 0)))
125+ AP.<|> satisfy (> 0))
126+
127+-------------------------------------------------------------------------------
128+-- Benchmarks
129+-------------------------------------------------------------------------------
130+
131+moduleName :: String
132+moduleName = "Data.Parser.ParserK"
133+
134+o_1_space_serial :: Int -> [Benchmark]
135+o_1_space_serial value =
136+ [ benchIOSink value "takeWhile" $ takeWhileK value
137+ , benchIOSink value "splitApp" $ splitApp value
138+ ]
139+
140+-- O(n) heap beacuse of accumulation of the list in strict IO monad?
141+o_n_heap_serial :: Int -> [Benchmark]
142+o_n_heap_serial value =
143+ [ benchIOSink value "sequenceA" $ sequenceA value
144+ , benchIOSink value "sequenceA_" $ sequenceA_ value
145+ , benchIOSink value "sequence" $ sequence value
146+ , benchIOSink value "manyAlt" manyAlt
147+ , benchIOSink value "someAlt" someAlt
148+ , benchIOSink value "choice" $ choice value
149+ ]
150+
151+-------------------------------------------------------------------------------
152+-- Driver
153+-------------------------------------------------------------------------------
154+
155+main :: IO ()
156+main = runWithCLIOpts defaultStreamSize allBenchmarks
157+
158+ where
159+
160+ allBenchmarks value =
161+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
162+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
163+ ]
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/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/StreamD.hs+5−46
@@ -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
@@ -449,8 +409,8 @@ unfoldManyRepl :: Int -> Int -> Int -> IO ()
449409unfoldManyRepl outer inner n =
450410 S.drain
451411 $ S.unfoldMany
452− UF.replicateM
453− (S.map ((inner,) . return) (sourceUnfoldrMN outer n))
412+ (UF.lmap return (UF.replicateM inner))
413+ (sourceUnfoldrMN outer n)
454414
455415#ifdef INSPECTION
456416inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -463,7 +423,7 @@ inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
463423-------------------------------------------------------------------------------
464424
465425moduleName :: String
466−moduleName = "Data.StreamD"
426+moduleName = "Data.Stream.StreamD"
467427
468428o_1_space :: [Benchmark]
469429o_1_space =
@@ -479,7 +439,6 @@ o_1_space =
479439 [ benchFold "toNull" toNull sourceUnfoldrM
480440 , benchFold "mapM_" mapM_ sourceUnfoldrM
481441 , benchFold "uncons" uncons sourceUnfoldrM
482− , benchFold "foldBreak" foldBreak sourceUnfoldrM
483442 , benchFold "foldl'" foldl sourceUnfoldrM
484443 , benchFold "last" last sourceUnfoldrM
485444 ]
benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hsrenamed+4−6
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.Data.Stream.StreamDK
53-- Copyright : (c) 2018 Composewell Technologies
@@ -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
@@ -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+33−61
@@ -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,22 @@
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
27+ ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
3228 , repeat, replicate
3329 )
3430
3531import qualified Prelude as P
3632import qualified Data.List as List
3733
38−import qualified Streamly.Internal.Data.StreamK as S
34+import qualified Streamly.Internal.Control.Concurrent as S
35+import qualified Streamly.Internal.Data.Stream.StreamK.Type as S
36+import qualified Streamly.Internal.Data.Stream.StreamK as S
3937
40−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
38+import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
4139
4240import Streamly.Benchmark.Common
4341
@@ -117,7 +115,7 @@ Benchmarks that need to be added
117115-- Stream generation and elimination
118116-------------------------------------------------------------------------------
119117
120−type Stream m a = S.StreamK m a
118+type Stream m a = S.Stream m a
121119
122120{-# INLINE unfoldr #-}
123121unfoldr :: Int -> Int -> Stream m Int
@@ -129,7 +127,7 @@ unfoldr streamLen n = S.unfoldr step n
129127 else Just (cnt, cnt + 1)
130128
131129{-# INLINE unfoldrM #-}
132−unfoldrM :: Monad m => Int -> Int -> Stream m Int
130+unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
133131unfoldrM streamLen n = S.unfoldrMWith S.consM step n
134132 where
135133 step cnt =
@@ -142,7 +140,7 @@ repeat :: Int -> Int -> Stream m Int
142140repeat streamLen = S.take streamLen . S.repeat
143141
144142{-# INLINE repeatM #-}
145−repeatM :: Monad m => Int -> Int -> Stream m Int
143+repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
146144repeatM streamLen = S.take streamLen . S.repeatM . return
147145
148146{-# INLINE replicate #-}
@@ -150,7 +148,7 @@ replicate :: Int -> Int -> Stream m Int
150148replicate = S.replicate
151149
152150{-# INLINE replicateM #-}
153−replicateM :: Monad m => Int -> Int -> Stream m Int
151+replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
154152replicateM streamLen = S.replicateMWith S.consM streamLen . return
155153
156154{-# INLINE iterate #-}
@@ -158,7 +156,7 @@ iterate :: Int -> Int -> Stream m Int
158156iterate streamLen = S.take streamLen . S.iterate (+1)
159157
160158{-# INLINE iterateM #-}
161−iterateM :: Monad m => Int -> Int -> Stream m Int
159+iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
162160iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
163161
164162{-# INLINE fromFoldable #-}
@@ -166,27 +164,26 @@ fromFoldable :: Int -> Int -> Stream m Int
166164fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
167165
168166{-# INLINE fromFoldableM #-}
169−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
167+fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
170168fromFoldableM streamLen n =
171− List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
169+ Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
172170
173171{-# INLINABLE concatMapFoldableWith #-}
174−concatMapFoldableWith :: P.Foldable f
172+concatMapFoldableWith :: Foldable f
175173 => (Stream m b -> Stream m b -> Stream m b)
176174 -> (a -> Stream m b)
177175 -> f a
178176 -> Stream m b
179−concatMapFoldableWith f g = P.foldr (f . g) S.nil
177+concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
180178
181179{-# INLINE concatMapFoldableSerial #-}
182180concatMapFoldableSerial :: Int -> Int -> Stream m Int
183−concatMapFoldableSerial streamLen n =
184− concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
181+concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]
185182
186183{-# INLINE concatMapFoldableSerialM #-}
187184concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
188185concatMapFoldableSerialM streamLen n =
189− concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
186+ concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
190187
191188-------------------------------------------------------------------------------
192189-- Elimination
@@ -271,11 +268,11 @@ fmapK :: Monad m => Int -> Stream m Int -> m ()
271268fmapK n = composeN n $ P.fmap (+ 1)
272269
273270{-# INLINE mapM #-}
274−mapM :: Monad m => Int -> Stream m Int -> m ()
271+mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
275272mapM n = composeN n $ S.mapMWith S.consM return
276273
277274{-# INLINE mapMSerial #-}
278−mapMSerial :: Monad m => Int -> Stream m Int -> m ()
275+mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
279276mapMSerial n = composeN n $ S.mapMSerial return
280277
281278{-# INLINE filterEven #-}
@@ -327,7 +324,7 @@ foldlS :: Monad m => Int -> Stream m Int -> m ()
327324foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
328325
329326{-# INLINE intersperse #-}
330−intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
327+intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
331328intersperse streamLen n = composeN n $ S.intersperse streamLen
332329
333330-------------------------------------------------------------------------------
@@ -336,7 +333,8 @@ intersperse streamLen n = composeN n $ S.intersperse streamLen
336333
337334{-# INLINE iterateSource #-}
338335iterateSource
339− :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
336+ :: S.MonadAsync m
337+ => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
340338iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
341339 where
342340 f (0 :: Int) m = g m
@@ -344,37 +342,37 @@ iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
344342
345343-- this is quadratic
346344{-# INLINE iterateScan #-}
347−iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
345+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
348346iterateScan iterStreamLen maxIters =
349347 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
350348
351349-- this is quadratic
352350{-# INLINE iterateDropWhileFalse #-}
353−iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
351+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
354352iterateDropWhileFalse streamLen iterStreamLen maxIters =
355353 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
356354
357355{-# INLINE iterateMapM #-}
358−iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
356+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
359357iterateMapM iterStreamLen =
360358 iterateSource iterStreamLen (S.mapMWith S.consM return)
361359
362360{-# INLINE iterateFilterEven #-}
363−iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
361+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
364362iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365363
366364{-# INLINE iterateTakeAll #-}
367−iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
365+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
368366iterateTakeAll streamLen iterStreamLen =
369367 iterateSource iterStreamLen (S.take streamLen)
370368
371369{-# INLINE iterateDropOne #-}
372−iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
370+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
373371iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
374372
375373{-# INLINE iterateDropWhileTrue #-}
376−iterateDropWhileTrue ::
377− Monad m => Int -> Int -> Int -> Int -> Stream m Int
374+iterateDropWhileTrue :: S.MonadAsync m =>
375+ Int -> Int -> Int -> Int -> Stream m Int
378376iterateDropWhileTrue streamLen iterStreamLen =
379377 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
380378
@@ -392,7 +390,7 @@ zipWithM src = drain $ S.zipWithM (curry return) src src
392390
393391{-# INLINE sortByK #-}
394392sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395−sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
393+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
396394
397395{-# INLINE sortBy #-}
398396sortBy :: Monad m => Stream m Int -> m ()
@@ -494,7 +492,7 @@ sourceConcatMapId val n =
494492{-# INLINE concatMapBySerial #-}
495493concatMapBySerial :: Int -> Int -> Int -> IO ()
496494concatMapBySerial outer inner n =
497− S.drain $ S.concatMapWith S.append
495+ S.drain $ S.concatMapWith S.serial
498496 (unfoldrM inner)
499497 (unfoldrM outer n)
500498
@@ -502,32 +500,6 @@ concatMapBySerial outer inner n =
502500-- Nested Composition
503501-------------------------------------------------------------------------------
504502
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−
531503{-# INLINE drainApplicative #-}
532504drainApplicative :: Monad m => Stream m Int -> m ()
533505drainApplicative s = drain $ do
@@ -634,7 +606,7 @@ filterAllInNestedList str = do
634606-------------------------------------------------------------------------------
635607
636608moduleName :: String
637−moduleName = "Data.StreamK"
609+moduleName = "Data.Stream.StreamK"
638610
639611o_1_space_generation :: Int -> Benchmark
640612o_1_space_generation streamLen =
@@ -731,7 +703,7 @@ o_1_space_concat streamLen =
731703 -- This is for comparison with concatMapFoldableWith
732704 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
733705 (S.drain
734− . S.concatMapWith S.append id
706+ . S.concatMapWith S.serial id
735707 . sourceConcatMapId streamLen)
736708
737709 , benchIOSrc1 "concatMapBy serial (n of 1)"
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/Unfold.hs+60−89
@@ -21,8 +21,6 @@ module Main (main) where
2121
2222import Control.DeepSeq (NFData(..))
2323import Control.Exception (SomeException, ErrorCall, try)
24−import Data.Char (ord)
25−import Data.Word (Word8)
2624import Streamly.Internal.Data.Unfold (Unfold)
2725import System.IO (Handle, hClose)
2826import System.Random (randomRIO)
@@ -31,18 +29,17 @@ import qualified Prelude
3129import qualified Streamly.FileSystem.Handle as FH
3230import qualified Streamly.Internal.Data.Fold as FL
3331import 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
32+import qualified Streamly.Internal.Data.Stream.IsStream as S
33+import qualified Streamly.Internal.Data.Stream.StreamD as D
34+import qualified Streamly.Internal.Data.Stream.StreamK as K
35+import qualified Streamly.Prelude as SP
3836
39−import Test.Tasty.Bench hiding (env)
40−import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile)
37+import Gauge hiding (env)
38+import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
4139import Streamly.Benchmark.Common
4240import Streamly.Benchmark.Common.Handle
4341
4442#ifdef INSPECTION
45−import Control.Monad.Catch (MonadCatch)
4643import Test.Inspection
4744#endif
4845
@@ -57,7 +54,7 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
5754-- generate numbers up to the argument value
5855{-# INLINE source #-}
5956source :: Monad m => Int -> Unfold m Int Int
60−source n = UF.second n UF.enumerateFromToIntegral
57+source n = UF.supplySecond n UF.enumerateFromToIntegral
6158
6259-------------------------------------------------------------------------------
6360-- Benchmark helpers
@@ -76,7 +73,7 @@ drainTransformation unf f seed = drainGeneration (f unf) seed
7673drainTransformationDefault ::
7774 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
7875drainTransformationDefault to =
79− drainTransformation (UF.second to UF.enumerateFromToIntegral)
76+ drainTransformation (UF.supplySecond to UF.enumerateFromToIntegral)
8077
8178{-# INLINE drainProduct #-}
8279drainProduct ::
@@ -99,7 +96,7 @@ drainProductDefault to = drainProduct src src
9996
10097 where
10198
102− src = UF.second to UF.enumerateFromToIntegral
99+ src = UF.supplySecond to UF.enumerateFromToIntegral
103100
104101-------------------------------------------------------------------------------
105102-- Operations on input
@@ -115,26 +112,26 @@ lmapM :: Monad m => Int -> Int -> m ()
115112lmapM size start =
116113 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
117114
118−{-# INLINE both #-}
119−both :: Monad m => Int -> Int -> m ()
120−both size start =
121− drainTransformationDefault (size + start) (UF.both start) undefined
115+{-# INLINE supply #-}
116+supply :: Monad m => Int -> Int -> m ()
117+supply size start =
118+ drainTransformationDefault (size + start) (UF.supply start) undefined
122119
123120
124−{-# INLINE first #-}
125−first :: Monad m => Int -> Int -> m ()
126−first size start =
121+{-# INLINE supplyFirst #-}
122+supplyFirst :: Monad m => Int -> Int -> m ()
123+supplyFirst size start =
127124 drainTransformation
128125 (UF.take size UF.enumerateFromThenIntegral)
129− (UF.first start)
126+ (UF.supplyFirst start)
130127 1
131128
132−{-# INLINE second #-}
133−second :: Monad m => Int -> Int -> m ()
134−second size start =
129+{-# INLINE supplySecond #-}
130+supplySecond :: Monad m => Int -> Int -> m ()
131+supplySecond size start =
135132 drainTransformation
136133 (UF.take size UF.enumerateFromThenIntegral)
137− (UF.second 1)
134+ (UF.supplySecond 1)
138135 start
139136
140137{-# INLINE discardFirst #-}
@@ -162,7 +159,7 @@ swap size start =
162159{-# INLINE fromStream #-}
163160fromStream :: Int -> Int -> IO ()
164161fromStream size start =
165− drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)
162+ drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
166163
167164-- XXX INVESTIGATE: Although the performance of this should be equivalant to
168165-- fromStream, this is considerably worse. More than 4x worse.
@@ -232,7 +229,7 @@ _fromProducer = undefined
232229
233230{-# INLINE replicateM #-}
234231replicateM :: Monad m => Int -> Int -> m ()
235−replicateM size start = drainGeneration UF.replicateM (size, return start)
232+replicateM size start = drainGeneration (UF.replicateM size) (return start)
236233
237234{-# INLINE repeatM #-}
238235repeatM :: Monad m => Int -> Int -> m ()
@@ -257,7 +254,7 @@ enumerateFromThenIntegral size start =
257254enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
258255enumerateFromToIntegral size start =
259256 drainGeneration
260− ( UF.second
257+ ( UF.supplySecond
261258 (size + start)
262259 UF.enumerateFromToIntegral
263260 ) start
@@ -281,7 +278,7 @@ enumerateFromToFractional :: Monad m => Int -> Int -> m ()
281278enumerateFromToFractional size start =
282279 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
283280 in drainGeneration
284− ( UF.second
281+ ( UF.supplySecond
285282 (intToDouble $ start + size)
286283 UF.enumerateFromToFractional
287284 )
@@ -291,11 +288,6 @@ enumerateFromToFractional size start =
291288-- Stream transformation
292289-------------------------------------------------------------------------------
293290
294−{-# INLINE postscan #-}
295−postscan :: Monad m => Int -> Int -> m ()
296−postscan size start =
297− drainTransformationDefault (size + start) (UF.postscan FL.sum) start
298−
299291{-# INLINE map #-}
300292map :: Monad m => Int -> Int -> m ()
301293map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
@@ -305,12 +297,12 @@ mapM :: Monad m => Int -> Int -> m ()
305297mapM size start =
306298 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
307299
308−{-# INLINE mapM2 #-}
309−mapM2 :: Monad m => Int -> Int -> m ()
310−mapM2 size start =
300+{-# INLINE mapMWithInput #-}
301+mapMWithInput :: Monad m => Int -> Int -> m ()
302+mapMWithInput size start =
311303 drainTransformationDefault
312304 size
313− (UF.mapM2 (\a b -> return $ a + b))
305+ (UF.mapMWithInput (\a b -> return $ a + b))
314306 start
315307
316308-------------------------------------------------------------------------------
@@ -418,16 +410,13 @@ teeZipWith size start =
418410-- Applicative
419411-------------------------------------------------------------------------------
420412
421−nthRoot :: Double -> Int -> Int
422−nthRoot n value = round (fromIntegral value**(1/n))
423−
424413{-# INLINE toNullAp #-}
425414toNullAp :: Monad m => Int -> Int -> m ()
426415toNullAp value start =
427416 let end = start + nthRoot 2 value
428417 s = source end
429418 -- in UF.fold ((+) <$> s <*> s) FL.drain start
430− in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start
419+ in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
431420
432421{-# INLINE _apDiscardFst #-}
433422_apDiscardFst :: Int -> Int -> m ()
@@ -441,6 +430,9 @@ _apDiscardSnd = undefined
441430-- Monad
442431-------------------------------------------------------------------------------
443432
433+nthRoot :: Double -> Int -> Int
434+nthRoot n value = round (fromIntegral value**(1/n))
435+
444436{-# INLINE concatMapM #-}
445437concatMapM :: Monad m => Int -> Int -> m ()
446438concatMapM value start =
@@ -449,8 +441,8 @@ concatMapM value start =
449441 where
450442
451443 val = nthRoot 2 value
452− unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
453− unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
444+ unfoldInGen i = return (UF.supplySecond (i + val) UF.enumerateFromToIntegral)
445+ unfoldOut = UF.supplySecond (start + val) UF.enumerateFromToIntegral
454446
455447{-# INLINE toNull #-}
456448toNull :: Monad m => Int -> Int -> m ()
@@ -601,9 +593,9 @@ concatCount :: Int -> Int
601593concatCount linearCount =
602594 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
603595
604−{-# INLINE many #-}
605−many :: Monad m => Int -> Int -> m ()
606−many linearCount start = do
596+{-# INLINE concat #-}
597+concat :: Monad m => Int -> Int -> m ()
598+concat linearCount start = do
607599 let end = start + concatCount linearCount
608600 UF.fold FL.drain (UF.many (source end) (source end)) start
609601
@@ -620,9 +612,9 @@ o_1_space_transformation_input size =
620612 "transformation/input"
621613 [ benchIO "lmap" $ lmap size
622614 , benchIO "lmapM" $ lmapM size
623− , benchIO "both" $ both size
624− , benchIO "first" $ first size
625− , benchIO "second" $ second size
615+ , benchIO "supply" $ supply size
616+ , benchIO "supplyFirst" $ supplyFirst size
617+ , benchIO "supplySecond" $ supplySecond size
626618 , benchIO "discardFirst" $ discardFirst size
627619 , benchIO "discardSecond" $ discardSecond size
628620 , benchIO "swap" $ swap size
@@ -668,8 +660,7 @@ o_1_space_transformation size =
668660 "transformation"
669661 [ benchIO "map" $ map size
670662 , benchIO "mapM" $ mapM size
671− , benchIO "mapM2" $ mapM2 size
672− , benchIO "postscan" $ postscan size
663+ , benchIO "mapMWithInput" $ mapMWithInput size
673664 ]
674665 ]
675666
@@ -702,17 +693,8 @@ o_1_space_zip size =
702693 ]
703694 ]
704695
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 =
696+o_1_space_nested :: Int -> [Benchmark]
697+o_1_space_nested size =
716698 [ bgroup
717699 "nested"
718700 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -728,9 +710,7 @@ o_1_space_nested env size =
728710 , benchIO "filterAllIn" $ filterAllIn size
729711 , benchIO "filterSome" $ filterSome size
730712
731− , benchIO "many" $ many size
732− , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
733− $ \inh _ -> foldManySepBy inh
713+ , benchIO "concat" $ concat size
734714 ]
735715 ]
736716
@@ -749,11 +729,11 @@ o_n_space_nested size =
749729-- | Send the file contents to /dev/null with exception handling
750730readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
751731readWriteOnExceptionUnfold inh devNull =
752− let readEx = UF.onException (\_ -> hClose inh) FH.reader
753− in S.fold (FH.write devNull) $ S.unfold readEx inh
732+ let readEx = UF.onException (\_ -> hClose inh) FH.read
733+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
754734
755735#ifdef INSPECTION
756−-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
736+inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
757737-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
758738#endif
759739
@@ -761,54 +741,45 @@ readWriteOnExceptionUnfold inh devNull =
761741readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
762742readWriteHandleExceptionUnfold inh devNull =
763743 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
744+ readEx = UF.handle (UF.functionM handler) FH.read
745+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
766746
767747#ifdef INSPECTION
768−-- hasNoTypeClasses started failing in GHC 9.4.4
769−-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
748+inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
770749-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
771750#endif
772751
773752-- | Send the file contents to /dev/null with exception handling
774753readWriteFinally_Unfold :: Handle -> Handle -> IO ()
775754readWriteFinally_Unfold inh devNull =
776− let readEx = UF.finally_ (\_ -> hClose inh) FH.reader
777− in S.fold (FH.write devNull) $ S.unfold readEx inh
755+ let readEx = UF.finally_ (\_ -> hClose inh) FH.read
756+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
778757
779758#ifdef INSPECTION
780−#if __GLASGOW_HASKELL__ >= 906
781−inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]
782−#else
783759inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
784−#endif
785760-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
786761#endif
787762
788763readWriteFinallyUnfold :: Handle -> Handle -> IO ()
789764readWriteFinallyUnfold inh devNull =
790− let readEx = UF.finally (\_ -> hClose inh) FH.reader
791− in S.fold (FH.write devNull) $ S.unfold readEx inh
765+ let readEx = UF.finally (\_ -> hClose inh) FH.read
766+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
792767
793768-- | Send the file contents to /dev/null with exception handling
794769readWriteBracket_Unfold :: Handle -> Handle -> IO ()
795770readWriteBracket_Unfold inh devNull =
796− let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader
797− in S.fold (FH.write devNull) $ S.unfold readEx inh
771+ let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
772+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
798773
799774#ifdef INSPECTION
800−#if __GLASGOW_HASKELL__ >= 906
801−inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]
802−#else
803775inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
804−#endif
805776-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
806777#endif
807778
808779readWriteBracketUnfold :: Handle -> Handle -> IO ()
809780readWriteBracketUnfold inh devNull =
810− let readEx = UF.bracket return (\_ -> hClose inh) FH.reader
811− in S.fold (FH.write devNull) $ S.unfold readEx inh
781+ let readEx = UF.bracket return (\_ -> hClose inh) FH.read
782+ in SP.fold (FH.write devNull) $ S.unfold readEx inh
812783
813784o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
814785o_1_space_copy_read_exceptions env =
@@ -848,7 +819,7 @@ main = do
848819 , o_1_space_transformation size
849820 , o_1_space_filtering size
850821 , o_1_space_zip size
851− , o_1_space_nested env size
822+ , o_1_space_nested size
852823 , o_1_space_copy_read_exceptions env
853824 ]
854825 , bgroup (o_n_space_prefix moduleName)
benchmark/Streamly/Benchmark/FileSystem/Handle.hs+5−1
@@ -17,12 +17,16 @@
1717{-# LANGUAGE TemplateHaskell #-}
1818{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
1919#endif
20+
21+#if __GLASGOW_HASKELL__ >= 800
22+#endif
23+
2024import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
2125
2226import qualified Handle.ReadWrite as RW
2327import qualified Handle.Read as RO
2428
25−import Test.Tasty.Bench hiding (env)
29+import Gauge hiding (env)
2630import Prelude hiding (last, length)
2731import Streamly.Benchmark.Common
2832
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+62−66
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.FileSystem.Handle
53-- Copyright : (c) 2019 Composewell Technologies
@@ -26,29 +24,32 @@ where
2624
2725import Data.Word (Word8)
2826import GHC.Magic (inline)
27+#if __GLASGOW_HASKELL__ >= 802
2928import GHC.Magic (noinline)
29+#else
30+#define noinline
31+#endif
3032import System.IO (Handle)
3133
32−import qualified Streamly.Data.Stream as Stream
33−import qualified Streamly.Data.Fold as Fold
3434import qualified Streamly.FileSystem.Handle as FH
35−import qualified Streamly.Internal.Data.Array as A
35+import qualified Streamly.Internal.Data.Array.Foreign as A
36+import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
3637import qualified Streamly.Internal.Data.Fold as FL
37−import qualified Streamly.Internal.Data.Stream as IP
38+import qualified Streamly.Internal.Data.Stream.IsStream as IP
3839import qualified Streamly.Internal.FileSystem.Handle as IFH
3940import qualified Streamly.Internal.Unicode.Stream as IUS
40−import qualified Streamly.Data.Stream.Prelude as S
41+import qualified Streamly.Prelude as S
4142import qualified Streamly.Unicode.Stream as SS
4243
43−import Test.Tasty.Bench hiding (env)
44+import Gauge hiding (env)
4445import Prelude hiding (last, length)
4546import Streamly.Benchmark.Common.Handle
4647
4748#ifdef INSPECTION
48−import Streamly.Internal.Data.Stream (Step(..), FoldMany)
49+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)
4950
50−import qualified Streamly.Internal.Data.MutArray as MutArray
51−import qualified Streamly.Internal.Data.Stream as D
51+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
52+import qualified Streamly.Internal.Data.Stream.StreamD as D
5253import qualified Streamly.Internal.Data.Unfold as IUF
5354
5455import Test.Inspection
@@ -62,49 +63,49 @@ import Test.Inspection
6263
6364-- | Get the last byte from a file bytestream.
6465readLast :: Handle -> IO (Maybe Word8)
65−readLast = S.fold Fold.last . S.unfold FH.reader
66+readLast = S.last . S.unfold FH.read
6667
6768#ifdef INSPECTION
6869inspect $ hasNoTypeClasses 'readLast
6970inspect $ 'readLast `hasNoType` ''Step -- S.unfold
7071inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
71−inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
72+inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
7273#endif
7374
7475-- assert that flattenArrays constructors are not present
7576-- | Count the number of bytes in a file.
7677readCountBytes :: Handle -> IO Int
77−readCountBytes = S.fold Fold.length . S.unfold FH.reader
78+readCountBytes = S.length . S.unfold FH.read
7879
7980#ifdef INSPECTION
8081inspect $ hasNoTypeClasses 'readCountBytes
8182inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
8283inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
83−inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
84+inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
8485#endif
8586
8687-- | Count the number of lines in a file.
8788readCountLines :: Handle -> IO Int
8889readCountLines =
89− S.fold Fold.length
90+ S.length
9091 . IUS.lines FL.drain
9192 . SS.decodeLatin1
92− . S.unfold FH.reader
93+ . S.unfold FH.read
9394
9495#ifdef INSPECTION
9596inspect $ hasNoTypeClasses 'readCountLines
9697inspect $ 'readCountLines `hasNoType` ''Step
9798inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
99+inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
99100#endif
100101
101102-- | Count the number of words in a file.
102103readCountWords :: Handle -> IO Int
103104readCountWords =
104− S.fold Fold.length
105+ S.length
105106 . IUS.words FL.drain
106107 . SS.decodeLatin1
107− . S.unfold FH.reader
108+ . S.unfold FH.read
108109
109110#ifdef INSPECTION
110111inspect $ hasNoTypeClasses 'readCountWords
@@ -113,13 +114,13 @@ inspect $ hasNoTypeClasses 'readCountWords
113114
114115-- | Sum the bytes in a file.
115116readSumBytes :: Handle -> IO Word8
116−readSumBytes = S.fold Fold.sum . S.unfold FH.reader
117+readSumBytes = S.sum . S.unfold FH.read
117118
118119#ifdef INSPECTION
119120inspect $ hasNoTypeClasses 'readSumBytes
120121inspect $ 'readSumBytes `hasNoType` ''Step
121122inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
122−inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
123+inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
123124#endif
124125
125126-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
@@ -133,21 +134,21 @@ inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
133134-- fusion-plugin to propagate INLINE phase information such that this problem
134135-- does not occur.
135136readDrain :: Handle -> IO ()
136−readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh
137+readDrain inh = S.drain $ S.unfold FH.read inh
137138
138139-- XXX investigate why we need an INLINE in this case (GHC)
139140{-# INLINE readDecodeLatin1 #-}
140141readDecodeLatin1 :: Handle -> IO ()
141142readDecodeLatin1 inh =
142− S.fold Fold.drain
143+ S.drain
143144 $ SS.decodeLatin1
144− $ S.unfold FH.reader inh
145+ $ S.unfold FH.read inh
145146
146147readDecodeUtf8 :: Handle -> IO ()
147148readDecodeUtf8 inh =
148− S.fold Fold.drain
149+ S.drain
149150 $ SS.decodeUtf8
150− $ S.unfold FH.reader inh
151+ $ S.unfold FH.read inh
151152
152153#ifdef INSPECTION
153154inspect $ hasNoTypeClasses 'readDecodeUtf8
@@ -186,25 +187,25 @@ o_1_space_reduce_read env =
186187-------------------------------------------------------------------------------
187188
188189-- | Count the number of lines in a file.
189−getChunksConcatUnfoldCountLines :: Handle -> IO Int
190−getChunksConcatUnfoldCountLines inh =
191− S.fold Fold.length
190+toChunksConcatUnfoldCountLines :: Handle -> IO Int
191+toChunksConcatUnfoldCountLines inh =
192+ S.length
192193 $ IUS.lines FL.drain
193194 $ SS.decodeLatin1
194195 -- XXX replace with toBytes
195− $ S.unfoldMany A.reader (IFH.readChunks inh)
196+ $ S.unfoldMany A.read (IFH.toChunks inh)
196197
197198#ifdef INSPECTION
198−inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines
199−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step
200−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
199+inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
200+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
201+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
201202#endif
202203
203204o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
204205o_1_space_reduce_toBytes env =
205206 [ bgroup "reduce/toBytes"
206207 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
207− getChunksConcatUnfoldCountLines inh
208+ toChunksConcatUnfoldCountLines inh
208209 ]
209210 ]
210211
@@ -213,51 +214,46 @@ o_1_space_reduce_toBytes env =
213214-------------------------------------------------------------------------------
214215
215216chunksOfSum :: Int -> Handle -> IO Int
216−chunksOfSum n inh =
217− S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh)
217+chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
218218
219219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
220220foldManyPostChunksOfSum n inh =
221− S.fold Fold.length
222− $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh)
221+ S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.read inh)
223222
224223foldManyChunksOfSum :: Int -> Handle -> IO Int
225224foldManyChunksOfSum n inh =
226− S.fold Fold.length
227− $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh)
225+ S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.read inh)
228226
229227-- XXX investigate why we need an INLINE in this case (GHC)
230228-- Even though allocations remain the same in both cases inlining improves time
231229-- by 4x.
232230-- | 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 =
231+{-# INLINE chunksOf #-}
232+chunksOf :: Int -> Handle -> IO Int
233+chunksOf n inh =
236234 -- 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)
235+ S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
239236
240237#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
238+inspect $ hasNoTypeClasses 'chunksOf
239+inspect $ 'chunksOf `hasNoType` ''Step
240+inspect $ 'chunksOf `hasNoType` ''FoldMany
241+inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
242+inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
243+inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
247244#endif
248245
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)
246+{-# INLINE arraysOf #-}
247+arraysOf :: Int -> Handle -> IO Int
248+arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)
253249
254250o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
255251o_1_space_reduce_read_grouped env =
256252 [ bgroup "reduce/read/chunks"
257− [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $
253+ [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
258254 \inh _ ->
259255 chunksOfSum (bigSize env) inh
260− , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->
256+ , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
261257 chunksOfSum 1 inh
262258
263259 -- XXX investigate why we need inline/noinline in these cases (GHC)
@@ -280,20 +276,20 @@ o_1_space_reduce_read_grouped env =
280276 $ \inh _ -> inline foldManyChunksOfSum 1 inh
281277
282278 -- 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
291279 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
292280 chunksOf 1 inh
293281 , mkBench "S.chunksOf 10" env $ \inh _ ->
294282 chunksOf 10 inh
295283 , mkBench "S.chunksOf 1000" env $ \inh _ ->
296284 chunksOf 1000 inh
285+
286+ -- arraysOf may use a different impl than chunksOf
287+ , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
288+ arraysOf 1 inh
289+ , mkBench "S.arraysOf 10" env $ \inh _ ->
290+ arraysOf 10 inh
291+ , mkBench "S.arraysOf 1000" env $ \inh _ ->
292+ arraysOf 1000 inh
297293 ]
298294 ]
299295
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+48−45
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.FileSystem.Handle
53-- Copyright : (c) 2019 Composewell Technologies
@@ -31,18 +29,20 @@ import Streamly.Internal.System.IO (defaultChunkSize)
3129import qualified Streamly.FileSystem.Handle as FH
3230import qualified Streamly.Internal.Data.Unfold as IUF
3331import qualified Streamly.Internal.FileSystem.Handle as IFH
34−import qualified Streamly.Data.Array as A
35−import qualified Streamly.Data.Stream.Prelude as S
32+import qualified Streamly.Data.Array.Foreign as A
33+import qualified Streamly.Prelude as S
3634
37−import Test.Tasty.Bench hiding (env)
35+import Gauge hiding (env)
3836import Streamly.Benchmark.Common.Handle
3937
4038#ifdef INSPECTION
41−import Streamly.Internal.Data.Stream (Step(..))
39+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
4240
43−import qualified Streamly.Internal.Data.Stream as D
41+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
4442import qualified Streamly.Internal.Data.Tuple.Strict as Strict
45−import qualified Streamly.Internal.Data.MutArray as MutArray
43+import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS
44+import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
45+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
4646
4747import Test.Inspection
4848#endif
@@ -53,7 +53,7 @@ import Test.Inspection
5353
5454-- | Copy file
5555copyChunks :: Handle -> Handle -> IO ()
56−copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh
56+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
5757
5858#ifdef INSPECTION
5959inspect $ hasNoTypeClasses 'copyChunks
@@ -62,7 +62,7 @@ inspect $ 'copyChunks `hasNoType` ''Step
6262
6363o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
6464o_1_space_copy_chunked env =
65− [ bgroup "copy/getChunks"
65+ [ bgroup "copy/toChunks"
6666 [ mkBench "toNull" env $ \inH _ ->
6767 copyChunks inH (nullH env)
6868 , mkBench "raw" env $ \inH outH ->
@@ -76,14 +76,14 @@ o_1_space_copy_chunked env =
7676
7777-- | Copy file
7878copyStream :: Handle -> Handle -> IO ()
79−copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.reader inh)
79+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
8080
8181#ifdef INSPECTION
8282inspect $ hasNoTypeClasses 'copyStream
8383inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
8484inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
86− -- FH.read/A.read
85+inspect $ 'copyStream `hasNoType` ''MA.ReadUState -- FH.read/A.read
86+inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
8787inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
8888#endif
8989
@@ -103,28 +103,28 @@ o_1_space_copy_read env =
103103
104104-- | Send the file contents to /dev/null
105105readFromBytesNull :: Handle -> Handle -> IO ()
106−readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh
106+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.read inh
107107
108108#ifdef INSPECTION
109109inspect $ hasNoTypeClasses 'readFromBytesNull
110110inspect $ 'readFromBytesNull `hasNoType` ''Step
111−inspect $ 'readFromBytesNull `hasNoType` ''MutArray.SpliceState
112−inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
111+inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState
112+inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
113113inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
114114#endif
115115
116116-- | Send the file contents ('defaultChunkSize') to /dev/null
117−readWithFromBytesNull :: Handle -> Handle -> IO ()
118−readWithFromBytesNull inh devNull =
117+readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
118+readWithBufferOfFromBytesNull inh devNull =
119119 IFH.putBytes devNull
120− $ S.unfold FH.readerWith (defaultChunkSize, inh)
120+ $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
121121
122122#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
123+inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
124+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
125+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState
126+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
127+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.FoldMany
128128#endif
129129
130130-- | Send the chunk content ('defaultChunkSize') to /dev/null
@@ -135,60 +135,63 @@ _readChunks inh devNull = IUF.fold fld unf inh
135135 where
136136
137137 fld = FH.write devNull
138− unf = IUF.many A.reader FH.chunkReader
138+ unf = IUF.many FH.readChunks A.read
139139
140140-- | 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)
141+-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
142+_readChunksWithBufferOf :: Handle -> Handle -> IO ()
143+_readChunksWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
144144
145145 where
146146
147147 fld = FH.write devNull
148− unf = IUF.many A.reader FH.chunkReaderWith
148+ unf = IUF.many FH.readChunksWithBufferOf A.read
149+
149150
150151o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
151152o_1_space_copy_fromBytes env =
152153 [ bgroup "copy/putBytes"
153154 [ mkBench "rawToNull" env $ \inh _ ->
154155 readFromBytesNull inh (nullH env)
155− , mkBench "FH.readWith" env $ \inh _ ->
156− readWithFromBytesNull inh (nullH env)
156+ , mkBench "FH.readWithBufferOf" env $ \inh _ ->
157+ readWithBufferOfFromBytesNull inh (nullH env)
157158 ]
158159 ]
159160
160161-- | Send the file contents ('defaultChunkSize') to /dev/null
161−writeReadWith :: Handle -> Handle -> IO ()
162−writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
162+{-# NOINLINE writeReadWithBufferOf #-}
163+writeReadWithBufferOf :: Handle -> Handle -> IO ()
164+writeReadWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
163165
164166 where
165167
166− fld = FH.writeWith defaultChunkSize devNull
167− unf = FH.readerWith
168+ fld = FH.writeWithBufferOf defaultChunkSize devNull
169+ unf = FH.readWithBufferOf
168170
169171#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
172+inspect $ hasNoTypeClasses 'writeReadWithBufferOf
173+inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
174+inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
175+inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
176+inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
175177#endif
176178
177179-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
180+{-# NOINLINE writeRead #-}
178181writeRead :: Handle -> Handle -> IO ()
179182writeRead inh devNull = IUF.fold fld unf inh
180183
181184 where
182185
183186 fld = FH.write devNull
184− unf = FH.reader
187+ unf = FH.read
185188
186189#ifdef INSPECTION
187190inspect $ hasNoTypeClasses 'writeRead
188191inspect $ 'writeRead `hasNoType` ''Step
189192inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
190−inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
191− -- FH.read/A.read
193+inspect $ 'writeRead `hasNoType` ''MA.ReadUState -- FH.read/A.read
194+inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
192195#endif
193196
194197o_1_space_copy :: BenchEnv -> [Benchmark]
@@ -196,8 +199,8 @@ o_1_space_copy env =
196199 [ bgroup "copy"
197200 [ mkBench "FH.write . FH.read" env $ \inh _ ->
198201 writeRead inh (nullH env)
199− , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->
200− writeReadWith inh (nullH env)
202+ , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
203+ writeReadWithBufferOf inh (nullH env)
201204 ]
202205 ]
203206
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+6−11
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -10,7 +8,7 @@
108import Control.Concurrent (threadDelay)
119import Control.Monad (when)
1210import Control.Monad.IO.Class (liftIO)
13−import Test.Tasty.Bench
11+import Gauge
1412import Streamly.Prelude as S
1513import System.Random (randomRIO)
1614
@@ -36,14 +34,11 @@ source range = S.replicateM value $ do
3634
3735{-# INLINE run #-}
3836run :: 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
37+run srange crange t = S.drain $ do
38+ n <- t $ source srange
39+ d <- liftIO (randomRIO crange)
40+ when (d /= 0) $ liftIO $ threadDelay d
41+ return n
4742
4843low, medium, high :: Int
4944low = 10
benchmark/Streamly/Benchmark/Prelude/Ahead.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
1513import Streamly.Benchmark.Common
1614import Streamly.Benchmark.Prelude
1715
18−import Test.Tasty.Bench
16+import Gauge
1917
2018moduleName :: String
2119moduleName = "Prelude.Ahead"
benchmark/Streamly/Benchmark/Prelude/Async.hs+3−5
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -16,7 +14,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform
1614import Streamly.Benchmark.Common
1715import Streamly.Benchmark.Prelude
1816
19−import Test.Tasty.Bench
17+import Gauge
2018
2119moduleName :: String
2220moduleName = "Prelude.Async"
@@ -124,9 +122,9 @@ o_1_space_concatFoldable value =
124122 (sourceFoldMapWithStream value)
125123 , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
126124 (sourceFoldMapWithM value)
127− , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"
125+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
128126 (concatFoldableWith value)
129− , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"
127+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
130128 (concatForFoldableWith value)
131129 , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
132130 ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+1−2
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
21{-# LANGUAGE CPP #-}
32{-# LANGUAGE RankNTypes #-}
43-- |
@@ -15,7 +14,7 @@ import Streamly.Prelude
1514 , fromWAsync, parallel, fromParallel
1615 )
1716
18−import Test.Tasty.Bench
17+import Gauge
1918import qualified Streamly.Prelude as S
2019
2120-------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Prelude/Merge.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -30,13 +28,13 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Stream
3028import Streamly.Benchmark.Common
3129import Streamly.Benchmark.Prelude
3230
33−import Test.Tasty.Bench
31+import Gauge
3432
3533#ifdef INSPECTION
3634import GHC.Types (SPEC(..))
3735import Test.Inspection
3836
39−import qualified Streamly.Internal.Data.Stream as D
37+import qualified Streamly.Internal.Data.Stream.StreamD as D
4038#endif
4139
4240moduleName :: String
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -22,7 +20,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Internal
2220import Streamly.Benchmark.Common
2321import Streamly.Benchmark.Prelude
2422
25−import Test.Tasty.Bench
23+import Gauge
2624
2725moduleName :: String
2826moduleName = "Prelude.Parallel"
benchmark/Streamly/Benchmark/Prelude/Rate.hs+1−2
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
21{-# LANGUAGE FlexibleContexts #-}
32
43-- |
@@ -14,7 +13,7 @@ import qualified Streamly.Prelude as S
1413import Streamly.Benchmark.Common
1514import Streamly.Benchmark.Prelude
1615
17−import Test.Tasty.Bench
16+import Gauge
1817
1918moduleName :: String
2019moduleName = "Prelude.Rate"
benchmark/Streamly/Benchmark/Prelude/Serial.hsnew file+53
@@ -0,0 +1,53 @@
1+-- |
2+-- Module : Serial
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+module Main (main) where
13+
14+import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
15+
16+import qualified Serial.Elimination as Elimination
17+import qualified Serial.Exceptions as Exceptions
18+import qualified Serial.Generation as Generation
19+import qualified Serial.NestedStream as NestedStream
20+import qualified Serial.Split as Split
21+import qualified Serial.Transformation as Transformation
22+import qualified Serial.NestedFold as NestedFold
23+import qualified Serial.Lift as Lift
24+
25+import Streamly.Benchmark.Common
26+
27+moduleName :: String
28+moduleName = "Prelude.Serial"
29+
30+-------------------------------------------------------------------------------
31+-- Main
32+-------------------------------------------------------------------------------
33+
34+-- In addition to gauge options, the number of elements in the stream can be
35+-- passed using the --stream-size option.
36+--
37+main :: IO ()
38+main = do
39+ env <- mkHandleBenchEnv
40+ runWithCLIOpts defaultStreamSize (allBenchmarks env)
41+
42+ where
43+
44+ allBenchmarks env size = Prelude.concat
45+ [ Generation.benchmarks moduleName size
46+ , Elimination.benchmarks moduleName size
47+ , Exceptions.benchmarks moduleName env size
48+ , Split.benchmarks moduleName env
49+ , Transformation.benchmarks moduleName size
50+ , NestedFold.benchmarks moduleName size
51+ , Lift.benchmarks moduleName size
52+ , NestedStream.benchmarks moduleName size
53+ ]
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hsrenamed+121−183
@@ -1,20 +1,14 @@
11-- |
2−-- Module : Stream.Eliminate
2+-- Module : Serial.Elimination
33-- Copyright : (c) 2018 Composewell Technologies
44-- License : BSD-3-Clause
55-- Maintainer : streamly@composewell.com
66
77{-# LANGUAGE CPP #-}
88{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
109{-# LANGUAGE ScopedTypeVariables #-}
1110{-# LANGUAGE RankNTypes #-}
1211
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
1812#ifdef __HADDOCK_VERSION__
1913#undef INSPECTION
2014#endif
@@ -24,7 +18,7 @@
2418{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2519#endif
2620
27−module Stream.Eliminate (benchmarks) where
21+module Serial.Elimination (benchmarks) where
2822
2923import Control.DeepSeq (NFData(..))
3024import Data.Functor.Identity (Identity, runIdentity)
@@ -32,45 +26,28 @@ import System.Random (randomRIO)
3226
3327import qualified Data.Foldable as F
3428import qualified GHC.Exts as GHC
35−import qualified Streamly.Internal.Data.Fold as Fold
3629
3730#ifdef INSPECTION
3831import GHC.Types (SPEC(..))
3932import Test.Inspection
40−import qualified Streamly.Internal.Data.Stream as D
41−#endif
4233
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
34+import qualified Streamly.Internal.Data.Stream.StreamD as D
5835#endif
5936
60−import Test.Tasty.Bench
37+import qualified Streamly.Prelude as S
38+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
39+
40+import Gauge
41+import Streamly.Prelude (SerialT, IsStream, fromSerial)
6142import Streamly.Benchmark.Common
43+import Streamly.Benchmark.Prelude
6244import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
6345 lookup, repeat, minimum, maximum, product, last, mapM_, init)
6446import qualified Prelude
6547
66−#ifdef USE_PRELUDE
67−type Stream = S.SerialT
68−fromStream = id
69−
7048{-# INLINE repeat #-}
7149repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
7250repeat count = S.take count . S.repeat
73−#endif
7451
7552-------------------------------------------------------------------------------
7653-- Elimination
@@ -83,92 +60,90 @@ repeat count = S.take count . S.repeat
8360{-# INLINE foldableFoldl' #-}
8461foldableFoldl' :: Int -> Int -> Int
8562foldableFoldl' value n =
86− F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int)
63+ F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
8764
8865{-# INLINE foldableFoldrElem #-}
8966foldableFoldrElem :: Int -> Int -> Bool
9067foldableFoldrElem value n =
9168 F.foldr (\x xs -> x == value || xs)
9269 False
93− (sourceUnfoldr value n :: Stream Identity Int)
70+ (sourceUnfoldr value n :: S.SerialT Identity Int)
9471
9572{-# INLINE foldableSum #-}
9673foldableSum :: Int -> Int -> Int
9774foldableSum value n =
98− Prelude.sum (sourceUnfoldr value n :: Stream Identity Int)
75+ Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
9976
10077{-# INLINE foldableProduct #-}
10178foldableProduct :: Int -> Int -> Int
10279foldableProduct value n =
103− Prelude.product (sourceUnfoldr value n :: Stream Identity Int)
80+ Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)
10481
10582{-# INLINE _foldableNull #-}
10683_foldableNull :: Int -> Int -> Bool
10784_foldableNull value n =
108− Prelude.null (sourceUnfoldr value n :: Stream Identity Int)
85+ Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)
10986
11087{-# INLINE foldableElem #-}
11188foldableElem :: Int -> Int -> Bool
11289foldableElem value n =
113− value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int)
90+ value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
11491
11592{-# INLINE foldableNotElem #-}
11693foldableNotElem :: Int -> Int -> Bool
11794foldableNotElem value n =
118− value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int)
95+ value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
11996
12097{-# INLINE foldableFind #-}
12198foldableFind :: Int -> Int -> Maybe Int
12299foldableFind value n =
123− F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
100+ F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
124101
125102{-# INLINE foldableAll #-}
126103foldableAll :: Int -> Int -> Bool
127104foldableAll value n =
128− Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
105+ Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
129106
130107{-# INLINE foldableAny #-}
131108foldableAny :: Int -> Int -> Bool
132109foldableAny value n =
133− Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
110+ Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
134111
135−{- HLINT ignore "Use all"-}
136112{-# INLINE foldableAnd #-}
137113foldableAnd :: Int -> Int -> Bool
138114foldableAnd value n =
139− Prelude.and $ fmap
140− (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
115+ Prelude.and $ S.map
116+ (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
141117
142−{- HLINT ignore "Use any"-}
143118{-# INLINE foldableOr #-}
144119foldableOr :: Int -> Int -> Bool
145120foldableOr value n =
146− Prelude.or $ fmap
147− (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
121+ Prelude.or $ S.map
122+ (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
148123
149124{-# INLINE foldableLength #-}
150125foldableLength :: Int -> Int -> Int
151126foldableLength value n =
152− Prelude.length (sourceUnfoldr value n :: Stream Identity Int)
127+ Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)
153128
154129{-# INLINE foldableMin #-}
155130foldableMin :: Int -> Int -> Int
156131foldableMin value n =
157− Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int)
132+ Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
158133
159134{-# INLINE ordInstanceMin #-}
160−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
135+ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
161136ordInstanceMin src = min src src
162137
163138{-# INLINE foldableMax #-}
164139foldableMax :: Int -> Int -> Int
165140foldableMax value n =
166− Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int)
141+ Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
167142
168143{-# INLINE foldableMinBy #-}
169144foldableMinBy :: Int -> Int -> Int
170145foldableMinBy value n =
171− F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int)
146+ F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
172147
173148{-# INLINE foldableListMinBy #-}
174149foldableListMinBy :: Int -> Int -> Int
@@ -177,30 +152,30 @@ foldableListMinBy value n = F.minimumBy compare [1..value+n]
177152{-# INLINE foldableMaxBy #-}
178153foldableMaxBy :: Int -> Int -> Int
179154foldableMaxBy value n =
180− F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int)
155+ F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
181156
182157{-# INLINE foldableToList #-}
183158foldableToList :: Int -> Int -> [Int]
184159foldableToList value n =
185− F.toList (sourceUnfoldr value n :: Stream Identity Int)
160+ F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
186161
187162{-# INLINE foldableMapM_ #-}
188163foldableMapM_ :: Monad m => Int -> Int -> m ()
189164foldableMapM_ value n =
190− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int)
165+ F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
191166
192167{-# INLINE foldableSequence_ #-}
193168foldableSequence_ :: Int -> Int -> IO ()
194169foldableSequence_ value n =
195− F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int))
170+ F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
196171
197172{-# INLINE _foldableMsum #-}
198173_foldableMsum :: Int -> Int -> IO Int
199174_foldableMsum value n =
200− F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int))
175+ F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
201176
202177{-# INLINE showInstance #-}
203−showInstance :: Stream Identity Int -> String
178+showInstance :: SerialT Identity Int -> String
204179showInstance = show
205180
206181o_1_space_elimination_foldable :: Int -> [Benchmark]
@@ -217,9 +192,6 @@ o_1_space_elimination_foldable value =
217192 , bench "minimum" $ nf (foldableMin value) 1
218193 , benchPureSink value "min (ord)" ordInstanceMin
219194 , 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
223195 , bench "length . toList"
224196 $ nf (Prelude.length . foldableToList value) 1
225197 , bench "notElem" $ nf (foldableNotElem value) 1
@@ -242,25 +214,34 @@ o_1_space_elimination_foldable value =
242214 ]
243215 ]
244216
217+o_n_space_elimination_foldable :: Int -> [Benchmark]
218+o_n_space_elimination_foldable value =
219+ -- Head recursive strict right folds.
220+ [ bgroup "foldl"
221+ -- XXX the definitions of minimumBy and maximumBy in Data.Foldable use
222+ -- foldl1 which does not work in constant memory for our
223+ -- implementation. It works in constant memory for lists but even for
224+ -- lists it takes 15x more time compared to our foldl' based
225+ -- implementation.
226+ [ bench "minimumBy" $ nf (`foldableMinBy` 1) value
227+ , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
228+ , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
229+ ]
230+ ]
231+
245232-------------------------------------------------------------------------------
246233-- Stream folds
247234-------------------------------------------------------------------------------
248235
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−
255236{-# INLINE benchPureSink #-}
256237benchPureSink :: NFData b
257− => Int -> String -> (Stream Identity Int -> b) -> Benchmark
238+ => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
258239benchPureSink value name = benchPure name (sourceUnfoldr value)
259240
260241{-# INLINE benchHoistSink #-}
261242benchHoistSink
262− :: (NFData b)
263− => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
243+ :: (IsStream t, NFData b)
244+ => Int -> String -> (t Identity Int -> IO b) -> Benchmark
264245benchHoistSink value name f =
265246 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
266247
@@ -268,8 +249,8 @@ benchHoistSink value name f =
268249-- we can't use it as it requires MonadAsync constraint.
269250{-# INLINE benchIdentitySink #-}
270251benchIdentitySink
271− :: (NFData b)
272− => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark
252+ :: (IsStream t, NFData b)
253+ => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
273254benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
274255
275256-------------------------------------------------------------------------------
@@ -277,29 +258,23 @@ benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
277258-------------------------------------------------------------------------------
278259
279260{-# 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
261+uncons :: Monad m => SerialT m Int -> m ()
285262uncons s = do
286− r <- StreamK.uncons s
263+ r <- S.uncons s
287264 case r of
288265 Nothing -> return ()
289266 Just (_, t) -> uncons t
290267
291−#ifdef USE_PRELUDE
292268{-# INLINE init #-}
293−init :: Monad m => Stream m a -> m ()
269+init :: Monad m => SerialT m a -> m ()
294270init s = S.init s >>= Prelude.mapM_ S.drain
295271
296272{-# INLINE mapM_ #-}
297−mapM_ :: Monad m => Stream m Int -> m ()
273+mapM_ :: Monad m => SerialT m Int -> m ()
298274mapM_ = S.mapM_ (\_ -> return ())
299−#endif
300275
301276{-# INLINE foldrMElem #-}
302−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
277+foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
303278foldrMElem e =
304279 S.foldrM
305280 (\x xs ->
@@ -308,187 +283,155 @@ foldrMElem e =
308283 else xs)
309284 (return False)
310285
311−#ifdef USE_STREAMK
312286{-# 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
287+foldrToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)
288+foldrToStream = S.foldr S.cons S.nil
320289
321290{-# INLINE foldrMBuild #-}
322−foldrMBuild :: Monad m => Stream m Int -> m [Int]
291+foldrMBuild :: Monad m => SerialT m Int -> m [Int]
323292foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
324293
325−#ifdef USE_PRELUDE
326294{-# INLINE foldl'Reduce #-}
327−foldl'Reduce :: Monad m => Stream m Int -> m Int
295+foldl'Reduce :: Monad m => SerialT m Int -> m Int
328296foldl'Reduce = S.foldl' (+) 0
329297
330298{-# INLINE foldl1'Reduce #-}
331−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
299+foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)
332300foldl1'Reduce = S.foldl1' (+)
333301
334302{-# INLINE foldlM'Reduce #-}
335−foldlM'Reduce :: Monad m => Stream m Int -> m Int
303+foldlM'Reduce :: Monad m => SerialT m Int -> m Int
336304foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
337305
338306{-# INLINE last #-}
339−last :: Monad m => Stream m Int -> m (Maybe Int)
307+last :: Monad m => SerialT m Int -> m (Maybe Int)
340308last = S.last
341309
342310{-# INLINE _head #-}
343−_head :: Monad m => Stream m Int -> m (Maybe Int)
311+_head :: Monad m => SerialT m Int -> m (Maybe Int)
344312_head = S.head
345313
346314{-# INLINE elem #-}
347−elem :: Monad m => Int -> Stream m Int -> m Bool
315+elem :: Monad m => Int -> SerialT m Int -> m Bool
348316elem value = S.elem (value + 1)
349317
350318{-# INLINE notElem #-}
351−notElem :: Monad m => Int -> Stream m Int -> m Bool
319+notElem :: Monad m => Int -> SerialT m Int -> m Bool
352320notElem value = S.notElem (value + 1)
353321
354322{-# INLINE length #-}
355−length :: Monad m => Stream m Int -> m Int
323+length :: Monad m => SerialT m Int -> m Int
356324length = S.length
357325
358326{-# INLINE all #-}
359−all :: Monad m => Int -> Stream m Int -> m Bool
327+all :: Monad m => Int -> SerialT m Int -> m Bool
360328all value = S.all (<= (value + 1))
361329
362330{-# INLINE any #-}
363−any :: Monad m => Int -> Stream m Int -> m Bool
331+any :: Monad m => Int -> SerialT m Int -> m Bool
364332any value = S.any (> (value + 1))
365333
366334{-# INLINE and #-}
367−and :: Monad m => Int -> Stream m Int -> m Bool
335+and :: Monad m => Int -> SerialT m Int -> m Bool
368336and value = S.and . S.map (<= (value + 1))
369337
370338{-# INLINE or #-}
371−or :: Monad m => Int -> Stream m Int -> m Bool
339+or :: Monad m => Int -> SerialT m Int -> m Bool
372340or value = S.or . S.map (> (value + 1))
373341
374342{-# INLINE find #-}
375−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
343+find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
376344find value = S.find (== (value + 1))
377345
378346{-# INLINE findM #-}
379−findM :: Monad m => Int -> Stream m Int -> m (Maybe Int)
347+findM :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
380348findM value = S.findM (\z -> return $ z == (value + 1))
381349
382350{-# INLINE findIndex #-}
383−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
351+findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
384352findIndex value = S.findIndex (== (value + 1))
385353
386354{-# INLINE elemIndex #-}
387−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
355+elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
388356elemIndex value = S.elemIndex (value + 1)
389357
390358{-# INLINE maximum #-}
391−maximum :: Monad m => Stream m Int -> m (Maybe Int)
359+maximum :: Monad m => SerialT m Int -> m (Maybe Int)
392360maximum = S.maximum
393361
394362{-# INLINE minimum #-}
395−minimum :: Monad m => Stream m Int -> m (Maybe Int)
363+minimum :: Monad m => SerialT m Int -> m (Maybe Int)
396364minimum = S.minimum
397365
398366{-# INLINE sum #-}
399−sum :: Monad m => Stream m Int -> m Int
367+sum :: Monad m => SerialT m Int -> m Int
400368sum = S.sum
401369
402370{-# INLINE product #-}
403−product :: Monad m => Stream m Int -> m Int
371+product :: Monad m => SerialT m Int -> m Int
404372product = S.product
405373
406374{-# INLINE minimumBy #-}
407−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
375+minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)
408376minimumBy = S.minimumBy compare
409377
410378{-# INLINE maximumBy #-}
411−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
379+maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
412380maximumBy = S.maximumBy compare
413381
414382{-# INLINE the #-}
415−the :: Monad m => Stream m Int -> m (Maybe Int)
383+the :: Monad m => SerialT m Int -> m (Maybe Int)
416384the = S.the
417385
418386{-# INLINE drainN #-}
419−drainN :: Monad m => Int -> Stream m Int -> m ()
387+drainN :: Monad m => Int -> SerialT m Int -> m ()
420388drainN = S.drainN
421389
422390{-# INLINE drainWhile #-}
423−drainWhile :: Monad m => Stream m Int -> m ()
391+drainWhile :: Monad m => SerialT m Int -> m ()
424392drainWhile = S.drainWhile (const True)
425393
426394{-# INLINE (!!) #-}
427−(!!) :: Monad m => Int -> Stream m Int -> m (Maybe Int)
428−(!!) = flip (S.!!)
395+(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
396+(!!) = flip (Internal.!!)
429397
430398{-# INLINE lookup #-}
431−lookup :: Monad m => Int -> Stream m Int -> m (Maybe Int)
399+lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
432400lookup val = S.lookup val . S.map (\x -> (x, x))
433−#endif
434401
435402o_1_space_elimination_folds :: Int -> [Benchmark]
436403o_1_space_elimination_folds value =
437404 [ bgroup "elimination"
438405 -- Basic folds
439− [
440−#ifdef USE_PRELUDE
441− bgroup "reduce"
406+ [ bgroup "reduce"
442407 [ bgroup
443408 "IO"
444409 [ benchIOSink value "foldl'" foldl'Reduce
445410 , benchIOSink value "foldl1'" foldl1'Reduce
446411 , benchIOSink value "foldlM'" foldlM'Reduce
447412 ]
448−
449413 , bgroup
450414 "Identity"
451415 [ benchIdentitySink value "foldl'" foldl'Reduce
452416 , benchIdentitySink value "foldl1'" foldl1'Reduce
453417 , benchIdentitySink value "foldlM'" foldlM'Reduce
454418 ]
455− ] ,
456−#endif
457− bgroup "build"
419+ ]
420+ , bgroup "build"
458421 [ bgroup "IO"
459422 [ benchIOSink value "foldrMElem" (foldrMElem value)
460423 ]
461424 , bgroup "Identity"
462425 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
463−#ifdef USE_STREAMK
464426 , 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− -}
427+ (S.length . runIdentity . foldrToStream)
480428 , benchPureSink value "foldrMToListLength"
481429 (Prelude.length . runIdentity . foldrMBuild)
482430 ]
483431 ]
484432
485433 -- 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
434+ , benchIOSink value "uncons" uncons
492435 , benchIOSink value "init" init
493436
494437 -- draining
@@ -502,6 +445,8 @@ o_1_space_elimination_folds value =
502445 -- , benchIOSink value "head" head
503446 , benchIOSink value "last" last
504447 , benchIOSink value "length" length
448+ , benchHoistSink value "length . generally"
449+ (length . Internal.generally)
505450 , benchIOSink value "sum" sum
506451 , benchIOSink value "product" product
507452 , benchIOSink value "maximumBy" maximumBy
@@ -525,7 +470,6 @@ o_1_space_elimination_folds value =
525470 , benchIOSink value "any" (any value)
526471 , benchIOSink value "and" (and value)
527472 , benchIOSink value "or" (or value)
528−#endif
529473
530474 -- length is used to check for foldr/build fusion
531475 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
@@ -536,13 +480,12 @@ o_1_space_elimination_folds value =
536480-- Buffered Transformations by fold
537481-------------------------------------------------------------------------------
538482
539−#ifdef USE_PRELUDE
540483{-# INLINE foldl'Build #-}
541−foldl'Build :: Monad m => Stream m Int -> m [Int]
484+foldl'Build :: Monad m => SerialT m Int -> m [Int]
542485foldl'Build = S.foldl' (flip (:)) []
543486
544487{-# INLINE foldlM'Build #-}
545−foldlM'Build :: Monad m => Stream m Int -> m [Int]
488+foldlM'Build :: Monad m => SerialT m Int -> m [Int]
546489foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
547490
548491o_n_heap_elimination_foldl :: Int -> [Benchmark]
@@ -556,7 +499,6 @@ o_n_heap_elimination_foldl value =
556499 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
557500 ]
558501 ]
559−#endif
560502
561503-- For comparisons
562504{-# INLINE showInstanceList #-}
@@ -576,7 +518,7 @@ o_n_heap_elimination_buffered value =
576518 ]
577519
578520{-# INLINE foldrMReduce #-}
579−foldrMReduce :: Monad m => Stream m Int -> m Int
521+foldrMReduce :: Monad m => SerialT m Int -> m Int
580522foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
581523
582524o_n_space_elimination_foldr :: Int -> [Benchmark]
@@ -592,14 +534,13 @@ o_n_space_elimination_foldr value =
592534 ]
593535 ]
594536
595−#ifdef USE_PRELUDE
596537o_n_heap_elimination_toList :: Int -> [Benchmark]
597538o_n_heap_elimination_toList value =
598539 [ bgroup "toList"
599540 -- Converting the stream to a list or pure stream in a strict monad
600− [ benchIOSink value "toListRev" S.toListRev
541+ [ benchIOSink value "toListRev" Internal.toListRev
601542 , benchIOSink value "toStreamRev"
602− (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))
543+ (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
603544 ]
604545 ]
605546
@@ -608,13 +549,10 @@ o_n_space_elimination_toList value =
608549 [ bgroup "toList"
609550 -- Converting the stream to a list or pure stream in a strict monad
610551 [ benchIOSink value "toList" S.toList
611−#ifndef USE_PRELUDE
612552 , benchIOSink value "toStream"
613− (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))
614−#endif
553+ (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
615554 ]
616555 ]
617−#endif
618556
619557-------------------------------------------------------------------------------
620558-- Multi-stream folds
@@ -625,7 +563,7 @@ o_n_space_elimination_toList value =
625563-------------------------------------------------------------------------------
626564
627565{-# INLINE eqBy' #-}
628−eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool
566+eqBy' :: (Monad m, Eq a) => SerialT m a -> m Bool
629567eqBy' src = S.eqBy (==) src src
630568
631569{-# INLINE eqByPure #-}
@@ -639,15 +577,15 @@ inspect $ 'eqByPure `hasNoType` ''D.Step
639577#endif
640578
641579{-# INLINE eqInstance #-}
642−eqInstance :: Stream Identity Int -> Bool
580+eqInstance :: SerialT Identity Int -> Bool
643581eqInstance src = src == src
644582
645583{-# INLINE eqInstanceNotEq #-}
646−eqInstanceNotEq :: Stream Identity Int -> Bool
584+eqInstanceNotEq :: SerialT Identity Int -> Bool
647585eqInstanceNotEq src = src /= src
648586
649587{-# INLINE cmpBy' #-}
650−cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering
588+cmpBy' :: (Monad m, Ord a) => SerialT m a -> m Ordering
651589cmpBy' src = S.cmpBy compare src src
652590
653591{-# INLINE cmpByPure #-}
@@ -661,7 +599,7 @@ inspect $ 'cmpByPure `hasNoType` ''D.Step
661599#endif
662600
663601{-# INLINE ordInstance #-}
664−ordInstance :: Stream Identity Int -> Bool
602+ordInstance :: SerialT Identity Int -> Bool
665603ordInstance src = src < src
666604
667605o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
@@ -676,15 +614,15 @@ o_1_space_elimination_multi_stream_pure value =
676614 ]
677615
678616{-# INLINE isPrefixOf #-}
679−isPrefixOf :: Monad m => Stream m Int -> m Bool
617+isPrefixOf :: Monad m => SerialT m Int -> m Bool
680618isPrefixOf src = S.isPrefixOf src src
681619
682620{-# INLINE isSubsequenceOf #-}
683−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
621+isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
684622isSubsequenceOf src = S.isSubsequenceOf src src
685623
686624{-# INLINE stripPrefix #-}
687−stripPrefix :: Monad m => Stream m Int -> m ()
625+stripPrefix :: Monad m => SerialT m Int -> m ()
688626stripPrefix src = do
689627 _ <- S.stripPrefix src src
690628 return ()
@@ -735,14 +673,14 @@ benchmarks moduleName size =
735673 , o_1_space_elimination_multi_stream_pure size
736674 , o_1_space_elimination_multi_stream size
737675 ]
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
676+ , bgroup (o_n_heap_prefix moduleName) $ concat
677+ [ o_n_heap_elimination_foldl size
678+ , o_n_heap_elimination_toList size
679+ , o_n_heap_elimination_buffered size
680+ ]
681+ , bgroup (o_n_space_prefix moduleName) $ concat
682+ [ o_n_space_elimination_foldable size
683+ , o_n_space_elimination_toList size
684+ , o_n_space_elimination_foldr size
685+ ]
748686 ]
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hsrenamed+70−124
@@ -1,5 +1,5 @@
11-- |
2−-- Module : Stream.Exceptions
2+-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions
33-- Copyright : (c) 2019 Composewell Technologies
44-- License : BSD-3-Clause
55-- Maintainer : streamly@composewell.com
@@ -7,13 +7,8 @@
77-- Portability : GHC
88
99{-# LANGUAGE CPP #-}
10−{-# LANGUAGE FlexibleContexts #-}
1110{-# LANGUAGE ScopedTypeVariables #-}
1211
13−#ifdef USE_PRELUDE
14−{-# OPTIONS_GHC -Wno-deprecations #-}
15−#endif
16−
1712#ifdef __HADDOCK_VERSION__
1813#undef INSPECTION
1914#endif
@@ -23,63 +18,29 @@
2318{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2419#endif
2520
26−module Stream.Exceptions (benchmarks) where
21+module Serial.Exceptions (benchmarks) where
2722
28−import Control.Exception (Exception, throwIO)
29−import Stream.Common (drain)
23+import Control.Exception (SomeException, Exception, throwIO)
24+import System.IO (Handle, hClose, hPutChar)
3025
3126import qualified Data.IORef as Ref
3227import qualified Data.Map.Strict as Map
3328
34−import Control.Exception (SomeException)
35−import System.IO (Handle, hClose, hPutChar)
3629import qualified Streamly.FileSystem.Handle as FH
37−import qualified Streamly.Internal.FileSystem.Handle as IFH
3830import 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
31+import qualified Streamly.Internal.FileSystem.Handle as IFH
32+import qualified Streamly.Internal.Data.Stream.IsStream as IP
33+import qualified Streamly.Prelude as S
4734
48−import Test.Tasty.Bench hiding (env)
35+import Gauge hiding (env)
4936import Prelude hiding (last, length)
5037import Streamly.Benchmark.Common
5138import Streamly.Benchmark.Common.Handle
5239
5340#ifdef INSPECTION
54−import Control.Monad.Catch (MonadCatch)
5541import Test.Inspection
5642
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
43+import qualified Streamly.Internal.Data.Stream.StreamD as D
8344#endif
8445
8546-------------------------------------------------------------------------------
@@ -95,41 +56,37 @@ instance Exception BenchException
9556
9657retryNoneSimple :: Int -> Int -> IO ()
9758retryNoneSimple length from =
98− drain
99− $ Stream.retry
100− (Map.singleton BenchException1 length)
101− (const Stream.nil)
102− source
59+ IP.drain
60+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
10361
10462 where
10563
106− source = Stream.enumerateFromTo from (from + length)
64+ source = S.enumerateFromTo from (from + length)
10765
10866retryNone :: Int -> Int -> IO ()
10967retryNone length from = do
11068 ref <- Ref.newIORef (0 :: Int)
111− drain
112− $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
69+ IP.drain
70+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil)
11371 $ source ref
11472
11573 where
11674
11775 source ref =
118− Stream.replicateM (from + length)
76+ IP.replicateM (from + length)
11977 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
12078
12179retryAll :: Int -> Int -> IO ()
12280retryAll length from = do
12381 ref <- Ref.newIORef 0
124− drain
125− $ Stream.retry
126− (Map.singleton BenchException1 (length + from)) (const Stream.nil)
82+ IP.drain
83+ $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
12784 $ source ref
12885
12986 where
13087
13188 source ref =
132− Stream.fromEffect
89+ IP.fromEffect
13390 $ do
13491 Ref.modifyIORef' ref (+ 1)
13592 val <- Ref.readIORef ref
@@ -139,13 +96,13 @@ retryAll length from = do
13996
14097retryUnknown :: Int -> Int -> IO ()
14198retryUnknown length from = do
142− drain
143− $ Stream.retry (Map.singleton BenchException1 length) (const source)
144− $ throwIO BenchException2 `Stream.before` Stream.nil
99+ IP.drain
100+ $ IP.retry (Map.singleton BenchException1 length) (const source)
101+ $ throwIO BenchException2 `S.before` S.nil
145102
146103 where
147104
148− source = Stream.enumerateFromTo from (from + length)
105+ source = S.enumerateFromTo from (from + length)
149106
150107
151108o_1_space_serial_exceptions :: Int -> [Benchmark]
@@ -159,8 +116,6 @@ o_1_space_serial_exceptions length =
159116 ]
160117 ]
161118
162−-- XXX Move these to FileSystem.Handle benchmarks
163−
164119-------------------------------------------------------------------------------
165120-- copy stream exceptions
166121-------------------------------------------------------------------------------
@@ -168,8 +123,8 @@ o_1_space_serial_exceptions length =
168123-- | Send the file contents to /dev/null with exception handling
169124readWriteOnExceptionStream :: Handle -> Handle -> IO ()
170125readWriteOnExceptionStream inh devNull =
171− let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
172− in Stream.fold (FH.write devNull) readEx
126+ let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
127+ in S.fold (FH.write devNull) $ readEx
173128
174129#ifdef INSPECTION
175130inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@@ -178,10 +133,9 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
178133-- | Send the file contents to /dev/null with exception handling
179134readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
180135readWriteHandleExceptionStream 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
136+ let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
137+ readEx = S.handle handler (S.unfold FH.read inh)
138+ in S.fold (FH.write devNull) $ readEx
185139
186140#ifdef INSPECTION
187141inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@@ -190,9 +144,8 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
190144-- | Send the file contents to /dev/null with exception handling
191145readWriteFinally_Stream :: Handle -> Handle -> IO ()
192146readWriteFinally_Stream inh devNull =
193− let readEx =
194− finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
195− in Stream.fold (FH.write devNull) readEx
147+ let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
148+ in S.fold (FH.write devNull) readEx
196149
197150#ifdef INSPECTION
198151inspect $ hasNoTypeClasses 'readWriteFinally_Stream
@@ -200,15 +153,15 @@ inspect $ hasNoTypeClasses 'readWriteFinally_Stream
200153
201154readWriteFinallyStream :: Handle -> Handle -> IO ()
202155readWriteFinallyStream inh devNull =
203− let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
204− in Stream.fold (FH.write devNull) readEx
156+ let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
157+ in S.fold (FH.write devNull) readEx
205158
206159-- | Send the file contents to /dev/null with exception handling
207160fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
208161fromToBytesBracket_Stream inh devNull =
209− let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
210− (\_ -> fromStreamD $ IFH.read inh)
211− in IFH.putBytes devNull (toStreamD readEx)
162+ let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
163+ (\_ -> IFH.toBytes inh)
164+ in IFH.putBytes devNull $ readEx
212165
213166#ifdef INSPECTION
214167inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
@@ -216,16 +169,16 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
216169
217170fromToBytesBracketStream :: Handle -> Handle -> IO ()
218171fromToBytesBracketStream inh devNull =
219− let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
220− (\_ -> fromStreamD $ IFH.read inh)
221− in IFH.putBytes devNull (toStreamD readEx)
172+ let readEx = S.bracket (return ()) (\_ -> hClose inh)
173+ (\_ -> IFH.toBytes inh)
174+ in IFH.putBytes devNull $ readEx
222175
223176readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
224177readWriteBeforeAfterStream inh devNull =
225178 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
179+ IP.after (hClose inh)
180+ $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
181+ in S.fold (FH.write devNull) readEx
229182
230183#ifdef INSPECTION
231184inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
@@ -233,8 +186,8 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
233186
234187readWriteAfterStream :: Handle -> Handle -> IO ()
235188readWriteAfterStream inh devNull =
236− let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
237− in Stream.fold (FH.write devNull) readEx
189+ let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
190+ in S.fold (FH.write devNull) readEx
238191
239192#ifdef INSPECTION
240193inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
@@ -242,8 +195,8 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
242195
243196readWriteAfter_Stream :: Handle -> Handle -> IO ()
244197readWriteAfter_Stream inh devNull =
245− let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
246− in Stream.fold (FH.write devNull) readEx
198+ let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
199+ in S.fold (FH.write devNull) readEx
247200
248201#ifdef INSPECTION
249202inspect $ hasNoTypeClasses 'readWriteAfter_Stream
@@ -253,25 +206,25 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
253206o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
254207o_1_space_copy_stream_exceptions env =
255208 [ bgroup "exceptions"
256− [ mkBenchSmall "Stream.onException" env $ \inh _ ->
209+ [ mkBenchSmall "S.onException" env $ \inh _ ->
257210 readWriteOnExceptionStream inh (nullH env)
258− , mkBenchSmall "Stream.handle" env $ \inh _ ->
211+ , mkBenchSmall "S.handle" env $ \inh _ ->
259212 readWriteHandleExceptionStream inh (nullH env)
260− , mkBenchSmall "Stream.finally_" env $ \inh _ ->
213+ , mkBenchSmall "S.finally_" env $ \inh _ ->
261214 readWriteFinally_Stream inh (nullH env)
262− , mkBenchSmall "Stream.finally" env $ \inh _ ->
215+ , mkBenchSmall "S.finally" env $ \inh _ ->
263216 readWriteFinallyStream inh (nullH env)
264− , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
217+ , mkBenchSmall "S.after . S.before" env $ \inh _ ->
265218 readWriteBeforeAfterStream inh (nullH env)
266− , mkBenchSmall "Stream.after" env $ \inh _ ->
219+ , mkBenchSmall "S.after" env $ \inh _ ->
267220 readWriteAfterStream inh (nullH env)
268− , mkBenchSmall "Stream.after_" env $ \inh _ ->
221+ , mkBenchSmall "S.after_" env $ \inh _ ->
269222 readWriteAfter_Stream inh (nullH env)
270223 ]
271224 , bgroup "exceptions/fromToBytes"
272− [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
225+ [ mkBenchSmall "S.bracket_" env $ \inh _ ->
273226 fromToBytesBracket_Stream inh (nullH env)
274− , mkBenchSmall "Stream.bracket" env $ \inh _ ->
227+ , mkBenchSmall "S.bracket" env $ \inh _ ->
275228 fromToBytesBracketStream inh (nullH env)
276229 ]
277230 ]
@@ -283,34 +236,26 @@ o_1_space_copy_stream_exceptions env =
283236-- | Send the file contents to /dev/null with exception handling
284237readChunksOnException :: Handle -> Handle -> IO ()
285238readChunksOnException inh devNull =
286− let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
239+ let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
287240 in IUF.fold (IFH.writeChunks devNull) readEx inh
288241
289242#ifdef INSPECTION
290−#if __GLASGOW_HASKELL__ >= 906
291−inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
292−#else
293243inspect $ hasNoTypeClasses 'readChunksOnException
294244#endif
295−#endif
296245
297246-- | Send the file contents to /dev/null with exception handling
298247readChunksBracket_ :: Handle -> Handle -> IO ()
299248readChunksBracket_ inh devNull =
300− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
249+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks
301250 in IUF.fold (IFH.writeChunks devNull) readEx inh
302251
303252#ifdef INSPECTION
304−#if __GLASGOW_HASKELL__ >= 906
305−inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
306−#else
307253inspect $ hasNoTypeClasses 'readChunksBracket_
308254#endif
309−#endif
310255
311256readChunksBracket :: Handle -> Handle -> IO ()
312257readChunksBracket inh devNull =
313− let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
258+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
314259 in IUF.fold (IFH.writeChunks devNull) readEx inh
315260
316261o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
@@ -332,11 +277,11 @@ o_1_space_copy_exceptions_readChunks env =
332277-- | Send the file contents to /dev/null with exception handling
333278toChunksBracket_ :: Handle -> Handle -> IO ()
334279toChunksBracket_ inh devNull =
335− let readEx = bracketUnsafe
280+ let readEx = IP.bracket_
336281 (return ())
337282 (\_ -> hClose inh)
338− (\_ -> fromStreamD $ IFH.readChunks inh)
339− in Stream.fold (IFH.writeChunks devNull) readEx
283+ (\_ -> IFH.toChunks inh)
284+ in S.fold (IFH.writeChunks devNull) $ readEx
340285
341286#ifdef INSPECTION
342287inspect $ hasNoTypeClasses 'toChunksBracket_
@@ -344,28 +289,29 @@ inspect $ hasNoTypeClasses 'toChunksBracket_
344289
345290toChunksBracket :: Handle -> Handle -> IO ()
346291toChunksBracket inh devNull =
347− let readEx = Stream.bracket
292+ let readEx = S.bracket
348293 (return ())
349294 (\_ -> hClose inh)
350− (\_ -> fromStreamD $ IFH.readChunks inh)
351− in Stream.fold (IFH.writeChunks devNull) readEx
295+ (\_ -> IFH.toChunks inh)
296+ in S.fold (IFH.writeChunks devNull) $ readEx
352297
353298o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
354299o_1_space_copy_exceptions_toChunks env =
355300 [ bgroup "exceptions/toChunks"
356− [ mkBench "Stream.bracket_" env $ \inH _ ->
301+ [ mkBench "S.bracket_" env $ \inH _ ->
357302 toChunksBracket_ inH (nullH env)
358− , mkBench "Stream.bracket" env $ \inH _ ->
303+ , mkBench "S.bracket" env $ \inH _ ->
359304 toChunksBracket inH (nullH env)
360305 ]
361306 ]
362307
308+
363309benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
364−benchmarks moduleName _env size =
310+benchmarks moduleName env size =
365311 [ 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
312+ [ o_1_space_copy_exceptions_readChunks env
313+ , o_1_space_copy_exceptions_toChunks env
314+ , o_1_space_copy_stream_exceptions env
315+ , o_1_space_serial_exceptions size
370316 ]
371317 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hsnew file+179
@@ -0,0 +1,179 @@
1+-- |
2+-- Module : Serial.Generation
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+module Serial.Generation (benchmarks) where
13+
14+import Data.Functor.Identity (Identity)
15+
16+import qualified Prelude
17+import qualified GHC.Exts as GHC
18+
19+import qualified Streamly.Prelude as S
20+
21+import Gauge
22+import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
23+import Streamly.Benchmark.Common
24+import Streamly.Benchmark.Prelude
25+import Prelude hiding (repeat, replicate, iterate)
26+
27+-------------------------------------------------------------------------------
28+-- Generation
29+-------------------------------------------------------------------------------
30+
31+-------------------------------------------------------------------------------
32+-- fromList
33+-------------------------------------------------------------------------------
34+
35+{-# INLINE sourceIsList #-}
36+sourceIsList :: Int -> Int -> SerialT Identity Int
37+sourceIsList value n = GHC.fromList [n..n+value]
38+
39+{-# INLINE sourceIsString #-}
40+sourceIsString :: Int -> Int -> SerialT Identity Char
41+sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
42+
43+{-# INLINE readInstance #-}
44+readInstance :: String -> SerialT Identity Int
45+readInstance str =
46+ let r = reads str
47+ in case r of
48+ [(x,"")] -> x
49+ _ -> error "readInstance: no parse"
50+
51+-- For comparisons
52+{-# INLINE readInstanceList #-}
53+readInstanceList :: String -> [Int]
54+readInstanceList str =
55+ let r = reads str
56+ in case r of
57+ [(x,"")] -> x
58+ _ -> error "readInstance: no parse"
59+
60+{-# INLINE repeat #-}
61+repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
62+repeat count = S.take count . S.repeat
63+
64+{-# INLINE repeatM #-}
65+repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
66+repeatM count = S.take count . S.repeatM . return
67+
68+{-# INLINE replicate #-}
69+replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
70+replicate = S.replicate
71+
72+{-# INLINE replicateM #-}
73+replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
74+replicateM count = S.replicateM count . return
75+
76+{-# INLINE enumerateFrom #-}
77+enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
78+enumerateFrom count = S.take count . S.enumerateFrom
79+
80+{-# INLINE enumerateFromTo #-}
81+enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
82+enumerateFromTo = sourceIntFromTo
83+
84+{-# INLINE enumerateFromThen #-}
85+enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
86+enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)
87+
88+{-# INLINE enumerateFromThenTo #-}
89+enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
90+enumerateFromThenTo = sourceIntFromThenTo
91+
92+-- n ~ 1
93+{-# INLINE enumerate #-}
94+enumerate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
95+enumerate count n = S.take (count + n) S.enumerate
96+
97+-- n ~ 1
98+{-# INLINE enumerateTo #-}
99+enumerateTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
100+enumerateTo count n = S.enumerateTo (minBound + count + n)
101+
102+{-# INLINE iterate #-}
103+iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
104+iterate count = S.take count . S.iterate (+1)
105+
106+{-# INLINE iterateM #-}
107+iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
108+iterateM count = S.take count . S.iterateM (return . (+1)) . return
109+
110+{-# INLINE fromIndices #-}
111+fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
112+fromIndices value n = S.take value $ S.fromIndices (+ n)
113+
114+{-# INLINE fromIndicesM #-}
115+fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
116+fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
117+
118+o_1_space_generation :: Int -> [Benchmark]
119+o_1_space_generation value =
120+ [ bgroup "generation"
121+ [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
122+ , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
123+ , benchIOSrc fromSerial "repeat" (repeat value)
124+ , benchIOSrc fromSerial "repeatM" (repeatM value)
125+ , benchIOSrc fromSerial "replicate" (replicate value)
126+ , benchIOSrc fromSerial "replicateM" (replicateM value)
127+ , benchIOSrc fromSerial "iterate" (iterate value)
128+ , benchIOSrc fromSerial "iterateM" (iterateM value)
129+ , benchIOSrc fromSerial "fromIndices" (fromIndices value)
130+ , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)
131+ , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)
132+ , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)
133+ , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)
134+ , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)
135+ , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)
136+ , benchIOSrc fromSerial "fromList" (sourceFromList value)
137+ , benchPureSrc "IsList.fromList" (sourceIsList value)
138+ , benchPureSrc "IsString.fromString" (sourceIsString value)
139+ , benchIOSrc fromSerial "fromListM" (sourceFromListM value)
140+ , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)
141+ , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)
142+ , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)
143+ , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)
144+ , benchIOSrc fromSerial "enumerate" (enumerate value)
145+ , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)
146+
147+ -- These essentially test cons and consM
148+ , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
149+ , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
150+
151+ , benchIOSrc fromSerial "absTimes" $ absTimes value
152+ ]
153+ ]
154+
155+o_n_heap_generation :: Int -> [Benchmark]
156+o_n_heap_generation value =
157+ [ bgroup "buffered"
158+ -- Buffers the output of show/read.
159+ -- XXX can the outputs be streaming? Can we have special read/show
160+ -- style type classes, readM/showM supporting streaming effects?
161+ [ bench "readsPrec pure streams" $
162+ nf readInstance (mkString value)
163+ , bench "readsPrec Haskell lists" $
164+ nf readInstanceList (mkListString value)
165+ ]
166+ ]
167+
168+-------------------------------------------------------------------------------
169+-- Main
170+-------------------------------------------------------------------------------
171+
172+-- In addition to gauge options, the number of elements in the stream can be
173+-- passed using the --stream-size option.
174+--
175+benchmarks :: String -> Int -> [Benchmark]
176+benchmarks moduleName size =
177+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
178+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
179+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hsnew file+123
@@ -0,0 +1,123 @@
1+-- |
2+-- Module : Serial.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+module Serial.Lift (benchmarks) where
13+
14+import Control.Monad.State.Strict (StateT, get, put, MonadState)
15+import qualified Control.Monad.State.Strict as State
16+import Control.Monad.Trans.Class (lift)
17+
18+import qualified Streamly.Prelude as S
19+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20+
21+import Gauge
22+import Streamly.Prelude (SerialT, fromSerial)
23+import Streamly.Benchmark.Common
24+import Streamly.Benchmark.Prelude
25+import Prelude hiding (reverse, tail)
26+
27+-------------------------------------------------------------------------------
28+-- Monad transformation (hoisting etc.)
29+-------------------------------------------------------------------------------
30+
31+{-# INLINE sourceUnfoldrState #-}
32+sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
33+ => Int -> Int -> t (StateT Int m) Int
34+sourceUnfoldrState value n = S.unfoldrM step n
35+ where
36+ step cnt =
37+ if cnt > n + value
38+ then return Nothing
39+ else do
40+ s <- get
41+ put (s + 1)
42+ return (Just (s, cnt + 1))
43+
44+{-# INLINE evalStateT #-}
45+evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
46+evalStateT value n =
47+ Internal.evalStateT (return 0) (sourceUnfoldrState value n)
48+
49+{-# INLINE withState #-}
50+withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
51+withState value n =
52+ Internal.evalStateT
53+ (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
54+
55+o_1_space_hoisting :: Int -> [Benchmark]
56+o_1_space_hoisting value =
57+ [ bgroup "hoisting"
58+ [ benchIOSrc fromSerial "evalState" (evalStateT value)
59+ , benchIOSrc fromSerial "withState" (withState value)
60+ ]
61+ ]
62+
63+{-# INLINE iterateStateIO #-}
64+iterateStateIO ::
65+ (S.MonadAsync m)
66+ => Int
67+ -> StateT Int m Int
68+iterateStateIO n = do
69+ x <- get
70+ if x > n
71+ then do
72+ put (x - 1)
73+ iterateStateIO n
74+ else return x
75+
76+{-# INLINE iterateStateT #-}
77+iterateStateT :: Int -> SerialT (StateT Int IO) Int
78+iterateStateT n = do
79+ x <- lift get
80+ if x > n
81+ then do
82+ lift $ put (x - 1)
83+ iterateStateT n
84+ else return x
85+
86+{-# INLINE iterateState #-}
87+{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
88+iterateState ::
89+ (S.MonadAsync m, MonadState Int m)
90+ => Int
91+ -> SerialT m Int
92+iterateState n = do
93+ x <- get
94+ if x > n
95+ then do
96+ put (x - 1)
97+ iterateState n
98+ else return x
99+
100+o_n_heap_transformer :: Int -> [Benchmark]
101+o_n_heap_transformer value =
102+ [ bgroup "transformer"
103+ [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
104+ State.evalStateT (iterateStateIO n) value
105+ , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
106+ State.evalStateT (S.drain (iterateStateT n)) value
107+ , benchIO "MonadState Int m => SerialT m Int" $ \n ->
108+ State.evalStateT (S.drain (iterateState n)) value
109+ ]
110+ ]
111+
112+-------------------------------------------------------------------------------
113+-- Main
114+-------------------------------------------------------------------------------
115+
116+-- In addition to gauge options, the number of elements in the stream can be
117+-- passed using the --stream-size option.
118+--
119+benchmarks :: String -> Int -> [Benchmark]
120+benchmarks moduleName size =
121+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
122+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
123+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hsnew file+463
@@ -0,0 +1,463 @@
1+-- |
2+-- Module : Serial.NestedFold
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+{-# LANGUAGE TupleSections #-}
14+
15+module Serial.NestedFold (benchmarks) where
16+
17+import Control.DeepSeq (NFData(..))
18+import Control.Monad (when)
19+import Control.Monad.IO.Class (MonadIO(..))
20+import Data.Monoid (Sum(..))
21+import GHC.Generics (Generic)
22+
23+import qualified Streamly.Internal.Data.Refold.Type as Refold
24+import qualified Streamly.Internal.Data.Fold as FL
25+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
26+import qualified Streamly.Prelude as S
27+
28+import Gauge
29+import Streamly.Prelude (SerialT, fromSerial)
30+import Streamly.Benchmark.Common
31+import Streamly.Benchmark.Prelude
32+import Prelude hiding (reverse, tail)
33+
34+-------------------------------------------------------------------------------
35+-- Iteration/looping utilities
36+-------------------------------------------------------------------------------
37+
38+{-# INLINE iterateN #-}
39+iterateN :: (Int -> a -> a) -> a -> Int -> a
40+iterateN g initial count = f count initial
41+
42+ where
43+
44+ f (0 :: Int) x = x
45+ f i x = f (i - 1) (g i x)
46+
47+-- Iterate a transformation over a singleton stream
48+{-# INLINE iterateSingleton #-}
49+iterateSingleton :: S.MonadAsync m
50+ => (Int -> SerialT m Int -> SerialT m Int)
51+ -> Int
52+ -> Int
53+ -> SerialT m Int
54+iterateSingleton g count n = iterateN g (return n) count
55+
56+-- XXX need to check why this is slower than the explicit recursion above, even
57+-- if the above code is written in a foldr like head recursive way. We also
58+-- need to try this with foldlM' once #150 is fixed.
59+-- However, it is perhaps best to keep the iteration benchmarks independent of
60+-- foldrM and any related fusion issues.
61+{-# INLINE _iterateSingleton #-}
62+_iterateSingleton ::
63+ S.MonadAsync m
64+ => (Int -> SerialT m Int -> SerialT m Int)
65+ -> Int
66+ -> Int
67+ -> SerialT m Int
68+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
69+
70+-- Apply transformation g count times on a stream of length len
71+{-# INLINE iterateSource #-}
72+iterateSource ::
73+ S.MonadAsync m
74+ => (SerialT m Int -> SerialT m Int)
75+ -> Int
76+ -> Int
77+ -> Int
78+ -> SerialT m Int
79+iterateSource g count len n = f count (sourceUnfoldrM len n)
80+
81+ where
82+
83+ f (0 :: Int) stream = stream
84+ f i stream = f (i - 1) (g stream)
85+
86+-------------------------------------------------------------------------------
87+-- Functor
88+-------------------------------------------------------------------------------
89+
90+o_n_space_functor :: Int -> [Benchmark]
91+o_n_space_functor value =
92+ [ bgroup "Functor"
93+ [ benchIO "(+) (n times) (baseline)" $ \i0 ->
94+ iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
95+ , benchIOSrc fromSerial "(<$) (n times)" $
96+ iterateSingleton (<$) value
97+ , benchIOSrc fromSerial "fmap (n times)" $
98+ iterateSingleton (fmap . (+)) value
99+ {-
100+ , benchIOSrc fromSerial "_(<$) (n times)" $
101+ _iterateSingleton (<$) value
102+ , benchIOSrc fromSerial "_fmap (n times)" $
103+ _iterateSingleton (fmap . (+)) value
104+ -}
105+ ]
106+ ]
107+
108+-------------------------------------------------------------------------------
109+-- Grouping transformations
110+-------------------------------------------------------------------------------
111+
112+{-# INLINE groups #-}
113+groups :: MonadIO m => SerialT m Int -> m ()
114+groups = S.drain . S.groups FL.drain
115+
116+-- XXX Change this test when the order of comparison is later changed
117+{-# INLINE groupsByGT #-}
118+groupsByGT :: MonadIO m => SerialT m Int -> m ()
119+groupsByGT = S.drain . S.groupsBy (>) FL.drain
120+
121+{-# INLINE groupsByEq #-}
122+groupsByEq :: MonadIO m => SerialT m Int -> m ()
123+groupsByEq = S.drain . S.groupsBy (==) FL.drain
124+
125+-- XXX Change this test when the order of comparison is later changed
126+{-# INLINE groupsByRollingLT #-}
127+groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
128+groupsByRollingLT =
129+ S.drain . S.groupsByRolling (<) FL.drain
130+
131+{-# INLINE groupsByRollingEq #-}
132+groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
133+groupsByRollingEq =
134+ S.drain . S.groupsByRolling (==) FL.drain
135+
136+{-# INLINE foldMany #-}
137+foldMany :: Monad m => SerialT m Int -> m ()
138+foldMany =
139+ S.drain
140+ . S.map getSum
141+ . Internal.foldMany (FL.take 2 FL.mconcat)
142+ . S.map Sum
143+
144+{-# INLINE refoldMany #-}
145+refoldMany :: Monad m => SerialT m Int -> m ()
146+refoldMany =
147+ S.drain
148+ . S.map getSum
149+ . Internal.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
150+ . S.map Sum
151+
152+{-# INLINE foldIterateM #-}
153+foldIterateM :: Monad m => SerialT m Int -> m ()
154+foldIterateM =
155+ S.drain
156+ . S.map getSum
157+ . Internal.foldIterateM
158+ (return . FL.take 2 . FL.sconcat) (return (Sum 0))
159+ . S.map Sum
160+
161+{-# INLINE refoldIterateM #-}
162+refoldIterateM :: Monad m => SerialT m Int -> m ()
163+refoldIterateM =
164+ S.drain
165+ . S.map getSum
166+ . Internal.refoldIterateM
167+ (Refold.take 2 Refold.sconcat) (return (Sum 0))
168+ . S.map Sum
169+
170+o_1_space_grouping :: Int -> [Benchmark]
171+o_1_space_grouping value =
172+ -- Buffering operations using heap proportional to group/window sizes.
173+ [ bgroup "grouping"
174+ [ benchIOSink value "groups" groups
175+ , benchIOSink value "groupsByGT" groupsByGT
176+ , benchIOSink value "groupsByEq" groupsByEq
177+ , benchIOSink value "groupsByRollingLT" groupsByRollingLT
178+ , benchIOSink value "groupsByRollingEq" groupsByRollingEq
179+ , benchIOSink value "foldMany" foldMany
180+ , benchIOSink value "refoldMany" refoldMany
181+ , benchIOSink value "foldIterateM" foldIterateM
182+ , benchIOSink value "refoldIterateM" refoldIterateM
183+ ]
184+ ]
185+
186+-------------------------------------------------------------------------------
187+-- Size conserving transformations (reordering, buffering, etc.)
188+-------------------------------------------------------------------------------
189+
190+{-# INLINE reverse #-}
191+reverse :: MonadIO m => Int -> SerialT m Int -> m ()
192+reverse n = composeN n S.reverse
193+
194+{-# INLINE reverse' #-}
195+reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
196+reverse' n = composeN n Internal.reverse'
197+
198+o_n_heap_buffering :: Int -> [Benchmark]
199+o_n_heap_buffering value =
200+ [ bgroup "buffered"
201+ [
202+ -- Reversing a stream
203+ benchIOSink value "reverse" (reverse 1)
204+ , benchIOSink value "reverse'" (reverse' 1)
205+
206+ , benchIOSink value "mkAsync" (mkAsync fromSerial)
207+ ]
208+ ]
209+
210+-------------------------------------------------------------------------------
211+-- Grouping/Splitting
212+-------------------------------------------------------------------------------
213+
214+{-# INLINE classifySessionsOf #-}
215+classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()
216+classifySessionsOf =
217+ S.drain
218+ . Internal.classifySessionsOf (const (return False)) 3 FL.drain
219+ . Internal.timestamped
220+ . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
221+
222+o_n_space_grouping :: Int -> [Benchmark]
223+o_n_space_grouping value =
224+ -- Buffering operations using heap proportional to group/window sizes.
225+ [ bgroup "grouping"
226+ [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf
227+ ]
228+ ]
229+
230+-------------------------------------------------------------------------------
231+-- Mixed Transformation
232+-------------------------------------------------------------------------------
233+
234+{-# INLINE scanMap #-}
235+scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
236+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
237+
238+{-# INLINE dropMap #-}
239+dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
240+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
241+
242+{-# INLINE dropScan #-}
243+dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
244+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
245+
246+{-# INLINE takeDrop #-}
247+takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
248+takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
249+
250+{-# INLINE takeScan #-}
251+takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
252+takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
253+
254+{-# INLINE takeMap #-}
255+takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
256+takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
257+
258+{-# INLINE filterDrop #-}
259+filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
260+filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
261+
262+{-# INLINE filterTake #-}
263+filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
264+filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
265+
266+{-# INLINE filterScan #-}
267+filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
268+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
269+
270+{-# INLINE filterScanl1 #-}
271+filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
272+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
273+
274+{-# INLINE filterMap #-}
275+filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
276+filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
277+
278+-------------------------------------------------------------------------------
279+-- Scan and fold
280+-------------------------------------------------------------------------------
281+
282+data Pair a b =
283+ Pair !a !b
284+ deriving (Generic, NFData)
285+
286+{-# INLINE sumProductFold #-}
287+sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
288+sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
289+
290+{-# INLINE sumProductScan #-}
291+sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
292+sumProductScan =
293+ S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
294+ S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
295+
296+{-# INLINE foldl'ReduceMap #-}
297+foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
298+foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0
299+
300+o_1_space_transformations_mixed :: Int -> [Benchmark]
301+o_1_space_transformations_mixed value =
302+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
303+ -- library. If scan/fold followed by a map is efficient enough we may not
304+ -- need monolithic implementations of these.
305+ [ bgroup "mixed"
306+ [ benchIOSink value "scanl-map" (scanMap 1)
307+ , benchIOSink value "foldl-map" foldl'ReduceMap
308+ , benchIOSink value "sum-product-fold" sumProductFold
309+ , benchIOSink value "sum-product-scan" sumProductScan
310+ ]
311+ ]
312+
313+o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
314+o_1_space_transformations_mixedX4 value =
315+ [ bgroup "mixedX4"
316+ [ benchIOSink value "scan-map" (scanMap 4)
317+ , benchIOSink value "drop-map" (dropMap 4)
318+ , benchIOSink value "drop-scan" (dropScan 4)
319+ , benchIOSink value "take-drop" (takeDrop value 4)
320+ , benchIOSink value "take-scan" (takeScan value 4)
321+ , benchIOSink value "take-map" (takeMap value 4)
322+ , benchIOSink value "filter-drop" (filterDrop value 4)
323+ , benchIOSink value "filter-take" (filterTake value 4)
324+ , benchIOSink value "filter-scan" (filterScan 4)
325+ , benchIOSink value "filter-scanl1" (filterScanl1 4)
326+ , benchIOSink value "filter-map" (filterMap value 4)
327+ ]
328+ ]
329+
330+-------------------------------------------------------------------------------
331+-- Iterating a transformation over and over again
332+-------------------------------------------------------------------------------
333+
334+-- this is quadratic
335+{-# INLINE iterateScan #-}
336+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
337+iterateScan = iterateSource (S.scanl' (+) 0)
338+
339+-- this is quadratic
340+{-# INLINE iterateScanl1 #-}
341+iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
342+iterateScanl1 = iterateSource (S.scanl1' (+))
343+
344+{-# INLINE iterateMapM #-}
345+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
346+iterateMapM = iterateSource (S.mapM return)
347+
348+{-# INLINE iterateFilterEven #-}
349+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
350+iterateFilterEven = iterateSource (S.filter even)
351+
352+{-# INLINE iterateTakeAll #-}
353+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
354+iterateTakeAll value = iterateSource (S.take (value + 1))
355+
356+{-# INLINE iterateDropOne #-}
357+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
358+iterateDropOne = iterateSource (S.drop 1)
359+
360+{-# INLINE iterateDropWhileFalse #-}
361+iterateDropWhileFalse :: S.MonadAsync m
362+ => Int -> Int -> Int -> Int -> SerialT m Int
363+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
364+
365+{-# INLINE iterateDropWhileTrue #-}
366+iterateDropWhileTrue :: S.MonadAsync m
367+ => Int -> Int -> Int -> Int -> SerialT m Int
368+iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
369+
370+{-# INLINE tail #-}
371+tail :: Monad m => SerialT m a -> m ()
372+tail s = S.tail s >>= mapM_ tail
373+
374+{-# INLINE nullHeadTail #-}
375+nullHeadTail :: Monad m => SerialT m Int -> m ()
376+nullHeadTail s = do
377+ r <- S.null s
378+ when (not r) $ do
379+ _ <- S.head s
380+ S.tail s >>= mapM_ nullHeadTail
381+
382+-- Head recursive operations.
383+o_n_stack_iterated :: Int -> [Benchmark]
384+o_n_stack_iterated value = by10 `seq` by100 `seq`
385+ [ bgroup "iterated"
386+ [ benchIOSrc fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10
387+ , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $
388+ iterateScan by100 100
389+ , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
390+ , benchIOSrc fromSerial "filterEven (n/10 x 10)" $
391+ iterateFilterEven by10 10
392+ , benchIOSrc fromSerial "takeAll (n/10 x 10)" $
393+ iterateTakeAll value by10 10
394+ , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10
395+ , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $
396+ iterateDropWhileFalse value by10 10
397+ , benchIOSrc fromSerial "dropWhileTrue (n/10 x 10)" $
398+ iterateDropWhileTrue value by10 10
399+ , benchIOSink value "tail" tail
400+ , benchIOSink value "nullHeadTail" nullHeadTail
401+ ]
402+ ]
403+
404+ where
405+
406+ by10 = value `div` 10
407+ by100 = value `div` 100
408+
409+-------------------------------------------------------------------------------
410+-- Pipes
411+-------------------------------------------------------------------------------
412+
413+o_1_space_pipes :: Int -> [Benchmark]
414+o_1_space_pipes value =
415+ [ bgroup "pipes"
416+ [ benchIOSink value "mapM" (transformMapM fromSerial 1)
417+ , benchIOSink value "compose" (transformComposeMapM fromSerial 1)
418+ , benchIOSink value "tee" (transformTeeMapM fromSerial 1)
419+#ifdef DEVBUILD
420+ -- XXX this take 1 GB memory to compile
421+ , benchIOSink value "zip" (transformZipMapM fromSerial 1)
422+#endif
423+ ]
424+ ]
425+
426+o_1_space_pipesX4 :: Int -> [Benchmark]
427+o_1_space_pipesX4 value =
428+ [ bgroup "pipesX4"
429+ [ benchIOSink value "mapM" (transformMapM fromSerial 4)
430+ , benchIOSink value "compose" (transformComposeMapM fromSerial 4)
431+ , benchIOSink value "tee" (transformTeeMapM fromSerial 4)
432+#ifdef DEVBUILD
433+ -- XXX this take 1 GB memory to compile
434+ , benchIOSink value "zip" (transformZipMapM fromSerial 4)
435+#endif
436+ ]
437+ ]
438+
439+-------------------------------------------------------------------------------
440+-- Main
441+-------------------------------------------------------------------------------
442+
443+-- In addition to gauge options, the number of elements in the stream can be
444+-- passed using the --stream-size option.
445+--
446+benchmarks :: String -> Int -> [Benchmark]
447+benchmarks moduleName size =
448+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
449+ [ o_1_space_grouping size
450+ , o_1_space_transformations_mixed size
451+ , o_1_space_transformations_mixedX4 size
452+
453+ -- pipes
454+ , o_1_space_pipes size
455+ , o_1_space_pipesX4 size
456+ ]
457+ , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
458+ , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
459+ [ o_n_space_grouping size
460+ , o_n_space_functor size
461+ , o_n_heap_buffering size
462+ ]
463+ ]
benchmark/Streamly/Benchmark/Data/Stream/Expand.hs → benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hsrenamed+134−254
@@ -1,5 +1,5 @@
11-- |
2−-- Module : Stream.Expand
2+-- Module : Serial.NestedStream
33-- Copyright : (c) 2018 Composewell Technologies
44-- License : BSD-3-Clause
55-- Maintainer : streamly@composewell.com
@@ -8,11 +8,6 @@
88{-# LANGUAGE FlexibleContexts #-}
99{-# LANGUAGE ScopedTypeVariables #-}
1010{-# LANGUAGE RankNTypes #-}
11−{-# LANGUAGE TupleSections #-}
12−
13−#ifdef USE_PRELUDE
14−{-# OPTIONS_GHC -Wno-deprecations #-}
15−#endif
1611
1712#ifdef __HADDOCK_VERSION__
1813#undef INSPECTION
@@ -23,47 +18,33 @@
2318{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2419#endif
2520
26−module Stream.Expand (benchmarks) where
21+module Serial.NestedStream (benchmarks) where
22+
23+import Control.Monad.Trans.Class (lift)
24+
25+import qualified Control.Applicative as AP
2726
2827#ifdef INSPECTION
2928import GHC.Types (SPEC(..))
3029import Test.Inspection
3130
32−import qualified Streamly.Internal.Data.Stream as D
31+import qualified Streamly.Internal.Data.Stream.StreamD as D
3332#endif
3433
35−import qualified Stream.Common as Common
34+import qualified Streamly.Prelude as S
35+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
3636import qualified Streamly.Internal.Data.Unfold as UF
3737
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
38+import Gauge
39+import Streamly.Prelude (SerialT, fromSerial, serial)
5940import Streamly.Benchmark.Common
41+import Streamly.Benchmark.Prelude
6042import Prelude hiding (concatMap)
6143
6244-------------------------------------------------------------------------------
6345-- Iteration/looping utilities
6446-------------------------------------------------------------------------------
6547
66−#ifdef USE_STREAMK
6748{-# INLINE iterateN #-}
6849iterateN :: (Int -> a -> a) -> a -> Int -> a
6950iterateN g initial count = f count initial
@@ -75,18 +56,13 @@ iterateN g initial count = f count initial
7556
7657-- Iterate a transformation over a singleton stream
7758{-# INLINE iterateSingleton #-}
78−iterateSingleton :: Applicative m =>
79− (Int -> CrossStreamK m Int -> CrossStreamK m Int)
59+iterateSingleton :: S.MonadAsync m
60+ => (Int -> SerialT m Int -> SerialT m Int)
8061 -> Int
8162 -> 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
63+ -> SerialT m Int
64+iterateSingleton g count n = iterateN g (return n) count
8865
89−{-
9066-- XXX need to check why this is slower than the explicit recursion above, even
9167-- if the above code is written in a foldr like head recursive way. We also
9268-- need to try this with foldlM' once #150 is fixed.
@@ -94,13 +70,12 @@ iterateSingleton g count n =
9470-- foldrM and any related fusion issues.
9571{-# INLINE _iterateSingleton #-}
9672_iterateSingleton ::
97− Monad m
98− => (Int -> Stream m Int -> Stream m Int)
73+ S.MonadAsync m
74+ => (Int -> SerialT m Int -> SerialT m Int)
9975 -> Int
10076 -> Int
101− -> Stream m Int
77+ -> SerialT m Int
10278_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
103−-}
10479
10580-------------------------------------------------------------------------------
10681-- Multi-Stream
@@ -113,28 +88,50 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
11388{-# INLINE serial2 #-}
11489serial2 :: Int -> Int -> IO ()
11590serial2 count n =
116− drain $ toStream $
117− Common.append
118− (fromStream $ sourceUnfoldrM count n)
119− (fromStream $ sourceUnfoldrM count (n + 1))
91+ S.drain $
92+ S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
12093
12194{-# INLINE serial4 #-}
12295serial4 :: Int -> Int -> IO ()
12396serial4 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)))
97+ S.drain $
98+ S.serial
99+ (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
100+ (S.serial
101+ (sourceUnfoldrM count (n + 2))
102+ (sourceUnfoldrM count (n + 3)))
103+
104+{-# INLINE append2 #-}
105+append2 :: Int -> Int -> IO ()
106+append2 count n =
107+ S.drain $
108+ Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
109+
110+{-# INLINE append4 #-}
111+append4 :: Int -> Int -> IO ()
112+append4 count n =
113+ S.drain $
114+ Internal.append
115+ (Internal.append
116+ (sourceUnfoldrM count n)
117+ (sourceUnfoldrM count (n + 1)))
118+ (Internal.append
119+ (sourceUnfoldrM count (n + 2))
120+ (sourceUnfoldrM count (n + 3)))
121+
122+#ifdef INSPECTION
123+inspect $ hasNoTypeClasses 'append2
124+inspect $ 'append2 `hasNoType` ''SPEC
125+inspect $ 'append2 `hasNoType` ''D.AppendState
126+#endif
132127
133128o_1_space_joining :: Int -> [Benchmark]
134129o_1_space_joining value =
135130 [ bgroup "joining"
136131 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
132+ , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
137133 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
134+ , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
138135 ]
139136 ]
140137
@@ -142,24 +139,22 @@ o_1_space_joining value =
142139-- Concat Foldable containers
143140-------------------------------------------------------------------------------
144141
145−#ifdef USE_PRELUDE
146142o_1_space_concatFoldable :: Int -> [Benchmark]
147143o_1_space_concatFoldable value =
148144 [ bgroup "concat-foldable"
149− [ benchIOSrc "foldMapWith (<>) (List)"
145+ [ benchIOSrc fromSerial "foldMapWith (<>) (List)"
150146 (sourceFoldMapWith value)
151− , benchIOSrc "foldMapWith (<>) (Stream)"
147+ , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"
152148 (sourceFoldMapWithStream value)
153− , benchIOSrc "foldMapWithM (<>) (List)"
149+ , benchIOSrc fromSerial "foldMapWithM (<>) (List)"
154150 (sourceFoldMapWithM value)
155− , benchIOSrc "S.concatFoldableWith (<>) (List)"
151+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
156152 (concatFoldableWith value)
157− , benchIOSrc "S.concatForFoldableWith (<>) (List)"
153+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
158154 (concatForFoldableWith value)
159− , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
155+ , benchIOSrc fromSerial "foldMapM (List)" (sourceFoldMapM value)
160156 ]
161157 ]
162−#endif
163158
164159-------------------------------------------------------------------------------
165160-- Concat
@@ -170,15 +165,14 @@ o_1_space_concatFoldable value =
170165{-# INLINE concatMap #-}
171166concatMap :: Int -> Int -> Int -> IO ()
172167concatMap outer inner n =
173− drain $ toStream $ StreamK.concatMap
174− (\_ -> fromStream $ sourceUnfoldrM inner n)
175− (fromStream $ sourceUnfoldrM outer n)
168+ S.drain $ S.concatMap
169+ (\_ -> sourceUnfoldrM inner n)
170+ (sourceUnfoldrM outer n)
176171
177−#ifndef USE_STREAMK
178172{-# INLINE concatMapM #-}
179173concatMapM :: Int -> Int -> Int -> IO ()
180174concatMapM outer inner n =
181− drain $ S.concatMapM
175+ S.drain $ S.concatMapM
182176 (\_ -> return $ sourceUnfoldrM inner n)
183177 (sourceUnfoldrM outer n)
184178
@@ -186,23 +180,18 @@ concatMapM outer inner n =
186180inspect $ hasNoTypeClasses 'concatMap
187181inspect $ 'concatMap `hasNoType` ''SPEC
188182#endif
189−#endif
190183
191184-- concatMap unfoldr/unfoldr
192185
193186{-# INLINE concatMapPure #-}
194187concatMapPure :: Int -> Int -> Int -> IO ()
195188concatMapPure outer inner n =
196− drain $ toStream $ StreamK.concatMap
197− (\_ -> fromStream $ sourceUnfoldr inner n)
198− (fromStream $ sourceUnfoldr outer n)
189+ S.drain $ S.concatMap
190+ (\_ -> sourceUnfoldr inner n)
191+ (sourceUnfoldr outer n)
199192
200193#ifdef INSPECTION
201−#if __GLASGOW_HASKELL__ >= 906
202−inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]
203−#else
204194inspect $ hasNoTypeClasses 'concatMapPure
205−#endif
206195inspect $ 'concatMapPure `hasNoType` ''SPEC
207196#endif
208197
@@ -211,53 +200,42 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
211200{-# INLINE concatMapRepl #-}
212201concatMapRepl :: Int -> Int -> Int -> IO ()
213202concatMapRepl outer inner n =
214− drain $ toStream $ StreamK.concatMap
215− (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)
203+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
216204
217205#ifdef INSPECTION
218−#if __GLASGOW_HASKELL__ >= 906
219−inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]
220−#else
221206inspect $ hasNoTypeClasses 'concatMapRepl
222−#endif
223207inspect $ 'concatMapRepl `hasNoType` ''SPEC
224208#endif
225209
226210-- concatMapWith
227211
228−#ifdef USE_STREAMK
229212{-# INLINE concatMapWithSerial #-}
230213concatMapWithSerial :: Int -> Int -> Int -> IO ()
231−concatMapWithSerial = concatStreamsWith Common.append
214+concatMapWithSerial = concatStreamsWith S.serial
232215
233216#ifdef INSPECTION
234217inspect $ hasNoTypeClasses 'concatMapWithSerial
235218inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
236219#endif
237220
238−{-
239221{-# INLINE concatMapWithAppend #-}
240222concatMapWithAppend :: Int -> Int -> Int -> IO ()
241−concatMapWithAppend = concatStreamsWith Common.append2
223+concatMapWithAppend = concatStreamsWith Internal.append
242224
243225#ifdef INSPECTION
244226inspect $ hasNoTypeClasses 'concatMapWithAppend
245227inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
246228#endif
247−-}
248229
249−-- mergeMapWith
230+-- concatPairWith
250231
251−{-# INLINE mergeMapWithSerial #-}
252−mergeMapWithSerial :: Int -> Int -> Int -> IO ()
253−mergeMapWithSerial = mergeMapWith Common.append
232+{-# INLINE concatPairWithSerial #-}
233+concatPairWithSerial :: Int -> Int -> Int -> IO ()
234+concatPairWithSerial = concatPairsWith Internal.serial
254235
255−{-
256−{-# INLINE mergeMapWithAppend #-}
257−mergeMapWithAppend :: Int -> Int -> Int -> IO ()
258−mergeMapWithAppend = mergeMapWith Common.append2
259−-}
260−#endif
236+{-# INLINE concatPairWithAppend #-}
237+concatPairWithAppend :: Int -> Int -> Int -> IO ()
238+concatPairWithAppend = concatPairsWith Internal.append
261239
262240-- unfoldMany
263241
@@ -266,11 +244,10 @@ mergeMapWithAppend = mergeMapWith Common.append2
266244{-# INLINE unfoldManyRepl #-}
267245unfoldManyRepl :: Int -> Int -> Int -> IO ()
268246unfoldManyRepl outer inner n =
269− drain
247+ S.drain
270248 $ S.unfoldMany
271− UF.replicateM
272− (fmap ((inner,) . return) (sourceUnfoldrM outer n))
273−
249+ (UF.lmap return (UF.replicateM inner))
250+ (sourceUnfoldrM outer n)
274251
275252#ifdef INSPECTION
276253inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -288,6 +265,10 @@ o_1_space_concat value = sqrtVal `seq`
288265 , benchIOSrc1 "concatMapPure (1 of n)"
289266 (concatMapPure 1 value)
290267
268+ -- This is for comparison with foldMapWith
269+ , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"
270+ (S.concatMap id . sourceConcatMapId value)
271+
291272 , benchIOSrc1 "concatMap (n of 1)"
292273 (concatMap value 1)
293274 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
@@ -295,25 +276,16 @@ o_1_space_concat value = sqrtVal `seq`
295276 , benchIOSrc1 "concatMap (1 of n)"
296277 (concatMap 1 value)
297278
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−
303279 , benchIOSrc1 "concatMapM (n of 1)"
304280 (concatMapM value 1)
305281 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
306282 (concatMapM sqrtVal sqrtVal)
307283 , benchIOSrc1 "concatMapM (1 of n)"
308284 (concatMapM 1 value)
309−#endif
310285
311−#ifdef USE_STREAMK
312− {-
313286 -- This is for comparison with foldMapWith
314− , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
315− (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
316− -}
287+ , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
288+ (S.concatMapWith serial id . sourceConcatMapId value)
317289
318290 , benchIOSrc1 "concatMapWith (n of 1)"
319291 (concatMapWithSerial value 1)
@@ -322,12 +294,9 @@ o_1_space_concat value = sqrtVal `seq`
322294 , benchIOSrc1 "concatMapWith (1 of n)"
323295 (concatMapWithSerial 1 value)
324296
325− {-
326297 -- quadratic with number of outer streams
327298 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
328299 (concatMapWithAppend 2 (value `div` 2))
329− -}
330−#endif
331300
332301 -- concatMap vs unfoldMany
333302 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
@@ -341,35 +310,31 @@ o_1_space_concat value = sqrtVal `seq`
341310
342311 sqrtVal = round $ sqrt (fromIntegral value :: Double)
343312
344−#ifdef USE_STREAMK
345−o_n_space_merge :: Int -> [Benchmark]
346−o_n_space_merge value = sqrtVal `seq`
313+o_n_space_concat :: Int -> [Benchmark]
314+o_n_space_concat value = sqrtVal `seq`
347315 [ bgroup "concat"
348316 [
349− -------------------mergeMapWith-----------------
317+ -------------------concatPairsWith-----------------
350318
351319 -- Use large number of streams to check scalability
352320
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− -}
321+ benchIOSrc1 "concatPairWithSerial (n of 1)"
322+ (concatPairWithSerial value 1)
323+ , benchIOSrc1 "concatPairWithSerial (sqrtVal of sqrtVal)"
324+ (concatPairWithSerial sqrtVal sqrtVal)
325+ , benchIOSrc1 "concatPairWithSerial (2 of n/2)"
326+ (concatPairWithSerial 2 (value `div` 2))
327+
328+ , benchIOSrc1 "concatPairWithAppend (n of 1)"
329+ (concatPairWithAppend value 1)
330+ , benchIOSrc1 "concatPairWithAppend (sqrtVal of sqrtVal)"
331+ (concatPairWithAppend sqrtVal sqrtVal)
366332 ]
367333 ]
368334
369335 where
370336
371337 sqrtVal = round $ sqrt (fromIntegral value :: Double)
372−#endif
373338
374339-------------------------------------------------------------------------------
375340-- Applicative
@@ -378,28 +343,26 @@ o_n_space_merge value = sqrtVal `seq`
378343o_1_space_applicative :: Int -> [Benchmark]
379344o_1_space_applicative value =
380345 [ 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
346+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial
347+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial
348+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial
349+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial
385350 ]
386351 ]
387352
388−#ifdef USE_STREAMK
389353o_n_space_applicative :: Int -> [Benchmark]
390354o_n_space_applicative value =
391− [ bgroup "iterated"
392− [ benchIOSrc "(*>) (n times)" $
355+ [ bgroup "Applicative"
356+ [ benchIOSrc fromSerial "(*>) (n times)" $
393357 iterateSingleton ((*>) . pure) value
394− , benchIOSrc "(<*) (n times)" $
358+ , benchIOSrc fromSerial "(<*) (n times)" $
395359 iterateSingleton (\x xs -> xs <* pure x) value
396− , benchIOSrc "(<*>) (n times)" $
360+ , benchIOSrc fromSerial "(<*>) (n times)" $
397361 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
398− , benchIOSrc "liftA2 (n times)" $
362+ , benchIOSrc fromSerial "liftA2 (n times)" $
399363 iterateSingleton (AP.liftA2 (+) . pure) value
400364 ]
401365 ]
402−#endif
403366
404367-------------------------------------------------------------------------------
405368-- Monad
@@ -408,122 +371,48 @@ o_n_space_applicative value =
408371o_1_space_monad :: Int -> [Benchmark]
409372o_1_space_monad value =
410373 [ bgroup "Monad"
411− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
412− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
374+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial
375+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial
413376 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
414− filterAllOutM value
377+ filterAllOutM value fromSerial
415378 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
416− filterAllInM value
379+ filterAllInM value fromSerial
417380 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
418− filterSome value
381+ filterSome value fromSerial
419382 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
420− breakAfterSome value
383+ breakAfterSome value fromSerial
421384 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
422− toNullM3 value
385+ toNullM3 value fromSerial
423386 ]
424387 ]
425388
426−#ifdef USE_STREAMK
427389-- This is a good benchmark but inefficient way to compute primes. As we see a
428390-- new prime we keep appending a division filter for all the future numbers.
429391{-# INLINE sieve #-}
430−sieve :: Monad m => StreamK m Int -> StreamK m Int
431−sieve s = StreamK.concatEffect $ do
432− r <- StreamK.uncons s
392+sieve :: Monad m => SerialT m Int -> SerialT m Int
393+sieve s = do
394+ r <- lift $ S.uncons s
433395 case r of
434396 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
397+ prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest)
398+ Nothing -> S.nil
458399
459400o_n_space_monad :: Int -> [Benchmark]
460401o_n_space_monad value =
461402 [ bgroup "Monad"
462− [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
463− toListM value
403+ [ benchIOSrc fromSerial "(>>) (n times)" $
404+ iterateSingleton ((>>) . pure) value
405+ , benchIOSrc fromSerial "(>>=) (n times)" $
406+ iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
407+ , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
408+ toListM value fromSerial
464409 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
465− toListSome value
410+ toListSome value fromSerial
411+ , benchIO "naive prime sieve (n/4)"
412+ (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
466413 ]
467414 ]
468415
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−
527416-------------------------------------------------------------------------------
528417-- Main
529418-------------------------------------------------------------------------------
@@ -531,33 +420,24 @@ o_n_heap_buffering value =
531420-- In addition to gauge options, the number of elements in the stream can be
532421-- passed using the --stream-size option.
533422--
534−{-# ANN benchmarks "HLint: ignore" #-}
535423benchmarks :: String -> Int -> [Benchmark]
536424benchmarks moduleName size =
537425 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
538426 [
539427 -- multi-stream
540428 o_1_space_joining size
541−#ifdef USE_PRELUDE
542429 , o_1_space_concatFoldable size
543−#endif
544430 , o_1_space_concat size
431+
545432 , o_1_space_applicative size
546433 , o_1_space_monad size
434+
547435 ]
548436 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
549437 [
550438 -- 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
439+ o_n_space_applicative size
440+ , o_n_space_monad size
441+ , o_n_space_concat size
557442 ]
558− {-
559− , bgroup (o_n_heap_prefix moduleName) $
560− -- multi-stream
561− o_n_heap_buffering size
562− -}
563443 ]
benchmark/Streamly/Benchmark/Data/Stream/Split.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Split.hsrenamed+12−25
@@ -1,7 +1,5 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
4−-- Module : Stream.Split
2+-- Module : Streamly.Benchmark.Prelude.Serial.Split
53-- Copyright : (c) 2019 Composewell Technologies
64-- License : BSD-3-Clause
75-- Maintainer : streamly@composewell.com
@@ -20,14 +18,14 @@
2018{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2119#endif
2220
23−module Stream.Split (benchmarks) where
21+module Serial.Split (benchmarks) where
2422
2523import Data.Char (ord)
2624import Data.Word (Word8)
2725import System.IO (Handle)
2826
2927import qualified Streamly.FileSystem.Handle as FH
30−import qualified Streamly.Internal.Data.Array as A
28+import qualified Streamly.Internal.Data.Array.Foreign as A
3129import qualified Streamly.Internal.Data.Fold as FL
3230import qualified Streamly.Internal.Data.Parser as PR
3331import qualified Streamly.Internal.Data.Stream.IsStream as IP
@@ -35,15 +33,15 @@ import qualified Streamly.Internal.FileSystem.Handle as IFH
3533import qualified Streamly.Internal.Unicode.Stream as IUS
3634import qualified Streamly.Prelude as S
3735
38−import Test.Tasty.Bench hiding (env)
36+import Gauge hiding (env)
3937import Prelude hiding (last, length)
4038import Streamly.Benchmark.Common
4139import Streamly.Benchmark.Common.Handle
4240
4341#ifdef INSPECTION
44−import Streamly.Internal.Data.Stream (Step(..))
42+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
4543
46−import qualified Streamly.Internal.Data.MutArray as MA
44+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
4745import qualified Streamly.Internal.Data.Unfold as IUF
4846
4947import Test.Inspection
@@ -69,7 +67,7 @@ splitOn inh =
6967inspect $ hasNoTypeClasses 'splitOn
7068inspect $ 'splitOn `hasNoType` ''Step
7169inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
72−inspect $ 'splitOn `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
70+inspect $ 'splitOn `hasNoType` ''MA.ReadUState -- FH.read/A.read
7371#endif
7472
7573-- | Split suffix on line feed.
@@ -82,7 +80,7 @@ splitOnSuffix inh =
8280inspect $ hasNoTypeClasses 'splitOnSuffix
8381inspect $ 'splitOnSuffix `hasNoType` ''Step
8482inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'splitOnSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
83+inspect $ 'splitOnSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
8684#endif
8785
8886-- | Split suffix with line feed.
@@ -95,7 +93,7 @@ splitWithSuffix inh =
9593inspect $ hasNoTypeClasses 'splitWithSuffix
9694inspect $ 'splitWithSuffix `hasNoType` ''Step
9795inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'splitWithSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
96+inspect $ 'splitWithSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
9997#endif
10098
10199-- | Split on line feed.
@@ -126,7 +124,7 @@ wordsBy inh =
126124inspect $ hasNoTypeClasses 'wordsBy
127125inspect $ 'wordsBy `hasNoType` ''Step
128126inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
129−inspect $ 'wordsBy `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
127+inspect $ 'wordsBy `hasNoType` ''MA.ReadUState -- FH.read/A.read
130128#endif
131129
132130-- | Split on a word8 sequence.
@@ -143,7 +141,7 @@ splitOnSeq str inh =
143141-- | Split on a word8 sequence.
144142splitOnSeq100k :: Handle -> IO Int
145143splitOnSeq100k inh = do
146− arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123
144+ arr <- A.fromStream $ S.replicate 100000 123
147145 (S.length $ IP.splitOnSeq arr FL.drain
148146 $ S.unfold FH.read inh) -- >>= print
149147
@@ -158,12 +156,6 @@ splitOnSuffixSeq str inh =
158156-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
159157#endif
160158
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−
167159o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
168160o_1_space_reduce_read_split env =
169161 [ bgroup "split"
@@ -193,8 +185,6 @@ o_1_space_reduce_read_split env =
193185 splitOnSeq "\r\n" inh
194186 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
195187 splitOnSuffixSeq "\r\n" inh
196− , mkBench "S.splitWithSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
197− splitWithSuffixSeq "\r\n" inh
198188 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
199189 splitOnSeq "aa" inh
200190 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
@@ -211,8 +201,6 @@ o_1_space_reduce_read_split env =
211201 env $ \inh _ -> splitOnSeq100k inh
212202 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
213203 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
214− , mkBenchSmall "S.splitWithSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
215− env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
216204 ]
217205 ]
218206
@@ -220,9 +208,8 @@ o_1_space_reduce_read_split env =
220208splitOnSeqUtf8 :: String -> Handle -> IO Int
221209splitOnSeqUtf8 str inh =
222210 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
223− $ IP.fromStream
224211 $ IUS.decodeUtf8Arrays
225− $ IFH.readChunks inh) -- >>= print
212+ $ IFH.toChunks inh) -- >>= print
226213
227214o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
228215o_1_space_reduce_toChunks_split env =
benchmark/Streamly/Benchmark/Data/Stream/Transform.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hsrenamed+164−284
@@ -1,20 +1,14 @@
11-- |
2−-- Module : Stream.Transform
2+-- Module : Serial.Transformation
33-- Copyright : (c) 2018 Composewell Technologies
44-- License : BSD-3-Clause
55-- Maintainer : streamly@composewell.com
66
77{-# LANGUAGE CPP #-}
88{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
109{-# LANGUAGE ScopedTypeVariables #-}
1110{-# LANGUAGE RankNTypes #-}
1211
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
1812#ifdef __HADDOCK_VERSION__
1913#undef INSPECTION
2014#endif
@@ -24,48 +18,30 @@
2418{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2519#endif
2620
27−module Stream.Transform (benchmarks) where
21+module Serial.Transformation (benchmarks) where
2822
23+import Control.DeepSeq (NFData(..))
2924import Control.Monad.IO.Class (MonadIO(..))
30−
25+import Data.Functor.Identity (Identity)
26+import Data.IORef (newIORef, modifyIORef')
3127import System.Random (randomRIO)
3228
33−import qualified Streamly.Internal.Data.Fold as FL
29+#ifdef INSPECTION
30+import Test.Inspection
31+#endif
3432
35−import qualified Stream.Common as Common
33+import qualified Streamly.Prelude as S
34+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
35+import qualified Streamly.Internal.Data.Fold as FL
3636import 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(..))
5437import 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
6038
61−import Test.Tasty.Bench
62−import Stream.Common hiding (scanl')
39+import Gauge
40+import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
6341import Streamly.Benchmark.Common
64−import Prelude hiding (sequence, mapM)
65−
66−#ifdef USE_PRELUDE
67−type Stream = Stream.SerialT
68−#endif
42+import Streamly.Benchmark.Prelude
43+import Streamly.Internal.Data.Time.Units
44+import Prelude hiding (sequence, mapM, fmap)
6945
7046-------------------------------------------------------------------------------
7147-- Pipelines (stream-to-stream transformations)
@@ -79,36 +55,28 @@ type Stream = Stream.SerialT
7955-- Traversable Instance
8056-------------------------------------------------------------------------------
8157
82−#ifdef USE_STREAMK
8358{-# INLINE traversableTraverse #-}
84−traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)
59+traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
8560traversableTraverse = traverse return
8661
8762{-# INLINE traversableSequenceA #-}
88−traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)
63+traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
8964traversableSequenceA = sequenceA . Prelude.fmap return
9065
9166{-# INLINE traversableMapM #-}
92−traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)
67+traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
9368traversableMapM = Prelude.mapM return
9469
9570{-# INLINE traversableSequence #-}
96−traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)
71+traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
9772traversableSequence = Prelude.sequence . Prelude.fmap return
9873
9974{-# INLINE benchPureSinkIO #-}
10075benchPureSinkIO
10176 :: NFData b
102− => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark
77+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
10378benchPureSinkIO 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)
79+ bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
11280
11381o_n_space_traversable :: Int -> [Benchmark]
11482o_n_space_traversable value =
@@ -121,124 +89,113 @@ o_n_space_traversable value =
12189 , benchPureSinkIO value "sequence" traversableSequence
12290 ]
12391 ]
124−#endif
12592
12693-------------------------------------------------------------------------------
12794-- maps and scans
12895-------------------------------------------------------------------------------
12996
130−#ifdef USE_PRELUDE
13197{-# INLINE scanl' #-}
132−scanl' :: MonadIO m => Int -> Stream m Int -> m ()
133−scanl' n = composeN n $ Stream.scanl' (+) 0
98+scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
99+scanl' n = composeN n $ S.scanl' (+) 0
134100
135101{-# 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)
102+scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
103+scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
138104
139105{-# INLINE scanl1' #-}
140−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
141−scanl1' n = composeN n $ Stream.scanl1' (+)
106+scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
107+scanl1' n = composeN n $ S.scanl1' (+)
142108
143109{-# 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
110+scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
111+scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
147112
148113{-# INLINE scan #-}
149−scan :: MonadIO m => Int -> Stream m Int -> m ()
150−scan n = composeN n $ Stream.scan FL.sum
114+scan :: MonadIO m => Int -> SerialT m Int -> m ()
115+scan n = composeN n $ S.scan FL.sum
151116
152−#ifdef USE_PRELUDE
153117{-# INLINE postscanl' #-}
154−postscanl' :: MonadIO m => Int -> Stream m Int -> m ()
155−postscanl' n = composeN n $ Stream.postscanl' (+) 0
118+postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
119+postscanl' n = composeN n $ S.postscanl' (+) 0
156120
157121{-# 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
122+postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
123+postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
161124
162125{-# INLINE postscan #-}
163−postscan :: MonadIO m => Int -> Stream m Int -> m ()
164−postscan n = composeN n $ Stream.postscan FL.sum
126+postscan :: MonadIO m => Int -> SerialT m Int -> m ()
127+postscan n = composeN n $ S.postscan FL.sum
165128
166129{-# INLINE sequence #-}
167−sequence :: MonadAsync m => Stream m (m Int) -> m ()
168−sequence = Common.drain . Stream.sequence
130+sequence ::
131+ (S.IsStream t, S.MonadAsync m)
132+ => (t m Int -> S.SerialT m Int)
133+ -> t m (m Int)
134+ -> m ()
135+sequence t = S.drain . t . S.sequence
169136
170137{-# INLINE tap #-}
171−tap :: MonadIO m => Int -> Stream m Int -> m ()
172−tap n = composeN n $ Stream.tap FL.sum
138+tap :: MonadIO m => Int -> SerialT m Int -> m ()
139+tap n = composeN n $ S.tap FL.sum
140+
141+{-# INLINE tapRate #-}
142+tapRate :: Int -> SerialT IO Int -> IO ()
143+tapRate n str = do
144+ cref <- newIORef 0
145+ composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
173146
174−#ifdef USE_PRELUDE
175147{-# INLINE pollCounts #-}
176−pollCounts :: Int -> Stream IO Int -> IO ()
148+pollCounts :: Int -> SerialT IO Int -> IO ()
177149pollCounts n =
178− composeN n (Stream.pollCounts (const True) f)
150+ composeN n (Internal.pollCounts (const True) f FL.drain)
179151
180152 where
181153
182− f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
154+ f = Internal.rollingMap (-) . Internal.delayPost 1
183155
184156{-# INLINE timestamped #-}
185−timestamped :: (MonadAsync m) => Stream m Int -> m ()
186−timestamped = Stream.drain . Stream.timestamped
187−#endif
157+timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
158+timestamped = S.drain . Internal.timestamped
188159
189−#ifdef USE_STREAMK
190160{-# 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)
161+foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
162+foldrS n = composeN n $ Internal.foldrS S.cons S.nil
194163
195164{-# 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
165+foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
166+foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
204167
205−{-
206168{-# 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)
169+foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
170+foldrT n = composeN n $ Internal.foldrT S.cons S.nil
211171
212172{-# 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−-}
173+foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
174+foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
175+
216176
217177{-# INLINE trace #-}
218−trace :: MonadAsync m => Int -> Stream m Int -> m ()
219−trace n = composeN n $ Stream.trace return
178+trace :: MonadAsync m => Int -> SerialT m Int -> m ()
179+trace n = composeN n $ Internal.trace return
220180
221181o_1_space_mapping :: Int -> [Benchmark]
222182o_1_space_mapping value =
223183 [ bgroup
224184 "mapping"
225185 [
226−#ifdef USE_STREAMK
227186 -- Right folds
228187 benchIOSink value "foldrS" (foldrS 1)
229188 , benchIOSink value "foldrSMap" (foldrSMap 1)
230− ,
231−#endif
232− -- , benchIOSink value "foldrT" (foldrT 1)
233− -- , benchIOSink value "foldrTMap" (foldrTMap 1)
189+ , benchIOSink value "foldrT" (foldrT 1)
190+ , benchIOSink value "foldrTMap" (foldrTMap 1)
234191
235192 -- Mapping
236− benchIOSink value "map" (mapN 1)
193+ , benchIOSink value "map" (mapN fromSerial 1)
237194 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
238− sequence (sourceUnfoldrAction value n)
239− , benchIOSink value "mapM" (mapM 1)
195+ sequence fromSerial (sourceUnfoldrAction value n)
196+ , benchIOSink value "mapM" (mapM fromSerial 1)
240197 , benchIOSink value "tap" (tap 1)
241−#ifdef USE_PRELUDE
198+ , benchIOSink value "tapRate 1 second" (tapRate 1)
242199 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
243200 , benchIOSink value "timestamped" timestamped
244201
@@ -249,7 +206,7 @@ o_1_space_mapping value =
249206 , benchIOSink value "scanl1M'" (scanl1M' 1)
250207 , benchIOSink value "postscanl'" (postscanl' 1)
251208 , benchIOSink value "postscanlM'" (postscanlM' 1)
252−#endif
209+
253210 , benchIOSink value "scan" (scan 1)
254211 , benchIOSink value "postscan" (postscan 1)
255212 ]
@@ -258,37 +215,36 @@ o_1_space_mapping value =
258215o_1_space_mappingX4 :: Int -> [Benchmark]
259216o_1_space_mappingX4 value =
260217 [ bgroup "mappingX4"
261− [ benchIOSink value "map" (mapN 4)
262− , benchIOSink value "mapM" (mapM 4)
218+ [ benchIOSink value "map" (mapN fromSerial 4)
219+ , benchIOSink value "mapM" (mapM fromSerial 4)
263220 , benchIOSink value "trace" (trace 4)
264221
265−#ifdef USE_PRELUDE
266222 , benchIOSink value "scanl'" (scanl' 4)
267223 , benchIOSink value "scanl1'" (scanl1' 4)
268224 , benchIOSink value "scanlM'" (scanlM' 4)
269225 , benchIOSink value "scanl1M'" (scanl1M' 4)
270226 , benchIOSink value "postscanl'" (postscanl' 4)
271227 , benchIOSink value "postscanlM'" (postscanlM' 4)
272−#endif
228+
273229 ]
274230 ]
275231
276232{-# INLINE sieveScan #-}
277−sieveScan :: Monad m => Stream m Int -> Stream m Int
233+sieveScan :: Monad m => SerialT m Int -> SerialT m Int
278234sieveScan =
279− Stream.mapMaybe snd
280− . Stream.scan (FL.foldlM' (\(primes, _) n -> do
235+ S.mapMaybe snd
236+ . S.scanlM' (\(primes, _) n -> do
281237 return $
282238 let ps = takeWhile (\p -> p * p <= n) primes
283239 in if all (\p -> n `mod` p /= 0) ps
284240 then (primes ++ [n], Just n)
285− else (primes, Nothing)) (return ([2], Just 2)))
241+ else (primes, Nothing)) (return ([2], Just 2))
286242
287243o_n_space_mapping :: Int -> [Benchmark]
288244o_n_space_mapping value =
289245 [ bgroup "mapping"
290246 [ benchIO "naive prime sieve"
291− (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))
247+ (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
292248 ]
293249 ]
294250
@@ -299,75 +255,8 @@ o_n_space_mapping value =
299255o_1_space_functor :: Int -> [Benchmark]
300256o_1_space_functor value =
301257 [ 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− -}
258+ [ benchIOSink value "fmap" (fmapN fromSerial 1)
259+ , benchIOSink value "fmap x 4" (fmapN fromSerial 4)
371260 ]
372261 ]
373262
@@ -376,129 +265,121 @@ o_n_space_iterated value =
376265-------------------------------------------------------------------------------
377266
378267{-# INLINE filterEven #-}
379−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
380−filterEven n = composeN n $ Stream.filter even
268+filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
269+filterEven n = composeN n $ S.filter even
381270
382271{-# INLINE filterAllOut #-}
383−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
384−filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
272+filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
273+filterAllOut value n = composeN n $ S.filter (> (value + 1))
385274
386275{-# INLINE filterAllIn #-}
387−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
388−filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
276+filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
277+filterAllIn value n = composeN n $ S.filter (<= (value + 1))
389278
390279{-# INLINE filterMEven #-}
391−filterMEven :: MonadIO m => Int -> Stream m Int -> m ()
392−filterMEven n = composeN n $ Stream.filterM (return . even)
280+filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
281+filterMEven n = composeN n $ S.filterM (return . even)
393282
394283{-# 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))
284+filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
285+filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
397286
398287{-# 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))
288+filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
289+filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
401290
402291{-# INLINE _takeOne #-}
403−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
404−_takeOne n = composeN n $ Stream.take 1
292+_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
293+_takeOne n = composeN n $ S.take 1
405294
406295{-# INLINE takeAll #-}
407−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
408−takeAll value n = composeN n $ Stream.take (value + 1)
296+takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
297+takeAll value n = composeN n $ S.take (value + 1)
409298
410299{-# INLINE takeWhileTrue #-}
411−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
412−takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
300+takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
301+takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
413302
414303{-# INLINE takeWhileMTrue #-}
415−takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
416−takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
304+takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
305+takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
417306
418−#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
419307{-# INLINE takeInterval #-}
420−takeInterval :: Double -> Int -> Stream IO Int -> IO ()
421−takeInterval i n = composeN n (Stream.takeInterval i)
308+takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
309+takeInterval i n = composeN n (Internal.takeInterval i)
422310
423−-- Inspection testing is disabled for takeInterval
424−-- Enable it when looking at it throughly
425311#ifdef INSPECTION
426312-- inspect $ hasNoType 'takeInterval ''SPEC
427−-- inspect $ hasNoTypeClasses 'takeInterval
313+inspect $ hasNoTypeClasses 'takeInterval
428314-- inspect $ 'takeInterval `hasNoType` ''D.Step
429315#endif
430316
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−
443317{-# INLINE dropOne #-}
444−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
445−dropOne n = composeN n $ Stream.drop 1
318+dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
319+dropOne n = composeN n $ S.drop 1
446320
447321{-# INLINE dropAll #-}
448−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
449−dropAll value n = composeN n $ Stream.drop (value + 1)
322+dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
323+dropAll value n = composeN n $ S.drop (value + 1)
450324
451325{-# INLINE dropWhileTrue #-}
452−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
453−dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
326+dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
327+dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
454328
455329{-# INLINE dropWhileMTrue #-}
456−dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
457−dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
330+dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
331+dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
458332
459333{-# INLINE dropWhileFalse #-}
460−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
461−dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
334+dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
335+dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
462336
463−#ifdef USE_PRELUDE
464337-- XXX Decide on the time interval
465338{-# INLINE _intervalsOfSum #-}
466−_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()
467−_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
339+_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
340+_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
341+
342+{-# INLINE dropInterval #-}
343+dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
344+dropInterval i n = composeN n (Internal.dropInterval i)
345+
346+#ifdef INSPECTION
347+inspect $ hasNoTypeClasses 'dropInterval
348+-- inspect $ 'dropInterval `hasNoType` ''D.Step
468349#endif
469350
470351{-# INLINE findIndices #-}
471−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
472−findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
352+findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
353+findIndices value n = composeN n $ S.findIndices (== (value + 1))
473354
474355{-# INLINE elemIndices #-}
475−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
476−elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
356+elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
357+elemIndices value n = composeN n $ S.elemIndices (value + 1)
477358
478359{-# INLINE deleteBy #-}
479−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
480−deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
360+deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
361+deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
481362
482363-- uniq . uniq == uniq, composeN 2 ~ composeN 1
483364{-# INLINE uniq #-}
484−uniq :: MonadIO m => Int -> Stream m Int -> m ()
485−uniq n = composeN n Stream.uniq
365+uniq :: MonadIO m => Int -> SerialT m Int -> m ()
366+uniq n = composeN n S.uniq
486367
487368{-# INLINE mapMaybe #-}
488−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
369+mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
489370mapMaybe n =
490371 composeN n $
491− Stream.mapMaybe
372+ S.mapMaybe
492373 (\x ->
493374 if odd x
494375 then Nothing
495376 else Just x)
496377
497378{-# INLINE mapMaybeM #-}
498−mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()
379+mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
499380mapMaybeM n =
500381 composeN n $
501− Stream.mapMaybeM
382+ S.mapMaybeM
502383 (\x ->
503384 if odd x
504385 then return Nothing
@@ -517,14 +398,18 @@ o_1_space_filtering value =
517398
518399 -- Trimming
519400 , benchIOSink value "take-all" (takeAll value 1)
401+ , benchIOSink
402+ value
403+ "takeInterval-all"
404+ (takeInterval (NanoSecond64 maxBound) 1)
520405 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
521406 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
522407 , benchIOSink value "drop-one" (dropOne 1)
523408 , 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
409+ , benchIOSink
410+ value
411+ "dropInterval-all"
412+ (dropInterval (NanoSecond64 maxBound) 1)
528413 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
529414 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
530415 , benchIOSink
@@ -587,26 +472,26 @@ o_1_space_filteringX4 value =
587472-------------------------------------------------------------------------------
588473
589474{-# INLINE intersperse #-}
590−intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
591−intersperse value n = composeN n $ Stream.intersperse (value + 1)
475+intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
476+intersperse value n = composeN n $ S.intersperse (value + 1)
592477
593478{-# INLINE intersperseM #-}
594−intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
595−intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
479+intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
480+intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
596481
597482{-# INLINE insertBy #-}
598−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
599−insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
483+insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
484+insertBy value n = composeN n $ S.insertBy compare (value + 1)
600485
601486{-# INLINE interposeSuffix #-}
602−interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
487+interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
603488interposeSuffix value n =
604− composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
489+ composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity
605490
606491{-# INLINE intercalateSuffix #-}
607−intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
492+intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
608493intercalateSuffix value n =
609− composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
494+ composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)
610495
611496o_1_space_inserting :: Int -> [Benchmark]
612497o_1_space_inserting value =
@@ -632,12 +517,12 @@ o_1_space_insertingX4 value =
632517-------------------------------------------------------------------------------
633518
634519{-# INLINE indexed #-}
635−indexed :: MonadIO m => Int -> Stream m Int -> m ()
636−indexed n = composeN n (fmap snd . Stream.indexed)
520+indexed :: MonadIO m => Int -> SerialT m Int -> m ()
521+indexed n = composeN n (S.map snd . S.indexed)
637522
638523{-# INLINE indexedR #-}
639−indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()
640−indexedR value n = composeN n (fmap snd . Stream.indexedR value)
524+indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
525+indexedR value n = composeN n (S.map snd . S.indexedR value)
641526
642527o_1_space_indexing :: Int -> [Benchmark]
643528o_1_space_indexing value =
@@ -676,12 +561,7 @@ benchmarks moduleName size =
676561 , o_1_space_indexingX4 size
677562 ]
678563 , 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
564+ [ o_n_space_traversable size
565+ , o_n_space_mapping size
686566 ]
687567 ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
1513import Streamly.Benchmark.Common
1614import Streamly.Benchmark.Prelude
1715
18−import Test.Tasty.Bench
16+import Gauge
1917
2018moduleName :: String
2119moduleName = "Prelude.WAsync"
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -29,13 +27,13 @@ import qualified Streamly.Internal.Data.Unfold as UF
2927import Streamly.Benchmark.Common
3028import Streamly.Benchmark.Prelude
3129
32−import Test.Tasty.Bench
30+import Gauge
3331
3432#ifdef INSPECTION
3533import GHC.Types (SPEC(..))
3634import Test.Inspection
3735
38−import qualified Streamly.Internal.Data.Stream as D
36+import qualified Streamly.Internal.Data.Stream.StreamD as D
3937#endif
4038
4139moduleName :: String
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+2−11
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
1513import Streamly.Benchmark.Common
1614import Streamly.Benchmark.Prelude
1715
18−import Test.Tasty.Bench
16+import Gauge
1917
2018moduleName :: String
2119moduleName = "Prelude.ZipAsync"
@@ -58,13 +56,7 @@ o_1_space_joining value =
5856 (value `div` 2))
5957 , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
6058 , benchIOSink value "fmap zipAsyncly" $ fmapN S.fromZipAsync 1
61− ]
62− ]
63−
64−o_n_heap_joining :: Int -> [Benchmark]
65−o_n_heap_joining value =
66− [ bgroup "joining"
67− [ fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)
59+ , fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)
6860 ]
6961 ]
7062
@@ -93,5 +85,4 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
9385 [ o_1_space_joining size
9486 , o_1_space_outerProduct size
9587 ]
96− , bgroup (o_n_heap_prefix moduleName) $ o_n_heap_joining size
9788 ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Main
53-- Copyright : (c) 2018 Composewell Technologies
@@ -29,13 +27,13 @@ import qualified Streamly.Prelude as S
2927import Streamly.Benchmark.Common
3028import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
3129
32−import Test.Tasty.Bench
30+import Gauge
3331
3432#ifdef INSPECTION
3533import GHC.Types (SPEC(..))
3634import Test.Inspection
3735
38−import qualified Streamly.Internal.Data.Stream as D
36+import qualified Streamly.Internal.Data.Stream.StreamD as D
3937#endif
4038
4139moduleName :: String
benchmark/Streamly/Benchmark/Unicode/Char.hs+10−18
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}
2−
31--
42-- Module : Streamly.Unicode.Char
53-- Copyright : (c) 2021 Composewell Technologies
@@ -12,19 +10,19 @@
1210-- Imports
1311--------------------------------------------------------------------------------
1412
15−import Control.DeepSeq (NFData(..))
16−import Streamly.Internal.Data.Array (Array)
13+import Control.DeepSeq (NFData)
14+import Streamly.Internal.Data.Array.Foreign (Array)
1715import System.FilePath (dropExtensions, takeFileName)
1816import System.FilePath.Posix ((</>))
19−import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, env, nfIO)
17+import Gauge.Main (Benchmark, bench, bgroup, defaultMain, env, nfIO)
2018import Streamly.Internal.Unicode.Char
2119 ( NormalizationMode(NFC, NFD, NFKC, NFKD)
2220 , normalize
2321 )
2422import Streamly.Benchmark.Common (o_1_space_prefix)
2523
26−import qualified Streamly.Internal.Data.Array as Array
27−import qualified Streamly.Internal.Data.Stream as IsStream
24+import qualified Streamly.Internal.Data.Array.Foreign as Array
25+import qualified Streamly.Internal.Data.Stream.IsStream as IsStream
2826import qualified System.Directory as Dir
2927
3028--------------------------------------------------------------------------------
@@ -43,13 +41,7 @@ dataDir = "benchmark/Streamly/Benchmark/Unicode/data"
4341dataSetSize :: Int
4442dataSetSize = 1000000
4543
46−-- Unboxed arrays are fully evaluated.
47−instance NFData (Array a) where
48− {-# INLINE rnf #-}
49− rnf _ = ()
50−
51−makeBench ::
52− (String, Array Char -> IO ()) -> (String, IO (Array Char)) -> Benchmark
44+makeBench :: (NFData a) => (String, a -> IO ()) -> (String, IO a) -> Benchmark
5345makeBench (implName, func) (dataName, setup) =
5446 env setup (bench (implName ++ "/" ++ dataName) . nfIO . func)
5547
@@ -73,10 +65,10 @@ arrInput file = second (fmap Array.fromList) (strInput file)
7365
7466benchFunctions :: [(String, Array Char -> IO ())]
7567benchFunctions =
76− [ ("NFD", IsStream.drain . normalize NFD . Array.read)
77− , ("NFKD", IsStream.drain . normalize NFKD . Array.read)
78− , ("NFC", IsStream.drain . normalize NFC . Array.read)
79− , ("NFKC", IsStream.drain . normalize NFKC . Array.read)
68+ [ ("NFD", IsStream.drain . normalize NFD . Array.toStream)
69+ , ("NFKD", IsStream.drain . normalize NFKD . Array.toStream)
70+ , ("NFC", IsStream.drain . normalize NFC . Array.toStream)
71+ , ("NFKC", IsStream.drain . normalize NFKC . Array.toStream)
8072 ]
8173
8274main :: IO ()
benchmark/Streamly/Benchmark/Unicode/Parser.hsdeleted−107
@@ -1,107 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Parser
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−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#undef FUSION_CHECK
14−#ifdef FUSION_CHECK
15−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
16−#endif
17−
18−module Main
19− (
20− main
21− ) where
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad (replicateM_)
25−import Streamly.Internal.Data.Parser (ParseError(..))
26−import Streamly.Internal.Data.Stream (Stream)
27−import Prelude hiding
28− (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)
29−
30−import qualified Streamly.Data.Array as Array
31−import qualified Streamly.Data.Stream as Stream
32−import qualified Streamly.Internal.Unicode.Parser as PRU
33−
34−import Test.Tasty.Bench hiding (env)
35−import Streamly.Benchmark.Common
36−
37−runParser :: Int -> (Stream IO Char -> IO a) -> IO ()
38−runParser count p = do
39− let v = "+123456789.123456789e-123"
40− let !(arr :: Array.Array Char) = Array.fromListN (length v) v
41− let s = Stream.unfold Array.reader arr
42− replicateM_ count (p s)
43−
44−-- | Takes a fold method, and uses it with a default source.
45−{-# INLINE benchIOSink #-}
46−benchIOSink :: Int -> String -> (Stream IO Char -> IO b) -> Benchmark
47−benchIOSink value name f = bench name $ nfIO $ runParser value f
48−
49−{-# INLINE doubleParser #-}
50−doubleParser :: Monad m => Stream m Char -> m (Either ParseError (Int, Int))
51−doubleParser = Stream.parse PRU.doubleParser
52−
53−{-# INLINE number #-}
54−number :: Monad m => Stream m Char -> m (Either ParseError (Integer, Int))
55−number = Stream.parse PRU.number
56−
57−{-# INLINE double #-}
58−double :: Monad m => Stream m Char -> m (Either ParseError Double)
59−double = Stream.parse PRU.double
60−
61−{-# INLINE numberDouble #-}
62−numberDouble :: Monad m => Stream m Char -> m (Either ParseError Double)
63−numberDouble = Stream.parse p
64− where p = uncurry PRU.mkDouble <$> PRU.number
65−
66−-------------------------------------------------------------------------------
67−-- Benchmarks
68−-------------------------------------------------------------------------------
69−
70−moduleName :: String
71−moduleName = "Unicode.Parser"
72−
73−instance NFData ParseError where
74− {-# INLINE rnf #-}
75− rnf (ParseError x) = rnf x
76−
77−o_n_heap_serial :: Int -> [Benchmark]
78−o_n_heap_serial value =
79− [
80− benchIOSink value "doubleParser" doubleParser
81− , benchIOSink value "number" number
82− , benchIOSink value "double (doubleParser)" double
83− , benchIOSink value "double (number)" numberDouble
84− ]
85−
86−-------------------------------------------------------------------------------
87−-- Driver
88−-------------------------------------------------------------------------------
89−
90−main :: IO ()
91−main = do
92−#ifndef FUSION_CHECK
93− runWithCLIOpts defaultStreamSize allBenchmarks
94−
95− where
96−
97− allBenchmarks value =
98− [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
99− ]
100−#else
101− -- Enable FUSION_CHECK macro at the beginning of the file
102− -- Enable one benchmark below, and run the benchmark
103− -- Check the .dump-simpl output
104− let value = 100000
105− runParser value double
106− return ()
107−#endif
benchmark/Streamly/Benchmark/Unicode/Stream.hs+30−77
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31--
42-- Module : Streamly.Unicode.Stream
53-- Copyright : (c) 2019 Composewell Technologies
@@ -11,11 +9,6 @@
119{-# LANGUAGE CPP #-}
1210{-# LANGUAGE ScopedTypeVariables #-}
1311
14−#undef FUSION_CHECK
15−#ifdef FUSION_CHECK
16−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
17−#endif
18−
1912#ifdef __HADDOCK_VERSION__
2013#undef INSPECTION
2114#endif
@@ -25,30 +18,29 @@
2518{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
2619#endif
2720
28−import Streamly.Data.Stream (Stream)
29−import Streamly.Data.Fold (Fold)
3021import Prelude hiding (last, length)
3122import System.IO (Handle)
3223
33−import qualified Streamly.Data.Array as Array
24+import qualified Streamly.Data.Array.Foreign as Array
3425import qualified Streamly.Data.Fold as Fold
35−import qualified Streamly.Internal.Data.Stream as Stream
26+import qualified Streamly.FileSystem.Handle as Handle
27+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
3628import qualified Streamly.Internal.Data.Unfold as Unfold
3729import qualified Streamly.Internal.FileSystem.Handle as Handle
38−import qualified Streamly.Internal.Unicode.Array as UnicodeArr
30+import qualified Streamly.Internal.Unicode.Array.Char as UnicodeArr
3931import qualified Streamly.Internal.Unicode.Stream as Unicode
4032
41−import Test.Tasty.Bench hiding (env)
33+import Gauge hiding (env)
4234import Streamly.Benchmark.Common
4335import Streamly.Benchmark.Common.Handle
4436
4537#ifdef INSPECTION
46−import Streamly.Internal.Data.MutByteArray (Unbox)
47−import Streamly.Internal.Data.Stream (Step(..))
48−import qualified Streamly.Internal.Data.Array as Array
49−import qualified Streamly.Internal.Data.MutArray as MutArray
50−import qualified Streamly.Internal.Data.Fold as Fold
38+import Foreign.Storable (Storable)
39+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
40+import qualified Streamly.Internal.Data.Fold.Type as Fold
5141import qualified Streamly.Internal.Data.Tuple.Strict as Strict
42+import qualified Streamly.Internal.Data.Array.Foreign.Type as Array
43+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MArray
5244
5345import Test.Inspection
5446#endif
@@ -62,8 +54,8 @@ copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
6254copyCodecUtf8ArraysLenient inh outh =
6355 Stream.fold (Handle.write outh)
6456 $ Unicode.encodeUtf8'
65− $ Unicode.decodeUtf8Chunks
66− $ Handle.readChunks inh
57+ $ Unicode.decodeUtf8Arrays
58+ $ Handle.toChunks inh
6759
6860#ifdef INSPECTION
6961inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
@@ -83,29 +75,23 @@ o_1_space_decode_encode_chunked env =
8375-- copy with group/ungroup transformations
8476-------------------------------------------------------------------------------
8577
86−{-# INLINE splitOnSuffix #-}
87−splitOnSuffix
88− :: (Monad m)
89− => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
90−splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)
91−
9278{-# NOINLINE linesUnlinesCopy #-}
9379linesUnlinesCopy :: Handle -> Handle -> IO ()
9480linesUnlinesCopy inh outh =
9581 Stream.fold (Handle.write outh)
9682 $ Unicode.encodeLatin1'
9783 $ Unicode.unlines Unfold.fromList
98− $ splitOnSuffix (== '\n') Fold.toList
84+ $ Stream.splitOnSuffix (== '\n') Fold.toList
9985 $ Unicode.decodeLatin1
100− $ Stream.unfold Handle.reader inh
86+ $ Stream.unfold Handle.read inh
10187
10288{-# NOINLINE linesUnlinesArrayWord8Copy #-}
10389linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
10490linesUnlinesArrayWord8Copy inh outh =
10591 Stream.fold (Handle.write outh)
106− $ Stream.interposeSuffix 10 Array.reader
107− $ splitOnSuffix (== 10) Array.write
108− $ Stream.unfold Handle.reader inh
92+ $ Stream.interposeSuffix 10 Array.read
93+ $ Stream.splitOnSuffix (== 10) Array.write
94+ $ Stream.unfold Handle.read inh
10995
11096-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
11197-- | Lines and unlines
@@ -117,10 +103,10 @@ linesUnlinesArrayCharCopy inh outh =
117103 $ UnicodeArr.unlines
118104 $ UnicodeArr.lines
119105 $ Unicode.decodeLatin1
120− $ Stream.unfold Handle.reader inh
106+ $ Stream.unfold Handle.read inh
121107
122108#ifdef INSPECTION
123−inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox]
109+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
124110-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
125111#endif
126112
@@ -145,7 +131,7 @@ wordsUnwordsCopyWord8 inh outh =
145131 Stream.fold (Handle.write outh)
146132 $ Stream.interposeSuffix 32 Unfold.fromList
147133 $ Stream.wordsBy isSp Fold.toList
148− $ Stream.unfold Handle.reader inh
134+ $ Stream.unfold Handle.read inh
149135
150136#ifdef INSPECTION
151137inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
@@ -169,7 +155,7 @@ wordsUnwordsCopy inh outh =
169155 $ Stream.wordsBy isSpace Fold.toList
170156 -- -- $ Stream.splitOn isSpace Fold.toList
171157 $ Unicode.decodeLatin1
172− $ Stream.unfold Handle.reader inh
158+ $ Stream.unfold Handle.read inh
173159
174160#ifdef INSPECTION
175161-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
@@ -184,7 +170,7 @@ wordsUnwordsCharArrayCopy inh outh =
184170 $ UnicodeArr.unwords
185171 $ UnicodeArr.words
186172 $ Unicode.decodeLatin1
187− $ Stream.unfold Handle.reader inh
173+ $ Stream.unfold Handle.read inh
188174
189175o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
190176o_1_space_copy_read_group_ungroup env =
@@ -216,16 +202,16 @@ copyStreamLatin1' inh outh =
216202 Stream.fold (Handle.write outh)
217203 $ Unicode.encodeLatin1'
218204 $ Unicode.decodeLatin1
219− $ Stream.unfold Handle.reader inh
205+ $ Stream.unfold Handle.read inh
220206
221207#ifdef INSPECTION
222208inspect $ hasNoTypeClasses 'copyStreamLatin1'
223209inspect $ 'copyStreamLatin1' `hasNoType` ''Step
224210inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
211+inspect $ 'copyStreamLatin1' `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
225212
226213inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step
227−inspect $ 'copyStreamLatin1' `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
228− -- Handle.read/Array.read
214+inspect $ 'copyStreamLatin1' `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
229215inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
230216#endif
231217
@@ -236,17 +222,17 @@ copyStreamLatin1 inh outh =
236222 Stream.fold (Handle.write outh)
237223 $ Unicode.encodeLatin1
238224 $ Unicode.decodeLatin1
239− $ Stream.unfold Handle.reader inh
225+ $ Stream.unfold Handle.read inh
240226
241227#ifdef INSPECTION
242228inspect $ hasNoTypeClasses 'copyStreamLatin1
243229inspect $ 'copyStreamLatin1 `hasNoType` ''Step
244230inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
231+inspect $ 'copyStreamLatin1 `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
245232
246233inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState
247234inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step
248−inspect $ 'copyStreamLatin1 `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
249− -- Handle.read/Array.read
235+inspect $ 'copyStreamLatin1 `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
250236inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
251237#endif
252238
@@ -256,7 +242,7 @@ _copyStreamUtf8' inh outh =
256242 Stream.fold (Handle.write outh)
257243 $ Unicode.encodeUtf8'
258244 $ Unicode.decodeUtf8'
259− $ Stream.unfold Handle.reader inh
245+ $ Stream.unfold Handle.read inh
260246
261247#ifdef INSPECTION
262248inspect $ hasNoTypeClasses '_copyStreamUtf8'
@@ -272,7 +258,7 @@ copyStreamUtf8 inh outh =
272258 Stream.fold (Handle.write outh)
273259 $ Unicode.encodeUtf8
274260 $ Unicode.decodeUtf8
275− $ Stream.unfold Handle.reader inh
261+ $ Stream.unfold Handle.read inh
276262
277263#ifdef INSPECTION
278264inspect $ hasNoTypeClasses 'copyStreamUtf8
@@ -281,24 +267,6 @@ inspect $ hasNoTypeClasses 'copyStreamUtf8
281267-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
282268#endif
283269
284−{-# NOINLINE _copyStreamUtf8'Fold #-}
285−_copyStreamUtf8'Fold :: Handle -> Handle -> IO ()
286−_copyStreamUtf8'Fold inh outh =
287− Stream.fold (Handle.write outh)
288− $ Unicode.encodeUtf8
289− $ Stream.catRights
290− $ Stream.parseMany Unicode.writeCharUtf8'
291− $ Stream.unfold Handle.reader inh
292−
293−{-# NOINLINE _copyStreamUtf8Parser #-}
294−_copyStreamUtf8Parser :: Handle -> Handle -> IO ()
295−_copyStreamUtf8Parser inh outh =
296− Stream.fold (Handle.write outh)
297− $ Unicode.encodeUtf8
298− $ Stream.catRights $ Stream.parseMany
299− (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)
300− $ Stream.unfold Handle.reader inh
301−
302270o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]
303271o_1_space_decode_encode_read env =
304272 [ bgroup "decode-encode"
@@ -312,11 +280,7 @@ o_1_space_decode_encode_read env =
312280 -- Requires valid unicode input
313281 , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh ->
314282 _copyStreamUtf8' inh outh
315− , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh ->
316− _copyStreamUtf8'Fold inh outh
317283#endif
318− , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env
319− $ \inh outh -> _copyStreamUtf8Parser inh outh
320284 , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->
321285 copyStreamUtf8 inh outh
322286 ]
@@ -324,7 +288,6 @@ o_1_space_decode_encode_read env =
324288
325289main :: IO ()
326290main = do
327−#ifndef FUSION_CHECK
328291 env <- mkHandleBenchEnv
329292 defaultMain (allBenchmarks env)
330293
@@ -337,13 +300,3 @@ main = do
337300 , o_1_space_decode_encode_read env
338301 ]
339302 ]
340−#else
341− -- Enable FUSION_CHECK macro at the beginning of the file
342− -- Enable one benchmark below, and run the benchmark
343− -- Check the .dump-simpl output
344− env <- mkHandleBenchEnv
345− let mkHandles (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh
346− (Handles inh outh) <- getHandles env mkHandles
347− copyStreamLatin1' inh outh
348− return ()
349−#endif
benchmark/Streamly/Benchmark/Unicode/Utf8.hs+3−3
@@ -13,7 +13,7 @@
1313import Data.Char (chr)
1414import Streamly.Internal.Unicode.Utf8 (Utf8)
1515
16−import Test.Tasty.Bench hiding (env)
16+import Gauge hiding (env)
1717import Streamly.Benchmark.Common
1818
1919import qualified Streamly.Internal.Unicode.Utf8 as Utf8
@@ -49,7 +49,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
4949 allBenchmarks value =
5050 [ bgroup
5151 moduleName
52− [ bench "pack" $ whnf pack value
53− , bench "pack + unpack" $ whnf packUnpack value
52+ [ bench "pack" $ nf pack value
53+ , bench "pack + unpack" $ nf packUnpack value
5454 ]
5555 ]
benchmark/bench-report/BenchReport.hsnew file+273
@@ -0,0 +1,273 @@
1+{-# LANGUAGE RecordWildCards #-}
2+{-# LANGUAGE ScopedTypeVariables #-}
3+
4+module Main where
5+
6+import Control.Exception (catch, ErrorCall(..))
7+import Control.Monad (mzero)
8+import Control.Monad.IO.Class (liftIO)
9+import Control.Monad.Trans.Maybe
10+import Control.Monad.Trans.State
11+import Data.Char (toLower)
12+import Data.List
13+import GHC.Real (infinity)
14+import System.Environment (getArgs)
15+import Text.Read (readMaybe)
16+
17+import BenchShow
18+
19+------------------------------------------------------------------------------
20+-- Command line parsing
21+------------------------------------------------------------------------------
22+
23+data BenchType
24+ = Compare String
25+ | Standard String
26+ deriving Show
27+
28+data Options = Options
29+ { genGraphs :: Bool
30+ , sortByName :: Bool
31+ , useGauge :: Bool
32+ , benchType :: Maybe BenchType
33+ , fields :: [String]
34+ , diffStyle :: GroupStyle
35+ , cutOffPercent :: Double
36+ } deriving Show
37+
38+defaultOptions :: Options
39+defaultOptions = Options False False False Nothing ["time"] PercentDiff 0
40+
41+setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
42+setGenGraphs val = do
43+ (args, opts) <- get
44+ put (args, opts { genGraphs = val })
45+
46+setSortByName :: Monad m => Bool -> StateT (a, Options) m ()
47+setSortByName val = do
48+ (args, opts) <- get
49+ put (args, opts { sortByName = val })
50+
51+setUseGauge :: Monad m => Bool -> StateT (a, Options) m ()
52+setUseGauge val = do
53+ (args, opts) <- get
54+ put (args, opts { useGauge = val })
55+
56+setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
57+setBenchType val = do
58+ (args, opts) <- get
59+ put (args, opts { benchType = Just val })
60+
61+setFields :: Monad m => [String] -> StateT (a, Options) m ()
62+setFields val = do
63+ (args, opts) <- get
64+ put (args, opts { fields = val })
65+
66+setDiff :: Monad m => String -> StateT (a, Options) m ()
67+setDiff val = do
68+ (args, opts) <- get
69+ let cmpStyle =
70+ case val of
71+ "absolute" -> Absolute
72+ "multiples" -> Multiples
73+ "percent" -> PercentDiff
74+ x -> error $ "Unknown diff option: " ++ show x
75+ in put (args, opts { diffStyle = cmpStyle })
76+
77+setCutOff :: Monad m => String -> StateT (a, Options) m ()
78+setCutOff val = do
79+ (args, opts) <- get
80+ case readMaybe val of
81+ Just x -> put (args, opts { cutOffPercent = x })
82+ Nothing -> error $ "Invalid cutoff value: " ++ show val
83+
84+-- Like the shell "shift" to shift the command line arguments
85+shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
86+shift = do
87+ s <- get
88+ case s of
89+ ([], _) -> return Nothing
90+ (x : xs, opts) -> put (xs, opts) >> return (Just x)
91+
92+parseBench :: StateT ([String], Options) (MaybeT IO) ()
93+parseBench = do
94+ x <- shift
95+ case x of
96+ Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
97+ Just str -> setBenchType (Standard str)
98+ Nothing -> do
99+ liftIO $ putStrLn "please provide a benchmark type "
100+ mzero
101+
102+parseFields :: StateT ([String], Options) (MaybeT IO) ()
103+parseFields = do
104+ x <- shift
105+ case x of
106+ Just str -> setFields (words str)
107+ Nothing -> do
108+ liftIO $ putStrLn
109+ "please provide a list of fields after --fields"
110+ mzero
111+
112+parseDiff :: StateT ([String], Options) (MaybeT IO) ()
113+parseDiff = do
114+ x <- shift
115+ case x of
116+ Just str -> setDiff str
117+ Nothing -> do
118+ liftIO $ putStrLn "please provide a diff type"
119+ mzero
120+
121+parseCutOff :: StateT ([String], Options) (MaybeT IO) ()
122+parseCutOff = do
123+ x <- shift
124+ case x of
125+ Just str -> setCutOff str
126+ Nothing -> do
127+ liftIO $ putStrLn "please provide a cutoff percent"
128+ mzero
129+
130+-- totally imperative style option parsing
131+parseOptions :: IO (Maybe Options)
132+parseOptions = do
133+ args <- getArgs
134+ runMaybeT $ flip evalStateT (args, defaultOptions) $ do
135+ parseLoop
136+ fmap snd get
137+
138+ where
139+
140+ parseOpt opt =
141+ case opt of
142+ "--graphs" -> setGenGraphs True
143+ "--sort-by-name" -> setSortByName True
144+ "--use-gauge" -> setUseGauge True
145+ "--benchmark" -> parseBench
146+ "--fields" -> parseFields
147+ "--diff-style" -> parseDiff
148+ "--diff-cutoff-percent" -> parseCutOff
149+ str -> do
150+ liftIO $ putStrLn $ "Unrecognized option " <> str
151+ mzero
152+
153+ parseLoop = do
154+ next <- shift
155+ case next of
156+ Just opt -> parseOpt opt >> parseLoop
157+ Nothing -> return ()
158+
159+ignoringErr :: IO () -> IO ()
160+ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
161+ putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
162+
163+------------------------------------------------------------------------------
164+-- Generic
165+------------------------------------------------------------------------------
166+
167+makeGraphs :: String -> Config -> String -> IO ()
168+makeGraphs name cfg@Config{..} inputFile =
169+ ignoringErr $ graph inputFile name cfg
170+
171+------------------------------------------------------------------------------
172+-- Arrays
173+------------------------------------------------------------------------------
174+
175+showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
176+showComparisons Options{..} cfg inp out =
177+ let cfg1 = cfg { classifyBenchmark = classifyComparison }
178+ in if genGraphs
179+ then ignoringErr $ graph inp "comparison"
180+ cfg1 { outputDir = Just out
181+ , presentation = Groups Absolute
182+ }
183+ else ignoringErr $ report inp Nothing cfg1
184+
185+ where
186+
187+ separator = if useGauge then '/' else '.'
188+ dropComponent sep = dropWhile (== sep) . dropWhile (/= sep)
189+
190+ -- In case of tasty-bench the names could be like
191+ -- All.Data.Array.Prim.Pinned/o-1-space.generation.show
192+ -- All.Data.Array.Foreign/o-1-space.generation.show
193+ classifyComparison b =
194+ let b1 =
195+ if useGauge
196+ then b
197+ else dropComponent separator b --- drop "All." at the beginning
198+ in Just
199+ ( takeWhile (/= '/') b1
200+ , dropComponent '/' b1 -- for tasty-bench drop up to "/"
201+ )
202+
203+------------------------------------------------------------------------------
204+-- text reports
205+------------------------------------------------------------------------------
206+
207+selectBench
208+ :: Options
209+ -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
210+ -> [String]
211+selectBench Options{..} f =
212+ reverse
213+ $ fmap fst
214+ $ filter (\(_,y) -> filterPred y)
215+ $ either
216+ (const $ either error sortFunc $ f (ColumnIndex 0) (Just PercentDiff))
217+ sortFunc
218+ $ f (ColumnIndex 1) (Just PercentDiff)
219+
220+ where
221+
222+ sortFunc = if sortByName then sortOn fst else sortOn snd
223+
224+ cutOffMultiples = 1 + cutOffPercent / 100
225+
226+ filterPred x =
227+ case benchType of
228+ Just (Compare _) ->
229+ x <= negate cutOffPercent || x >= cutOffPercent
230+ _ -> True
231+
232+benchShow ::
233+ Options
234+ -> Config
235+ -> (Config -> String -> IO ())
236+ -> String
237+ -> FilePath
238+ -> IO ()
239+benchShow Options{..} cfg func inp out =
240+ if genGraphs
241+ then func cfg {outputDir = Just out} inp
242+ else ignoringErr $ report inp Nothing cfg
243+
244+main :: IO ()
245+main = do
246+ res <- parseOptions
247+ case res of
248+ Nothing -> do
249+ putStrLn "cannot parse options"
250+ return ()
251+ Just opts@Options{fields = fs, benchType = btype} ->
252+ let cfg = defaultConfig
253+ { presentation = Groups (diffStyle opts)
254+ , selectBenchmarks = selectBench opts
255+ , selectFields = filter
256+ ( flip elem (fmap (fmap toLower) fs)
257+ . fmap toLower
258+ )
259+ }
260+ in case btype of
261+ Just (Compare str) ->
262+ showComparisons opts cfg
263+ { title = Just str }
264+ ("charts/" ++ str ++ "/results.csv")
265+ ("charts/" ++ str)
266+ Just (Standard str) ->
267+ benchShow opts cfg
268+ { title = Just str }
269+ (makeGraphs str)
270+ ("charts/" ++ str ++ "/results.csv")
271+ ("charts/" ++ str)
272+ Nothing ->
273+ error "Please specify a benchmark using --benchmark."
benchmark/bench-report/bench-report.cabalnew file+23
@@ -0,0 +1,23 @@
1+cabal-version: 2.2
2+name: bench-report
3+version: 0.0.0
4+synopsis: Benchmark report generation
5+description: Benchmark reporting application is not included in the overall
6+ cabal project so that the dependencies of both can remain independent.
7+ Benchmark reporting has a lot of dependencies that usually lag behind
8+ when new GHC releases arrive.
9+
10+-------------------------------------------------------------------------------
11+-- benchmark comparison and presentation
12+-------------------------------------------------------------------------------
13+
14+executable bench-report
15+ default-language: Haskell2010
16+ ghc-options: -Wall
17+ hs-source-dirs: .
18+ main-is: BenchReport.hs
19+ buildable: True
20+ build-Depends:
21+ base >= 4.9 && < 5
22+ , bench-show >= 0.3 && < 0.4
23+ , transformers >= 0.4 && < 0.6
benchmark/bench-report/bin/bench-runner.shnew file+673
@@ -0,0 +1,673 @@
1+#!/usr/bin/env bash
2+
3+# Note that this script is used in the "streamly" package as well as
4+# in "streaming-benchmarks" package. Any changes to the script should be
5+# generic enough so that it works in both the cases.
6+
7+#------------------------------------------------------------------------------
8+
9+set -o pipefail
10+
11+SCRIPT_DIR=$(cd `dirname $0`; pwd)
12+
13+RUNNING_BENCHMARKS=y
14+source $SCRIPT_DIR/build-lib.sh
15+
16+print_help () {
17+ echo "Usage: $0 "
18+ echo " [--benchmarks <"bench1 bench2 ..." | help>]"
19+ echo " [--prefix <benchmark name prefix to match>"
20+ echo " [--fields <"field1 field2 ..." | help>]"
21+ echo " [--sort-by-name]"
22+ echo " [--compare]"
23+ echo " [--diff-style <absolute|percent|multiples>]"
24+ echo " [--cutoff-percent <percent-value>]"
25+ echo " [--graphs]"
26+ echo " [--no-measure]"
27+ echo " [--append]"
28+ echo " [--long]"
29+ echo " [--slow]"
30+ echo " [--quick]"
31+ echo " [--raw]"
32+ echo " [--dev-build]"
33+ echo " [--use-nix]"
34+ echo " [--with-compiler <compiler exe name>]"
35+ echo " [--cabal-build-options <options>]"
36+ echo " [--rtsopts <opts>]"
37+ #echo " [--commit-compare] [--base <commit>] [--candidate <commit>]"
38+ #echo " -- <gauge options or benchmarks>"
39+ echo
40+ echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"
41+ echo "--compare: compare the specified benchmarks with each other"
42+ echo "--fields: measurement fields to report, use 'help' for a list"
43+ echo "--graphs: Generate graphical reports"
44+ echo "--no-measure: Don't run benchmarks, run reports from previous results"
45+ echo "--append: Don't overwrite previous results, append for comparison"
46+ echo "--long: Use much longer stream size for infinite stream benchmarks"
47+ echo "--slow: Slightly more accurate results at the expense of speed"
48+ echo "--quick: Faster results, useful for longer benchmarks"
49+ echo "--raw: Run the benchmarks but don't report them. This is useful when"
50+ echo " you only want to work with the csv files generated."
51+ echo "--cabal-build-options: Pass any cabal build options to be used for build"
52+ echo " e.g. --cabal-build-options \"--flag dev\""
53+ echo
54+ echo "When specific space complexity group is chosen then (and only then) "
55+ echo "RTS memory restrictions are used accordingly. For example, "
56+ echo "bench.sh --benchmarks Data.Parser -- Data.Parser/o-1-space "
57+ echo "restricts Heap/Stack space for O(1) characterstics"
58+ echo
59+ #echo "When using --commit-compare, by default comparative chart of HEAD^ vs HEAD"
60+ #echo "commit is generated, in the 'charts' directory."
61+ #echo "Use --base and --candidate to select the commits to compare."
62+ #echo
63+ #echo "Any arguments after a '--' are passed directly to gauge"
64+ exit
65+}
66+
67+#-----------------------------------------------------------------------------
68+# Reporting utility functions
69+#-----------------------------------------------------------------------------
70+
71+list_comparisons () {
72+ echo "Comparison groups:"
73+ for i in $COMPARISONS
74+ do
75+ echo -n "$i ["
76+ eval "echo -n \$$i"
77+ echo "]"
78+ done
79+ echo
80+}
81+
82+build_report_prog() {
83+ local prog_path=$BENCH_REPORT_DIR/bin/bench-report
84+
85+ hash -r
86+ if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"
87+ then
88+ echo "Building bench-report executables"
89+ BUILD_ONCE=1
90+ pushd $BENCH_REPORT_DIR
91+ local cmd
92+ cmd="$CABAL_EXECUTABLE install --installdir bin bench-report"
93+ if test "$USE_NIX" -eq 0
94+ then
95+ $cmd || die "bench-report build failed"
96+ else
97+ nix-shell --run "$cmd" || die "bench-report build failed"
98+ fi
99+ popd
100+ elif test ! -x "$prog_path"
101+ then
102+ return 1
103+ fi
104+ return 0
105+}
106+
107+build_report_progs() {
108+ if test "$RAW" = "0"
109+ then
110+ build_report_prog || exit 1
111+ local prog
112+ prog=$BENCH_REPORT_DIR/bin/bench-report
113+ test -x $prog || die "Cannot find bench-report executable"
114+ echo "Using bench-report executable [$prog]"
115+ fi
116+}
117+
118+# We run the benchmarks in isolation in a separate process so that different
119+# benchmarks do not interfere with other. To enable that we need to pass the
120+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
121+# own path currently.
122+
123+# The path is dependent on the architecture and cabal version.
124+
125+bench_output_file() {
126+ local bench_name=$1
127+ echo "charts/$bench_name/results.csv"
128+}
129+
130+#------------------------------------------------------------------------------
131+# Speed options
132+#------------------------------------------------------------------------------
133+
134+# tasty-bench does not like an option set twice
135+set_super_quick_mode () {
136+ echo -n super_quick
137+}
138+
139+# For certain long benchmarks if the user has not requested super quick
140+# mode we anyway use a slightly quicker mode.
141+use_quicker_mode () {
142+ if test "$QUICK_MODE" -eq 0
143+ then
144+ echo quicker
145+ fi
146+}
147+
148+#------------------------------------------------------------------------------
149+# Determine options from benchmark name
150+#------------------------------------------------------------------------------
151+
152+# Global environment passed:
153+# BENCH_EXEC_PATH: the benchmark executable
154+# RTS_OPTIONS: additional RTS options
155+# QUICK_MODE: whether we are in quick mode
156+# USE_GAUGE: whether to use gauge or tasty-bench
157+# LONG: whether to use a large stream size
158+
159+# $1: bench name
160+bench_exec_one() {
161+ local BENCH_NAME_ORIG
162+ BENCH_NAME_ORIG="$1"
163+ shift
164+
165+ local SUPER_QUICK_OPTIONS
166+ local QUICKER_OPTIONS
167+ if test "$USE_GAUGE" -eq 0
168+ then
169+ SUPER_QUICK_OPTIONS="--stdev 1000000"
170+ QUICKER_OPTIONS="--stdev 100"
171+ else
172+ # Do not keep time limit as 0 otherwise GC stats may remain 0 in some cases.
173+ SUPER_QUICK_OPTIONS="--quick --min-duration 0 --time-limit 0.01 --include-first-iter"
174+ QUICKER_OPTIONS="--min-samples 3 --time-limit 1"
175+ fi
176+
177+ local BENCH_NAME0
178+ local BENCH_NAME1
179+ local BENCH_NAME2
180+ local BENCH_NAME
181+ # XXX this is a hack to make the "/" separated names used in the functions
182+ # determining options based on benchmark name. For tasty-bench the benchmark
183+ # names are separated by "." instead of "/" and are prefixed by "All".
184+ #
185+ # For example, All.Prelude.Serial/x.y.z => Prelude.Serial/x/y/z
186+ if test "$USE_GAUGE" -eq 0
187+ then
188+ # Remove the prefix "All."
189+ BENCH_NAME0=$(echo $BENCH_NAME_ORIG | sed -e s/^All\.//)
190+
191+ # Module names could contain dots e.g. "Prelude.Serial". So we insert
192+ # an explicit "/" to separate the module name part and the rest of
193+ # the benchmark name. For example, Prelude.Serial/elimination.drain
194+ BENCH_NAME1=$(echo $BENCH_NAME0 | cut -f1 -d '/')
195+
196+ if test "$BENCH_NAME1" = "$BENCH_NAME0"
197+ then
198+ # There is no "/" separator
199+ BENCH_NAME1=$(echo $BENCH_NAME0 | sed -e 's/\./\//g')
200+ BENCH_NAME2=""
201+ else
202+ BENCH_NAME2=/$(echo $BENCH_NAME0 | cut -f2- -d '/' | sed -e 's/\./\//g')
203+ fi
204+ BENCH_NAME="${BENCH_NAME1}${BENCH_NAME2}"
205+ else
206+ BENCH_NAME=$BENCH_NAME_ORIG
207+ fi
208+
209+ local RTS_OPTIONS1
210+ RTS_OPTIONS1="\
211++RTS -T \
212+$(bench_rts_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME) \
213+$RTS_OPTIONS \
214+-RTS"
215+
216+ local QUICK_MODE_TYPE
217+ QUICK_MODE_TYPE="\
218+ $(if test "$QUICK_MODE" -ne 0; then set_super_quick_mode; fi) \
219+ $(bench_speed_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME)"
220+
221+ local QUICK_BENCH_OPTIONS
222+ for i in $QUICK_MODE_TYPE
223+ do
224+ case "$i" in
225+ super_quick) QUICK_BENCH_OPTIONS="$SUPER_QUICK_OPTIONS"; break ;;
226+ quicker) QUICK_BENCH_OPTIONS="$QUICKER_OPTIONS"; break ;;
227+ esac
228+ done
229+
230+ local STREAM_SIZE
231+ local STREAM_LEN
232+ local STREAM_SIZE_OPT
233+ if test "$LONG" -ne 0
234+ then
235+ STREAM_SIZE=10000000
236+ STREAM_LEN=$(env LC_ALL=en_US.UTF-8 printf "--stream-size %'.f\n" $STREAM_SIZE)
237+ STREAM_SIZE_OPT="--stream-size $STREAM_SIZE"
238+ fi
239+
240+ echo "$BENCH_NAME_ORIG: \
241+ $RTS_OPTIONS1 \
242+ $STREAM_LEN \
243+ $QUICK_BENCH_OPTIONS" \
244+ "$@"
245+
246+ #------------------------------------------------------------------------------
247+ # Run benchmark with options and collect results
248+ #------------------------------------------------------------------------------
249+
250+ local output_file
251+ output_file=$(bench_output_file $(basename $BENCH_EXEC_PATH))
252+ mkdir -p `dirname $output_file`
253+ rm -f ${output_file}.tmp
254+
255+ local BENCH_NAME_ESC
256+ if test $USE_GAUGE -eq 0
257+ then
258+ # Escape "\" and double quotes in benchmark names
259+ BENCH_NAME_ESC=$(echo "$BENCH_NAME_ORIG" | sed -e 's/\\/\\\\/g' | sed -e 's/"/\\"/g')
260+ $BENCH_EXEC_PATH \
261+ -j 1 \
262+ $RTS_OPTIONS1 \
263+ $STREAM_SIZE_OPT \
264+ $QUICK_BENCH_OPTIONS \
265+ "$@" \
266+ --csv=${output_file}.tmp \
267+ -p '$0 == "'"$BENCH_NAME_ESC"'"' || die "Benchmark execution failed."
268+
269+ # Convert cpuTime field from picoseconds to seconds
270+ awk --version 2>&1 | grep -q "GNU Awk" \
271+ || die "Need GNU awk. [$(which awk)] is not GNU awk."
272+ tail -n +2 ${output_file}.tmp | \
273+ awk 'BEGIN {FPAT = "([^,]+)|(\"[^\"]+\")";OFS=","} {$2=$2/1000000000000;print}' \
274+ >> $output_file
275+ else
276+ $BENCH_EXEC_PATH \
277+ $RTS_OPTIONS1 \
278+ $STREAM_SIZE_OPT \
279+ $QUICK_BENCH_OPTIONS \
280+ "$@" \
281+ --csvraw=${output_file}.tmp \
282+ -m exact "$BENCH_NAME" || die "Benchmark execution failed."
283+ tail -n +2 ${output_file}.tmp \
284+ >> $output_file
285+ fi
286+}
287+
288+invoke_gauge () {
289+ local target_prog="$1"
290+ local target_name="$2"
291+ local output_file="$3"
292+
293+ local MATCH=""
294+ if test "$LONG" -ne 0
295+ then
296+ MATCH="$target_name/o-1-space"
297+ else
298+ MATCH="$BENCH_PREFIX"
299+ fi
300+ echo "name,iters,time,cycles,cpuTime,utime,stime,maxrss,minflt,majflt,nvcsw,nivcsw,allocated,numGcs,bytesCopied,mutatorWallSeconds,mutatorCpuSeconds,gcWallSeconds,gcCpuSeconds" >> $output_file
301+ # keep only benchmark names with shortest prefix e.g. "a/b/c" and "a/b", we
302+ # should only keep "a/b" otherwise benchmarks will run multiple times. why?
303+ $target_prog -l \
304+ | grep "^$MATCH" \
305+ | while read -r name; \
306+ do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
307+ || die "Benchmark execution failed."
308+}
309+
310+invoke_tasty_bench () {
311+ local target_prog="$1"
312+ local target_name="$2"
313+ local output_file="$3"
314+
315+ local MATCH=""
316+ if test "$LONG" -ne 0
317+ then
318+ MATCH="-p /$target_name\/o-1-space/"
319+ else
320+ if test -n "$BENCH_PREFIX"
321+ then
322+ # escape "/"
323+ local escaped_name=$(echo "$BENCH_PREFIX" | sed -e 's/\//\\\//g')
324+ MATCH="-p /$escaped_name/"
325+ fi
326+ fi
327+ echo "Name,cpuTime,2*Stdev (ps),Allocated,bytesCopied,maxrss" >> $output_file
328+ $target_prog -l $MATCH \
329+ | grep "^All" \
330+ | while read -r name; \
331+ do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
332+ || die "Benchmark execution failed."
333+}
334+
335+run_bench_target () {
336+ local package_name=$1
337+ local component=$2
338+ local target_name=$3
339+
340+ local target_prog
341+ if test -z "$BENCHMARK_PACKAGE_VERSION"
342+ then
343+ echo "Please set BENCHMARK_PACKAGE_VERSION in bench_config"
344+ exit 1
345+ fi
346+ target_prog=$(cabal_target_prog $package_name-$BENCHMARK_PACKAGE_VERSION $component $target_name) || \
347+ die "Cannot find executable for target $target_name"
348+
349+ echo "Running executable $target_name ..."
350+
351+ # Needed by bench_exec_one
352+ BENCH_EXEC_PATH=$target_prog
353+
354+ local output_file=$(bench_output_file $target_name)
355+ mkdir -p `dirname $output_file`
356+ if test "$USE_GAUGE" -eq 0
357+ then invoke_tasty_bench "$target_prog" "$target_name" "$output_file"
358+ else invoke_gauge "$target_prog" "$target_name" "$output_file"
359+ fi
360+}
361+
362+# $1: package name
363+# $2: component
364+# $3: targets
365+run_bench_targets() {
366+ for i in $3
367+ do
368+ run_bench_target $1 $2 $i
369+ done
370+}
371+
372+run_benches_comparing() {
373+ local bench_list=$1
374+
375+ if test -z "$CANDIDATE"
376+ then
377+ CANDIDATE=$(git rev-parse HEAD)
378+ fi
379+ if test -z "$BASE"
380+ then
381+ # XXX Should be where the current branch is forked from master
382+ BASE="$CANDIDATE^"
383+ fi
384+ echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"
385+ echo "Checking out base commit [$BASE] for benchmarking"
386+ # XXX git checkout will overwrite this script itself and the scripts
387+ # imported/used by this script.
388+ git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"
389+
390+ # $BUILD_BENCH || die "build failed"
391+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
392+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
393+
394+ echo "Checking out candidate commit [$CANDIDATE] for benchmarking"
395+ git checkout "$CANDIDATE" || \
396+ die "Checkout of candidate [$CANDIDATE] commit failed"
397+
398+ # $BUILD_BENCH || die "build failed"
399+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
400+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
401+ # XXX reset back to the original commit
402+}
403+
404+backup_output_file() {
405+ local bench_name=$1
406+ local output_file=$(bench_output_file $bench_name)
407+
408+ if test -e $output_file -a "$APPEND" != 1
409+ then
410+ mv -f -v $output_file ${output_file}.prev
411+ fi
412+}
413+
414+run_measurements() {
415+ local bench_list=$1
416+
417+ for i in $bench_list
418+ do
419+ backup_output_file $i
420+ done
421+
422+ if test "$COMMIT_COMPARE" = "0"
423+ then
424+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
425+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
426+ else
427+ run_benches_comparing "$bench_list"
428+ fi
429+}
430+
431+run_reports() {
432+ local prog
433+ prog=$BENCH_REPORT_DIR/bin/bench-report
434+ test -x $prog || die "Cannot find bench-report executable"
435+ echo
436+
437+ for i in $1
438+ do
439+ echo "Generating reports for ${i}..."
440+ $prog \
441+ --benchmark $i \
442+ $(test "$USE_GAUGE" = 1 && echo "--use-gauge") \
443+ $(test "$GRAPH" = 1 && echo "--graphs") \
444+ $(test "$SORT_BY_NAME" = 1 && echo "--sort-by-name") \
445+ $(test -n "$BENCH_DIFF_STYLE" && echo "--diff-style $BENCH_DIFF_STYLE") \
446+ $(test -n "$BENCH_CUTOFF_PERCENT" && echo "--diff-cutoff-percent $BENCH_CUTOFF_PERCENT") \
447+ --fields "$FIELDS"
448+ done
449+}
450+
451+#-----------------------------------------------------------------------------
452+# Execution starts here
453+#-----------------------------------------------------------------------------
454+
455+USE_GIT_CABAL=1 # This is used by set_common_vars
456+set_common_vars
457+
458+USE_NIX=0
459+COMPARE=0
460+COMMIT_COMPARE=0
461+BASE=
462+CANDIDATE=
463+
464+APPEND=0
465+LONG=0
466+RAW=0
467+SORT_BY_NAME=0
468+GRAPH=0
469+MEASURE=1
470+
471+GAUGE_ARGS=
472+BUILD_ONCE=0
473+
474+CABAL_BUILD_OPTIONS="--flag fusion-plugin --flag limit-build-mem"
475+
476+#-----------------------------------------------------------------------------
477+# Read command line
478+#-----------------------------------------------------------------------------
479+
480+while test -n "$1"
481+do
482+ case $1 in
483+ -h|--help|help) print_help ;;
484+ # options with arguments
485+ --benchmarks) shift; TARGETS=$1; shift ;;
486+ --targets) shift; TARGETS=$1; shift ;;
487+ --prefix) shift; BENCH_PREFIX="$1"; shift ;;
488+ --fields) shift; FIELDS=$1; shift ;;
489+ --base) shift; BASE=$1; shift ;;
490+ --candidate) shift; CANDIDATE=$1; shift ;;
491+ --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;
492+ --cabal-build-flags) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
493+ --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
494+ --rtsopts) shift; RTS_OPTIONS=$1; shift ;;
495+ --config) shift; BENCH_CONFIG_FILE=$1; shift ;;
496+ --diff-style) shift; BENCH_DIFF_STYLE=$1; shift ;;
497+ --diff-cutoff-percent) shift; BENCH_CUTOFF_PERCENT=$1; shift ;;
498+ # flags
499+ --slow) SLOW=1; shift ;;
500+ --quick) QUICK_MODE=1; shift ;;
501+ --compare) COMPARE=1; shift ;;
502+ --commit-compare) COMMIT_COMPARE=1; shift ;;
503+ --raw) RAW=1; shift ;;
504+ --append) APPEND=1; shift ;;
505+ --long) LONG=1; shift ;;
506+ --sort-by-name) SORT_BY_NAME=1; shift ;;
507+ --graphs) GRAPH=1; shift ;;
508+ --no-measure) MEASURE=0; shift ;;
509+ # This is used in build-lib.sh to enable dev_build function which is used
510+ # in targets.sh to enable or disable some targets.
511+ --dev-build) RUNNING_DEVBUILD=1; shift ;;
512+ --use-nix) USE_NIX=1; shift ;;
513+ --use-gauge) USE_GAUGE=1; shift ;;
514+ --) shift; break ;;
515+ *) echo "Unknown flags: $*"; echo; print_help ;;
516+ esac
517+done
518+GAUGE_ARGS=("$@")
519+
520+if test -z "$BENCH_CONFIG_FILE"
521+then
522+ die "Please use --config to specify config file"
523+fi
524+
525+source "$BENCH_CONFIG_FILE" || \
526+ die "Failed to source config file $BENCH_CONFIG_FILE"
527+
528+# Defined in $BENCH_CONFIG_FILE
529+bench_config
530+
531+if test -z "$FIELDS"
532+then
533+ FIELDS=$DEFAULT_FIELDS
534+fi
535+
536+set_derived_vars
537+
538+#-----------------------------------------------------------------------------
539+# Determine targets
540+#-----------------------------------------------------------------------------
541+
542+only_real_benchmarks () {
543+ for i in $TARGETS
544+ do
545+ local SKIP=0
546+ for j in $COMPARISONS
547+ do
548+ if test $i == $j
549+ then
550+ SKIP=1
551+ fi
552+ done
553+ if test "$SKIP" -eq 0
554+ then
555+ echo -n "$i "
556+ fi
557+ done
558+}
559+
560+# defined in $BENCH_CONFIG_FILE
561+bench_targets
562+
563+if test "$(has_item "$TARGETS" help)" = "help"
564+then
565+ list_target_groups
566+ list_comparisons
567+ list_targets
568+ exit
569+fi
570+
571+COMMON_FIELDS="allocated bytescopied cputime maxrss"
572+if test "$USE_GAUGE" -eq 1
573+then
574+ ALL_FIELDS="$COMMON_FIELDS time cycles utime stime minflt majflt nvcsw nivcsw"
575+else
576+ ALL_FIELDS="$COMMON_FIELDS"
577+fi
578+if test "$(has_item "$FIELDS" help)" = "help"
579+then
580+ echo "Supported fields: $ALL_FIELDS"
581+ echo "Default fields: $DEFAULT_FIELDS"
582+ exit
583+fi
584+
585+if test "$LONG" -ne 0
586+then
587+ if test -n "$TARGETS"
588+ then
589+ echo "Cannot specify benchmarks [$TARGETS] with --long"
590+ exit
591+ fi
592+ TARGETS=$infinite_grp
593+fi
594+
595+DEFAULT_TARGETS="$(all_grp)"
596+TARGETS=$(set_targets)
597+
598+TARGETS_ORIG=$TARGETS
599+TARGETS=$(only_real_benchmarks)
600+
601+echo "Using benchmark suites [$TARGETS]"
602+
603+#-----------------------------------------------------------------------------
604+# Build reporting utility
605+#-----------------------------------------------------------------------------
606+
607+# We need to build the report progs first at the current (latest) commit before
608+# checking out any other commit for benchmarking.
609+build_report_progs
610+
611+#-----------------------------------------------------------------------------
612+# Build and run targets
613+#-----------------------------------------------------------------------------
614+
615+if test "$USE_GAUGE" -eq 1
616+then
617+ BUILD_FLAGS="--flag use-gauge"
618+fi
619+
620+BUILD_BENCH="$CABAL_EXECUTABLE v2-build $BUILD_FLAGS $CABAL_BUILD_OPTIONS --enable-benchmarks"
621+if test "$MEASURE" = "1"
622+then
623+ run_measurements "$TARGETS"
624+fi
625+
626+#-----------------------------------------------------------------------------
627+# Run reports
628+#-----------------------------------------------------------------------------
629+
630+# $1: var name
631+build_comparison_results () {
632+ local name
633+ local constituents
634+
635+ name=$1
636+ constituents=$(eval "echo -n \$${name}")
637+ mkdir -p "charts/$name"
638+ dest_file="charts/$name/results.csv"
639+ : > $dest_file
640+ for j in $constituents
641+ do
642+ cat "charts/$j/results.csv" >> $dest_file
643+ done
644+}
645+
646+if test "$COMPARE" -eq 1
647+then
648+ DYN_CMP_GRP="$(echo "$TARGETS" | sed -e 's/ /_/g')_cmp"
649+ eval "$DYN_CMP_GRP=\"$TARGETS\""
650+ COMPARISON_REPORTS=$DYN_CMP_GRP
651+ build_comparison_results $DYN_CMP_GRP
652+else
653+ COMPARISON_REPORTS=""
654+fi
655+
656+for i in $COMPARISONS
657+do
658+ if test "$(has_item "$TARGETS_ORIG" $i)" = $i
659+ then
660+ COMPARISON_REPORTS="$COMPARISON_REPORTS $i"
661+ build_comparison_results $i
662+ fi
663+done
664+
665+if test "$RAW" = "0"
666+then
667+ run_reports "$TARGETS"
668+ run_reports "$COMPARISON_REPORTS"
669+ if test -n "$DYN_CMP_GRP"
670+ then
671+ rm -rf "charts/$DYN_CMP_GRP"
672+ fi
673+fi
benchmark/bench-report/bin/build-lib.shnew file+213
@@ -0,0 +1,213 @@
1+# $1: message
2+die () {
3+ >&2 echo -e "Error: $1"
4+ exit 1
5+}
6+
7+warn () {
8+ >&2 echo -e "Warning: $1"
9+}
10+
11+# $1: command
12+function run_verbose() {
13+ echo "$*"
14+ bash -c "$*"
15+}
16+
17+has_item () {
18+ for i in $1
19+ do
20+ if test "$i" = "$2"
21+ then
22+ echo "$i"
23+ break
24+ fi
25+ done
26+}
27+
28+#------------------------------------------------------------------------------
29+# target groups
30+#------------------------------------------------------------------------------
31+
32+test_only () {
33+ if test -n "$RUNNING_TESTS"
34+ then
35+ echo $1
36+ fi
37+}
38+
39+bench_only () {
40+ if test -n "$RUNNING_BENCHMARKS"
41+ then
42+ echo $1
43+ fi
44+}
45+
46+dev_build () {
47+ if test -n "$RUNNING_DEVBUILD"
48+ then
49+ echo $1
50+ fi
51+}
52+
53+# A group consisting of all known individual targets
54+all_grp () {
55+ { for i in $GROUP_TARGETS
56+ do
57+ for j in $(eval "echo \$$i")
58+ do
59+ echo $j
60+ done
61+ done
62+ for i in $INDIVIDUAL_TARGETS
63+ do
64+ echo $i
65+ done
66+ } | sort | uniq
67+}
68+
69+# All groups
70+all_target_groups () {
71+ echo $GROUP_TARGETS
72+}
73+
74+# XXX pass as arg
75+list_targets () {
76+ echo "Individual targets:"
77+ for i in $(all_grp)
78+ do
79+ echo "$i"
80+ done
81+ echo
82+}
83+
84+# XXX pass as arg
85+list_target_groups () {
86+ echo "All Targets: all_grp"
87+ echo "Target groups:"
88+ for i in $(all_target_groups)
89+ do
90+ echo -n "$i ["
91+ eval "echo -n \$$i"
92+ echo "]"
93+ done
94+ echo
95+}
96+
97+# XXX pass as arg
98+set_targets() {
99+ if test -z "$TARGETS"
100+ then
101+ echo $DEFAULT_TARGETS
102+ else
103+ for i in $(echo $TARGETS)
104+ do
105+ case $i in
106+ *_grp) eval "echo -n \$${i}" ;;
107+ *_cmp) eval "echo -n \$${i} $i" ;;
108+ *) echo -n $i ;;
109+ esac
110+ echo -n " "
111+ done
112+ fi
113+}
114+
115+# XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables
116+
117+# $1: builddir
118+# $2: package name with version
119+# $3: component ("" (lib), t (test), b (benchmark), x (executable))
120+# $4: command to find
121+cabal_which_builddir() {
122+ local noopt=""
123+ if test "$TEST_QUICK_MODE" = "1"
124+ then
125+ noopt="/noopt"
126+ fi
127+
128+ local path=$(echo $1/build/*/ghc-${GHC_VERSION}/${2}/$3/$4$noopt/build/$4/$4)
129+ echo "[cabal_which $path]" 1>&2
130+ test -f "$path" && echo $path
131+}
132+
133+# $1: package name with version
134+# $2: component
135+# $3: command to find
136+cabal_which() {
137+ cabal_which_builddir $BUILD_DIR $1 $2 $3
138+}
139+
140+# We run the benchmarks in isolation in a separate process so that different
141+# benchmarks do not interfere with other. To enable that we need to pass the
142+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
143+# own path currently.
144+
145+# The path is dependent on the architecture and cabal version.
146+
147+# $1: package name with version
148+# $2: component
149+# $3: target
150+cabal_target_prog () {
151+ local target_prog=`cabal_which $1 $2 $3`
152+ if test -x "$target_prog"
153+ then
154+ echo $target_prog
155+ else
156+ return 1
157+ fi
158+}
159+
160+set_common_vars () {
161+ SLOW=0
162+ QUICK_MODE=0
163+
164+ RUNNING_DEVBUILD=
165+
166+ TARGET_EXE_ARGS=
167+ RTS_OPTIONS=
168+
169+ CABAL_BUILD_OPTIONS=""
170+ CABAL_EXECUTABLE=cabal
171+
172+ # Use branch specific builds if git-cabal is present in PATH
173+ BUILD_DIR=dist-newstyle
174+ if test "$USE_GIT_CABAL" -eq 1
175+ then
176+ if which git-cabal 2>/dev/null
177+ then
178+ echo "Using git-cabal for branch specific builds"
179+ CABAL_EXECUTABLE=git-cabal
180+ BUILD_DIR=$(git-cabal show-builddir)
181+ fi
182+ fi
183+}
184+
185+# To be called after parsing CLI arguments
186+set_derived_vars () {
187+ if test -n "$CABAL_WITH_COMPILER"
188+ then
189+ CABAL_BUILD_OPTIONS+=" --with-compiler $CABAL_WITH_COMPILER"
190+ else
191+ CABAL_WITH_COMPILER=ghc
192+ fi
193+
194+ GHC_VERSION=$($CABAL_WITH_COMPILER --numeric-version)
195+}
196+
197+# $1: build program
198+# $2: package name
199+# $3: component prefix
200+# $4: targets
201+run_build () {
202+ local build_prog=$1
203+ local package=$2
204+ local component_prefix=$3
205+ local COMPONENTS
206+ local c
207+
208+ for c in $4
209+ do
210+ COMPONENTS+="$package:$component_prefix:$c "
211+ done
212+ run_verbose $build_prog $COMPONENTS || die "build failed"
213+}
targets/cabal.project → benchmark/bench-report/cabal.projectrenamed

The content is the same.

benchmark/bench-report/default.nixnew file+50
@@ -0,0 +1,50 @@
1+{
2+ nixpkgs ?
3+ # nixpkgs 21.05 needs a revised version of bench-show and we do not
4+ # know how to use a revised version in nix.
5+ #import (builtins.fetchTarball https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz)
6+ import (builtins.fetchTarball https://github.com/composewell/nixpkgs/archive/01dd2b4e738.tar.gz)
7+ {}
8+#, compiler ? "ghc884" # For nix 21.05
9+, compiler ? "default"
10+}:
11+let haskellPackages =
12+ if compiler == "default"
13+ then nixpkgs.haskellPackages
14+ else nixpkgs.haskell.packages.${compiler};
15+
16+ mkPackage = super: pkg: path: opts: inShell:
17+ let orig = super.callCabal2nixWithOptions pkg path opts {};
18+ in if inShell
19+ # Avoid copying the source directory to nix store by using
20+ # src = null.
21+ then orig.overrideAttrs (oldAttrs: { src = null; })
22+ else orig;
23+
24+ mkHaskellPackages = inShell:
25+ haskellPackages.override {
26+ overrides = self: super:
27+ with nixpkgs.haskell.lib;
28+ {
29+ bench-report = mkPackage super "bench-report" ./. "" inShell;
30+ };
31+ };
32+
33+ drv = mkHaskellPackages true;
34+
35+ shell = drv.shellFor {
36+ packages = p:
37+ [ p.bench-report
38+ ];
39+ # Use a better prompt
40+ shellHook = ''
41+ export CABAL_DIR="$(pwd)/.cabal.nix"
42+ if test -n "$PS_SHELL"
43+ then
44+ export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
45+ fi
46+ '';
47+ };
48+in if nixpkgs.lib.inNixShell
49+ then shell
50+ else (mkHaskellPackages false).bench-report
benchmark/bench-runner/Main.hsdeleted−183
@@ -1,183 +0,0 @@
1−module Main (main) where
2−
3−import BenchRunner (mainWith)
4−import BuildLib (Quickness(..))
5−import Control.Applicative ((<|>))
6−import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
7−
8−import Targets (targets)
9−
10−rtsOpts :: String -> String -> String
11−rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]
12−
13− where
14−
15− -- Drop All.
16− benchName = drop 4 benchName0
17−
18− general
19− -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
20− | "o-1-sp" `isInfixOf` benchName = "-K36K -M32M"
21− | "o-n-h" `isInfixOf` benchName = "-K36K -M32M"
22− -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
23− | "o-n-st" `isInfixOf` benchName = "-K1M -M32M"
24− | "o-n-sp" `isInfixOf` benchName = "-K1M -M32M"
25− | otherwise = ""
26−
27− exeSpecific
28− | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M"
29− | otherwise = ""
30−
31− benchSpecific
32− -- GHC-9.6 requires 64M, earlier it was 16M
33− | "Data.Fold/o-n-heap.key-value.toHashMapIO (max buckets) sum" == benchName =
34− "-M64M"
35−
36− -- This is required only for the --long case because we allocate all
37− -- the arrays upfront. depends on the size of the stream.
38− | "Data.Parser/o-1-space" `isPrefixOf` benchName =
39− "-M128M"
40−
41− -----------------------------------------------------------------------
42−
43− | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = "-M256M"
44− | "Prelude.Parallel/o-n-heap.monad-outer-product."
45− `isPrefixOf` benchName = "-M256M"
46− | "Prelude.Parallel/o-n-space.monad-outer-product."
47− `isPrefixOf` benchName = "-K2M -M256M"
48− | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
49− | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
50− | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
51− | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
52− "-K4M"
53− | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
54− "-K128K -M32M"
55− | "Prelude.Ahead/o-1-space." `isPrefixOf` benchName = "-K128K"
56− | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
57− "-K4M"
58− | "Prelude.WAsync/o-n-heap.monad-outer-product.toNull3" == benchName =
59− "-M64M"
60− | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
61− "-K4M"
62−
63− -- This module is dev only now, and can be removed at some point
64− | "Data.Stream.StreamDK/o-1-space.grouping.classifySessionsOf"
65− `isPrefixOf` benchName = "-K512K"
66− | "Data.Stream.StreamDK/o-n-space.foldr.foldrM/"
67− `isPrefixOf` benchName = "-K4M"
68− | "Data.Stream.StreamDK/o-n-space.iterated."
69− `isPrefixOf` benchName = "-K4M -M64M"
70− -- GHC 9.4.4 requires 4M
71− | "Data.Stream.StreamDK/o-n-space.traversable."
72− `isPrefixOf` benchName = "-K4M"
73− -- GHC-9.6 requires 64M, earlier it was 32M
74− | "Data.Stream.StreamDK/o-n-heap.buffered.readsPrec pure streams" == benchName =
75− "-M64M"
76− -- GHC-9.6 requires 64M, earlier it was 32M
77− | "Data.Stream.StreamDK/o-n-heap.buffered.showPrec Haskell lists" == benchName =
78− "-M64M"
79−
80− -----------------------------------------------------------------------
81−
82− | "Data.StreamD/o-n-space.elimination.toList" == benchName =
83− "-K2M"
84− | "Data.StreamK/o-n-space.elimination.toList" == benchName =
85− "-K2M"
86−
87− -----------------------------------------------------------------------
88−
89− | "Data.Stream/o-1-space.grouping.classifySessionsOf"
90− `isPrefixOf` benchName = "-K512K"
91− | "Data.Stream/o-n-space.foldr.foldrM/"
92− `isPrefixOf` benchName = "-K4M"
93− | "Data.Stream/o-n-space.iterated."
94− `isPrefixOf` benchName = "-K4M"
95−
96− -- GHC-9.6 requires 64M, earlier it was 32M
97− | "Data.Stream/o-n-heap.buffered.showPrec Haskell lists" == benchName =
98− "-M64M"
99− -- GHC-9.6 requires 64M, earlier it was 32M
100− | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" == benchName =
101− "-M64M"
102−
103− | "Data.Stream.ConcurrentEager/o-n-heap.monad-outer-product.toNullAp"
104− `isPrefixOf` benchName = "-M1024M"
105− | "Data.Stream.ConcurrentEager/o-1-space."
106− `isPrefixOf` benchName = "-M128M"
107−
108− | "Data.Stream.ConcurrentOrdered/o-1-space.concat-foldable.foldMapWith"
109− `isPrefixOf` benchName = "-K128K"
110−
111− ----------------------------------------------------------------------
112−
113− | "Data.Array" `isPrefixOf` benchName
114− && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M"
115− -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
116− | "Data.Array" `isPrefixOf` benchName
117− && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M64M"
118− -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
119− | "Data.Array.Generic/o-1-space.transformationX4.map"
120− `isPrefixOf` benchName = "-M64M"
121−
122− -- XXX For --long option, need to check why so much heap is required.
123− -- Note, if we remove the chunked stream module we need to keep the
124− -- chunked stream benchmarks in the stream module.
125− | "Data.Array.Stream/o-1-space"
126− `isPrefixOf` benchName = "-K4M -M512M"
127− -- XXX Takes up to 160MB heap for --long, we use chunked stream for
128− -- this, so the reason may be related to chunked streams.
129− | "Data.ParserK/o-1-space"
130− `isPrefixOf` benchName = "-K4M -M256M"
131−
132− -----------------------------------------------------------------------
133−
134− | "Unicode.Char/o-1-space." `isPrefixOf` benchName = "-M32M"
135−
136− | otherwise = ""
137−
138−speedOpts :: String -> String -> Maybe Quickness
139−speedOpts exeName benchName0 = exeSpecific <|> benchSpecific
140−
141− where
142−
143− -- slowestOf Quicker _ = Quicker
144− -- slowestOf _ Quicker = Quicker
145− -- slowestOf _ _ = SuperQuick
146−
147− -- Drop All.
148− benchName = drop 4 benchName0
149− exeSpecific
150− | "Prelude.Concurrent" == exeName = Just SuperQuick
151− | "Prelude.Rate" == exeName = Just SuperQuick
152− | "Prelude.Adaptive" == exeName = Just SuperQuick
153− | otherwise = Nothing
154− benchSpecific
155− | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName =
156− Just SuperQuick
157− | "Prelude.Parallel/o-n-heap.monad-outer-product."
158− `isPrefixOf` benchName = Just SuperQuick
159− | "Prelude.Parallel.o-n-space.monad-outer-product."
160− `isPrefixOf` benchName = Just SuperQuick
161− | "Prelude.Parallel/o-n-heap.generation." `isPrefixOf` benchName =
162− Just Quicker
163− | "Prelude.Parallel/o-n-heap.mapping." `isPrefixOf` benchName =
164− Just Quicker
165− | "Prelude.Parallel/o-n-heap.concat-foldable." `isPrefixOf` benchName =
166− Just Quicker
167− | "Prelude.Async/o-1-space.monad-outer-product." `isPrefixOf` benchName =
168− Just Quicker
169− | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
170− Just Quicker
171− | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
172− Just Quicker
173− | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
174− Just Quicker
175− | "Prelude.WAsync/o-n-heap.monad-outer-product." `isPrefixOf` benchName =
176− Just Quicker
177− | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
178− Just Quicker
179− | "FileSystem.Handle." `isPrefixOf` benchName = Just Quicker
180− | otherwise = Nothing
181−
182−main :: IO ()
183−main = mainWith targets speedOpts rtsOpts
benchmark/bench-runner/bench-runner.cabaldeleted−42
@@ -1,42 +0,0 @@
1−cabal-version: 2.4
2−name: bench-runner
3−version: 0.1.0.0
4−
5−-- A short (one-line) description of the package.
6−-- synopsis:
7−
8−-- A longer description of the package.
9−-- description:
10−
11−-- A URL where users can report bugs.
12−-- bug-reports:
13−
14−-- The license under which the package is released.
15−-- license:
16−
17−-- The package author(s).
18−-- author:
19−
20−-- An email address to which users can send suggestions, bug reports, and patches.
21−-- maintainer:
22−
23−-- A copyright notice.
24−-- copyright:
25−-- category:
26−-- extra-source-files: CHANGELOG.md
27−
28−executable bench-runner
29− ghc-options: -Wall
30− main-is: Main.hs
31−
32− -- Modules included in this executable, other than Main.
33− -- other-modules:
34−
35− -- LANGUAGE extensions used by modules in this package.
36− -- other-extensions:
37− build-depends: base
38− , bench-report
39− , containers
40− , streamly-targets
41− hs-source-dirs: .
42− default-language: Haskell2010
benchmark/bench-runner/cabal.projectdeleted−4
@@ -1,4 +0,0 @@
1−packages: . ../../targets
2−
3−package bench-report
4− flags: +no-charts
benchmark/bench-runner/default.nixdeleted−164
@@ -1,164 +0,0 @@
1−let
2− nixpkgsPath_21_11 =
3− "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.11.tar.gz";
4− nixpkgsDefault = import (builtins.fetchTarball nixpkgsPath_21_11) { };
5−in
6−{
7− nixpkgs ? nixpkgsDefault
8−, compiler ? "default"
9−}:
10−let haskellPackages =
11− if compiler == "default"
12− then nixpkgs.haskellPackages
13− else nixpkgs.haskell.packages.${compiler};
14−
15− mkPackage = super: pkg: path: opts: inShell:
16− let orig = super.callCabal2nixWithOptions pkg path opts {};
17− in if inShell
18− # Avoid copying the source directory to nix store by using
19− # src = null.
20− then orig.overrideAttrs (oldAttrs: { src = null; })
21− else orig;
22−
23− mkPkgGit = super: gitSrc: rev: name:
24− let
25− src = builtins.fetchGit {
26− url = gitSrc;
27− rev = rev;
28− };
29− in super.callCabal2nix name src { };
30−
31− mkPkgGitRef = super: gitSrc: rev: ref: name:
32− let
33− src = builtins.fetchGit {
34− url = gitSrc;
35− rev = rev;
36− ref = ref;
37− };
38− in super.callCabal2nix name src { };
39−
40− mkHaskellPackages = inShell:
41− haskellPackages.override {
42− overrides = self: super:
43− with nixpkgs.haskell.lib;
44− {
45− bench-runner = mkPackage super "bench-runner" ./. "" inShell;
46− streamly-targets = mkPackage super "streamly-targets" ../../targets "" false;
47−
48− bench-report =
49− nixpkgs.haskell.lib.overrideCabal
50− (let src = fetchGit {
51− url = "git@github.com:composewell/bench-report.git";
52− rev = "3b50bf0ad06f746bca42f30c8d40a0426e159af3";
53− }; in super.callCabal2nix "bench-report" src {})
54− (old:
55− { enableLibraryProfiling = false;
56− doHaddock = false;
57− });
58−
59− bench-show = super.callHackageDirect {
60− pkg = "bench-show";
61− ver = "0.3.2";
62− sha256 = "16b8vyzdp9b5bh34kqmbfwjsyv8wgnxxwl8kjcpgxjsh52xzyaa0";
63− } { };
64−
65−# streamly-coreutils = let
66−# src = "git@github.com:composewell/streamly-coreutils.git";
67−# rev = "a12756efe24bbf303f2f6d66a95426c7657d297b";
68−# in mkPkgGit super src rev "streamly-coreutils";
69−
70− streamly-coreutils =
71− nixpkgs.haskell.lib.overrideCabal
72− (let src = fetchGit {
73− url = "git@github.com:composewell/streamly-coreutils.git";
74− rev = "b1e6fc37f0e898c54378129750d3ccc1c034f611";
75− }; in super.callCabal2nix "streamly-coreutils" src {})
76− (old:
77− { librarySystemDepends =
78− if builtins.currentSystem == "x86_64-darwin"
79− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
80− else [];
81− #enableLibraryProfiling = false;
82− doHaddock = false;
83− doCheck = false;
84− });
85−
86− streamly-shell = let
87− src = "https://github.com/composewell/streamly-shell.git";
88− rev = "1b3fea3239ebe47963955d81565b9d5e34567ab7";
89− in mkPkgGit super src rev "streamly-shell";
90−
91− streamly-process = let
92− src = "https://github.com/composewell/streamly-process.git";
93− rev = "e310c8a9c6e61515373a2f5f1fb82f6e15fe452b";
94− in nixpkgs.haskell.lib.dontCheck
95− (mkPkgGit super src rev "streamly-process");
96−
97− #streamly-process = nixpkgs.haskell.lib.dontCheck
98− # (super.callHackageDirect {
99− # pkg = "streamly-process";
100− # ver = "0.1.0";
101− # sha256 = "01nxisqfmn29fbirdsx71sfjp2rdqwrf469qyjcql2d11i1bxn94";
102− # } { });
103−
104− # streamly = super.callHackageDirect {
105− # pkg = "streamly";
106− # ver = "0.8.0";
107− # sha256 = "0vy2lkljizlhpbpbybmg9jcmj2g4s1aaqd2dzy5c0y0n4rgwxask";
108− # } { };
109− streamly =
110− nixpkgs.haskell.lib.overrideCabal
111− #(super.callHackageDirect
112− # { pkg = "streamly";
113− # ver = "0.8.2";
114− # sha256 = "sha256-CjFq9SCdbgLZa7NqOE4OtC8OaFg4vK8VmIDjGU5rGko=";
115− # } {})
116− (let src = fetchGit {
117− url = "git@github.com:composewell/streamly.git";
118− rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
119− }; in super.callCabal2nix "streamly" src {})
120− (old:
121− { librarySystemDepends =
122− if builtins.currentSystem == "x86_64-darwin"
123− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
124− else [];
125− #enableLibraryProfiling = false;
126− doHaddock = false;
127− });
128−
129− streamly-core =
130− nixpkgs.haskell.lib.overrideCabal
131− (let src = fetchGit {
132− url = "git@github.com:composewell/streamly.git";
133− rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
134− }; in super.callCabal2nix "streamly-core" "${src}/core" {})
135− (old:
136− { librarySystemDepends =
137− if builtins.currentSystem == "x86_64-darwin"
138− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
139− else [];
140− #enableLibraryProfiling = false;
141− doHaddock = false;
142− });
143−
144− };
145− };
146−
147− drv = mkHaskellPackages true;
148−
149− shell = drv.shellFor {
150− packages = p:
151− [ p.bench-runner
152− ];
153− # Use a better prompt
154− shellHook = ''
155− export CABAL_DIR="$(pwd)/.cabal.nix"
156− if test -n "$PS_SHELL"
157− then
158− export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
159− fi
160− '';
161− };
162−in if nixpkgs.lib.inNixShell
163− then shell
164− else (mkHaskellPackages false).bench-runner
benchmark/lib/Streamly/Benchmark/Common.hs+12−11
@@ -1,5 +1,7 @@
11{-# LANGUAGE CPP #-}
2+#if __GLASGOW_HASKELL__ >= 800
23{-# OPTIONS_GHC -Wno-orphans #-}
4+#endif
35
46-- |
57-- Module : Streamly.Benchmark.Common
@@ -53,10 +55,10 @@ import Control.DeepSeq (NFData(..))
5355import Data.Functor.Identity (Identity, runIdentity)
5456import System.Random (randomRIO)
5557
56−import qualified Streamly.Internal.Data.Fold as Fold
57−import qualified Streamly.Internal.Data.Stream as S
58+import qualified Streamly.Prelude as S
5859
59−import Test.Tasty.Bench
60+import Streamly.Prelude (SerialT)
61+import Gauge
6062
6163-------------------------------------------------------------------------------
6264-- Benchmark Prefixes
@@ -78,6 +80,10 @@ o_n_stack_prefix name = name ++ "/o-n-stack"
7880-- Benchmarking utilities
7981-------------------------------------------------------------------------------
8082
83+#if !MIN_VERSION_deepseq(1,4,3)
84+instance NFData Ordering where rnf = (`seq` ())
85+#endif
86+
8187-- XXX once we convert all the functions to use this we can rename this to
8288-- benchIOSink
8389{-# INLINE benchIOSink1 #-}
@@ -107,12 +113,8 @@ benchPureSink1 name f =
107113 bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
108114
109115{-# INLINE benchPureSrc #-}
110−benchPureSrc :: String -> (Int -> S.Stream Identity a) -> Benchmark
111−benchPureSrc name src = benchPure name src (runIdentity . drain)
112−
113− where
114−
115− drain = S.fold Fold.drain
116+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
117+benchPureSrc name src = benchPure name src (runIdentity . S.drain)
116118
117119-------------------------------------------------------------------------------
118120-- String/List generation for read instances
@@ -242,9 +244,8 @@ runWithCLIOptsEnv defStreamSize alloc mkBench = do
242244 r <- alloc value
243245 value `seq` runMode (mode cfg) cfg benches (mkBench r value)
244246#else
245− r0 <- alloc 0
246247 (value, ingredients) <-
247− parseCLIOpts defStreamSize $ bgroup "All" (mkBench r0 0)
248+ parseCLIOpts defStreamSize $ bgroup "All" (mkBench undefined 0)
248249 r <- alloc value
249250 value `seq` defaultMainWithIngredients ingredients
250251 $ bgroup "All" (mkBench r value)
benchmark/lib/Streamly/Benchmark/Common/Handle.hs+4−15
@@ -30,25 +30,20 @@ module Streamly.Benchmark.Common.Handle
3030 , isSpace
3131 , isSp
3232 , mkHandleBenchEnv
33− , Handles(..)
34− , getHandles
3533 )
3634where
3735
3836import Control.DeepSeq (NFData(rnf))
3937import Data.Char (ord, chr)
40−#if MIN_VERSION_base(4,17,0)
41−import Data.Char (generalCategory, GeneralCategory(Space))
42−#endif
4338import Data.Word (Word8)
4439import System.Directory (getFileSize)
4540import System.Environment (lookupEnv)
4641import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)
47−import System.Process (callCommand)
42+import System.Process.Typed (shell, runProcess_)
4843
4944import Data.IORef
5045import Prelude hiding (last, length)
51−import Test.Tasty.Bench hiding (env)
46+import Gauge hiding (env)
5247
5348
5449scratchDir :: String
@@ -145,10 +140,8 @@ mkBenchSmall name env action =
145140
146141 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
147142
148−#if !MIN_VERSION_base(4,17,0)
149143foreign import ccall unsafe "u_iswspace"
150144 iswspace :: Int -> Int
151−#endif
152145
153146-- Code copied from base/Data.Char to INLINE it
154147{-# INLINE isSpace #-}
@@ -161,11 +154,7 @@ isSpace :: Char -> Bool
161154-- so we'll do it like this until there's a way around that.
162155isSpace c
163156 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
164−#if MIN_VERSION_base(4,17,0)
165− | otherwise = generalCategory c == Space
166−#else
167157 | otherwise = iswspace (ord c) /= 0
168−#endif
169158 where
170159 uc = fromIntegral (ord c) :: Word
171160
@@ -194,8 +183,8 @@ mkHandleBenchEnv = do
194183 ++ "\" && head -c " ++ show size
195184 ++ " </dev/urandom >" ++ infile
196185 ++ ";}"
197− callCommand (cmd inFileSmall smallFileSize)
198− callCommand (cmd inFileBig bigFileSize)
186+ runProcess_ (shell (cmd inFileSmall smallFileSize))
187+ runProcess_ (shell (cmd inFileBig bigFileSize))
199188 return (inFileSmall, inFileBig)
200189
201190 hPutStrLn stderr $ "Using small input file: " ++ small
benchmark/lib/Streamly/Benchmark/Prelude.hs+5−57
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
31-- |
42-- Module : Streamly.Benchmark.Prelude
53-- Copyright : (c) 2018 Composewell Technologies
@@ -12,66 +10,16 @@
1210{-# LANGUAGE ScopedTypeVariables #-}
1311{-# LANGUAGE RankNTypes #-}
1412
15−module Streamly.Benchmark.Prelude
16− ( absTimes
17− , apDiscardFst
18− , apDiscardSnd
19− , apLiftA2
20− , benchIO
21− , benchIOSink
22− , benchIOSrc
23− , breakAfterSome
24− , composeN
25− , concatFoldableWith
26− , concatForFoldableWith
27− , concatPairsWith
28− , concatStreamsWith
29− , filterAllInM
30− , filterAllOutM
31− , filterSome
32− , fmapN
33− , mapM
34− , mapN
35− , mkAsync
36− , monadThen
37− , runToList
38− , sourceConcatMapId
39− , sourceFoldMapM
40− , sourceFoldMapWith
41− , sourceFoldMapWithM
42− , sourceFoldMapWithStream
43− , sourceFracFromThenTo
44− , sourceFracFromTo
45− , sourceFromFoldable
46− , sourceFromFoldableM
47− , sourceFromList
48− , sourceFromListM
49− , sourceIntegerFromStep
50− , sourceIntFromThenTo
51− , sourceIntFromTo
52− , sourceUnfoldr
53− , sourceUnfoldrAction
54− , sourceUnfoldrM
55− , sourceUnfoldrMSerial
56− , toListM
57− , toListSome
58− , toNull
59− , toNullAp
60− , toNullM
61− , toNullM3
62− , transformComposeMapM
63− , transformMapM
64− , transformTeeMapM
65− , transformZipMapM
66− )
67−where
13+module Streamly.Benchmark.Prelude where
6814
6915import Control.Applicative (liftA2)
7016import Control.DeepSeq (NFData(..))
7117import Control.Exception (try)
7218import Data.Functor.Identity (Identity)
19+#if !(MIN_VERSION_base(4,11,0))
20+import Data.Semigroup (Semigroup((<>)))
21+#endif
7322import GHC.Exception (ErrorCall)
74−import Prelude hiding (mapM)
7523import System.Random (randomRIO)
7624
7725import qualified Data.Foldable as F
@@ -82,7 +30,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
8230import qualified Streamly.Internal.Data.Pipe as Pipe
8331import qualified Streamly.Internal.Data.Stream.Serial as Serial
8432
85−import Test.Tasty.Bench
33+import Gauge
8634import Streamly.Internal.Data.Time.Units
8735
8836-- Common polymorphic stream APIs used across multiple stream modules
benchmark/streamly-benchmarks.cabal+180−408
@@ -54,13 +54,8 @@ flag opt
5454 manual: True
5555 default: True
5656
57−flag use-streamly-core
58− description: Benchmark only core package
59− manual: True
60− default: False
61−
62−flag use-prelude
63− description: Use Prelude instead of Data.Stream for serial benchmarks
57+flag use-gauge
58+ description: Use gauge instead of tasty-bench for benchmarking
6459 manual: True
6560 default: False
6661
@@ -68,49 +63,9 @@ flag use-prelude
6863-- Common stanzas
6964-------------------------------------------------------------------------------
7065
71−common default-extensions
72− default-extensions:
73− BangPatterns
74− CApiFFI
75− CPP
76− ConstraintKinds
77− DeriveDataTypeable
78− DeriveGeneric
79− DeriveTraversable
80− ExistentialQuantification
81− FlexibleContexts
82− FlexibleInstances
83− GeneralizedNewtypeDeriving
84− InstanceSigs
85− KindSignatures
86− LambdaCase
87− MagicHash
88− MultiParamTypeClasses
89− PatternSynonyms
90− RankNTypes
91− RecordWildCards
92− ScopedTypeVariables
93− TupleSections
94− TypeApplications
95− TypeFamilies
96− TypeOperators
97− ViewPatterns
98−
99− -- MonoLocalBinds, enabled by TypeFamilies, causes performance
100− -- regressions. Disable it. This must come after TypeFamilies,
101− -- otherwise TypeFamilies will enable it again.
102− NoMonoLocalBinds
103−
104− -- UndecidableInstances -- Does not show any perf impact
105− -- UnboxedTuples -- interferes with (#.)
106−
10766common compile-options
108− import: default-extensions
10967 default-language: Haskell2010
11068
111− if flag(use-streamly-core)
112− cpp-options: -DUSE_STREAMLY_CORE
113−
11469 if flag(dev)
11570 cpp-options: -DDEVBUILD
11671
@@ -120,29 +75,15 @@ common compile-options
12075 if flag(inspection)
12176 cpp-options: -DINSPECTION
12277
123− ghc-options: -Weverything
124− -Wno-implicit-prelude
125− -Wno-missing-deriving-strategies
126− -Wno-missing-exported-signatures
127− -Wno-missing-import-lists
128− -Wno-missing-local-signatures
129− -Wno-missing-safe-haskell-mode
130− -Wno-missed-specialisations
131− -Wno-all-missed-specialisations
132− -Wno-monomorphism-restriction
133− -Wno-prepositive-qualified-module
134− -Wno-unsafe
135− -Wno-unused-packages
136− -Rghc-timing
137−
138− if impl(ghc >= 9.2)
139− ghc-options:
140− -Wno-missing-kind-signatures
141− -Wno-operator-whitespace
142−
143− if impl(ghc >= 9.8)
144− ghc-options:
145− -Wno-missing-role-annotations
78+ ghc-options: -Wall
79+ -Wcompat
80+ -Wunrecognised-warning-flags
81+ -Widentities
82+ -Wincomplete-record-updates
83+ -Wincomplete-uni-patterns
84+ -Wredundant-constraints
85+ -Wnoncanonical-monad-instances
86+ -Rghc-timing
14687
14788 if flag(has-llvm)
14889 ghc-options: -fllvm
@@ -151,17 +92,15 @@ common compile-options
15192 ghc-options: -Wmissed-specialisations
15293 -Wall-missed-specialisations
15394
95+ if flag(dev) || flag(debug)
96+ ghc-options: -fno-ignore-asserts
97+
15498common optimization-options
15599 if flag(opt)
156100 ghc-options: -O2
157101 -fdicts-strict
158102 -fspec-constr-recursive=16
159103 -fmax-worker-args=16
160−
161− -- For this to be effective it must come after the -O2 option
162− if flag(dev) || flag(debug)
163− ghc-options: -fno-ignore-asserts
164−
165104 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
166105 ghc-options: -fplugin Fusion.Plugin
167106 else
@@ -175,34 +114,37 @@ common bench-depends
175114 -- Core libraries shipped with ghc, the min and max
176115 -- constraints of these libraries should match with
177116 -- the GHC versions we support
178− base >= 4.9 && < 4.20
179− , deepseq >= 1.4.1 && < 1.6
180− , mtl >= 2.2 && < 2.3.2
117+ base >= 4.9 && < 5
118+ , deepseq >= 1.4.1 && < 1.5
119+ , mtl >= 2.2 && < 2.3
181120
182121 -- other libraries
183− , exceptions >= 0.8 && < 0.11
122+ , streamly >= 0.7.0
184123 , random >= 1.0 && < 2.0
185124 , transformers >= 0.4 && < 0.7
186− , containers >= 0.5 && < 0.8
187− , hashable >= 1.3 && < 1.5
188− , unordered-containers >= 0.2 && < 0.3
189− , process >= 1.4 && < 1.7
125+ , containers >= 0.5 && < 0.7
126+ , typed-process >= 0.2.3 && < 0.3
190127 , directory >= 1.2.2 && < 1.4
191− , filepath >= 1.4.1 && < 1.6
192− , ghc-prim >= 0.4 && < 0.12
193− , tasty-bench >= 0.3 && < 0.4
194− , tasty >= 1.4.1 && < 1.6
195− , streamly-core
128+ , filepath >= 1.4.1 && < 1.5
129+ , ghc-prim >= 0.4 && < 0.9
196130
197− if !flag(use-streamly-core)
198− build-depends: streamly
131+ if flag(use-gauge)
132+ build-depends: gauge >= 0.2.4 && < 0.3
133+ else
134+ build-depends: tasty-bench >= 0.3 && < 0.4
135+ , tasty >= 1.4.1 && < 1.5
136+ mixins: tasty-bench
137+ (Test.Tasty.Bench as Gauge
138+ , Test.Tasty.Bench as Gauge.Main
139+ )
199140
200141 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
201142 build-depends:
202143 fusion-plugin >= 0.2 && < 0.3
203144 if flag(inspection)
204− build-depends: template-haskell >= 2.14 && < 2.22
205− , inspection-testing >= 0.4 && < 0.6
145+ build-depends: template-haskell >= 2.14 && < 2.17
146+ , inspection-testing >= 0.4 && < 0.5
147+ , ghc-prim >= 0.2 && < 0.9
206148 -- Array uses a Storable constraint in dev build making several inspection
207149 -- tests fail
208150 if flag(dev) && flag(inspection)
@@ -216,10 +158,8 @@ library
216158 import: lib-options, bench-depends
217159 hs-source-dirs: lib
218160 exposed-modules: Streamly.Benchmark.Common
219− , Streamly.Benchmark.Common.Handle
220− if flag(use-prelude)
221− exposed-modules: Streamly.Benchmark.Prelude
222−
161+ , Streamly.Benchmark.Common.Handle
162+ , Streamly.Benchmark.Prelude
223163
224164-------------------------------------------------------------------------------
225165-- Benchmarks
@@ -227,7 +167,6 @@ library
227167
228168common bench-options
229169 import: compile-options, optimization-options, bench-depends
230− include-dirs: .
231170 ghc-options: -rtsopts
232171 if flag(limit-build-mem)
233172 ghc-options: +RTS -M512M -RTS
@@ -247,142 +186,123 @@ common bench-options-threaded
247186-- Serial Streams
248187-------------------------------------------------------------------------------
249188
250−benchmark Data.Stream
189+benchmark Prelude.Serial
251190 import: bench-options
252191 type: exitcode-stdio-1.0
253− hs-source-dirs: Streamly/Benchmark/Data
254− main-is: Stream.hs
192+ hs-source-dirs: Streamly/Benchmark/Prelude
193+ main-is: Serial.hs
255194 other-modules:
256− Stream.Generate
257− Stream.Eliminate
258− Stream.Transform
259− Stream.Reduce
260− Stream.Expand
261− Stream.Lift
262− Stream.Common
263− if !flag(use-streamly-core)
264− other-modules:
265− Stream.Exceptions
195+ Serial.Generation
196+ , Serial.Elimination
197+ , Serial.Transformation
198+ , Serial.NestedStream
199+ , Serial.NestedFold
200+ , Serial.Split
201+ , Serial.Exceptions
202+ , Serial.Lift
203+ if impl(ghcjs)
204+ buildable: False
205+ else
206+ buildable: True
266207 if flag(limit-build-mem)
267208 if flag(dev)
268209 ghc-options: +RTS -M3500M -RTS
269210 else
270− ghc-options: +RTS -M2500M -RTS
211+ ghc-options: +RTS -M2000M -RTS
271212
272−-- Use StreamK functions where possible, converting to StreaK to StreamD
273−benchmark Data.Stream.StreamDK
213+
214+benchmark Prelude.WSerial
274215 import: bench-options
275216 type: exitcode-stdio-1.0
276− hs-source-dirs: Streamly/Benchmark/Data
277− main-is: Stream.hs
278− other-modules:
279− Stream.Generate
280− Stream.Eliminate
281− Stream.Transform
282− Stream.Reduce
283− Stream.Expand
284− Stream.Lift
285− Stream.Common
286− if !flag(use-streamly-core)
287− other-modules:
288− Stream.Exceptions
289− -- Cannot use USE_STREAMK and USE_PRELUDE together
290− if flag(use-prelude)
217+ hs-source-dirs: Streamly/Benchmark/Prelude
218+ main-is: WSerial.hs
219+ if impl(ghcjs)
291220 buildable: False
292− cpp-options: -DUSE_STREAMK
293− if flag(limit-build-mem)
294− if flag(dev)
295− ghc-options: +RTS -M3500M -RTS
296− else
297− ghc-options: +RTS -M2500M -RTS
221+ else
222+ buildable: True
298223
299−benchmark Data.Stream.Concurrent
300− import: bench-options-threaded
224+benchmark Prelude.Merge
225+ import: bench-options
301226 type: exitcode-stdio-1.0
302− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
303− main-is: Concurrent.hs
304− other-modules:
305− Stream.ConcurrentCommon
306− Stream.Common
307− if flag(use-streamly-core) || impl(ghcjs)
227+ hs-source-dirs: Streamly/Benchmark/Prelude
228+ main-is: Merge.hs
229+ if impl(ghcjs)
308230 buildable: False
309231 else
310232 buildable: True
311233
312−benchmark Data.Stream.ConcurrentInterleaved
313− import: bench-options-threaded
234+benchmark Prelude.ZipSerial
235+ import: bench-options
314236 type: exitcode-stdio-1.0
315− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
316− main-is: ConcurrentInterleaved.hs
317− other-modules:
318− Stream.ConcurrentCommon
319− Stream.Common
320− if flag(use-streamly-core) || impl(ghcjs)
237+ hs-source-dirs: Streamly/Benchmark/Prelude
238+ main-is: ZipSerial.hs
239+ if impl(ghcjs)
321240 buildable: False
322241 else
323242 buildable: True
324243
325−benchmark Data.Stream.ConcurrentEager
326− import: bench-options-threaded
244+benchmark Prelude.ZipAsync
245+ import: bench-options
327246 type: exitcode-stdio-1.0
328− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
329− main-is: ConcurrentEager.hs
330− other-modules:
331− Stream.ConcurrentCommon
332− Stream.Common
333− if flag(use-streamly-core) || impl(ghcjs)
247+ hs-source-dirs: Streamly/Benchmark/Prelude
248+ main-is: ZipAsync.hs
249+ if impl(ghcjs)
334250 buildable: False
335251 else
336252 buildable: True
253+ if flag(limit-build-mem)
254+ ghc-options: +RTS -M1000M -RTS
337255
338−benchmark Data.Stream.ConcurrentOrdered
256+
257+benchmark Prelude.Ahead
339258 import: bench-options-threaded
340259 type: exitcode-stdio-1.0
341− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
342− main-is: ConcurrentOrdered.hs
343− other-modules:
344− Stream.ConcurrentCommon
345− Stream.Common
346− if flag(use-streamly-core) || impl(ghcjs)
260+ hs-source-dirs: Streamly/Benchmark/Prelude
261+ main-is: Ahead.hs
262+ if impl(ghcjs)
347263 buildable: False
348264 else
349265 buildable: True
350266
351−benchmark Data.Unbox
352− import: bench-options
267+benchmark Prelude.Async
268+ import: bench-options-threaded
353269 type: exitcode-stdio-1.0
354− hs-source-dirs: .
355− cpp-options: -DUSE_UNBOX
356− main-is: Streamly/Benchmark/Data/Serialize.hs
270+ hs-source-dirs: Streamly/Benchmark/Prelude
271+ main-is: Async.hs
272+ if impl(ghcjs)
273+ buildable: False
274+ else
275+ buildable: True
357276
358−benchmark Data.Unbox.Derive.TH
359− import: bench-options
277+benchmark Prelude.WAsync
278+ import: bench-options-threaded
360279 type: exitcode-stdio-1.0
361− hs-source-dirs: .
362− cpp-options: -DUSE_UNBOX
363− cpp-options: -DUSE_TH
364− main-is: Streamly/Benchmark/Data/Serialize.hs
280+ hs-source-dirs: Streamly/Benchmark/Prelude
281+ main-is: WAsync.hs
282+ if impl(ghcjs)
283+ buildable: False
284+ else
285+ buildable: True
365286
366−benchmark Data.Serialize
367− import: bench-options
287+benchmark Prelude.Parallel
288+ import: bench-options-threaded
368289 type: exitcode-stdio-1.0
369− hs-source-dirs: .
370− cpp-options: -DUSE_TH
371− main-is: Streamly/Benchmark/Data/Serialize.hs
372− build-depends: QuickCheck, template-haskell
373− other-modules:
374− Streamly.Benchmark.Data.Serialize.TH
375− Streamly.Benchmark.Data.Serialize.RecCompatible
376− Streamly.Benchmark.Data.Serialize.RecNonCompatible
290+ hs-source-dirs: Streamly/Benchmark/Prelude
291+ main-is: Parallel.hs
292+ if impl(ghcjs)
293+ buildable: False
294+ else
295+ buildable: True
377296 if flag(limit-build-mem)
378− ghc-options: +RTS -M1000M -RTS
297+ ghc-options: +RTS -M2000M -RTS
298+
379299
380300benchmark Data.Unfold
381301 import: bench-options
382302 type: exitcode-stdio-1.0
383303 hs-source-dirs: .
384304 main-is: Streamly/Benchmark/Data/Unfold.hs
385− if flag(use-streamly-core) || impl(ghcjs)
305+ if impl(ghcjs)
386306 buildable: False
387307 else
388308 buildable: True
@@ -392,26 +312,16 @@ benchmark Data.Fold
392312 type: exitcode-stdio-1.0
393313 hs-source-dirs: Streamly/Benchmark/Data
394314 main-is: Fold.hs
395− if flag(use-streamly-core) || impl(ghcjs)
396− buildable: False
397− else
398− buildable: True
399−
400−benchmark Data.Fold.Window
401− import: bench-options
402− type: exitcode-stdio-1.0
403− hs-source-dirs: Streamly/Benchmark/Data/Fold
404− main-is: Window.hs
405− if flag(use-streamly-core)
315+ if impl(ghcjs)
406316 buildable: False
407317 else
408318 buildable: True
409319
410−benchmark Data.Parser
320+benchmark Data.Parser.ParserD
411321 import: bench-options
412322 type: exitcode-stdio-1.0
413− hs-source-dirs: Streamly/Benchmark/Data
414− main-is: Parser.hs
323+ hs-source-dirs: Streamly/Benchmark/Data/Parser
324+ main-is: ParserD.hs
415325 if impl(ghcjs)
416326 buildable: False
417327 else
@@ -421,13 +331,12 @@ benchmark Data.Parser
421331 if flag(dev)
422332 ghc-options: +RTS -M3000M -RTS
423333 else
424− ghc-options: +RTS -M2000M -RTS
334+ ghc-options: +RTS -M750M -RTS
425335
426−benchmark Data.ParserK
336+benchmark Data.Parser.ParserK
427337 import: bench-options
428338 type: exitcode-stdio-1.0
429− hs-source-dirs: Streamly/Benchmark/Data
430− cpp-options: -DBENCH_SINGULAR
339+ hs-source-dirs: Streamly/Benchmark/Data/Parser
431340 main-is: ParserK.hs
432341 if impl(ghcjs)
433342 buildable: False
@@ -435,11 +344,15 @@ benchmark Data.ParserK
435344 buildable: True
436345 build-depends: exceptions >= 0.8 && < 0.11
437346
438−benchmark Data.ParserK.Chunked
347+-- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that
348+-- the rewrite rules are disabled. We can also use the "no-fusion" build
349+-- flag but we need to keep in mind that it disables fusion for streams
350+-- as well.
351+benchmark Data.Parser.FromParserK
439352 import: bench-options
440353 type: exitcode-stdio-1.0
441− hs-source-dirs: Streamly/Benchmark/Data
442− cpp-options: -DBENCH_CHUNKED
354+ hs-source-dirs: Streamly/Benchmark/Data/Parser
355+ cpp-options: -DFROM_PARSERK
443356 main-is: ParserK.hs
444357 if impl(ghcjs)
445358 buildable: False
@@ -447,166 +360,64 @@ benchmark Data.ParserK.Chunked
447360 buildable: True
448361 build-depends: exceptions >= 0.8 && < 0.11
449362
450−benchmark Data.ParserK.Chunked.Generic
363+benchmark Data.Parser
451364 import: bench-options
452365 type: exitcode-stdio-1.0
453366 hs-source-dirs: Streamly/Benchmark/Data
454− cpp-options: -DBENCH_CHUNKED_GENERIC
455− main-is: ParserK.hs
367+ main-is: Parser.hs
456368 if impl(ghcjs)
457369 buildable: False
458370 else
459371 buildable: True
460372 build-depends: exceptions >= 0.8 && < 0.11
373+ if flag(limit-build-mem)
374+ if flag(dev)
375+ ghc-options: +RTS -M3000M -RTS
376+ else
377+ ghc-options: +RTS -M1000M -RTS
461378
462379-------------------------------------------------------------------------------
463380-- Raw Streams
464381-------------------------------------------------------------------------------
465382
466−benchmark Data.StreamD
383+benchmark Data.Stream.StreamD
467384 import: bench-options
468385 type: exitcode-stdio-1.0
469386 hs-source-dirs: Streamly/Benchmark/Data/Stream
470387 main-is: StreamD.hs
471388 if impl(ghcjs)
472389 buildable: False
390+ else
391+ buildable: True
473392
474−benchmark Data.StreamK
393+benchmark Data.Stream.StreamK
475394 import: bench-options
476395 type: exitcode-stdio-1.0
477396 hs-source-dirs: Streamly/Benchmark/Data/Stream
478397 main-is: StreamK.hs
479398 if impl(ghcjs)
480399 buildable: False
400+ else
401+ buildable: True
481402
482−benchmark Data.Stream.ToStreamK
483− import: bench-options
484− type: exitcode-stdio-1.0
485− hs-source-dirs: Streamly/Benchmark/Data/Stream
486− main-is: ToStreamK.hs
487− if !flag(dev) || impl(ghcjs)
488− buildable: False
489−
490−benchmark Data.StreamK.Alt
403+benchmark Data.Stream.StreamDK
491404 import: bench-options
492405 type: exitcode-stdio-1.0
493406 hs-source-dirs: Streamly/Benchmark/Data/Stream
494− main-is: StreamKAlt.hs
495− if !flag(dev) || impl(ghcjs)
407+ main-is: StreamDK.hs
408+ if impl(ghcjs)
496409 buildable: False
410+ else
411+ buildable: True
497412
498413executable nano-bench
499414 import: bench-options
500415 hs-source-dirs: .
501416 main-is: NanoBenchmarks.hs
502− if !flag(dev)
503− buildable: False
504−
505−-------------------------------------------------------------------------------
506−-- Streamly.Prelude
507−-------------------------------------------------------------------------------
508−
509−benchmark Prelude
510− import: bench-options
511− type: exitcode-stdio-1.0
512− hs-source-dirs: Streamly/Benchmark/Data
513− main-is: Stream.hs
514− other-modules:
515− Stream.Generate
516− Stream.Eliminate
517− Stream.Transform
518− Stream.Reduce
519− Stream.Expand
520− Stream.Lift
521− Stream.Common
522− Stream.Split
523− Stream.Exceptions
524− cpp-options: -DUSE_PRELUDE
525− if !flag(use-prelude)
526− buildable: False
527− if flag(limit-build-mem)
528− if flag(dev)
529− ghc-options: +RTS -M3500M -RTS
530− else
531− ghc-options: +RTS -M2500M -RTS
532−
533−benchmark Prelude.WSerial
534− import: bench-options
535− type: exitcode-stdio-1.0
536− hs-source-dirs: Streamly/Benchmark/Prelude
537− main-is: WSerial.hs
538− cpp-options: -DUSE_PRELUDE
539− if !flag(use-prelude)
540− buildable: False
541− if flag(limit-build-mem)
542− ghc-options: +RTS -M750M -RTS
543−
544−benchmark Prelude.Merge
545− import: bench-options
546− type: exitcode-stdio-1.0
547− hs-source-dirs: Streamly/Benchmark/Prelude
548− main-is: Merge.hs
549− cpp-options: -DUSE_PRELUDE
550− if !flag(use-prelude)
551− buildable: False
552−
553−benchmark Prelude.ZipSerial
554− import: bench-options
555− type: exitcode-stdio-1.0
556− hs-source-dirs: Streamly/Benchmark/Prelude
557− main-is: ZipSerial.hs
558− cpp-options: -DUSE_PRELUDE
559− if !flag(use-prelude)
560− buildable: False
561−
562−benchmark Prelude.ZipAsync
563− import: bench-options
564− type: exitcode-stdio-1.0
565− hs-source-dirs: Streamly/Benchmark/Prelude
566− main-is: ZipAsync.hs
567− cpp-options: -DUSE_PRELUDE
568− if !flag(use-prelude)
569− buildable: False
570− if flag(limit-build-mem)
571− ghc-options: +RTS -M1000M -RTS
572−
573−benchmark Prelude.Ahead
574− import: bench-options-threaded
575− type: exitcode-stdio-1.0
576− hs-source-dirs: Streamly/Benchmark/Prelude
577− main-is: Ahead.hs
578− cpp-options: -DUSE_PRELUDE
579− if !flag(use-prelude)
580− buildable: False
581−
582−benchmark Prelude.Async
583− import: bench-options-threaded
584− type: exitcode-stdio-1.0
585− hs-source-dirs: Streamly/Benchmark/Prelude
586− main-is: Async.hs
587− cpp-options: -DUSE_PRELUDE
588− if !flag(use-prelude)
589− buildable: False
590−
591−benchmark Prelude.WAsync
592− import: bench-options-threaded
593− type: exitcode-stdio-1.0
594− hs-source-dirs: Streamly/Benchmark/Prelude
595− main-is: WAsync.hs
596− cpp-options: -DUSE_PRELUDE
597− if !flag(use-prelude)
598− buildable: False
599−
600−benchmark Prelude.Parallel
601− import: bench-options-threaded
602− type: exitcode-stdio-1.0
603− hs-source-dirs: Streamly/Benchmark/Prelude
604− main-is: Parallel.hs
605− cpp-options: -DUSE_PRELUDE
606− if !flag(use-prelude)
417+ if flag(dev)
418+ buildable: True
419+ else
607420 buildable: False
608− if flag(limit-build-mem)
609− ghc-options: +RTS -M2000M -RTS
610421
611422-------------------------------------------------------------------------------
612423-- Concurrent Streams
@@ -617,101 +428,84 @@ benchmark Prelude.Concurrent
617428 type: exitcode-stdio-1.0
618429 hs-source-dirs: Streamly/Benchmark/Prelude
619430 main-is: Concurrent.hs
620− cpp-options: -DUSE_PRELUDE
621− if !flag(use-prelude)
622− buildable: False
623431
624432benchmark Prelude.Adaptive
625433 import: bench-options-threaded
626434 type: exitcode-stdio-1.0
627435 hs-source-dirs: Streamly/Benchmark/Prelude
628436 main-is: Adaptive.hs
629− cpp-options: -DUSE_PRELUDE
630− if !flag(use-prelude)
437+ if impl(ghcjs)
631438 buildable: False
439+ else
440+ buildable: True
632441
633442benchmark Prelude.Rate
634443 import: bench-options-threaded
635444 type: exitcode-stdio-1.0
636445 hs-source-dirs: Streamly/Benchmark/Prelude
637446 main-is: Rate.hs
638− cpp-options: -DUSE_PRELUDE
639− if !flag(use-prelude)
447+ if impl(ghcjs)
640448 buildable: False
449+ else
450+ buildable: True
641451
642452-------------------------------------------------------------------------------
643453-- Array Benchmarks
644454-------------------------------------------------------------------------------
645455
646−benchmark Data.Array.Generic
456+benchmark Data.Array
647457 import: bench-options
648458 type: exitcode-stdio-1.0
649− hs-source-dirs: ., Streamly/Benchmark/Data
650− main-is: Streamly/Benchmark/Data/Array/Generic.hs
651− other-modules:
652− Stream.Common
653− if flag(use-streamly-core)
654− buildable: False
655− else
656− buildable: True
657− if flag(limit-build-mem)
658− ghc-options: +RTS -M1000M -RTS
459+ hs-source-dirs: .
460+ main-is: Streamly/Benchmark/Data/Array.hs
461+ other-modules: Streamly.Benchmark.Data.ArrayOps
462+ cpp-options: -DDATA_ARRAY
659463
660−benchmark Data.SmallArray
464+benchmark Data.Array.Prim
661465 import: bench-options
662466 type: exitcode-stdio-1.0
663− main-is: Streamly/Benchmark/Data/Array/SmallArray.hs
664− if flag(dev) && !flag(use-streamly-core)
665− buildable: True
666− else
667− buildable: False
467+ hs-source-dirs: .
468+ main-is: Streamly/Benchmark/Data/Array.hs
469+ other-modules: Streamly.Benchmark.Data.ArrayOps
470+ cpp-options: -DDATA_ARRAY_PRIM
471+ build-depends: primitive
668472
669−benchmark Data.Array
473+benchmark Data.SmallArray
670474 import: bench-options
671475 type: exitcode-stdio-1.0
672− hs-source-dirs: ., Streamly/Benchmark/Data
476+ hs-source-dirs: .
673477 main-is: Streamly/Benchmark/Data/Array.hs
674− other-modules:
675− Stream.Common
676− if flag(use-streamly-core)
677− buildable: False
678− else
679− buildable: True
680− if flag(limit-build-mem)
681− ghc-options: +RTS -M1500M -RTS
478+ other-modules: Streamly.Benchmark.Data.ArrayOps
479+ cpp-options: -DDATA_SMALLARRAY
682480
683−benchmark Data.MutArray
481+benchmark Data.Array.Prim.Pinned
684482 import: bench-options
685483 type: exitcode-stdio-1.0
686− main-is: Streamly/Benchmark/Data/MutArray.hs
687− if flag(limit-build-mem)
688− ghc-options: +RTS -M1500M -RTS
689− if flag(use-streamly-core)
690− buildable: False
691− else
692− buildable: True
693−
694−-------------------------------------------------------------------------------
695−-- Ring Benchmarks
696−-------------------------------------------------------------------------------
484+ hs-source-dirs: .
485+ main-is: Streamly/Benchmark/Data/Array.hs
486+ other-modules: Streamly.Benchmark.Data.ArrayOps
487+ cpp-options: -DDATA_ARRAY_PRIM_PINNED
697488
698−benchmark Data.Ring.Unboxed
489+benchmark Data.Array.Foreign
699490 import: bench-options
700491 type: exitcode-stdio-1.0
701− main-is: Streamly/Benchmark/Data/Ring/Unboxed.hs
492+ hs-source-dirs: .
493+ main-is: Streamly/Benchmark/Data/Array.hs
494+ other-modules: Streamly.Benchmark.Data.ArrayOps
495+ cpp-options: -DMEMORY_ARRAY
702496 if flag(limit-build-mem)
703− ghc-options: +RTS -M1500M -RTS
497+ ghc-options: +RTS -M1000M -RTS
704498
705499-------------------------------------------------------------------------------
706500-- Array Stream Benchmarks
707501-------------------------------------------------------------------------------
708502
709−benchmark Data.Array.Stream
503+benchmark Data.Array.Stream.Foreign
710504 import: bench-options
711505 type: exitcode-stdio-1.0
712− hs-source-dirs: Streamly/Benchmark/Data/Array
713− main-is: Stream.hs
714− if flag(use-streamly-core) || impl(ghcjs)
506+ hs-source-dirs: Streamly/Benchmark/Data/Array/Stream
507+ main-is: Foreign.hs
508+ if impl(ghcjs)
715509 buildable: False
716510 else
717511 buildable: True
@@ -729,12 +523,6 @@ benchmark FileSystem.Handle
729523 other-modules:
730524 Handle.Read
731525 , Handle.ReadWrite
732− if flag(limit-build-mem)
733− ghc-options: +RTS -M1000M -RTS
734− if flag(use-streamly-core)
735− buildable: False
736− else
737− buildable: True
738526
739527-------------------------------------------------------------------------------
740528-- Unicode Benchmarks
@@ -745,12 +533,6 @@ benchmark Unicode.Stream
745533 type: exitcode-stdio-1.0
746534 hs-source-dirs: Streamly/Benchmark/Unicode
747535 main-is: Stream.hs
748− if flag(limit-build-mem)
749− ghc-options: +RTS -M1000M -RTS
750− if flag(use-streamly-core)
751− buildable: False
752− else
753− buildable: True
754536
755537benchmark Unicode.Char
756538 import: bench-options
@@ -758,7 +540,7 @@ benchmark Unicode.Char
758540 hs-source-dirs: Streamly/Benchmark/Unicode
759541 main-is: Char.hs
760542 -- Takes too much memory for ghcjs
761− if flag(use-streamly-core) || impl(ghcjs)
543+ if impl(ghcjs)
762544 buildable: False
763545
764546benchmark Unicode.Utf8
@@ -766,13 +548,3 @@ benchmark Unicode.Utf8
766548 type: exitcode-stdio-1.0
767549 hs-source-dirs: Streamly/Benchmark/Unicode
768550 main-is: Utf8.hs
769− if flag(use-streamly-core)
770− buildable: False
771− else
772− buildable: True
773−
774−benchmark Unicode.Parser
775− import: bench-options
776− type: exitcode-stdio-1.0
777− hs-source-dirs: Streamly/Benchmark/Unicode
778− main-is: Parser.hs
bin/bench-config.shnew file+160
@@ -0,0 +1,160 @@
1+#!/usr/bin/env bash
2+
3+BENCH_CONFIG_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" &> /dev/null && pwd)"
4+source $BENCH_CONFIG_DIR/targets.sh \
5+ || { echo "Cannot source $BENCH_CONFIG_DIR/targets.sh"; exit 1; }
6+
7+# Customization options
8+bench_config () {
9+ BENCH_REPORT_DIR=benchmark/bench-report
10+ BENCHMARK_PACKAGE_NAME=streamly-benchmarks
11+ BENCHMARK_PACKAGE_VERSION=0.0.0
12+
13+ USE_GAUGE=0
14+ DEFAULT_FIELDS="allocated cputime bytescopied"
15+}
16+
17+#------------------------------------------------------------------------------
18+# benchmark groups
19+#------------------------------------------------------------------------------
20+
21+bench_targets () {
22+ targets
23+}
24+
25+#------------------------------------------------------------------------------
26+# RTS options based on the benchmark executable name and benchmark name
27+#------------------------------------------------------------------------------
28+
29+bench_rts_options () {
30+ local exe_name
31+ local bench_name
32+
33+ exe_name="$1"
34+ bench_name="$2"
35+
36+ # Based on benchmark class
37+ case "$bench_name" in
38+ */o-1-sp*) echo -n "-K36K -M16M" ;;
39+ */o-n-h*) echo -n "-K36K -M32M" ;;
40+ */o-n-st*) echo -n "-K1M -M16M" ;;
41+ */o-n-sp*) echo -n "-K1M -M32M" ;;
42+ *) echo -n "" ;;
43+ esac
44+
45+ echo -n " "
46+ case "$exe_name" in
47+ Prelude.Concurrent*) echo -n "-K256K -M384M" ;;
48+ *) echo -n "" ;;
49+ esac
50+
51+ echo -n " "
52+ # Based on specific benchmark
53+ # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
54+ # with "/" for matching with this. It may not work reliably if the benchmark
55+ # name already contains ".".
56+ case "$bench_name" in
57+ Data.Stream.StreamD/o-n-space/elimination/toList) echo -n "-K2M" ;;
58+ Data.Stream.StreamK/o-n-space/elimination/toList) echo -n "-K2M" ;;
59+
60+ Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
61+ Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
62+ Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
63+
64+ Prelude.Rate/o-1-space/*) echo -n "-K128K" ;;
65+ Prelude.Rate/o-1-space/asyncly/*) echo -n "-K128K" ;;
66+
67+ # XXX For GHC-9.0
68+ Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;
69+
70+ # XXX These should be moved to o-n-space?
71+ Prelude.Serial/o-n-heap/grouping/classifySessionsOf) echo -n "-K1M -M32M" ;;
72+ Prelude.Serial/o-n-heap/Functor/*) echo -n "-K4M -M32M" ;;
73+ Prelude.Serial/o-n-heap/transformer/*) echo -n "-K8M -M64M" ;;
74+
75+ Prelude.Serial/o-n-space/Functor/*) echo -n "-K4M -M64M" ;;
76+ Prelude.Serial/o-n-space/Applicative/*) echo -n "-K8M -M128M" ;;
77+ Prelude.Serial/o-n-space/Monad/*) echo -n "-K8M -M64M" ;;
78+
79+ # Use -K4M for o-n-space except for grouping
80+ Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
81+ Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
82+
83+ Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
84+
85+ Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
86+ Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
87+ Prelude.Ahead/o-1-space/*) echo -n "-K128K" ;;
88+
89+ Prelude.WAsync/o-n-heap/monad-outer-product/toNull3) echo -n "-M64M" ;;
90+ Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
91+
92+ # XXX need to investigate these, taking too much stack
93+ Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;
94+ Data.Parser/o-1-space/some) echo -n "-K8M" ;;
95+ Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
96+ Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
97+ Data.Parser/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
98+ Data.Parser/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
99+ Data.Parser/o-n-heap/choice) echo -n "-K16M -M32M" ;;
100+ Data.Parser.ParserK/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
101+ Data.Parser.ParserK/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
102+ Data.Parser.ParserK/o-n-heap/sequence) echo -n "-M64M";;
103+ Data.Parser.ParserK/o-n-heap/sequenceA) echo -n "-M64M";;
104+
105+ Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
106+ # For tasty-bench
107+ Data.Array*/o-1-space/generation/show) echo -n "-M32M" ;;
108+ # XXX For GHC-8.10
109+ Data.Array/o-1-space/transformationX4/map) echo -n "-M32M" ;;
110+ # DEVBUILD only benchmarks - array foldable instance
111+ Data.Array.Foreign/o-1-space/elimination/foldable/foldl*) echo -n "-K8M" ;;
112+ Data.Array.Foreign/o-1-space/elimination/foldable/sum) echo -n "-K8M" ;;
113+ *) echo -n "" ;;
114+ esac
115+}
116+
117+#------------------------------------------------------------------------------
118+# Speed options
119+#------------------------------------------------------------------------------
120+
121+bench_speed_options () {
122+ local exe_name
123+ local bench_name
124+
125+ exe_name="$1"
126+ bench_name="$2"
127+
128+ case "$exe_name" in
129+ Prelude.Concurrent) set_super_quick_mode ;;
130+ Prelude.Rate) set_super_quick_mode ;;
131+ Prelude.Adaptive) set_super_quick_mode;;
132+ *) echo -n "" ;;
133+ esac
134+
135+ # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
136+ # with "/" for matching with this. It may not work reliably if the benchmark
137+ # name already contains ".".
138+
139+ # Use quick options for benchmarks that take too long
140+ case "$bench_name" in
141+ Prelude.Parallel/o-n-heap/mapping/mapM) set_super_quick_mode ;;
142+ Prelude.Parallel/o-n-heap/monad-outer-product/*) set_super_quick_mode ;;
143+ Prelude.Parallel/o-n-space/monad-outer-product/*) set_super_quick_mode ;;
144+ Prelude.Parallel/o-n-heap/generation/*) use_quicker_mode ;;
145+ Prelude.Parallel/o-n-heap/mapping/*) use_quicker_mode ;;
146+ Prelude.Parallel/o-n-heap/concat-foldable/*) use_quicker_mode ;;
147+
148+ Prelude.Async/o-1-space/monad-outer-product/*) use_quicker_mode ;;
149+ Prelude.Async/o-n-space/monad-outer-product/*) use_quicker_mode ;;
150+
151+ Prelude.Ahead/o-1-space/monad-outer-product/*) use_quicker_mode ;;
152+ Prelude.Ahead/o-n-space/monad-outer-product/*) use_quicker_mode ;;
153+
154+ Prelude.WAsync/o-n-heap/monad-outer-product/*) use_quicker_mode ;;
155+ Prelude.WAsync/o-n-space/monad-outer-product/*) use_quicker_mode ;;
156+
157+ FileSystem.Handle/*) use_quicker_mode ;;
158+ *) echo -n "" ;;
159+ esac
160+}
bin/bench.shnew file+15
@@ -0,0 +1,15 @@
1+#!/usr/bin/env bash
2+
3+SCRIPT_DIR=$(cd `dirname $0`; pwd)
4+source $SCRIPT_DIR/bench-config.sh \
5+ || { echo "Cannot source $SCRIPT_DIR/bench-config.sh"; exit 1; }
6+
7+bench_config
8+if test -z "$BENCH_REPORT_DIR"
9+then
10+ echo "BENCH_REPORT_DIR variable not defined by bench-config() in $SCRIPT_DIR/bench-config.sh"
11+ exit 1
12+fi
13+
14+cd $SCRIPT_DIR/..
15+$BENCH_REPORT_DIR/bin/bench-runner.sh --config $SCRIPT_DIR/bench-config.sh "$@"
bin/mk-hscope.sh+1−1
@@ -1,7 +1,7 @@
11#!/usr/bin/env bash
22
33GHC_VERSION=8.10.4
4−STREAMLY_VERSION=0.9.0
4+STREAMLY_VERSION=0.8.1.1
55
66case `uname` in
77 Darwin) SYSTEM=x86_64-osx;;
bin/repldeleted−3
@@ -1,3 +0,0 @@
1−#!/bin/bash
2−
3−cabal repl --project-file cabal.project.O0
bin/run-ci.sh+29−29
@@ -10,6 +10,7 @@
1010
1111SCRIPT_DIR=$(cd "$(dirname "$0")" || exit; pwd)
1212SCRIPT_NAME=$(basename "$0")
13+source "$SCRIPT_DIR/../benchmark/bench-report/bin/build-lib.sh"
1314
1415CABAL_BUILD_OPTIONS="--flag limit-build-mem"
1516
@@ -18,8 +19,8 @@ CABAL_BUILD_OPTIONS="--flag limit-build-mem"
1819#------------------------------------------------------------------------------
1920
2021# XXX take these from command line
21−GHC_PRIME_NIX="ghc922"
22−GHC_PRIME_VER="9.2.2"
22+GHC_PRIME_NIX="ghc8104"
23+GHC_PRIME_VER="8.10"
2324JOBS=1
2425
2526# Without cabal project file, it will not run any tests
@@ -72,9 +73,9 @@ ghc_prime_perf () {
7273 --argstr compiler "$GHC_PRIME_NIX" \
7374 --argstr c2nix "--flag inspection" \
7475 --run "\
75− bin/test-runner --cabal-build-options \
76+ bin/test.sh --cabal-build-options \
7677 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\";\
77− bin/bench-runner --cabal-build-options \
78+ bin/bench.sh --cabal-build-options \
7879 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\" \
7980 --quick --raw;"
8081}
@@ -83,7 +84,7 @@ ghc_prime_O0 () {
8384 nix-shell \
8485 --argstr compiler "$GHC_PRIME_NIX" \
8586 --run "\
86− bin/test-runner --cabal-build-options \
87+ bin/test.sh --cabal-build-options \
8788 \"--jobs=$JOBS --project-file cabal.project.O0\""
8889}
8990
@@ -94,7 +95,7 @@ ghc_prime_O0 () {
9495# XXX avoid rebuilding if nothing has changed in the source
9596# XXX run hlint only on changed files
9697lint () {
97− packcheck.sh cabal \
98+ packcheck cabal \
9899 HLINT_OPTIONS="lint --cpp-include=src --cpp-include=test" \
99100 HLINT_TARGETS="src test benchmark"
100101}
@@ -108,7 +109,7 @@ werror () {
108109ghc_prime_Werror () {
109110 nix-shell \
110111 --argstr compiler "$GHC_PRIME_NIX" \
111− --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror --enable-tests --enable-benchmarks all"
112+ --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror all"
112113}
113114
114115ghc_prime_doctests () {
@@ -127,7 +128,7 @@ ghc_prime_doctests () {
127128ghc_prime_coverage () {
128129 nix-shell \
129130 --argstr compiler "$GHC_PRIME_NIX" \
130− --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS\" --coverage"
131+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS\" --coverage"
131132}
132133
133134#------------------------------------------------------------------------------
@@ -138,7 +139,7 @@ ghc_prime_dev_test () {
138139 nix-shell \
139140 --argstr compiler "$GHC_PRIME_NIX" \
140141 --run "\
141− bin/test-runner --cabal-build-options \
142+ bin/test.sh --cabal-build-options \
142143 \"--jobs=$JOBS --flag dev\""
143144}
144145
@@ -146,14 +147,26 @@ ghc_prime_dev_perf () {
146147 nix-shell \
147148 --argstr compiler "$GHC_PRIME_NIX" \
148149 --run "\
149− bin/bench-runner --cabal-build-options \
150+ bin/bench.sh --cabal-build-options \
150151 \"--jobs=$JOBS --flag dev $PERF_FLAGS\" --quick --raw"
151152}
152153
154+ghc_prime_c_malloc () {
155+ nix-shell \
156+ --argstr compiler "$GHC_PRIME_NIX" \
157+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag use-c-malloc\""
158+}
159+
153160ghc_prime_debug () {
154161 nix-shell \
155162 --argstr compiler "$GHC_PRIME_NIX" \
156− --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS --flag debug\""
163+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag debug\""
164+}
165+
166+ghc_prime_streamk () {
167+ nix-shell \
168+ --argstr compiler "$GHC_PRIME_NIX" \
169+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag streamk\""
157170}
158171
159172#------------------------------------------------------------------------------
@@ -200,15 +213,11 @@ ghcHEAD () {
200213# ghcjs
201214#------------------------------------------------------------------------------
202215
203−# Use the following nix expression for ghcjs
204−# nix-env -f https://github.com/composewell/nixpkgs/archive/refs/tags/22.05-composewell.tar.gz -iA pkgs.haskell.compiler.ghcjs
205216ghcjs () {
206− # We don't pass 'CABAL_BUILD_OPTIONS="--flag limit-build-mem"' here as
207− # ghcjs requires more memory to build. Adding a conditional for ghcjs in
208− # the cabal file is a maintainence overhead.
217+ export PATH=~/.local/bin:/opt/ghc/bin:/opt/ghcjs/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:$PATH
209218 packcheck.sh cabal-v2 \
210− GHCVER=8.10.7 \
211− CABAL_BUILD_OPTIONS="--jobs=$JOBS" \
219+ GHCVER=8.4.0 \
220+ CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
212221 CABAL_CHECK_RELAX=y \
213222 DISABLE_SDIST_BUILD=y \
214223 DISABLE_TEST=y \
@@ -229,7 +238,9 @@ ghc_prime_O0 \
229238ghc_prime_Werror \
230239ghc_prime_doctests \
231240ghc_prime_coverage \
241+ghc_prime_c_malloc \
232242ghc_prime_debug \
243+ghc_prime_streamk \
233244ghc901 \
234245ghc884 \
235246ghcjs \
@@ -288,17 +299,6 @@ else
288299 fi
289300fi
290301
291−has_item () {
292− for i in $1
293− do
294− if test "$i" = "$2"
295− then
296− echo "$i"
297− break
298− fi
299− done
300−}
301−
302302for i in $TARGETS
303303do
304304 if test "$(has_item "$ALL_TARGETS" "$i")" != "$i"
bin/run-repl-quick.shdeleted−113
@@ -1,113 +0,0 @@
1−#!/usr/bin/env bash
2−
3−# XXX Having a repl-ish option on packcheck can be very useful for quick type
4−# checking. Running that in a loop in a smart way will work like ghcid.
5−
6−# The idea is to have an extremely light version of run-ci.sh
7−# This can be very helpful on any refactoring change.
8−
9−# This script should be majorly improved but it solves my use case for the time
10−# being.
11−
12−set -e
13−
14−SCRIPT_DIR=$(dirname $0)
15−
16−STREAMLY_VERSION=0.9.0
17−BENCH_REPORT_DIR=benchmark/bench-report
18−source $SCRIPT_DIR/targets.sh
19−
20−#------------------------------------------------------------------------------
21−# Script
22−#------------------------------------------------------------------------------
23−
24−print_help () {
25− echo "Usage: $0"
26− echo
27− echo "Very dumb script."
28− echo "Currently runs everything in the repl and exits."
29− echo "Useful for type checking and displaying warnings."
30− echo
31− exit
32−}
33−
34−#------------------------------------------------------------------------------
35−# Helper functions
36−#------------------------------------------------------------------------------
37−
38−run_build_repl () {
39− local prefix=$1
40− local targets=$2
41− local COMPONENTS
42− local c
43−
44− for c in $targets
45− do
46− CABAL_BUILD_OPTIONS=$(dev_build "--flag dev")
47− echo "|--------------------------------------------------------------------"
48− echo "|" $CABAL_EXECUTABLE repl "$prefix:$c" $CABAL_BUILD_OPTIONS <<< :q
49− echo "|--------------------------------------------------------------------"
50− run_verbose $CABAL_EXECUTABLE repl "$prefix:$c" $CABAL_BUILD_OPTIONS <<< :q
51− done
52−}
53−
54−#------------------------------------------------------------------------------
55−# Setup
56−#------------------------------------------------------------------------------
57−
58−source $BENCH_REPORT_DIR/bin/build-lib.sh
59−
60−USE_GIT_CABAL=0
61−set_common_vars
62−
63−#------------------------------------------------------------------------------
64−# Library
65−#------------------------------------------------------------------------------
66−
67−# XXX Ideally run for all the valid flag combinations
68−CABAL_BUILD_OPTIONS=""
69−run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
70−
71−CABAL_BUILD_OPTIONS="--flag dev"
72−run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
73−
74−CABAL_BUILD_OPTIONS="--flag streamk"
75−run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
76−
77−CABAL_BUILD_OPTIONS="--flag use-c-malloc"
78−run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
79−
80−#------------------------------------------------------------------------------
81−# Benchmarks
82−#------------------------------------------------------------------------------
83−
84−RUNNING_BENCHMARKS=y
85−RUNNING_TESTS=
86−
87−RUNNING_DEVBUILD=
88−targets
89−TARGETS="$(all_grp)"
90−run_build_repl "bench" "$TARGETS"
91−
92−
93−RUNNING_DEVBUILD=y
94−targets
95−TARGETS="$(all_grp)"
96−run_build_repl "bench" "$TARGETS"
97−
98−#------------------------------------------------------------------------------
99−# Tests
100−#------------------------------------------------------------------------------
101−
102−RUNNING_TESTS=y
103−RUNNING_BENCHMARKS=
104−
105−RUNNING_DEVBUILD=
106−targets
107−TARGETS="$(all_grp)"
108−run_build_repl "test" "$TARGETS"
109−
110−RUNNING_DEVBUILD=y
111−targets
112−TARGETS="$(all_grp)"
113−run_build_repl "test" "$TARGETS"
bin/targets.shnew file+120
@@ -0,0 +1,120 @@
1+#------------------------------------------------------------------------------
2+# test and benchmark groups
3+#------------------------------------------------------------------------------
4+
5+# Depends on RUNNING_TESTS, RUNNING_BENCHMARKS, RUNNING_DEVBUILD variables
6+# being set for dev_build, test_only, bench_only functions to work. So the
7+# "targets" fucntion should be called only after these are set.
8+
9+# IMPORTANT NOTE: the names "_grp" and "_cmp" suffixes are special, do
10+# not rename them to something else.
11+
12+targets () {
13+ base_stream_grp="\
14+ `bench_only Data.Stream.StreamD` \
15+ `bench_only Data.Stream.StreamK` \
16+ `bench_only Data.Stream.StreamDK`"
17+
18+ prelude_serial_grp="\
19+ Prelude.Serial \
20+ Prelude.WSerial \
21+ Prelude.ZipSerial"
22+
23+ prelude_concurrent_grp="\
24+ Prelude.Async \
25+ Prelude.WAsync \
26+ Prelude.Ahead \
27+ Prelude.Parallel \
28+ Prelude.ZipAsync"
29+
30+ prelude_other_grp="\
31+ `test_only Prelude` \
32+ $(test_only $(dev_build Prelude.Rate)) \
33+ `bench_only Prelude.Rate` \
34+ `test_only Prelude.Fold` \
35+ `test_only Prelude.Concurrent` \
36+ $(bench_only $(dev_build Prelude.Concurrent)) \
37+ `bench_only Prelude.Adaptive`"
38+
39+ array_grp="\
40+ Data.Array \
41+ Data.Array.Foreign \
42+ Data.Array.Prim \
43+ Data.SmallArray \
44+ Data.Array.Prim.Pinned"
45+
46+ base_parser_grp="\
47+ Data.Parser.ParserD \
48+ `bench_only Data.Parser.ParserK`"
49+
50+ parser_grp="\
51+ Data.Fold \
52+ Data.Parser"
53+
54+ list_grp="\
55+ `test_only Data.List.Base` \
56+ `test_only Data.List`"
57+
58+ #------------------------------------------------------------------------------
59+ # Streaming vs non-streaming
60+ #------------------------------------------------------------------------------
61+ # The "o-1-space" groups of these benchmarks are run with long stream
62+ # sizes when --long option is used.
63+
64+ infinite_grp="\
65+ $prelude_serial_grp \
66+ $prelude_concurrent_grp \
67+ `bench_only Prelude.Rate`"
68+
69+ #------------------------------------------------------------------------------
70+ # Benchmark comparison groups
71+ #------------------------------------------------------------------------------
72+
73+ # *_cmp denotes a comparison benchmark, the benchmarks provided in *_cmp
74+ # variables are compared with each other
75+ base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"
76+ serial_wserial_cmp="Prelude.Serial Prelude.WSerial"
77+ serial_async_cmp="Prelude.Serial Prelude.Async"
78+ concurrent_cmp="Prelude.Async Prelude.WAsync Prelude.Ahead Prelude.Parallel"
79+ array_cmp="Data.Array.Foreign Data.Array.Prim Data.Array Data.Array.Prim.Pinned"
80+ pinned_array_cmp="Data.Array.Foreign Data.Array.Prim.Pinned"
81+ base_parser_cmp=$base_parser_grp
82+
83+ COMPARISONS="\
84+ base_stream_cmp \
85+ serial_wserial_cmp \
86+ serial_async_cmp \
87+ concurrent_cmp \
88+ array_cmp \
89+ pinned_array_cmp \
90+ base_parser_cmp"
91+
92+ #------------------------------------------------------------------------------
93+ # All test/benchmark modules must be in at least one of these
94+ #------------------------------------------------------------------------------
95+
96+ # All groups
97+ GROUP_TARGETS="\
98+ base_stream_grp \
99+ prelude_serial_grp \
100+ prelude_concurrent_grp \
101+ prelude_other_grp \
102+ array_grp \
103+ base_parser_grp \
104+ parser_grp \
105+ list_grp \
106+ infinite_grp"
107+
108+ # Not in any groups
109+ INDIVIDUAL_TARGETS="\
110+ Data.Unfold \
111+ Unicode.Stream \
112+ $(test_only $(dev_build Unicode.Char)) \
113+ `bench_only Unicode.Char` \
114+ `bench_only Unicode.Utf8` \
115+ FileSystem.Handle \
116+ `test_only FileSystem.Event` \
117+ `test_only Network.Socket` \
118+ `test_only Network.Inet.TCP` \
119+ `test_only version-bounds`"
120+}
bin/test.shnew file+247
@@ -0,0 +1,247 @@
1+#!/usr/bin/env bash
2+
3+SCRIPT_DIR=$(dirname $0)
4+
5+STREAMLY_VERSION=0.8.1.1
6+BENCH_REPORT_DIR=benchmark/bench-report
7+source $SCRIPT_DIR/targets.sh
8+
9+#------------------------------------------------------------------------------
10+# Script
11+#------------------------------------------------------------------------------
12+
13+print_help () {
14+ echo "Usage: $0 "
15+ echo " [--targets <"target1 target2 ..." | help>]"
16+ echo
17+ echo " [--quick]"
18+ echo " [--with-compiler <compiler exe name>]"
19+ echo " [--cabal-build-options <option>]"
20+ echo " [--dev-build]"
21+ echo
22+ echo " [--coverage]"
23+ echo " [--hpc-report-options <option>]"
24+ echo " [--no-measure]"
25+ echo " [--raw]"
26+ echo
27+ echo " [--rtsopts <option>]"
28+ echo " -- <hspec options or test names>"
29+ echo
30+ echo "--targets: targets to run, use 'help' for list of targets"
31+ echo
32+ echo "--quick: disable optimizations to build quickly"
33+ echo "--cabal-build-options: Pass any cabal build options to be used for build"
34+ echo "--dev-build: runs some additional tests"
35+ echo
36+ echo "--coverage: enable coverage and report coverage info"
37+ echo "--hpc-report-options: option for 'hpc report'"
38+ echo "--no-measure: with --coverage, do not run tests, only show coverage info"
39+ echo "--raw: with --coverage, do not run hpc"
40+ echo
41+ echo "--rtsopts: pass GHC RTS options to the test executable"
42+ echo "Any arguments after a '--' are passed directly to hspec"
43+ exit
44+}
45+
46+#-----------------------------------------------------------------------------
47+# Read command line
48+#-----------------------------------------------------------------------------
49+
50+RUNNING_TESTS=y
51+source $BENCH_REPORT_DIR/bin/build-lib.sh
52+
53+USE_GIT_CABAL=1
54+set_common_vars
55+COVERAGE=0
56+MEASURE=1
57+HPC_REPORT_OPTIONS=
58+RAW=0
59+CABAL_BUILD_OPTIONS="--flag limit-build-mem"
60+TEST_QUICK_MODE=0
61+
62+# XXX add a bisect option
63+while test -n "$1"
64+do
65+ case $1 in
66+ -h|--help|help) print_help ;;
67+ # options with arguments
68+ --targets) shift; TARGETS=$1; shift ;;
69+ --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;
70+ --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
71+ --hpc-report-options) shift; HPC_REPORT_OPTIONS="$1"; shift ;;
72+ --rtsopts) shift; RTS_OPTIONS="$1"; shift ;;
73+ # flags
74+ --raw) RAW=1; shift ;;
75+ #--slow) SLOW=1; shift ;; # not implemented
76+ --quick) TEST_QUICK_MODE=1; shift ;;
77+ --dev-build) RUNNING_DEVBUILD=1 CABAL_BUILD_OPTIONS+=" --flag dev"; shift ;;
78+ --coverage) COVERAGE=1; shift ;;
79+ --no-measure) MEASURE=0; shift ;;
80+ --) shift; break ;;
81+ -*|--*) echo "Unknown flags: $*"; echo; print_help ;;
82+ *) break ;;
83+ esac
84+done
85+TARGET_EXE_ARGS=$*
86+
87+set_derived_vars
88+
89+if test $TEST_QUICK_MODE -eq 1
90+then
91+ CABAL_BUILD_OPTIONS+=" --disable-optimization --flags -opt"
92+fi
93+
94+#-----------------------------------------------------------------------------
95+# Determine targets
96+#-----------------------------------------------------------------------------
97+
98+# Defined in targets.sh
99+targets
100+
101+if test "$(has_item "$TARGETS" help)" = "help"
102+then
103+ list_target_groups
104+ list_targets
105+ exit
106+fi
107+
108+DEFAULT_TARGETS="$(all_grp)"
109+TARGETS=$(set_targets)
110+
111+echo "Using targets [$TARGETS]"
112+
113+#-----------------------------------------------------------------------------
114+# Build targets
115+#-----------------------------------------------------------------------------
116+
117+test_exe_rts_opts () {
118+ case "$1" in
119+ # XXX Data.Array.* heap requirement increased for GHC-8.10
120+ Data.Array.Foreign) echo -n "-M128M" ;;
121+ Data.Array.Prim) echo -n "-M128M" ;;
122+ Data.Array.Prim.Pinned) echo -n "-M128M" ;;
123+ Prelude.Rate) echo -n "-M512M" ;;
124+ # For -O0 case writeChunks test fails, maybe we should have a separate flag
125+ # for O0 case?
126+ FileSystem.Handle) echo -n "-K16M" ;;
127+ *) if test "$COVERAGE" -eq "1"
128+ then
129+ echo -n "-K8M -M1024M"
130+ else
131+ echo -n "-K8M -M64M"
132+ fi ;;
133+ esac
134+}
135+
136+# $1: bench name
137+# $2: bench executable
138+target_exe_extra_args () {
139+ local bench_name=$1
140+ local bench_prog=$2
141+
142+ echo "+RTS \
143+ $(test_exe_rts_opts $(basename $bench_prog)) \
144+ $RTS_OPTIONS \
145+ -RTS"
146+}
147+
148+if test "$COVERAGE" -eq "1"
149+then
150+ # Used to determine the hpc tix dir
151+ PACKAGE_FULL_NAME=streamly-$STREAMLY_VERSION
152+ case `uname` in
153+ Linux) SYSTEM=x86_64-linux ;;
154+ *) echo "Unsupported system"; exit 1 ;;
155+ esac
156+
157+ # With the --enable-coverage option the tests as well as the library get
158+ # compiled with -fhpc, and we get coverage for tests as well. But we want to
159+ # exclude that, so a project file is needed.
160+ CABAL_BUILD_OPTIONS+=" --project-file cabal.project.coverage"
161+ mkdir -p $BUILD_DIR/hpc
162+fi
163+BUILD_TEST="$CABAL_EXECUTABLE v2-build $CABAL_BUILD_OPTIONS --enable-tests"
164+
165+if test "$MEASURE" -eq "1"
166+then
167+run_build "$BUILD_TEST" streamly-tests test "$TARGETS"
168+fi
169+
170+#-----------------------------------------------------------------------------
171+# Run targets
172+#-----------------------------------------------------------------------------
173+
174+# $1: target name
175+get_tix_file () {
176+ echo $BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_FULL_NAME/hpc/vanilla/tix/$1/$1.tix
177+}
178+
179+# $1: package name
180+# $2: component
181+# $3: target
182+# $4: args generator func
183+run_target () {
184+ local package_name=$1
185+ local component=$2
186+ local target_name=$3
187+ local extra_args=$4
188+
189+ local target_prog
190+
191+ target_prog=$(cabal_target_prog $package_name $component $target_name) || \
192+ die "Cannot find executable for target $target_name"
193+
194+ echo "Running executable $target_name ..."
195+
196+ mkdir -p $(dirname $(get_tix_file $target_name))
197+ export HPCTIXFILE=$(get_tix_file $target_name)
198+
199+ run_verbose $target_prog $($extra_args $target_name $target_prog) \
200+ || die "Target exe failed"
201+
202+ # hpc-coveralls fails if there is an empty dir and no .tix file generated
203+ rmdir $(dirname $(get_tix_file $target_name)) 2>/dev/null || true
204+}
205+
206+# $1: package name with version
207+# $2: component
208+# $3: targets
209+# $4: args generator func
210+run_targets() {
211+ for i in $3
212+ do
213+ run_target $1 $2 $i $4
214+ done
215+}
216+
217+if test "$MEASURE" -eq "1"
218+then
219+run_targets "streamly-tests-0.0.0" t "$TARGETS" target_exe_extra_args
220+fi
221+
222+#-----------------------------------------------------------------------------
223+# Run coverage reports
224+#-----------------------------------------------------------------------------
225+
226+PACKAGE_NAME=streamly-$STREAMLY_VERSION
227+MIX_DIR=$BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_NAME/hpc/vanilla/mix/$PACKAGE_NAME/
228+ALLTIX=$BUILD_DIR/hpc/all.tix
229+
230+if test "$COVERAGE" -eq "1" -a "$RAW" -eq 0
231+then
232+ TIXFILES=
233+ for i in $TARGETS
234+ do
235+ tixfile="$(get_tix_file ${i})"
236+ if test -f "$tixfile"
237+ then
238+ TIXFILES+="$tixfile "
239+ fi
240+ done
241+
242+ #echo "Combining tix files:"
243+ #echo $TIXFILES | tr ' ' '\n'
244+ hpc sum --union --output=$ALLTIX $TIXFILES
245+ run_verbose hpc markup $ALLTIX --hpcdir $MIX_DIR
246+ run_verbose hpc report $ALLTIX $HPC_REPORT_OPTIONS --hpcdir $MIX_DIR
247+fi
cabal.project−1
@@ -1,5 +1,4 @@
11packages: streamly.cabal
2− , core/streamly-core.cabal
32 , test/streamly-tests.cabal
43 , benchmark/streamly-benchmarks.cabal
54 , docs/streamly-docs.cabal
cabal.project.O0+3−8
@@ -2,23 +2,18 @@ packages:
22 ./
33 test
44 benchmark
5− core
65
76-- Keep the flags same as cabal.project.doctest because we utilize the
87-- same build for doctests in CI.
98
109package streamly
1110 flags: -opt
12− ghc-options: -O0
13−
14−package streamly-core
15− flags: -opt
16− ghc-options: -O0
11+ ghc-options: -O0 -Werror
1712
1813package streamly-tests
1914 flags: -opt
20− ghc-options: -O0
15+ ghc-options: -O0 -Werror
2116
2217package streamly-benchmarks
2318 flags: -opt
24− ghc-options: -O0
19+ ghc-options: -O0 -Werror
cabal.project.Werror−4
@@ -2,14 +2,10 @@ packages:
22 ./
33 benchmark
44 test
5− core
65
76package streamly
87 ghc-options: -Werror
98
10−package streamly-core
11− ghc-options: -Werror
12−
139package streamly-benchmarks
1410 ghc-options: -Werror
1511
cabal.project.Werror-nocode−8
@@ -2,20 +2,12 @@ packages:
22 ./
33 benchmark
44 test
5− core
6−
7−package streamly-core
8− flags: -opt
9− ghc-options: -Werror -O0
105
116package streamly
12− flags: -opt
137 ghc-options: -Werror -fno-code
148
159package streamly-benchmarks
16− flags: -opt
1710 ghc-options: -Werror -fno-code
1811
1912package streamly-tests
20− flags: -opt
2113 ghc-options: -Werror -fno-code
cabal.project.coverage−4
@@ -1,14 +1,10 @@
11packages:
22 ./
33 test
4− core
54
65package streamly
76 coverage: true
87
9−package streamly-core
10− coverage: true
11−
128-- package streamly-tests
139 -- A few percent lesss coverage for some build speedup
1410 -- -DCOVERAGE_BUILD
cabal.project.doctest+3−14
@@ -1,24 +1,13 @@
11packages: streamly.cabal
2− , core/streamly-core.cabal
3− -- , docs/streamly-docs.cabal
4− -- for QuickCheck in property doctests
5− , test/streamly-tests.cabal
2+ , docs/streamly-docs.cabal
63
74-- Keep the flags same as cabal.project.O0 because we utilize the same build
85-- for doctest in CI.
96
107package streamly
118 flags: -opt
12− ghc-options: -O0
13−
14−package streamly-core
15− flags: -opt
16− ghc-options: -O0
9+ ghc-options: -O0 -Werror
1710
1811package streamly-docs
1912 flags: -opt
20− ghc-options: -O0
21−
22−package streamly-tests
23− flags: -opt
24− ghc-options: -O0
13+ ghc-options: -O0 -Werror
cabal.project.ghc-head+41−21
@@ -1,35 +1,55 @@
1−-- See head.hackage:
2−-- info at https://ghc.gitlab.haskell.org/head.hackage/
3−-- source at https://gitlab.haskell.org/ghc/head.hackage/
4−
51packages: streamly.cabal
6− , core/streamly-core.cabal
72 , test/streamly-tests.cabal
83 , benchmark/streamly-benchmarks.cabal
94 , docs/streamly-docs.cabal
105
11−write-ghc-environment-files: always
12−
13−repository head.hackage.ghc.haskell.org
14− url: https://ghc.gitlab.haskell.org/head.hackage/
15− secure: True
16− key-threshold: 3
17− root-keys:
18− f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89
19− 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329
20− 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d
6+-- Up to date on github
7+source-repository-package
8+ type: git
9+ location: https://github.com/haskell/primitive
10+ tag: d57dfacd4486b78785140ac9ae071770748a1c23
2111
22−active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
12+source-repository-package
13+ type: git
14+ location: https://github.com/haskell/random
15+ tag: 4c6da86e00f8128f7094e597bb9ff7db23cee2d8
2316
17+-- Modified
2418source-repository-package
2519 type: git
2620 location: https://github.com/composewell/fusion-plugin
27− tag: 3c6535a7027d60d88c37b9a601cb180b805e7431
21+ tag: 1ccd16a4fbe9470d0a81f50f1dee45ed0d1f6356
22+
23+source-repository-package
24+ type: git
25+ location: https://github.com/composewell/colour
26+ tag: 657cc05600a8e15464387bbe2379d03613636aa2
2827
2928source-repository-package
3029 type: git
31− location: https://github.com/rrnewton/haskell-lockfree
32− tag: 00a70cfe74994b41eb3627c752170d1e82118a8e
33− subdir: lockfree-queue
30+ location: https://github.com/composewell/network
31+ tag: b83c9146072b69f99128a32a9fcda3a6e9200722
32+
33+source-repository-package
34+ type: git
35+ location: https://github.com/composewell/tasty
36+ tag: a2cdda6868b3da1e02ca2b45c12525c1f74911b0
37+ subdir: core
38+
39+package fusion-plugin
40+ tests: false
41+
42+package primitive
43+ tests: false
44+
45+package random
46+ tests: false
47+
48+package colour
49+ tests: false
50+
51+package network
52+ tests: false
3453
35−allow-newer: all
54+package tasty
55+ tests: false
cabal.project.packdiffdeleted−9
@@ -1,9 +0,0 @@
1−source-repository-package
2− type: git
3− location: https://github.com/composewell/packdiff.git
4− tag: b11a50c9c0523382a19eebc0b12efdae194406a9
5−
6−source-repository-package
7− type: git
8− location: https://github.com/composewell/streamly-process.git
9− tag: d80b860d9d8ea98e4f7f63390442b3155c34dd08
cabal.project.reportdeleted−30
@@ -1,30 +0,0 @@
1−packages:
2− targets/streamly-targets.cabal
3− benchmark/bench-runner/bench-runner.cabal
4− test/test-runner/test-runner.cabal
5−
6−package bench-report
7− flags: +no-charts
8−
9−package bench-show
10− flags: +no-charts
11−
12−source-repository-package
13− type: git
14− location: https://github.com/composewell/bench-report.git
15− tag: 3b50bf0ad06f746bca42f30c8d40a0426e159af3
16−
17−source-repository-package
18− type: git
19− location: https://github.com/composewell/streamly-coreutils.git
20− tag: 5dbb8bcefac3aefd5eb298dc410b11e36e79f35a
21−
22−source-repository-package
23− type: git
24− location: https://github.com/composewell/streamly-shell.git
25− tag: b0c6318119d1cc5e2106343f17b5cff2ad94417f
26−
27−source-repository-package
28− type: git
29− location: https://github.com/composewell/streamly-process.git
30− tag: d80b860d9d8ea98e4f7f63390442b3155c34dd08
cabal.project.streamlydeleted−10
@@ -1,10 +0,0 @@
1−packages: streamly.cabal
2− , test/streamly-tests.cabal
3− , benchmark/streamly-benchmarks.cabal
4− , docs/streamly-docs.cabal
5−
6−source-repository-package
7− type: git
8− location: https://github.com/composewell/streamly
9− tag: master
10− subdir: core
configure+237−9

This diff is too big to show here.

configure.ac+5−1

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/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/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/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/Fold.hsdeleted−33

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/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/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/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/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/Ring/Generic.hsdeleted−185

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/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/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/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/FileSystem/Path.hsdeleted−515

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/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/config.h.indeleted−57

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.

default.nix+18−32

This diff is too big to show here.

docs/Developer/MAINTAINING.md → dev/MAINTAINING.mdrenamed+26−130

This diff is too big to show here.

docs/Developer/ci-tests.md → dev/ci-tests.mdrenamed+6−16

This diff is too big to show here.

docs/Developer/container-api.md → dev/container-api.mdrenamed

The content is the same.

docs/Developer/cps-vs-direct.rst → dev/cps-vs-direct.rstrenamed

The content is the same.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

The content is the same.

docs/Developer/module-organization.md → dev/module-organization.mdrenamed+4−4

This diff is too big to show here.

docs/Developer/optimization-guidelines.md → dev/optimization-guidelines.mdrenamed+1−13

This diff is too big to show here.

docs/Developer/overview.md → dev/overview.mdrenamed

The content is the same.

docs/Developer/paths.rst → dev/paths.rstrenamed+2−25

This diff is too big to show here.

docs/Developer/related-packages.md → dev/related-packages.mdrenamed

The content is the same.

docs/Developer/resources.md → dev/resources.mdrenamed

The content is the same.

docs/Developer/roadmap.md → dev/roadmap.mdrenamed

The content is the same.

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

The content is the same.

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

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.8.3.txt → docs/API-changelog.txtrenamed+4−4

This diff is too big to show here.

docs/User/Project/CONTRIBUTORS.md → docs/CONTRIBUTORS.mdrenamed−24

This diff is too big to show here.

docs/User/Tutorials/ConcurrentStreams.hs → docs/ConcurrentStreams.hsrenamed+33−23

This diff is too big to show here.

docs/User/Project/Credits.md → docs/Credits.mdrenamed

The content is the same.

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/Tests.mddeleted−139

This diff is too big to show here.

docs/Documentation.mddeleted−5

This diff is too big to show here.

docs/User/Explanatory/Overview.md → docs/Overview.mdrenamed+2−2

This diff is too big to show here.

docs/User/Tutorials/ReactiveProgramming.hs → docs/ReactiveProgramming.hsrenamed+3−5

This diff is too big to show here.

docs/User/Project/Roadmap.link → docs/Roadmap.linkrenamed

The content is the same.

docs/User/Tutorials/Tutorial.hs → docs/Tutorial.hsrenamed+69−48

This diff is too big to show here.

docs/User/Explanatory/design.mddeleted−42

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/Project/ApiChangelogs/0.8.3-0.9.0.txtdeleted−175

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/Upgrading-0.8-to-0.9.mddeleted−384

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/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/HowTo/Compiling.md → docs/building.mdrenamed+45−54

This diff is too big to show here.

docs/faq.mdnew file+70

This diff is too big to show here.

docs/getting-started.mdnew file+296

This diff is too big to show here.

docs/User/HowTo/interoperation.md → docs/interoperation.mdrenamed

The content is the same.

docs/User/Explanatory/monad-transformers.md → docs/monad-transformers.mdrenamed

The content is the same.

docs/User/HowTo/optimizing.md → docs/optimizing.mdrenamed

The content is the same.

docs/User/Explanatory/performance.md → docs/performance.mdrenamed

The content is the same.

docs/User/resources.md → docs/resources.mdrenamed

The content is the same.

docs/User/Explanatory/streaming-pradigms.rst → docs/streaming-pradigms.rstrenamed

The content is the same.

docs/streamly-docs.cabal+7−23

This diff is too big to show here.

docs/User/HowTo/streamly-vs-async.md → docs/streamly-vs-async.mdrenamed+1−3

This diff is too big to show here.

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

The content is the same.

docs/User/HowTo/streamly-vs-lists.md → docs/streamly-vs-lists.mdrenamed+2−4

This diff is too big to show here.

docs/User/Explanatory/unified-abstractions.md → docs/unified-abstractions.mdrenamed+8−11

This diff is too big to show here.

hie.yaml+38−81

This diff is too big to show here.

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

The content is the same.

src/Streamly.hsnew file+690

This diff is too big to show here.

core/src/Streamly/Console/Stdio.hs → src/Streamly/Console/Stdio.hsrenamed+4−3

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/Array/Foreign.hs+3−44

This diff is too big to show here.

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

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.hs+28−3

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

This diff is too big to show here.

src/Streamly/Data/Unicode/Stream.hsnew file+99

This diff is too big to show here.

core/src/Streamly/FileSystem/Handle.hs → src/Streamly/FileSystem/Handle.hsrenamed+13−34

This diff is too big to show here.

core/src/Streamly/Internal/BaseCompat.hs → src/Streamly/Internal/BaseCompat.hsrenamed+31−2

This diff is too big to show here.

core/src/Streamly/Internal/Console/Stdio.hs → src/Streamly/Internal/Console/Stdio.hsrenamed+45−44

This diff is too big to show here.

src/Streamly/Internal/Control/Concurrent.hs+67−44

This diff is too big to show here.

core/src/Streamly/Internal/Control/Exception.hs → src/Streamly/Internal/Control/Exception.hsrenamed+13−1

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

The content is the same.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign.hsnew file+596

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Mut.hsnew file+86

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hsnew file+2160

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Type.hsnew file+808

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/Type.hsnew file+94

This diff is too big to show here.

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

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/Type.hsnew file+176

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Chunked.hs → src/Streamly/Internal/Data/Array/Stream/Fold/Foreign.hsrenamed+90−133

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Stream/Foreign.hsnew file+859

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hsnew file+238

This diff is too big to show here.

core/src/Streamly/Internal/Data/Binary/Parser.hs → src/Streamly/Internal/Data/Binary/Decode.hsrenamed+43−164

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.

core/src/Streamly/Internal/Data/Either/Strict.hs → src/Streamly/Internal/Data/Either/Strict.hsrenamed−2

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Async.hs+10−23

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Step.hs → src/Streamly/Internal/Data/Fold/Step.hsrenamed+2−2

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Tee.hs → src/Streamly/Internal/Data/Fold/Tee.hsrenamed+6−33

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Type.hsnew file+1416

This diff is too big to show here.

core/src/Streamly/Internal/Data/IOFinalizer.hs → src/Streamly/Internal/Data/IOFinalizer.hsrenamed+22−20

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/IORef/Unboxed.hs → src/Streamly/Internal/Data/IORef/Prim.hsrenamed+35−36

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.

core/src/Streamly/Internal/Data/Maybe/Strict.hs → src/Streamly/Internal/Data/Maybe/Strict.hsrenamed+3−12

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Tee.hs → src/Streamly/Internal/Data/Parser/ParserD/Tee.hsrenamed+6−10

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Type.hs → src/Streamly/Internal/Data/Parser/ParserD/Type.hsrenamed+320−622

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserK/Type.hsnew file+494

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/Type.hsrenamed+3

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer.hs → src/Streamly/Internal/Data/Producer.hsrenamed+13−6

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer/Source.hs → src/Streamly/Internal/Data/Producer/Source.hsrenamed+36−101

This diff is too big to show here.

core/src/Streamly/Internal/Data/Producer/Type.hs → src/Streamly/Internal/Data/Producer/Type.hsrenamed+1−1

This diff is too big to show here.

core/src/Streamly/Internal/Data/Refold/Type.hs → src/Streamly/Internal/Data/Refold/Type.hsrenamed+8−5

This diff is too big to show here.

src/Streamly/Internal/Data/Ring.hsnew file+44

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring.hs → src/Streamly/Internal/Data/Ring/Foreign.hsrenamed+53−164

This diff is too big to show here.

src/Streamly/Internal/Data/SVar.hs+4−4

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Dispatch.hs+6−3

This diff is too big to show here.

core/src/Streamly/Internal/Data/SVar/Type.hs → src/Streamly/Internal/Data/SVar/Type.hsrenamed+1−10

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/Type.hsnew file+24

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray.hs+25−26

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray/Type.hs+75−8

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Ahead.hs+23−47

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Async.hs+29−62

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/Instances.hs+16−9

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream.hs+5−25

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs+2−4

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Common.hs+55−96

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+82−71

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs+2−15

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Exception.hs+19−31

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Expand.hs+101−87

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+72−32

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Lift.hs+10−8

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+310−346

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+108−240

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Transform.hs+187−111

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Type.hs+86−171

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+32−60

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Prelude.hs+45−7

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/PreludeCommon.hsnew file+139

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar.hsdeleted−18

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Generate.hs+12−15

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Serial.hs+105−83

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hsnew file+511

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Exception.hs → src/Streamly/Internal/Data/Stream/StreamD/Exception.hsrenamed+141−228

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Generate.hsnew file+406

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Lift.hsnew file+112

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Nesting.hs → src/Streamly/Internal/Data/Stream/StreamD/Nesting.hsrenamed+321−922

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Step.hs → src/Streamly/Internal/Data/Stream/StreamD/Step.hsrenamed+2−2

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Transform.hsnew file+1238

This diff is too big to show here.

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

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+3−143

This diff is too big to show here.

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

This diff is too big to show here.

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

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+91−39

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/Time.hsnew file+74

This diff is too big to show here.

src/Streamly/Internal/Data/Time/Clock.hsnew file+80

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

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

The content is the same.

core/src/Streamly/Internal/Data/Time/Clock/config-clock.h → src/Streamly/Internal/Data/Time/Clock/config-clock.hrenamed

The content is the same.

core/src/Streamly/Internal/Data/Time/TimeSpec.hsc → src/Streamly/Internal/Data/Time/TimeSpec.hscrenamed+3

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Units.hs → src/Streamly/Internal/Data/Time/Units.hsrenamed+7−8

This diff is too big to show here.

core/src/Streamly/Internal/Data/Tuple/Strict.hs → src/Streamly/Internal/Data/Tuple/Strict.hsrenamed−11

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold.hs → src/Streamly/Internal/Data/Unfold.hsrenamed+329−252

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Enumeration.hs → src/Streamly/Internal/Data/Unfold/Enumeration.hsrenamed+34−4

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.hs+6−3

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Type.hs → src/Streamly/Internal/Data/Unfold/Type.hsrenamed+80−302

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hsrenamed+84−191

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event.hs+4−7

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.hs+77−70

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Linux.hs+135−108

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Windows.hs+61−64

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FD.hs+64−71

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FDIO.hs+7

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/File.hs → src/Streamly/Internal/FileSystem/File.hsrenamed+148−216

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Handle.hs → src/Streamly/Internal/FileSystem/Handle.hsrenamed+242−209

This diff is too big to show here.

src/Streamly/Internal/Foreign/Malloc.hsnew file+49

This diff is too big to show here.

src/Streamly/Internal/Network/Inet/TCP.hs+128−166

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+249−184

This diff is too big to show here.

core/src/Streamly/Internal/System/IO.hs → src/Streamly/Internal/System/IO.hsrenamed+2−4

This diff is too big to show here.

src/Streamly/Internal/System/IOVec.hs+8−14

This diff is too big to show here.

src/Streamly/Internal/Unicode/Array/Char.hsnew file+92

This diff is too big to show here.

src/Streamly/Internal/Unicode/Array/Prim/Pinned.hsnew file+91

This diff is too big to show here.

src/Streamly/Internal/Unicode/Char.hs+12−21

This diff is too big to show here.

src/Streamly/Internal/Unicode/Char/Parser.hsnew file+187

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Stream.hs → src/Streamly/Internal/Unicode/Stream.hsrenamed+284−384

This diff is too big to show here.

src/Streamly/Internal/Unicode/Utf8.hs+9−15

This diff is too big to show here.

src/Streamly/Memory/Array.hsnew file+74

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Network/Socket.hs+51−84

This diff is too big to show here.

src/Streamly/Prelude.hs+8−14

This diff is too big to show here.

core/src/Streamly/Unicode/Stream.hs → src/Streamly/Unicode/Stream.hsrenamed+17−20

This diff is too big to show here.

src/assert.hsdeleted−6

This diff is too big to show here.

src/config.h.in+38

This diff is too big to show here.

src/inline.hs+2−2

This diff is too big to show here.

stack.yaml+2−3

This diff is too big to show here.

streamly.cabal+292−286

This diff is too big to show here.

targets/Targets.hsdeleted−213

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/README.mdmode 120000 → 100644+158−1

This diff is too big to show here.

test/Streamly/Test/Data/Array.hs+6−232

This diff is too big to show here.

test/Streamly/Test/Data/Array/Common.hs+25−17

This diff is too big to show here.

test/Streamly/Test/Data/Array/CommonImports.hs+4−4

This diff is too big to show here.

test/Streamly/Test/Data/Array/Foreign.hsnew file+120

This diff is too big to show here.

test/Streamly/Test/Data/Array/Generic.hs → test/Streamly/Test/Data/Array/Prim.hsrenamed+12−22

This diff is too big to show here.

test/Streamly/Test/Data/Array/Prim/Pinned.hsnew file+55

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/Array/Stream/Foreign.hsnew file+72

This diff is too big to show here.

test/Streamly/Test/Data/Fold.hs+161−205

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/List.hs+27−20

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.hs+194−764

This diff is too big to show here.

test/Streamly/Test/Data/ParserK.hs → test/Streamly/Test/Data/Parser/ParserD.hsrenamed+92−156

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.hs+1−3

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.hs+35−38

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Common.hs+6−10

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Darwin.hs+1−1

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Linux.hs+4−17

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Windows.hs+2−2

This diff is too big to show here.

test/Streamly/Test/FileSystem/Handle.hs+35−31

This diff is too big to show here.

test/Streamly/Test/Network/Inet/TCP.hs+18−25

This diff is too big to show here.

test/Streamly/Test/Network/Socket.hs+27−36

This diff is too big to show here.

test/Streamly/Test/Prelude.hs+3−2

This diff is too big to show here.

test/Streamly/Test/Prelude/Ahead.hs+4−3

This diff is too big to show here.

test/Streamly/Test/Prelude/Async.hs+4−24

This diff is too big to show here.

test/Streamly/Test/Prelude/Concurrent.hs+4−3

This diff is too big to show here.

test/Streamly/Test/Prelude/Fold.hs+1−3

This diff is too big to show here.

test/Streamly/Test/Prelude/Parallel.hs+4−3

This diff is too big to show here.

test/Streamly/Test/Prelude/Rate.hs+1−3

This diff is too big to show here.

test/Streamly/Test/Prelude/Serial.hs+120−159

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.hs+4−54

This diff is too big to show here.

test/Streamly/Test/Prelude/WSerial.hs+4−3

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipAsync.hs+1−3

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipSerial.hs+4−3

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.hs+16−13

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.hs+30−34

This diff is too big to show here.

test/lib/Streamly/Test/Common.hs+3−4

This diff is too big to show here.

test/lib/Streamly/Test/Prelude/Common.hs+48−29

This diff is too big to show here.

test/streamly-tests.cabal+40−201

This diff is too big to show here.

test/test-runner/Main.hsdeleted−33

This diff is too big to show here.

test/test-runner/cabal.projectdeleted−4

This diff is too big to show here.

test/test-runner/default.nixdeleted−164

This diff is too big to show here.

test/test-runner/test-runner.cabaldeleted−41

This diff is too big to show here.