on master help sign in
.circleci/config.yml+80−262
since splitsnapshots
unifiedsplit
@@ -1,7 +1,7 @@
1version: 2.1
1version: 2.1
2
2
3#-----------------------------------------------------------------------------
3#-----------------------------------------------------------------------------
4−# packcheck-0.4.2
4+# packcheck-0.7.0
5# Packcheck global environment variables
5# Packcheck global environment variables
6#-----------------------------------------------------------------------------
6#-----------------------------------------------------------------------------
7
7
@@ -11,6 +11,8 @@ env: &env
11 # Common options
11 # Common options
12 # ------------------------------------------------------------------------
12 # ------------------------------------------------------------------------
13 # GHC_OPTIONS: "-Werror"
13 # GHC_OPTIONS: "-Werror"
14+ # For updating see: https://downloads.haskell.org/~ghcup/
15+ GHCUP_VERSION: 0.1.20.0
14 CABAL_REINIT_CONFIG: "y"
16 CABAL_REINIT_CONFIG: "y"
15 LC_ALL: "C.UTF-8"
17 LC_ALL: "C.UTF-8"
16
18
@@ -22,7 +24,6 @@ env: &env
22 # DISABLE_DOCS: "y"
24 # DISABLE_DOCS: "y"
23 # DISABLE_SDIST_BUILD: "y"
25 # DISABLE_SDIST_BUILD: "y"
24 # DISABLE_DIST_CHECKS: "y"
26 # DISABLE_DIST_CHECKS: "y"
25− ENABLE_INSTALL: "y"
26
27
27 # ------------------------------------------------------------------------
28 # ------------------------------------------------------------------------
28 # stack options
29 # stack options
@@ -38,14 +39,12 @@ env: &env
38 # cabal options
39 # cabal options
39 # ------------------------------------------------------------------------
40 # ------------------------------------------------------------------------
40 CABAL_CHECK_RELAX: "y"
41 CABAL_CHECK_RELAX: "y"
41− CABAL_NO_SANDBOX: "y"
42+ CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
42− CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
43
43
44 # ------------------------------------------------------------------------
44 # ------------------------------------------------------------------------
45 # Where to find the required tools
45 # Where to find the required tools
46 # ------------------------------------------------------------------------
46 # ------------------------------------------------------------------------
47− PATH: /opt/ghc/bin:/opt/ghcjs/bin:/sbin:/usr/sbin:/bin:/usr/bin
47+ PATH: /sbin:/usr/sbin:/bin:/usr/bin
48− TOOLS_DIR: /opt
49
48
50 # ------------------------------------------------------------------------
49 # ------------------------------------------------------------------------
51 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
50 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
@@ -57,16 +56,16 @@ env: &env
57 PACKCHECK: "./packcheck.sh"
56 PACKCHECK: "./packcheck.sh"
58 # If you have not committed packcheck.sh in your repo at PACKCHECK
57 # If you have not committed packcheck.sh in your repo at PACKCHECK
59 # then it is automatically pulled from this URL.
58 # then it is automatically pulled from this URL.
60− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
59+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
61− PACKCHECK_GITHUB_COMMIT: "563702bd02c41343dcd3dfcfef0845ca428a9240"
60+ PACKCHECK_GITHUB_COMMIT: "f6cfd7b7a33b4bf6fd63cce6a3fb3d26f5031403"
62
61
63executors:
62executors:
64 amd64-executor:
63 amd64-executor:
65 docker:
64 docker:
66− - image: ubuntu:xenial
65+ - image: ubuntu:latest
67 x86-executor:
66 x86-executor:
68 docker:
67 docker:
69− - image: i386/ubuntu:eoan
68+ - image: i386/ubuntu:focal
70
69
71#-----------------------------------------------------------------------------
70#-----------------------------------------------------------------------------
72# Common utility stuff, not to be modified usually
71# Common utility stuff, not to be modified usually
@@ -78,42 +77,50 @@ preinstall: &preinstall
78 # required for https/cache save and restore
77 # required for https/cache save and restore
79 apt-get install -y ca-certificates
78 apt-get install -y ca-certificates
80
79
81− # required to (re)generate the configure script
80+ # Alternative way of installing ghc and cabal, directly from
82− apt-get install -y autoconf
81+ # haskell.org instead of using ghcup. NOTE: this is for Debian
83−
82+ # only and is debian release specific.
84− # For ghc and cabal-install packages from hvr's ppa
85 # gnupg is required for apt-key to work
83 # gnupg is required for apt-key to work
86− apt-get install -y gnupg
84+ #apt-get install -y gnupg
87− apt-get install -y apt-transport-https
88− apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
85+ #apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
89− apt-get install -y software-properties-common
90− add-apt-repository -y ppa:hvr/ghc
91− # echo "deb http://downloads.haskell.org/debian stretch main" >> /etc/apt/sources.list
86+ #echo "deb http://downloads.haskell.org/debian buster main" >> /etc/apt/sources.list
92− echo "deb-src http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main" >> /etc/apt/sources.list
93− apt-get update
87+ #apt-get update
94
88
95− # required for packcheck
89+ # required for outbound https for stack and for stack setup
90+ apt-get install -y netbase xz-utils make
96− apt-get install -y curl
91+ apt-get install -y zlib1g-dev
97
92
93+ # For ghcup to install ghc
94+ if test -n "$GHCUP_VERSION"
95+ then
96+ apt-get install -y gcc
97+ apt-get install -y g++
98+ fi
99+
98− # required for circleci.
100+ # libgmp required by ghc for linking
99− apt-get install -y libcurl4-gnutls-dev
101+ apt-get install -y libgmp-dev
100− apt-get install -y git
101 apt-get install -y libtinfo-dev
102 apt-get install -y libtinfo-dev
102
103
103− # required for outbound https for stack and for stack setup
104+ # Required by cabal when git URL is specified in project file
104− apt-get install -y netbase xz-utils make
105+ apt-get install -y git
105
106
106−project-preinstall: &project-preinstall
107+ # Required for and by packcheck
107− run: |
108+ apt-get install -y curl
108− # If a custom stack-yaml is specified, replace the default with that
109− if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
110− unset STACK_YAML
111
109
112 # Get packcheck if needed
110 # Get packcheck if needed
113− CURL=$(which curl)
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
114− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
117+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
115− if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi;
118+ curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
119+ chmod +x $PACKCHECK
120+ elif test ! -x "$PACKCHECK"
121+ then
116− chmod +x $PACKCHECK
122+ chmod +x $PACKCHECK
123+ fi
117
124
118restore: &restore
125restore: &restore
119 # Needs to happen after installing ca-certificates
126 # Needs to happen after installing ca-certificates
@@ -129,272 +136,83 @@ save: &save
129 save_cache:
136 save_cache:
130 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
137 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
131 paths:
138 paths:
132− - ~/.cabal
133− - ~/.ghc
134 - ~/.local
139 - ~/.local
140+ - ~/.cabal
135 - ~/.stack
141 - ~/.stack
142+ - ~/.ghcup
136
143
137#-----------------------------------------------------------------------------
144#-----------------------------------------------------------------------------
138# Build matrix
145# Build matrix
139#-----------------------------------------------------------------------------
146#-----------------------------------------------------------------------------
140
147
141jobs:
148jobs:
142− stack-ghc-8_8:
143− <<: *env
144− executor: amd64-executor
145− steps:
146− - *preinstall
147− - checkout
148− - *project-preinstall
149− - *restore
150− - run:
151− name: GHC 8.8 + stack lts-16.12
152− environment:
153− BUILD: "stack"
154− RESOLVER: "lts-16.12"
155− SDIST_OPTIONS: "--ignore-check"
156− STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
157− command: |
158− apt-get build-dep -y ghc-8.8.4
159− apt-get install -y cabal-install-3.2
160− bash -c "$PACKCHECK $BUILD"
161− - *save
162 cabal-ghc-8_6_5:
149 cabal-ghc-8_6_5:
163 <<: *env
150 <<: *env
164 executor: amd64-executor
151 executor: amd64-executor
165 steps:
152 steps:
166− - *preinstall
167 - checkout
153 - checkout
168− - *project-preinstall
169 - *restore
154 - *restore
170− - run: |
171− apt-get install -y ghc-8.6.3
172− apt-get install -y cabal-install-2.4
173− bash -c "$PACKCHECK cabal-v2"
174− - *save
175− cabal-ghc-8_4_4:
176− <<: *env
177− executor: x86-executor
178− steps:
179 - *preinstall
155 - *preinstall
180− - checkout
181− - *project-preinstall
182− - *restore
183− - run:
184− name: GHC 8.4.4 + x86 + debug
185− environment:
186− BUILD: "cabal-v2"
187− GHCVER: "8.4.4"
188− CABAL_BUILD_OPTIONS: "--flag debug"
189− command: |
190− apt-get install -y ghc-8.4.4
191− apt-get install -y cabal-install-3.2
192− bash -c "$PACKCHECK $BUILD"
193− - *save
194− cabal-ghc-8_2_2:
195− <<: *env
196− executor: amd64-executor
197− steps:
198− - *preinstall
199− - checkout
200− - *project-preinstall
201− - *restore
202 - run:
156 - run:
203 environment:
157 environment:
204− BUILD: "cabal-v2"
158+ GHCVER: "8.6.5"
205− DISABLE_TEST: "yes"
159+ CABAL_VERSION: "3.6.2.0"
206− DISABLE_BENCH: "yes"
160+ CABAL_PROJECT: "cabal.project"
207− DISABLE_DOCS: "yes"
208 DISABLE_SDIST_BUILD: "yes"
161 DISABLE_SDIST_BUILD: "yes"
209− DISABLE_DIST_CHECKS: "yes"
162+ CABAL_BUILD_OPTIONS: "--flag debug --flag -opt"
210 command: |
163 command: |
211− apt-get install -y ghc-8.2.2
212− apt-get install -y cabal-install-3.2
213− apt-get install libtinfo-dev
214− bash -c "$PACKCHECK $BUILD"
164+ bash -c "$PACKCHECK cabal"
215 - *save
165 - *save
216− cabal-ghc-8_0_2:
166+ cabal-ghc-9_8_1-docspec:
217 <<: *env
167 <<: *env
218 executor: amd64-executor
168 executor: amd64-executor
219 steps:
169 steps:
220− - *preinstall
221 - checkout
170 - checkout
222− - *project-preinstall
223 - *restore
171 - *restore
224− - run:
225− environment:
226− BUILD: "cabal-v2"
227− DISABLE_TEST: "yes"
228− DISABLE_BENCH: "yes"
229− DISABLE_DOCS: "yes"
230− DISABLE_SDIST_BUILD: "yes"
231− DISABLE_DIST_CHECKS: "yes"
232− command: |
233− apt-get install -y ghc-8.0.2
234− apt-get install -y cabal-install-3.2
235− bash -c "$PACKCHECK $BUILD"
236− - *save
237− cabal-ghc-7_10_3:
238− <<: *env
239− executor: amd64-executor
240− steps:
241 - *preinstall
172 - *preinstall
242− - checkout
243− - *project-preinstall
244− - *restore
245− - run: |
246− apt-get install -y ghc-7.10.3
247− apt-get install -y cabal-install-2.4
248− bash -c "$PACKCHECK cabal-v2"
249− - *save
250− stack-ghc-8_4:
251− <<: *env
252− executor: amd64-executor
253− steps:
254− - *preinstall
255− - checkout
256− - *project-preinstall
257− - *restore
258− - run: |
259− bash -c "$PACKCHECK stack RESOLVER=lts-12"
260− - *save
261− stack-ghc-8_2:
262− <<: *env
263− executor: amd64-executor
264− steps:
265− - *preinstall
266− - checkout
267− - *project-preinstall
268− - *restore
269− - run: |
270− bash -c "$PACKCHECK stack RESOLVER=lts-11"
271− - *save
272− cabal-ghcjs-8_4:
273− <<: *env
274− executor: amd64-executor
275− steps:
276− - *preinstall
277− - checkout
278− - *project-preinstall
279− - *restore
280− - run:
281− name: GHCJS 8.4+no-test+no-docs
282− environment:
283− BUILD: cabal-v2
284− ENABLE_GHCJS: "yes"
285− DISABLE_TEST: "yes"
286− ENABLE_INSTALL: ""
287− DISABLE_DOCS: "yes"
288− DISABLE_SDIST_BUILD: "yes"
289− command: |
290− add-apt-repository -y ppa:hvr/ghcjs
291− add-apt-repository -y 'deb https://deb.nodesource.com/node_11.x xenial main'
292− curl -sSL https://deb.nodesource.com/gpgkey/nodesource.gpg.key | apt-key add -
293− apt-get update
294− apt-get install -y cabal-install-3.2
295− apt-get install -y nodejs
296− apt-get install -y ghcjs-8.4
297− bash -c "$PACKCHECK $BUILD"
298− - *save
299− coveralls-ghc-8_2_2:
300− <<: *env
301− executor: amd64-executor
302− steps:
303− - *preinstall
304− - checkout
305− - *project-preinstall
306− - *restore
307 - run:
173 - run:
308 environment:
174 environment:
309− BUILD: cabal
175+ GHCVER: "9.8.1"
310− COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test test"
176+ CABAL_VERSION: "3.10.1.0"
311− GHC_OPTIONS: "-DCOVERAGE_BUILD"
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"
312 command: |
185 command: |
313− apt-get install -y ghc-8.2.2
314− apt-get install -y cabal-install-2.4
315− bash -c "$PACKCHECK cabal-v1"
186+ bash -c "$PACKCHECK cabal"
316 - *save
187 - *save
317− coveralls-ghc-8_8_3:
188+ hlint-trailing-spaces:
318 <<: *env
189 <<: *env
319 executor: amd64-executor
190 executor: amd64-executor
320 steps:
191 steps:
321− - *preinstall
322 - checkout
192 - checkout
323− - *project-preinstall
324 - *restore
193 - *restore
325− - run:
326− environment:
327− BUILD: cabal-v2
328− COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test"
329− CABAL_PROJECT: "cabal.project.coverage"
330− CABAL_BUILD_TARGETS: ""
331− command: |
332− apt-get install -y ghc-8.8.3
333− apt-get install -y cabal-install-3.0
334− bash -c "$PACKCHECK cabal-v2"
335− no_output_timeout: 25m
336− - *save
337− coveralls-ghc-8_10_2:
338− <<: *env
339− executor: amd64-executor
340− steps:
341 - *preinstall
194 - *preinstall
342− - checkout
343− - *project-preinstall
344− - *restore
345− - run:
346− name: Build and test with inspection, coverage, Werror
347− command: |
348− apt-get install -y ghc-8.10.2
349− apt-get install -y cabal-install-3.2
350− # Run tests with coverage
351− cabal update
352− cabal user-config update -a "jobs: 2"
353− bin/test.sh --coverage --raw
354− # Upload results to coveralls.io
355− PATH=$HOME/.cabal/bin:$PATH
356− export PATH
357− which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
358− hpc-coveralls --repo-token="$REPO_TOKEN" --coverage-mode=StrictlyFullLines
359− no_output_timeout: 25m
360− - *save
361− hlint-src:
362− <<: *env
363− executor: amd64-executor
364− steps:
365− - *preinstall
366− - checkout
367− - *project-preinstall
368− - *restore
369 - run:
195 - run:
370− name: Hlint src
196+ name: hlint and trailing spaces
371 environment:
197 environment:
372− BUILD: cabal-v2
198+ DISABLE_SDIST_BUILD: "yes"
199+ HLINT_VERSION: 3.6.1
373− HLINT_OPTIONS: lint --cpp-include=src --cpp-include=test
200+ HLINT_OPTIONS: lint
374− HLINT_TARGETS: src test benchmark
201+ HLINT_TARGETS: core/src src test benchmark
375 command: |
202 command: |
376− bash -c "$PACKCHECK $BUILD"
203+ bash -c "$PACKCHECK hlint" || exit 1
204+ echo "Checking trailing spaces..."
205+ count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
206+ exit $count
377 - *save
207 - *save
378
208
379workflows:
209workflows:
380 version: 2
210 version: 2
381 build:
211 build:
382 jobs:
212 jobs:
383− #- cabal-ghc-8.6.5
213+ #- cabal-ghc-8_6_5:
384− #- cabal-ghc-8_4_4:
214+ # name: 8.6.5-debug-unoptimized
385− # name: GHC 8.4.4 + x86 + debug
386− - cabal-ghc-8_2_2:
387− name: GHC 8.2.2 + no-test + no-bench + no-docs
388− - cabal-ghc-8_0_2:
215+ - cabal-ghc-9_8_1-docspec:
389− name: GHC 8.0.2 + no-test + no-bench + no-docs
216+ name: ghc-9.8.1-docspec
390− #- cabal-ghc-7.10.3
217+ - hlint-trailing-spaces:
391− - cabal-ghcjs-8_4:
218+ name: hlint and trailing spaces
392− name: GHCJS 8.4 + no-test + no-docs
393− #- stack-ghc-8.4
394− #- stack-ghc-8.2
395− #- coveralls-ghc-8.2.2
396− #- coveralls-ghc-8.8.3
397− - coveralls-ghc-8_10_2:
398− name: GHC 8.10.2 + inspection + coverage + Werror
399− - hlint-src:
400− name: Hlint src
.github/workflows/haskell.yml+212−78
@@ -8,117 +8,251 @@ on:
8
8
9jobs:
9jobs:
10 build:
10 build:
11− name: GHC ${{ matrix.name }}
11+ name: GHC ${{matrix.name}}
12 env:
12 env:
13− CABAL_REINIT_CONFIG: y
13+ # packcheck environment variables
14 LC_ALL: C.UTF-8
14 LC_ALL: C.UTF-8
15+ BUILD: ${{ matrix.build }}
16+ # For updating see: https://downloads.haskell.org/~ghcup/
17+ GHCUP_VERSION: 0.1.20.0
18+ DOCSPEC_URL: https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz
19+ DOCSPEC_OPTIONS: "--timeout 60 --check-properties --property-variables xs"
20+ GHCUP_GHC_OPTIONS: ${{ matrix.ghcup_ghc_options }}
21+ GHCVER: ${{ matrix.ghc_version }}
22+ CABALVER: ${{ matrix.cabal_version }}
23+ DISABLE_DOCS: ${{ matrix.disable_docs }}
24+ ENABLE_DOCSPEC: ${{ matrix.enable_docspec }}
25+ DISABLE_TEST: ${{ matrix.disable_test }}
26+ DISABLE_BENCH: ${{ matrix.disable_bench }}
27+ DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
28+ SDIST_OPTIONS: ${{ matrix.sdist_options }}
29+ DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
15
30
16− ENABLE_INSTALL: "n"
31+ # Cabal options
32+ CABAL_REINIT_CONFIG: y
33+ # Github has machines with 2 CPUS and 6GB memory so the cabal jobs
34+ # default (ncpus) is good, this can be checked from the packcheck
35+ # output in case it changes.
36+ CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }} --flag limit-build-mem
37+ CABAL_BUILD_TARGETS: ${{ matrix.cabal_build_targets }}
38+ CABAL_PROJECT: ${{ matrix.cabal_project }}
39+ CABAL_CHECK_RELAX: y
17
40
41+ # Stack options
18 STACK_UPGRADE: "y"
42 STACK_UPGRADE: "y"
43+ RESOLVER: ${{ matrix.resolver }}
44+ STACK_YAML: ${{ matrix.stack_yaml }}
45+ STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
19
46
20− CABAL_CHECK_RELAX: y
47+ # packcheck location and revision
21− CABAL_NO_SANDBOX: y
48+ PACKCHECK: "./packcheck.sh"
22− CABAL_HACKAGE_MIRROR: hackage.haskell.org:http://hackage.fpcomplete.com
49+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
50+ PACKCHECK_GITHUB_COMMIT: "v0.7.0"
23
51
24− PACKCHECK_LOCAL_PATH: "./packcheck.sh"
52+ # Pull token from "secrets" setting of the github repo
25− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
53+ COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
26− PACKCHECK_GITHUB_COMMIT: "563702bd02c41343dcd3dfcfef0845ca428a9240"
54+ COVERAGE: ${{ matrix.coverage }}
27
55
28− BUILD: ${{ matrix.build }}
56+ # hlint
29− GHCVER: ${{ matrix.ghc_version }}
57+ HLINT_VERSION: 3.6.1
30− RESOLVER: ${{ matrix.resolver }}
58+ HLINT_OPTIONS: "lint"
31− CABAL_BUILD_OPTIONS: ${{ matrix.cabal_build_options }}
59+ HLINT_TARGETS: "core/src src test benchmark"
32− CABAL_BUILD_TARGETS: ${{ matrix.cabal_build_targets }}
60+
33− CABAL_PROJECT: ${{ matrix.cabal_project }}
61+ # Subdir
34− STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
62+ SUBDIR: ${{ matrix.subdir }}
35− DISABLE_DOCS: ${{ matrix.disable_docs }}
36− SDIST_OPTIONS: ${{ matrix.sdist_options }}
37− DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
38− DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
39
63
40 runs-on: ${{ matrix.runner }}
64 runs-on: ${{ matrix.runner }}
65+ continue-on-error: ${{ matrix.ignore_error }}
41 strategy:
66 strategy:
42− fail-fast: false
67+ fail-fast: true
43 matrix:
68 matrix:
44− name: [8.10.2+macOS, 8.8.3+inspection+fusion-plugin+Werror, 8.8+stack+lts-16.2, 8.6.5+fusion-plugin, 8.6.5+streamk, 8.4.4+debug, doctests]
69+ # The order is important to optimize fail-fast.
45− cabal_version: ["3.2"]
70+ name:
71+ - 9.8.1-Werror
72+ # - 9.8.1-docspec
73+ # - 8.10.7-coverage
74+
75+ # Note: if cabal.project is not specified benchmarks and tests won't
76+ # run. But we need at least one test where we test without
77+ # cabal.project because that is how hackage would build it.
46 include:
78 include:
47− #- name: 9.0.1+no-bench
79+ - name: head
80+ ghc_version: head
81+ # The URL may change, to find a working URL go to https://gitlab.haskell.org/ghc/ghc/-/jobs/
82+ # Find a debian10/11/12 job, click on a passed/failed status, at the
83+ # end of the output you will find the tar.xz name, put that tar
84+ # name after "raw/", and put the job name after "job=".
85+ # Also see https://github.com/mpickering/ghc-artefact-nix/blob/master/gitlab-artifact.nix
86+ #
87+ # May also use ghcup for installing ghc head version, use the
88+ # version "LatestNightly", and the following config:
89+ # ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
90+ ghcup_ghc_options: "-u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-deb10-int_native-validate.tar.xz?job=x86_64-linux-deb10-int_native-validate"
91+ runner: ubuntu-latest
92+ build: cabal
93+ cabal_version: 3.10.2.0
94+ cabal_project: cabal.project.ghc-head
95+ disable_sdist_build: "y"
96+ ignore_error: true
97+ # Note: use linux for warning build for convenient dev testing
98+ - name: 9.8.1-Werror
48− # ghc_version: 9.0.1
99+ ghc_version: 9.8.1
100+ runner: ubuntu-latest
49− # build: cabal-v2
101+ build: cabal
50− # cabal_build_options: "--allow-newer=hsc2hs"
102+ cabal_version: 3.10.1.0
51− # cabal_build_targets: "streamly streamly-tests"
103+ disable_sdist_build: "y"
52− # 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
53 # runner: ubuntu-latest
108 # runner: ubuntu-latest
54− - name: 8.10.2+macOS
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
55− ghc_version: 8.10.2
119+ ghc_version: 9.8.1
120+ runner: ubuntu-latest
56− build: cabal-v2
121+ build: cabal
122+ cabal_version: 3.10.1.0
57 disable_sdist_build: "y"
123 disable_sdist_build: "y"
58− runner: macos-latest
59− - name: 8.8.3+inspection+fusion-plugin+Werror
60− ghc_version: 8.8.3
61− build: cabal-v2
62− cabal_project: cabal.project.ci
124+ cabal_project: cabal.project
63 cabal_build_options: "--flag fusion-plugin --flag inspection"
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
64 runner: ubuntu-latest
166 runner: ubuntu-latest
65− - name: 8.8+stack+lts-16.2
66 build: stack
167 build: stack
67− resolver: lts-16.12
168+ resolver: lts-20.13
169+ stack_yaml: stack.yaml
68 sdist_options: "--ignore-check"
170 sdist_options: "--ignore-check"
69 stack_build_options: "--flag streamly-benchmarks:-opt"
171 stack_build_options: "--flag streamly-benchmarks:-opt"
172+ cabal_version: 3.6.2.0
173+ ignore_error: false
174+ # - name: 8.10.7-coverage
175+ # ghc_version: 8.10.7
176+ # runner: ubuntu-latest
177+ # coverage: "y"
178+ # cabal_version: 3.6.2.0
179+ # ignore_error: false
180+ - name: 8.8.4
181+ ghc_version: 8.8.4
70 runner: ubuntu-latest
182 runner: ubuntu-latest
71− - name: 8.6.5+streamk
72− ghc_version: 8.6.5
73− build: cabal-v2
183+ build: cabal
74− cabal_build_options: "--flag streamk --flag -opt"
184+ cabal_version: 3.6.2.0
75− runner: ubuntu-latest
185+ cabal_project: cabal.project
76− - name: 8.6.5+fusion-plugin
186+ disable_sdist_build: "y"
187+ ignore_error: false
188+ - name: 8.6.5-debug-unoptimized
77 ghc_version: 8.6.5
189 ghc_version: 8.6.5
78− build: cabal-v2
79− cabal_build_options: "--flag fusion-plugin"
80− # haddock generation does not work with 8.6.5+fusion-plugin
81− disable_docs: "y"
82 runner: ubuntu-latest
190 runner: ubuntu-latest
83− - name: 8.4.4+debug
84− ghc_version: 8.4.4
85− build: cabal-v2
191+ build: cabal
192+ cabal_version: 3.6.2.0
193+ cabal_project: cabal.project
86 cabal_build_options: "--flag debug --flag -opt"
194 cabal_build_options: "--flag debug --flag -opt"
195+ disable_sdist_build: "y"
196+ ignore_error: false
197+ - name: hlint
198+ build: hlint
87 runner: ubuntu-latest
199 runner: ubuntu-latest
88− - name: doctests
200+ ignore_error: true
89− ghc_version: 8.8.3
90− build: cabal-v2
91− cabal_build_options: "--flag doctests"
92− disable_dist_checks: "y"
93− cabal_build_targets: doctests
94− runner: ubuntu-latest
95
201
96 steps:
202 steps:
97 - uses: actions/checkout@v2
203 - uses: actions/checkout@v2
98
204
99− - uses: haskell/actions/setup@v1
100− with:
101− ghc-version: ${{ matrix.ghc_version }}
102− cabal-version: ${{ matrix.cabal_version }}
103−
104 - uses: actions/cache@v1
205 - uses: actions/cache@v1
105− name: Cache ~/.cabal
206+ name: Cache common directories
106 with:
207 with:
208+ path: |
209+ ~/.local
107− path: ~/.cabal
210+ ~/.cabal
211+ ~/.stack
212+ ~/.ghcup
213+ # Bump the key version to clear the cache
108− key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal
214+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v2
109
215
110 - name: Download packcheck
216 - name: Download packcheck
111 run: |
217 run: |
112− # If a custom stack-yaml is specified, replace the default with that
218+ if test ! -e "$PACKCHECK"
113− if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
219+ then
114− unset STACK_YAML
220+ if test -z "$PACKCHECK_GITHUB_COMMIT"
115−
221+ then
116− # Get packcheck if needed
222+ die "PACKCHECK_GITHUB_COMMIT is not specified."
117− CURL=$(which curl)
223+ fi
118− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
224+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
119− if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
225+ curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
120− chmod +x $PACKCHECK_LOCAL_PATH
226+ chmod +x $PACKCHECK
227+ elif test ! -x "$PACKCHECK"
228+ then
229+ chmod +x $PACKCHECK
230+ fi
121
231
122− - name: Run packcheck
232+ - name: Run tests
123 run: |
233 run: |
234+ if test -n "$COVERAGE"
235+ then
236+ # Run tests with coverage
237+ cabal update
238+ # Build hpc-coveralls if needed
239+ sudo apt-get install -y libcurl4-gnutls-dev
240+ export PATH=$HOME/.cabal/bin:$PATH
241+ which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
242+ # Run tests and upload results to coveralls.io
243+ bin/test.sh --coverage --raw
244+ # XXX Uncomment this and fix it properly later
245+ # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
246+ else
247+ # /usr/local/opt/curl/bin for macOS
248+ export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
249+ if test -n "$SUBDIR"
250+ then
251+ mv "$PACKCHECK" "$SUBDIR/packcheck.sh"
252+ # This is required as dist-newstyle will be created on the top level
253+ # directory as it is considered the working dir.
254+ rm cabal.project
255+ cd "$SUBDIR"
256+ fi
124− bash -c "$PACKCHECK_LOCAL_PATH $BUILD"
257+ bash -c "$PACKCHECK $BUILD"
258+ fi
.github/workflows/packdiff.ymlnew file+39
@@ -0,0 +1,39 @@
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.ymlnew file+165
@@ -0,0 +1,165 @@
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+7−3
@@ -1,7 +1,11 @@
1# Build files/directories
1# Build files/directories
2−/.stack-work/
2+.stack-work/
3−/dist/
3+dist/
4−/dist-newstyle*/
4+dist-newstyle*/
5+.cabal.nix
6+autom4te.cache/
7+benchmark/bench-report/bin/bench-report
8+charts/
5
9
6# Local GHC and Cabal related files
10# Local GHC and Cabal related files
7.ghc.environment*
11.ghc.environment*
.hlint.ignore+12−39
@@ -1,67 +1,40 @@
1+core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs
2+core/src/Streamly/Internal/Data/Pipe/Type.hs
1−src/Streamly/Internal/Data/Stream/SVar.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
2src/Streamly/Internal/Data/Stream/Serial.hs
6src/Streamly/Internal/Data/Stream/Serial.hs
3src/Streamly/Internal/Data/Stream/Zip.hs
7src/Streamly/Internal/Data/Stream/Zip.hs
4−src/Streamly/Internal/Data/Stream/Parallel.hs
5−src/Streamly/Internal/Data/Stream/Async.hs
6−src/Streamly/Internal/Data/Stream/StreamDK.hs
7−src/Streamly/Internal/Data/Stream/StreamK.hs
8−src/Streamly/Internal/Data/Stream/StreamK/Type.hs
9−src/Streamly/Internal/Data/Stream/Ahead.hs
10−src/Streamly/Internal/Data/Stream/StreamD/Type.hs
11−src/Streamly/Internal/Data/Stream/StreamDK/Type.hs
12−src/Streamly/Internal/Data/Stream/StreamD.hs
13−src/Streamly/Internal/Data/Stream/StreamD/Generate.hs
14−src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs
15−src/Streamly/Internal/Data/Stream/StreamD/Transform.hs
16−src/Streamly/Internal/Data/Stream/StreamD/Exception.hs
17−src/Streamly/Internal/Data/Stream/StreamD/Lift.hs
18−src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs
19−src/Streamly/Internal/Data/Pipe/Type.hs
20−src/Streamly/Internal/Data/SmallArray/Type.hs
21−src/Streamly/Internal/Unicode/Stream.hs
22−src/Streamly/Internal/Data/IORef/Prim.hs
23−src/Streamly/Internal/Data/Array/Prim/Type.hs
24−src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs
25−src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs
26−src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs
27−src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs
28−src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs
29−test/Streamly/Test/Common/Array.hs
30test/Streamly/Test/Data/Array.hs
8test/Streamly/Test/Data/Array.hs
31−test/Streamly/Test/Data/Array/Prim.hs
32−test/Streamly/Test/Data/Array/Prim/Pinned.hs
33−test/Streamly/Test/Data/Array/Foreign.hs
34test/Streamly/Test/Data/Parser.hs
9test/Streamly/Test/Data/Parser.hs
35−test/Streamly/Test/Data/Parser/ParserD.hs
10+test/Streamly/Test/Data/ParserK.hs
36test/Streamly/Test/Data/SmallArray.hs
11test/Streamly/Test/Data/SmallArray.hs
37test/Streamly/Test/Data/Unfold.hs
12test/Streamly/Test/Data/Unfold.hs
38test/Streamly/Test/FileSystem/Event.hs
13test/Streamly/Test/FileSystem/Event.hs
39test/Streamly/Test/Prelude/Concurrent.hs
14test/Streamly/Test/Prelude/Concurrent.hs
15+test/Streamly/Test/Data/Stream/Concurrent.hs
16+test/lib/Streamly/Test/Prelude/Common.hs
40test/Streamly/Test/Prelude/Fold.hs
17test/Streamly/Test/Prelude/Fold.hs
41test/Streamly/Test/Prelude/Rate.hs
18test/Streamly/Test/Prelude/Rate.hs
42test/Streamly/Test/Prelude/Serial.hs
19test/Streamly/Test/Prelude/Serial.hs
43test/Streamly/Test/Unicode/Stream.hs
20test/Streamly/Test/Unicode/Stream.hs
21+test/Streamly/Test/Data/Unbox.hs
44benchmark/lib/Streamly/Benchmark/Common.hs
22benchmark/lib/Streamly/Benchmark/Common.hs
45benchmark/lib/Streamly/Benchmark/Common/Handle.hs
23benchmark/lib/Streamly/Benchmark/Common/Handle.hs
46benchmark/lib/Streamly/Benchmark/Prelude.hs
24benchmark/lib/Streamly/Benchmark/Prelude.hs
47benchmark/NanoBenchmarks.hs
25benchmark/NanoBenchmarks.hs
48benchmark/Streamly/Benchmark/Data/Array.hs
26benchmark/Streamly/Benchmark/Data/Array.hs
49−benchmark/Streamly/Benchmark/Data/ArrayOps.hs
50−benchmark/Streamly/Benchmark/Data/NestedUnfoldOps.hs
51benchmark/Streamly/Benchmark/Data/Parser.hs
27benchmark/Streamly/Benchmark/Data/Parser.hs
52−benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs
28+benchmark/Streamly/Benchmark/Data/ParserK.hs
53benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
29benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
54benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
30benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
55benchmark/Streamly/Benchmark/Data/Unfold.hs
31benchmark/Streamly/Benchmark/Data/Unfold.hs
56benchmark/Streamly/Benchmark/FileSystem/Handle.hs
32benchmark/Streamly/Benchmark/FileSystem/Handle.hs
57benchmark/Streamly/Benchmark/Prelude/Async.hs
33benchmark/Streamly/Benchmark/Prelude/Async.hs
34+benchmark/Streamly/Benchmark/Prelude/Concurrent.hs
35+benchmark/Streamly/Benchmark/Prelude/Merge.hs
58benchmark/Streamly/Benchmark/Prelude/Parallel.hs
36benchmark/Streamly/Benchmark/Prelude/Parallel.hs
59benchmark/Streamly/Benchmark/Prelude/Rate.hs
37benchmark/Streamly/Benchmark/Prelude/Rate.hs
60−benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
61−benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs
62−benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs
63−benchmark/Streamly/Benchmark/Prelude/Serial/Transformation1.hs
64benchmark/Streamly/Benchmark/Prelude/WAsync.hs
38benchmark/Streamly/Benchmark/Prelude/WAsync.hs
65benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
39benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
66benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
40benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
67−benchmark/Streamly/Benchmark/Unicode/Stream.hs
.hlint.yaml+17−2
@@ -10,6 +10,8 @@
10- suggest: {name: "Unused LANGUAGE pragma"}
10- suggest: {name: "Unused LANGUAGE pragma"}
11- suggest: {name: "Eta reduce"}
11- suggest: {name: "Eta reduce"}
12- suggest: {name: "Reduce duplication"}
12- suggest: {name: "Reduce duplication"}
13+
14+# Warnings currently ignored
13- ignore: {name: "Use list literal pattern"}
15- ignore: {name: "Use list literal pattern"}
14- ignore: {name: "Use tuple-section"} # requires GHC extension
16- ignore: {name: "Use tuple-section"} # requires GHC extension
15- ignore: {name: "Use fromMaybe"} # may want to use this suggestion, but it didn't match the common idiom of the library
17- ignore: {name: "Use fromMaybe"} # may want to use this suggestion, but it didn't match the common idiom of the library
@@ -22,11 +24,24 @@
22- ignore: {name: "Use uncurry"}
24- ignore: {name: "Use uncurry"}
23- ignore: {name: "Redundant $!"}
25- ignore: {name: "Redundant $!"}
24- ignore: {name: "Use fmap"}
26- ignore: {name: "Use fmap"}
27+- ignore: {name: "Use ++"}
25
28
29+# Warnings ignored in specific places
30+- ignore: {name: "Use mapM", within: Stream.Transform}
31+- ignore: {name: "Use traverse", within: Stream.Transform}
32+- ignore: {name: "Redundant <*", within: Stream.Expand}
33+- ignore: {name: "Redundant bracket", within: Stream.Split}
34+- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Parser}
26
35
27# Specify additional command line arguments
36# Specify additional command line arguments
28#
37#
29−# - arguments: [--color, --cpp-simple, -XQuasiQuotes]
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+ ]
30
45
31
46
32# Control which extensions/flags/modules/functions can be used
47# Control which extensions/flags/modules/functions can be used
@@ -56,7 +71,7 @@
56# Turn on hints that are off by default
71# Turn on hints that are off by default
57#
72#
58# Ban "module X(module X) where", to require a real export list
73# Ban "module X(module X) where", to require a real export list
59−# - warn: {name: Use explicit module export list}
74+- warn: {name: Use explicit module export list}
60#
75#
61# Replace a $ b $ c with a . b $ c
76# Replace a $ b $ c with a . b $ c
62# - group: {name: dollar, enabled: true}
77# - group: {name: dollar, enabled: true}
.packcheck.ignore+32
@@ -1,4 +1,36 @@
1+.circleci/config.yml
2+.ghci
3+.github/workflows/haskell.yml
4+.github/workflows/regression-check.yml
5+.github/workflows/packdiff.yml
6+.gitignore
7+.hlint.ignore
8+.hlint.yaml
1.packcheck.ignore
9.packcheck.ignore
10+appveyor.yml
11+benchmark/bench-runner/default.nix
12+benchmark/bench-runner/cabal.project
13+bin/ghc.sh
14+bin/repl
15+bin/run-ci.sh
16+bin/run-repl-quick.sh
17+cabal.project
2cabal.project.coverage
18cabal.project.coverage
19+cabal.project.doctest
20+cabal.project.ghc-head
3cabal.project.hpc-coveralls
21cabal.project.hpc-coveralls
22+cabal.project.O0
23+cabal.project.report
24+cabal.project.packdiff
25+cabal.project.streamly
26+cabal.project.Werror
27+cabal.project.Werror-nocode
28+core/
29+default.nix
30+examples/README.md
4hie.yaml
31hie.yaml
32+stack.yaml
33+targets/default.nix
34+targets/cabal.project
35+test/test-runner/default.nix
36+test/test-runner/cabal.project
.travis.ymldeleted−242
@@ -1,242 +0,0 @@
1−# packcheck-0.4.2
2−# You can use any of the options supported by packcheck as environment
3−# variables here. See https://github.com/harendra-kumar/packcheck for all
4−# options and their explanation.
5−
6−if: branch = master
7−
8−# dist: trusty
9−dist: xenial
10−env:
11− # ------------------------------------------------------------------------
12− # Global options, you can use these per build as well
13− # ------------------------------------------------------------------------
14− global:
15− # ------------------------------------------------------------------------
16− # Common options
17− # ------------------------------------------------------------------------
18− - GHC_OPTIONS="-Werror"
19− - CABAL_REINIT_CONFIG=y
20− - LC_ALL=C.UTF-8
21−
22− # ------------------------------------------------------------------------
23− # What to build
24− # ------------------------------------------------------------------------
25− # - DISABLE_TEST=y
26− # - DISABLE_BENCH=y
27− # - DISABLE_DOCS=y
28− # - DISABLE_SDIST_BUILD=y
29− # - DISABLE_DIST_CHECKS=y
30− - ENABLE_INSTALL=y
31−
32− # ------------------------------------------------------------------------
33− # stack options
34− # ------------------------------------------------------------------------
35− # Note requiring a specific version of stack using STACKVER may fail due to
36− # github API limit while checking and upgrading/downgrading to the specific
37− # version.
38− #- STACKVER="1.6.5"
39− - STACK_UPGRADE="y"
40−
41− # ------------------------------------------------------------------------
42− # cabal options
43− # ------------------------------------------------------------------------
44− - CABAL_CHECK_RELAX=y
45− - CABAL_NO_SANDBOX=y
46− - CABAL_HACKAGE_MIRROR=hackage.haskell.org:http://hackage.fpcomplete.com
47−
48− # ------------------------------------------------------------------------
49− # Where to find the required tools
50− # ------------------------------------------------------------------------
51− - PATH=/bin:/usr/bin
52− - TOOLS_DIR=/opt
53−
54− # ------------------------------------------------------------------------
55− # Location of packcheck.sh (the shell script invoked to perform CI tests ).
56− # ------------------------------------------------------------------------
57− # You can either commit the packcheck.sh script at this path in your repo or
58− # you can use it by specifying the PACKCHECK_REPO_URL option below in which
59− # case it will be automatically copied from the packcheck repo to this path
60− # during CI tests. In any case it is finally invoked from this path.
61− - PACKCHECK_LOCAL_PATH="./packcheck.sh"
62− # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH
63− # then it is automatically pulled from this URL.
64− - PACKCHECK_GITHUB_URL="https://raw.githubusercontent.com/harendra-kumar/packcheck"
65− - PACKCHECK_GITHUB_COMMIT="563702bd02c41343dcd3dfcfef0845ca428a9240"
66−
67−notifications:
68− email:
69− on_success: change
70− on_failure: always
71−
72−# This matrix has total of 6 builds enabled, we try to cover last three major
73−# GHC versions, stack, cabal, Linux and OSX with minimum number of builds
74−# possible. You can uncomment other disabled builds or comment out existing
75−# ones to your taste.
76−#
77−# We pre-install the cabal-install package to not incur the penalty of building
78−# it the first time in cached builds or every time in uncached builds.
79−matrix:
80− include:
81−
82− # --------------------------------------------------------------------------
83− # (Linux) cabal builds (BUILD=cabal-v1, BUILD=cabal-v2). Common envvars are:
84− # CABAL_CONFIGURE_OPTIONS (cabal-v1), CABAL_BUILD_OPTIONS (cabal-v2)
85− # --------------------------------------------------------------------------
86−
87− #- env: BUILD=cabal-v2 GHCVER=head
88− # addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
89−
90− # With coverage
91− - name: "GHC 8.10.1+inspection+Werror+coverage"
92− env: BUILD=cabal-v2 COVERALLS_OPTIONS=" --repo-token=9ezA743hCAcmzX3Ic273LhNlIXVdl7D1l --coverage-mode=StrictlyFullLines --exclude-dir=test" CABAL_PROJECT="cabal.project.coverage" GHC_OPTIONS=""
93− addons: {apt: {packages: [cabal-install-3.2,ghc-8.10.1], sources: [hvr-ghc]}}
94−
95− # Built on github ci/on travis-stack-linux/on travis-stack-macOS
96− #- env: BUILD=cabal-v2 GHCVER=8.8.4 GHC_OPTIONS="" CABAL_BUILD_OPTIONS=""
97− # addons: {apt: {packages: [cabal-install-3.2,ghc-8.8.4], sources: [hvr-ghc]}}
98− # os: linux
99− # arch: amd64
100−
101− # Built on github ci
102− #- env: BUILD=cabal-v2 GHCVER=8.6.5 GHC_OPTIONS="" CABAL_BUILD_OPTIONS=""
103− # addons: {apt: {packages: [cabal-install-3.2,ghc-8.6.5], sources: [hvr-ghc]}}
104− # os: linux
105− # arch: amd64
106−
107− - name: "GHC 8.4.4+x86+debug"
108− env: BUILD=cabal-v2 GHCVER=8.4.4 GHC_OPTIONS="" CABAL_BUILD_OPTIONS="--flag debug"
109− addons: {apt: {packages: [cabal-install-3.2,ghc-8.4.4], sources: [hvr-ghc]}}
110− os: linux
111− arch: x86
112−
113− # Built on circleci
114− # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
115− #- env: BUILD=cabal-v2 GHCVER=8.2.2 GHC_OPTIONS="" DISABLE_BENCH=y
116− # addons: {apt: {packages: [cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
117−
118− - name: "GHC 8.0.2"
119− env: BUILD=cabal-v2 GHCVER=8.0.2 GHC_OPTIONS=""
120− addons: {apt: {packages: [cabal-install-3.2,ghc-8.0.2], sources: [hvr-ghc]}}
121− os: linux
122− arch: amd64
123−
124− # You can specify build flags like this:
125− #- env: BUILD=cabal-v2 CABAL_BUILD_OPTIONS="--flags=dev"
126− # addons: {apt: {packages: [cabal-install-head,ghc-head], sources: [hvr-ghc]}}
127−
128− # --------------------------------------------------------------------------
129− # GHCJS cabal builds
130− # --------------------------------------------------------------------------
131−
132− # Use CABAL_BUILD_OPTIONS to pass any options to cabal e.g. project-file
133− # DISABLE_SDIST_BUILD is set because of a cabal issue. 'cabal info'
134− # unnecessarily requires "ghc".
135− - name: "GHCJS 8.4+no-test+no-docs"
136− env: BUILD=cabal-v2 ENABLE_GHCJS=y DISABLE_TEST=y ENABLE_INSTALL= DISABLE_DOCS=y DISABLE_SDIST_BUILD=y
137− addons:
138− apt:
139− sources:
140− - hvr-ghc
141− - sourceline: 'ppa:hvr/ghcjs'
142− - sourceline: 'deb https://deb.nodesource.com/node_11.x xenial main'
143− key_url: 'https://deb.nodesource.com/gpgkey/nodesource.gpg.key'
144− packages: [cabal-install-3.2,ghcjs-8.4]
145−
146− # --------------------------------------------------------------------------
147− # (Linux) stack builds (BUILD=stack). Some common envvars for stack builds
148− # are: STACK_YAML, STACK_OPTIONS, STACK_BUILD_OPTIONS
149− # --------------------------------------------------------------------------
150− #
151− # NOTE: cabal-install is required for some of the packcheck options to work.
152− # We just install it so that packcheck does not build it from source
153− # otherwise.
154−
155− #- env: BUILD=stack RESOLVER=nightly
156− # addons: {apt: {packages: [cabal-install-1.24], sources: [hvr-ghc]}}
157−
158− - name: "GHC 8.8+stack lts-16.12"
159− env: BUILD=stack RESOLVER=lts-16.12 GHCVER=8.8 SDIST_OPTIONS="--ignore-check"
160− addons: {apt: {packages: [cabal-install-3.2], sources: [hvr-ghc]}}
161− os: linux
162− arch: amd64
163−
164− #- env: BUILD=stack RESOLVER=lts-12 GHCVER=8.4
165− # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
166−
167− # GHC-8.2.2 hogs memory leading to out-of-memory when compiling benchmarks
168− # So disable the benchmarks for this build.
169− #- env: BUILD=stack GHCVER=8.2.2 RESOLVER=lts-11 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y DISABLE_BENCH=y
170− # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
171−
172− #- env: BUILD=stack RESOLVER=lts-9 GHCVER=8.0
173− # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
174−
175− #- env: BUILD=stack RESOLVER=lts-6 GHCVER=7.10
176− # addons: {apt: {packages: [cabal-install-2.4], sources: [hvr-ghc]}}
177−
178− # You can keep a STACK_YAML file at any path location
179− #- env: BUILD=stack STACK_YAML=.ci/stack-8.0.yaml
180−
181− # You can specify build flags like this:
182− #- env: BUILD=stack RESOLVER=lts-12 STACK_BUILD_OPTIONS="--flag packcheck:dev"
183−
184− # --------------------------------------------------------------------------
185− # OS X builds
186− # --------------------------------------------------------------------------
187−
188− # On OSX autoreconf is not installed therefore disable sdist build
189− - name: "GHC 8.8"
190− env: BUILD=stack RESOLVER=lts-16.12 GHCVER=8.8 GHC_OPTIONS="" DISABLE_SDIST_BUILD=y SDIST_OPTIONS="--ignore-check"
191− os: osx
192−
193− # --------------------------------------------------------------------------
194− # Lint e.g. HLINT_COMMANDS="hlint lint src; hlint lint test"
195− # --------------------------------------------------------------------------
196−
197− - name: "hlint src"
198− env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="src"
199−
200− - name: "hlint test benchmarks"
201− env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="test benchmarks"
202−
203− # --------------------------------------------------------------------------
204− # Builds that are allowed to fail
205− # --------------------------------------------------------------------------
206−
207− allow_failures:
208− - env: BUILD=cabal-v2 GHCVER=head GHC_OPTIONS=""
209− - env: BUILD=stack RESOLVER=nightly DISABLE_SDIST_BUILD=y DISABLE_DIST_CHECKS=y
210− - env: BUILD=cabal-v2 HLINT_OPTIONS="lint" HLINT_TARGETS="test benchmarks"
211−
212−# ------------------------------------------------------------------------
213−# Settings beyond this point are advanced and normally not tweaked
214−# ------------------------------------------------------------------------
215−
216−language: generic
217−sudo: false
218−cache:
219− directories:
220− - $HOME/.cabal
221− - $HOME/.ghc
222− - $HOME/.ghcjs
223− - $HOME/.local
224− - $HOME/.stack
225−install: true
226−
227−script:
228− - |
229− # If a custom stack-yaml is specified, replace the default with that
230− if test -e "$STACK_YAML"; then rm -f stack.yaml && ln -sv $STACK_YAML stack.yaml; else true; fi
231− unset STACK_YAML
232−
233− # Get packcheck if needed
234− CURL=$(which curl)
235− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
236− if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
237− chmod +x $PACKCHECK_LOCAL_PATH
238−
239− # This script is governed by various PACKCHECK envvars that are set above.
240− # In addition, hpc-coveralls needs TRAVIS, TRAVIS_JOB_ID variables set by
241− # the travis CI environment.
242− - bash -c "$PACKCHECK_LOCAL_PATH $BUILD PATH=/bin:/usr/bin"
CHANGELOG.mdnew file+1
@@ -0,0 +1 @@
1+docs/User/Project/Changelog.md
CONTRIBUTING.mdmode 100644 → 120000+1−251
@@ -1,251 +0,0 @@
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−## Contributing A Change
19−
20−If the feature makes significant changes to design, we encourage you to open an
21−issue as early as possible so that you do not have to redo much work because of
22−changes in design decisions. However, if you are confident, you can still go
23−ahead and take that risk as the maintainers are supposed to be reasonable
24−people.
25−
26−### Pull Requests (PR)
27−
28−Please feel free to [send a pull
29−request (PR)](https://github.com/composewell/streamly/pulls) whether it is a
30−single letter typo fix or a complex change. We will accept any PR that makes a
31−net positive change to the package. We encourage you to provide a complete,
32−consistent change with test, documentation and benchmarks. You can contact the
33−[maintainers](https://gitter.im/composewell/streamly) for any help or
34−collaboration needed in that regard. However, if due to lack of time you are
35−not able to complete the PR, you are still welcome to submit it, maintainers
36−will try their best to actively contribute and pick up your change as long as
37−the change is approved.
38−
39−### Pull Request (PR) Checklist
40−
41−Here is a quick checklist for a PR, for details please see the next section:
42−
43−* PR contains one logical changeset
44−* Each commit in the PR consists of a logical change
45−* Commits are rebased/squashed/fixup/reordered as needed
46−* Stylistic changes to irrelevant parts of the code are separated in
47− independent commits.
48−* Code is formatted as per the style of the file or that of other files
49−* Compiler warnings are fixed
50−* Reasonable hlint suggestions are accepted
51−* Tests are added to cover the changed parts
52−* All [tests](test) pass
53−* [Performance benchmarks](benchmark) are added, where applicable
54−* No significant regressions are reported by [performance benchmarks](benchmark/README.md)
55−* Haddock documentation is added to user visible APIs and data types
56−* Tutorial module, [README](README.md), and [guides](docs) are updated if
57− necessary.
58−* [Changelog](Changelog.md) is updated if needed
59−* The code conforms to the license, it is not stolen, credit is given,
60− copyright notices are retained, original license is included if needed.
61−
62−### Structuring Pull Requests
63−
64−__Lean PR:__ Please keep the reviewer in mind when sending pull
65−requests. Use one PR for each logical changeset. A lean and thin
66−PR with one independent logical change is more likely to be reviewed and
67−merged quickly than a big monolithic PR with several unrelated changes.
68−
69−__PR Dependencies:__ If your change depends on an earlier PR you can
70−create a branch from the old PR's branch, and raise a new PR targeting
71−to merge into the old PR branch. Do not push the commits to the same PR
72−just because the commit depends on that PR.
73−
74−__Commits:__ You are encouraged to group a logically related set of
75−changes into a single commit. When the overall changeset is largish you
76−can divide it into multiple smaller commits, with each commit having
77−a logically grouped changeset and the title summarizing the logical
78−grouping. Always keep in mind a logical division helps reviewers
79−understand and review your code quickly, easier history tracking and
80−when required clean reversal changes.
81−
82−__Functional Changes:__ Keep the reviewer in mind when making
83−changes. Please resist the temptation to make style related changes to
84−surrounding code unless you are changing that code anyway . Whenever
85−possible, try to separate unrelated refactoring changes which do not
86−affect functionality in separate commits so that it is easier for the
87−reviewer to verify functional changes.
88−
89−__Style Changes:__ Make sure that your IDE/Editor is not automatically
90−making sweeping style changes to all the files you are editing. That
91−makes separating the signal from the noise very difficult and makes
92−everything harder. If you would like to make style related changes
93−then please send a separate PR with just those changes and no other
94−functionality changes.
95−
96−__Rebasing:__ If your commits reflect how you fixed intermediate
97−problems during testing or made random changes at different times you
98−may have to squash your changes (`git rebase -i`) into a single commit
99−or logically related set of commits.
100−
101−### Resolving Conflicts
102−
103−If during the course of development or before you send the PR you find that
104−your changes are conflicting with the master branch then use `git rebase
105−master` to rebase your changes on top of master. DO NOT MERGE MASTER INTO YOUR
106−BRANCH.
107−
108−### Testing
109−
110−It is a good idea to include tests for the changes where applicable. See the
111−existing tests [here](test).
112−
113−### Documentation
114−
115−For user visible APIs, it is a good idea to provide haddock documentation that
116−is easily understood by the end programmer and does not sound highfalutin,
117−and preferably with examples. If your change affects the tutorial or needs to
118−be mentioned in the tutorial then please update the tutorial. Check if the
119−additional [guides](docs) are affected or need to updated.
120−
121−### Performance Benchmarks
122−
123−It is a good idea to run performance benchmarks to see if your change affects
124−any of the existing performance benchmarks. If you introduced something new
125−then you may want to add benchmarks to check if it performs as well as expected
126−by the programmers to deem it usable.
127−
128−See the [README](benchmark/README) file in the `benchmark` directory for more
129−details on how to run the benchmarks.
130−
131−The first level of check is the regression in "allocations", this is
132−the most stable measure of regression. "bytesCopied" is another stable
133−measure, it gives an idea of the amount of long lived data being copied
134−across generations of GC.
135−
136−The next measure to look at is "cpuTime" this may have some variance
137−from run to run because of factors like cpu frequency scaling, load on
138−the system or the number of context switches etc. However, the variance
139−would usually be within 5-10%, anything more than that is likely to be a
140−red flag.
141−
142−Quite often an increase in "cpuTime" would correspond to an increase
143−in "allocations". Increase in "allocations" indicates an inefficiency
144−in computing due to too much GC activity e.g. due to lack of
145−fusion. However, it is also possible for the cpu time to go up without
146−the allocations going up, this indicates an inefficiency in processing
147−in general or more CPU being used for the same task. It could be because
148−of inefficient code generation, branch mis-predictions or lack of cache
149−locality etc.
150−
151−For concurrent benchmarks we can compare "cpuTime" and "time" to check
152−the degree of concurrency and total efficiency.
153−
154−### Changelog
155−
156−Any new changes that affect the user of the library in some way must be
157−documented under `Unreleased` section at the top of the `Changelog`. The
158−changes in the changelog must be organized in the following categories, in that
159−order:
160−
161−* Breaking Changes
162−* Enhancements
163−* Bug Fixes
164−* Deprecations
165−
166−If there are very few changes then you can just prefix a bullet with these
167−annotations. If there are many changes make sections to group them. A section
168−can be absent if there is nothing to add in it.
169−
170−If you make changes that are incompatible with the released versions
171−of the library please indicate that in the `Changelog` as `Breaking Changes`
172−and also write short notes regarding what the programmers need to do to adapt
173−their existing code to the new change.
174−
175−### Licensing
176−
177−If you have copied code from elsewhere you need to conform to the
178−licensing terms of the original code. Usually you would need to add a
179−copyright notice in the source header, and include the license of the
180−original code as per the terms of the license. If the code you are
181−copying does not have an associated license please do not use it.
182−
183−## Developer documentation
184−
185−To build haddock documentation for all modules, including the ones not exposed
186−to users of the library, use the following commands:
187−
188−```
189−$ cabal haddock
190−$ stack haddock --no-haddock-deps
191−```
192−
193−For design documentation see the `design` directory.
194−
195−## Coding Guidelines
196−
197−### Coding Style
198−
199−Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).
200−
201−### StreamD coding style
202−
203−Some conventions that we follow in the StreamD code are illustrated by the
204−following example:
205−
206−```
207−mapM f (Stream step1 state1) = Stream step state
208− where
209−
210− step gst st = do
211− r <- step1 (adaptState gst) st
212− case r of
213− Yield x s -> f x >>= \a -> return $ Yield a s
214− Skip s -> return $ Skip s
215− Stop -> return Stop
216−```
217−
218−* For the input streams use numbering for `step` and `state` e.g.
219− step1/state1. For the output stream use `step` and `state`.
220−* For state argument of `step`, use `st`.
221−* For result of executing a `step` use `r` or `res`
222−* For the yielded element use `x`
223−* For the yielded state use `s`
224−
225−In general, the rule is - the shorter the scope of a variable the shorter its
226−name can be. For example, `s` has the shortest scope in the above code, `st`
227−has a bigger scope and `state` has the biggest scope.
228−
229−## Design guides
230−
231−See [the design directory](design) for design guidelines and documents.
232−
233−### Tricky Parts
234−
235−The state-passing through each API is currently fragile. Every time we run a
236−stream we need to be careful about the state we are passing to it. In case of
237−folds where there is no incoming state, we start with the initial state
238−`defState`. When we have an incoming state passed to us there are two cases:
239−
240−1. When we are building a concurrent stream that needs to share the same `SVar`
241− we pass the incoming state as is.
242−2. In all other cases we must not share the SVar and every time we pass on the
243− state to run a stream we must use `adaptState` to reset the `SVar` in the
244− state.
245−
246−When in doubt just use `adaptState` on the state before passing it on, we will at
247−most lose concurrency but the behavior will be correct.
248−
249−There is no type level enforcement about this as of now, and therefore we need
250−to be careful when coding. There are specific tests to detect and report any
251−problems due to this, all transform operations must be added to those tests.
@@ -0,0 +1 @@
1+docs/Developer/Contributing.md
INSTALL.mddeleted−298
@@ -1,298 +0,0 @@
1−<!--
2−Portions (c) 2020, Google LLC.
3−SPDX-License-Identifer: BSD-3-Clause
4−-->
5−
6−# Getting started with the `streamly` package
7−
8−This guide will show you how to write a simple program that uses
9−`streamly`, using the [`cabal`](https://www.haskell.org/cabal/) build
10−manager for Haskell.
11−
12−<!-- TODO: Add instructions for `stack` and `nix`.
13−
14−If you are using `stack` or `nix` please make sure to add the latest
15−version from Hackage to your tool configuration. -->
16−
17−No prior knowledge of either Haskell or of `cabal` is needed. We do
18−however assume that you are using a command-line shell on a POSIX
19−operating system. If you are running Windows&trade; then you may need
20−to run a command-line shell under `msys` and some of the commands
21−below may also need to be changed in small ways to make them work.
22−
23−**Note**: If you are new to Haskell you may find the [Haskell Getting
24−Started
25−Guide](https://github.com/composewell/haskell-dev/blob/master/getting-started.rst)
26−to be useful.
27−
28−If you know your way around Haskell, and have an up to date toolchain
29−already installed, then you can jump straight to the section titled
30−"[_Prepare Your Build Directory_](#user-content-prepare-your-build-directory)".
31−
32−## Getting started with `streamly` using `cabal`
33−
34−To get started, you will need a recent `cabal` binary to be installed
35−on your system.
36−
37−### Installing `cabal`
38−
39−A pre-packaged `cabal` binary may already be available for your
40−operating system.
41−
42−For example, on Debian GNU/Linux, you could install `cabal` using::
43−
44−```
45−$ sudo apt install cabal-install
46−```
47−
48−### Installing `ghc`
49−
50−You would also need to install the Glasgow Haskell Compiler `ghc`. In
51−most operating systems, using the system's package manager to install
52−`cabal` would also bring in a version of `ghc` as a dependency.
53−
54−Please verify that `ghc` is present:
55−
56−```
57−$ ghc --version
58−The Glorious Glasgow Haskell Compilation System, version 8.0.2
59−```
60−
61−If `ghc` isn't present, please install it using your operating
62−system's package manager. For example, on Debian GNU/Linux, use:
63−
64−```
65−$ sudo apt install ghc
66−```
67−
68−### Update `cabal` if necessary
69−
70−Many operating systems ship an old version of `cabal`; in order to use
71−`streamly` you should use `cabal` version 3.0 (or later).
72−
73−You can check the installed version of `cabal` by using its
74−`--version` flag:
75−
76−```
77−$ which cabal
78−/usr/bin/cabal
79−$ /usr/bin/cabal --version
80−cabal-install version 1.24.0.2
81−compiled using version 1.24.2.0 of the Cabal library
82−```
83−
84−In this example, the installed `cabal` binary is too old for our
85−needs. It would need to be upgraded.
86−
87−You can ask `cabal` to upgrade itself (please see
88−<https://www.haskell.org/cabal/>):
89−
90−```
91−$ cabal install Cabal cabal-install
92−Resolving dependencies...
93−Downloading base16-bytestring-0.1.1.7...
94−... lots of build output ...
95−Building cabal-install-3.0.0.0...
96−Installed cabal-install-3.0.0.0
97−```
98−
99−`cabal` will usually place its compiled binaries inside the directory
100−`$HOME/.cabal/bin`.
101−
102−You can verify the version of your newly installed binary by using the
103−`--version` flag again:
104−
105−```
106−$ $HOME/.cabal/bin/cabal --version
107−cabal-install version 3.0.0.0
108−compiled using version 3.0.2.0 of the Cabal library
109−```
110−
111−If you have upgraded `cabal`, do be sure to specify `$HOME/.cabal/bin`
112−early in your `PATH` shell variable, so that the new binary gets used
113−instead of the older version on your system.
114−
115−```
116−$ PATH=$HOME/.cabal/bin:$PATH
117−```
118−
119−Once you have `cabal` version 3.0 (or later) successfully installed,
120−please refresh its package list by using `cabal update`.
121−
122−```
123−$ cabal update
124−Downloading the latest package list from hackage.haskell.org
125−```
126−
127−### Prepare Your Build Directory
128−
129−Next, create a build directory, so that you can use `cabal`'s isolated
130−builds feature.
131−
132−```
133−$ mkdir streamly-play
134−$ cd streamly-play
135−```
136−
137−Run `cabal init` to create an initial set of project files:
138−
139−```
140−$ cabal init --minimal --dependency base --dependency streamly
141−
142−Generating LICENSE...
143−... other messages ...
144−Generating Main.hs...
145−Generating streamly-play.cabal...
146−
147−Warning: no synopsis given. You should edit the .cabal file and add one.
148−You may want to edit the .cabal file and add a Description field.
149−```
150−
151−This invocation will set up a build with two build dependencies,
152−namely `base` and `streamly`. You can add additional dependencies
153−later, by editing the `build-depends` section of the generated cabal
154−file `streamly-play.cabal`. Please see the [Cabal User
155−Guide](https://www.haskell.org/cabal/users-guide/) for more
156−information on how to configure `cabal`.
157−
158−This invocation also creates a skeletal `Main.hs` program which we
159−will use later.
160−
161−### Try `streamly` in the GHCi REPL
162−
163−You can now try out `streamly` using the `GHCi` interpreter's
164−read-eval-print-loop (REPL) facility.
165−
166−To start up the GHCi REPL using the released `streamly` version on
167−Hackage, please use:
168−
169−```
170−$ cabal repl --build-depends streamly
171−... plenty of build messaages, the first time around ...
172−GHCi, version 8.8.3: https://www.haskell.org/ghc/ :? for help
173−[1 of 1] Compiling Main ( Main.hs, interpreted )
174−Ok, one module loaded.
175−*Main>
176−```
177−
178−Once at the `*Main>` prompt, you can import `streamly` and use it
179−directly:
180−
181−```
182−*Main> import qualified Streamly.Prelude as S
183−
184−*Main S> S.drain $ S.mapM print $ S.fromList [1..3]
185−1
186−2
187−3
188−*Main S>
189−```
190−
191−For the curious, here is a high level overview of what these lines
192−do:
193−
194−1. `import qualified Streamly.Prelude as S` imports the Streamly
195− prelude into GHCi, and makes it available as module `S`.
196−2. `[1..3]` generates the Haskell list `[1, 2, 3]`.
197−3. `S.fromList` transforms that list into a stream of integers.
198−4. `S.mapM print` transforms the stream of integers into a stream of
199− actions that would print those integers when executed.
200−5. `S.drain` transforms that stream of actions into an IO action that
201− `main` or GHCi's REPL can execute.
202−
203−These concepts are explained in greater detail in the [Streamly
204−Tutorial][tutorial].
205−
206−#### Using a specific version of `streamly` in the REPL
207−
208−You can also ask `cabal` to use a specific version of `streamly` by
209−adding a version number constraint to the `--build-depends` flag:
210−
211−```
212−$ cabal repl --build-depends streamly==0.7.2
213−[1 of 1] Compiling Main ( Main.hs, interpreted )
214−Ok, modules loaded: Main.
215−*Main>
216−```
217−
218−#### (Advanced) Using the development version of `streamly` in the REPL
219−
220−To use the development version of `streamly`, we need to configure
221−`cabal` to fetch it from Github.
222−
223−Create a `cabal.project` file in the current directory with the
224−following content:
225−
226−```
227−packages: .
228−source-repository-package
229− type: git
230− location: https://github.com/composewell/streamly
231− tag: master
232−```
233−
234−With this file present, `cabal` will fetch and build the current
235−version of `streamly` from Github every time it is run. For example:
236−
237−```
238−$ cabal repl
239−... fetches the 'master' branch of streamly from Github ...
240−... build messages ...
241−[1 of 1] Compiling Main v ( Main.hs, interpreted )
242−Ok, modules loaded: Main.
243−*Main>
244−```
245−
246−### Using `streamly` in a standalone program
247−
248−Let us now turn the single-line stanza above into a standalone program
249−that uses `streamly`.
250−
251−Edit `Main.hs` to contain the following:
252−
253−```haskell
254−module Main where
255−
256−import qualified Streamly.Prelude as S
257−
258−main :: IO ()
259−main = S.drain $ S.mapM print $ S.fromList [1..3]
260−```
261−
262−Build and run this program using `cabal run`:
263−
264−```
265−$ cabal run
266−... build messages ...
267−1
268−2
269−3
270−```
271−
272−## Which version of `streamly` should you use?
273−
274−If you are new to Streamly, we recommend using latest [stable release
275−of streamly][streamly-hackage] on Hackage.
276−
277−If you need access to cutting edge features (and do not mind the
278−occasional breakage), please use the [development version of
279−streamly][streamly-github] on Github.
280−
281−
282−## Next Steps
283−
284−If you got this far successfully, congratulations!
285−
286−* For an overview of the `streamly` package, please read the
287− [Streamly Tutorial][tutorial].
288−* Please browse the code examples in the
289− [`examples`](./examples/README.md) directory.
290−* If you would like to start on a real world project, please take a
291− look at the [recommended compilation options](./docs/Build.md).
292−
293−
294−<!-- Markdown Links -->
295−
296− [tutorial]: https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html
297− [streamly-hackage]: https://hackage.haskell.org/package/streamly
298− [streamly-github]: https://github.com/composewell/streamly
LICENSE+68
@@ -25,3 +25,71 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
25CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
25CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
26OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28+
29+-------------------------------------------------------------------------------
30+fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
31+-------------------------------------------------------------------------------
32+Copyright (c) 2012, Mark Dittmer
33+
34+All rights reserved.
35+
36+Redistribution and use in source and binary forms, with or without
37+modification, are permitted provided that the following conditions are met:
38+
39+ * Redistributions of source code must retain the above copyright
40+ notice, this list of conditions and the following disclaimer.
41+
42+ * Redistributions in binary form must reproduce the above
43+ copyright notice, this list of conditions and the following
44+ disclaimer in the documentation and/or other materials provided
45+ with the distribution.
46+
47+ * Neither the name of Mark Dittmer nor the names of other
48+ contributors may be used to endorse or promote products derived
49+ from this software without specific prior written permission.
50+
51+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
52+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
53+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
54+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
55+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
56+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
57+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
58+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
59+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
60+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
61+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
62+
63+-------------------------------------------------------------------------------
64+hfsevents-0.1.6 (http://hackage.haskell.org/package/hfsevents-0.1.6)
65+-------------------------------------------------------------------------------
66+Copyright (c) 2012, Luite Stegeman
67+
68+All rights reserved.
69+
70+Redistribution and use in source and binary forms, with or without
71+modification, are permitted provided that the following conditions are met:
72+
73+ * Redistributions of source code must retain the above copyright
74+ notice, this list of conditions and the following disclaimer.
75+
76+ * Redistributions in binary form must reproduce the above
77+ copyright notice, this list of conditions and the following
78+ disclaimer in the documentation and/or other materials provided
79+ with the distribution.
80+
81+ * Neither the name of Luite Stegeman nor the names of other
82+ contributors may be used to endorse or promote products derived
83+ from this software without specific prior written permission.
84+
85+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
86+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
87+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
88+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
89+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
90+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
91+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
92+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
93+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
94+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
95+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
MAINTAINING.mddeleted−256
@@ -1,256 +0,0 @@
1−# Maintainers' Guide
2−
3−## PR Merge Checklist
4−
5−* All the CI tests pass
6−* New tests are added where applicable
7−* Benchmarks are added where applicable
8−* Run benchmarks locally if you suspect any regressions
9−* Documentation is added for any new combinators
10− * New combinators have time and space complexity annotations
11− * New combinators have `since` annotation
12−* Changelog entry is added for exposed combinators.
13−* Identify breaking changes, or changes that may require depndency
14− version bound changes. See https://pvp.haskell.org/. Also see the
15− "Breaking changes section below".
16−* Optionally, look at hlint output if anything in that is worth fixing.
17−* Merge the PR by rebasing. Note that github always creates new commits when
18− merged with rebase, it records the committer as well as the author in the
19− commit. This makes the local branch diverge from master. You can rebase and
20− merge the commit manually in your local git tree and push the resulting
21− master branch to avoid new commits and divergence from the original tree.
22−
23−## Release Checklist
24−
25−* Check if any critical pending bugs or issues are to be included
26−* If this is a major release check if any previously deprecated features are to
27− be removed in this release.
28−* _Documentation_:
29−
30− * README is updated
31− * Haddock docs are consistent with the changes in the release
32− * Tutorial has been updated for new changes
33− * Documents in the `docs` directory are consistent with new changes
34− * All combinators have time and space complexity annotations
35− * All combinators have `since` annotation
36−
37−* _Benchmarks_:
38−
39− * Check regressions from previous release
40− * Run benchmarks with large stream size (`bench.sh -- long`) to
41− check for space leaks and to ensure constant memory usage for streaming
42− operations.
43− * Run benchmarks with `dev` flag on. Some `fileio` benchmarks are disabled
44− in regular runs.
45− * Check comparative benchmarks using streaming-benchmarks
46−
47−* _Tests_:
48−
49− * Run tests with `dev` flag on. Many tests are disabled in regular runs.
50−
51−* _Examples_:
52−
53− * Update
54− [streamly-examples][https://github.com/composewell/streamly-examples]
55− to make sure it runs with the latest release.
56−
57−* _Update Package Metadata:_
58−
59− * Update `stack.yaml` to latest stable resolver, cleanup extra-deps
60− * Make sure the description in cabal file is in sync with README and other docs
61− * Make sure CI configs include last three major releases of GHC in CI testing.
62− * Update `tested-with` field
63− * Make sure all dependency bounds can use latest versions
64− * Make sure any additional files are added to `extra-source-files` in cabal
65− file
66−
67−* Copyrights and Contibutors
68−
69− * Make sure contributors to the release are listed in
70− `credits/CONTRIBUTORS.md`.
71− * Bump the release version in `credits/CONTRIBUTORS.md`.
72− * Make sure any third party code included in the release has been listed in
73− `credits/COPYRIGHTS.md` and the license is added to the repo.
74− * Change the `Unreleased` section, if exists, at the top of
75− `credits/COPYRIGHTS.md` to the new release version number.
76−
77−* _Update changelog & Version_:
78−
79− * Make sure all the bug fixes being included in this release are marked
80− with a target release on github. So that users can search by release if
81− they want.
82− * Change the `Unreleased` section at the top of changelog file to the new
83− release version number.
84− * Bump the package version in cabal file or package.yaml
85− * Bump the package version in configure.ac and run autoreconf
86−
87−* _Upload_:
88−
89− * Wait for final CI tests to pass:
90−
91− * Create a git tag corresponding to the release where X.Y.Z is the new
92− package version (`git tag vX.Y.Z && git push -f origin vX.Y.Z`).
93− * Mask out the build status lines from the README
94− * Upload to hackage
95− * Use a clean workspace to create source distribution
96− by freshly cloning the git repository. The reason for
97− doing this is that we use wild-cards in cabal file for
98− `extra-source-files`, these wild-cards may match additional
99− files lying around in the workspace and unintentionally ship
100− them as well.
101− * `cabal v2-sdist`; `cabal upload --publish <tarpath>`
102− * `stack upload .`
103− * Add to stackage (`build-constraints.yaml` in Stackage repo) if needed
104− * Optionally upload `package-X.Y.Z-sdist.tar.gz` to github release page
105− * Update release contributors on github release page
106− (`git shortlog -s prev_tag..new_tag | sed $'s/^[0-9 \t]*/* /' | sort -f`)
107− * Update and if needed release streaming-benchmarks package
108− * Check https://matrix.hackage.haskell.org/package/streamly
109− * Check haddocks on Hackage, upload if not built
110− * Announce to haskell-cafe@haskell.org
111−
112−## Breaking Changes
113−
114−This section lists what constitutes breaking changes. See
115−https://pvp.haskell.org/ breaking changes that can be determined by the
116−API alone. We specify some additional recommendations here:
117−
118−Behavior changes, this kind of changes are nasty and should be avoided. If such
119−changes are made they should be emphasized adequately in the changelog:
120−
121−* Silent changes in the behavior of an API without any changes to the
122− signature.
123−* Even fixing a bug could break things as users may have employed workarounds
124− for the bug.
125−* Changes in the behavior of a dependency may also cause a change in behavior.
126−
127−Be cautious about the following:
128−
129−* Change in version bounds of dependencies may cause compilation failure for
130− some programs because they may not be able to find a build plan.
131−* Ideally, new warnings should not be considered breaking, dependencies
132− should never be compiled with -Werror. But packages may not be following
133− it perfectly.
134−* Deprecating an API may issue new warnings, however the code can still be
135− compiled if warnings are not treated as errors.
136−
137−Internal APIs:
138−
139−* Internal APIs can change without having to change the major version. However,
140− we should try to align the Internal API changes with a major release as long
141− as possible.
142−
143−## Managing Issues
144−
145−We label the issues in different dimensions based on the lifecyle and different
146−management aspects of the issue. The folowing sections discuss the labels used
147−to manage the issues. If a new label is required, it should be discussed before
148−creating it.
149−
150−### Disposition
151−
152−The level-1 triaging of the issue determines the current disposition
153−of the issue. If no change is required the issue must have one of the
154−following labels:
155−
156−* invalid
157−* question
158−* discussion
159−* duplicate
160−* wontfix
161−
162−If a change is required we need to do level-2 triage of the issue, see the
163−sections below.
164−
165−### Change type
166−
167−When a change is required we need to put one of the __change type__
168−labels as part of level-2 triaging:
169−
170−* performance: User visible impact on performance.
171−* usability: It is not convenient to use the library.
172−* documentation: documentation is not correct or sufficient.
173−* bug: A functionality issue, not working as expected.
174−* enhancement: A new feature or enhancement of the product.
175−* maintenance: A refactor or any other change with no user visible impact.
176−
177−### Aspect
178−
179−In addition we can put a __product aspect__ label describing a feature name or
180−any other product specific classification bucket.
181−
182−* aspect:<aspect name>
183−
184−### Severity
185−
186−Optionally we can add a severity label to indicate how severe is the
187−impact of the bug/issue, which may determine how important it is to fix it. By
188−default the severity is normal, if it is high we put a label:
189−
190−* severity:high
191−
192−### Change impact
193−
194−For a user visible issue whether it has a release/changelog impact:
195−
196−* enhancement: includes a new feature or enhancement
197−* breaking: has a breaking impact on existing deployments
198−* deprecating: deprecates an existing functionality
199−
200−__RULE__: Any commit that may affect the end user in some way MUST have
201−either a changelog entry OR MUST have an issue marked with one of the
202−above labels OR both.
203−
204−### Priority
205−
206−By default the issues are normal priority. We use a label for high priority
207−issues:
208−
209−* priority:high
210−
211−### Scheduling
212−
213−If the issue is assigned to someone then it is considered scheduled. Otherwise
214−it is unscheduled. Unassigned issues may have the following labels:
215−
216−* deferred: blocked on any other fix or a decision to be made, or deliberately
217− deferred for some reason.
218−* help-wanted: anyone can take the issue and contribute
219−
220−## Correlating Changes, Issues and Releases
221−
222−For planning purposes, open issues may be marked with milestones or target
223−releases. However, it may not always be known which release a fix will finally
224−land in. For example, we may decide to make a minor release instead of a major
225−one if there are no breaking changes yet, so we may not always know what would
226−be the next release version.
227−
228−Trackability means that we should be able to find which issues got fixed in
229−which release. Or what all issues got fixed in a particular release. We track
230−significant changes using the changelog. However, there may be more changes
231−that can only be tracked via issues, PRs or commits. When we make a release we
232−can mark all the issues fixed in that release with a correct release target for
233−future trackability.
234−
235−For better trackability of which issue got fixed in which release we need the
236−following:
237−
238−* Before you close an issue make sure a commit or a PR fixing the issue is
239− attached with it. In the commit message you can reference an issue like
240− "fixes #50", you can do the same in a PR as well.
241−* Before we make a new release EVERY issue with a commit included in that
242− release that affects the end user, especially bugs and breaking changes MUST
243− have the target release correctly set.
244−
245−## Changelog Management
246−
247−Keep the unreleased changes in the `Unreleased` section at the top of changelog
248−file. Using `Unreleased` instead of the next release number for unreleased
249−changes is important. First, we do not know the next release number in advance,
250−it could be a major or minor release. Second, if we use the next release
251−number instead, then when adding a new change to the changelog, at one look we
252−cannot know whether the release number on top is unreleased or released.
253−
254−## TODO
255−
256−* GPG signed releases and tags
README.mdmode 100644 → 120000+1−606
@@ -1,606 +0,0 @@
1−# Streamly
2−
3−[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)
4−[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)
5−[![Travis](https://travis-ci.com/composewell/streamly.svg?branch=master)](https://travis-ci.com/composewell/streamly)
6−[![Appveyor](https://ci.appveyor.com/api/projects/status/ajxg0c79raou9ned?svg=true)](https://ci.appveyor.com/project/harendra-kumar/streamly)
7−[![CircleCI](https://circleci.com/gh/composewell/streamly/tree/master.svg?style=svg)](https://circleci.com/gh/composewell/streamly/tree/master)
8−[![Coverage Status](https://coveralls.io/repos/composewell/streamly/badge.svg?branch=master&service=github)](https://coveralls.io/github/composewell/streamly?branch=master)
9−
10−## Learning Materials
11−
12−* Documentation: [Quick](#streaming-concurrently) | [Tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html) | [Reference (Hackage)](https://hackage.haskell.org/package/streamly) | [Reference (Latest)](https://composewell.github.io/streamly) | [Guides](docs)
13−* Installing: [Installing](./INSTALL.md) | [Building for optimal performance](docs/Build.md)
14−* Examples: [streamly](examples) | [streamly-examples](https://github.com/composewell/streamly-examples)
15−* Benchmarks: [Streaming](https://github.com/composewell/streaming-benchmarks) | [Concurrency](https://github.com/composewell/concurrency-benchmarks)
16−* Talks: [Functional Conf 2019 Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Functional Conf 2019 Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)
17−
18−## Streaming Concurrently
19−
20−Haskell lists express pure computations using composable stream operations like
21−`:`, `unfold`, `map`, `filter`, `zip` and `fold`. Streamly is exactly like
22−lists except that it can express sequences of pure as well as monadic
23−computations aka streams. More importantly, it can express monadic sequences
24−with concurrent execution semantics without introducing any additional APIs.
25−
26−Streamly expresses concurrency using standard, well known abstractions.
27−Concurrency semantics are defined for list operations, semigroup, applicative
28−and monadic compositions. Programmer does not need to know any low level
29−notions of concurrency like threads, locking or synchronization. Concurrent
30−and non-concurrent programs are fundamentally the same. A chosen segment of
31−the program can be made concurrent by annotating it with an appropriate
32−combinator. We can choose a combinator for lookahead style or asynchronous
33−concurrency. Concurrency is automatically scaled up or down based on the
34−demand from the consumer application, we can finally say goodbye to managing
35−thread pools and associated sizing issues. The result is truly fearless
36−and declarative monadic concurrency.
37−
38−## Where to use streamly?
39−
40−Streamly is a general purpose programming framework. It can be used equally
41−efficiently from a simple `Hello World!` program to a massively concurrent
42−application. The answer to the question, "where to use streamly?" - would be
43−similar to the answer to - "Where to use Haskell lists or the IO monad?".
44−
45−Streamly simplifies streaming and makes it as intuitive as plain lists. Unlike
46−other streaming libraries, no fancy types are required. Streamly is simply a
47−generalization of Haskell lists to monadic streaming optionally with concurrent
48−composition. The basic stream type in streamly `SerialT m a` can be considered
49−as a list type `[a]` parameterized by the monad `m`. For example, `SerialT IO
50−a` is a moral equivalent of `[a]` in the IO monad. `SerialT Identity a`, is
51−equivalent to pure lists. Streams are constructed very much like lists, except
52−that they use `nil` and `cons` instead of `[]` and `:`. Unlike lists, streams
53−can be constructed from monadic effects, not just pure elements. Streams are
54−processed just like lists, with list like combinators, except that they are
55−monadic and work in a streaming fashion. In other words streamly just completes
56−what lists lack, you do not need to learn anything new. Please see [streamly vs
57−lists](docs/streamly-vs-lists.md) for a detailed comparison.
58−
59−Not surprisingly, the monad instance of streamly is a list transformer, with
60−concurrency capability.
61−
62−## Why data flow programming?
63−
64−If you need some convincing for using streaming or data flow programming
65−paradigm itself then try to answer this question - why do we use lists in
66−Haskell? It boils down to why we use functional programming in the first place.
67−Haskell is successful in enforcing the functional data flow paradigm for pure
68−computations using lists, but not for monadic computations. In the absence of a
69−standard and easy to use data flow programming paradigm for monadic
70−computations, and the IO monad providing an escape hatch to an imperative
71−model, we just love to fall into the imperative trap, and start asking the same
72−fundamental question again - why do we have to use the streaming data model?
73−
74−## Comparative Performance
75−
76−High performance and simplicity are the two primary goals of streamly.
77−`Streamly` employs two different stream representations (CPS and direct style)
78−and interconverts between the two to get the best of both worlds on different
79−operations. It uses both foldr/build (for CPS style) and stream fusion (for
80−direct style) techniques to fuse operations. In terms of performance,
81−Streamly's goal is to compete with equivalent C programs. Streamly redefines
82−"blazing fast" for streaming libraries, it competes with lists and `vector`.
83−Other streaming libraries like "streaming", "pipes" and "conduit" are orders of
84−magnitude slower on most microbenchmarks. See [streaming
85−benchmarks](https://github.com/composewell/streaming-benchmarks) for detailed
86−comparison.
87−
88−The following chart shows a comparison of those streamly and list operations
89−where performance of the two differs by more than 10%. Positive y-axis displays
90−how many times worse is a list operation compared to the same streamly
91−operation, negative y-axis shows where streamly is worse compared to lists.
92−
93−![Streamly vs Lists (time) comparison](charts-0/streamly-vs-list-time.svg)
94−
95−Streamly uses lock-free synchronization for concurrent operations. It employs
96−auto-scaling of the degree of concurrency based on demand. For CPU bound tasks
97−it tries to keep the threads close to the number of CPUs available whereas for
98−IO bound tasks more threads can be utilized. Parallelism can be utilized with
99−little overhead even if the task size is very small. See [concurrency
100−benchmarks](https://github.com/composewell/concurrency-benchmarks) for detailed
101−performance results and a comparison with the `async` package.
102−
103−## Installing and using
104−
105−Please see [INSTALL.md](./INSTALL.md) for instructions on how to use streamly
106−with your Haskell build tool or package manager. You may want to go through it
107−before jumping to run the examples below.
108−
109−The module `Streamly.Prelude` provides the core stream types and combinators
110−for type casting, controlling concurrency, stream construction, transformation,
111−folding, merging, and zipping.
112−
113−## Streaming Pipelines
114−
115−The following snippet provides a simple stream composition example that reads
116−numbers from stdin, prints the squares of even numbers and exits if an even
117−number more than 9 is entered.
118−
119−``` haskell
120−import qualified Streamly.Prelude as S
121−import Data.Function ((&))
122−
123−main = S.drain $
124− S.repeatM getLine
125− & fmap read
126− & S.filter even
127− & S.takeWhile (<= 9)
128− & fmap (\x -> x * x)
129− & S.mapM print
130−```
131−
132−Unlike `pipes` or `conduit` and like `vector` and `streaming`, `streamly`
133−composes stream data instead of stream processors (functions). A stream is
134−just like a list and is explicitly passed around to functions that process the
135−stream. Therefore, no special operator is needed to join stages in a streaming
136−pipeline, just the standard function application (`$`) or reverse function
137−application (`&`) operator is enough.
138−
139−## Concurrent Stream Generation
140−
141−`consM` or its operator form `|:` can be used to construct a stream from
142−monadic actions. A stream constructed with `consM` can run the monadic actions
143−in the stream concurrently when used with appropriate stream type combinator
144−(e.g. `asyncly`, `aheadly` or `parallely`).
145−
146−The following code finishes in 3 seconds (6 seconds when serial), note the
147−order of elements in the resulting output, the outputs are consumed as soon as
148−each action is finished (asyncly):
149−
150−``` haskell
151−> let p n = threadDelay (n * 1000000) >> return n
152−> S.toList $ S.asyncly $ p 3 |: p 2 |: p 1 |: S.nil
153−[1,2,3]
154−```
155−
156−Use `aheadly` if you want speculative concurrency i.e. execute the actions in
157−the stream concurrently but consume the results in the specified order:
158−
159−``` haskell
160−> S.toList $ S.aheadly $ p 3 |: p 2 |: p 1 |: S.nil
161−[3,2,1]
162−```
163−
164−Monadic stream generation functions e.g. `unfoldrM`, `replicateM`, `repeatM`,
165−`iterateM` and `fromFoldableM` etc. can work concurrently.
166−
167−The following finishes in 10 seconds (100 seconds when serial):
168−
169−``` haskell
170−S.drain $ S.asyncly $ S.replicateM 10 $ p 10
171−```
172−
173−## Concurrency Auto Scaling
174−
175−Concurrency is auto-scaled i.e. more actions are executed concurrently if the
176−consumer is consuming the stream at a higher speed. How many tasks are executed
177−concurrently can be controlled by `maxThreads` and how many results are
178−buffered ahead of consumption can be controlled by `maxBuffer`. See the
179−documentation in the `Streamly.Prelude` module.
180−
181−## Concurrent Streaming Pipelines
182−
183−Use `|&` or `|$` to apply stream processing functions concurrently. The
184−following example prints a "hello" every second; if you use `&` instead of
185−`|&` you will see that the delay doubles to 2 seconds instead because of serial
186−application.
187−
188−``` haskell
189−main = S.drain $
190− S.repeatM (threadDelay 1000000 >> return "hello")
191− |& S.mapM (\x -> threadDelay 1000000 >> putStrLn x)
192−```
193−
194−## Mapping Concurrently
195−
196−We can use `mapM` or `sequence` functions concurrently on a stream.
197−
198−``` haskell
199−> let p n = threadDelay (n * 1000000) >> return n
200−> S.drain $ S.aheadly $ S.mapM (\x -> p 1 >> print x) (S.serially $ S.repeatM (p 1))
201−```
202−
203−## Serial and Concurrent Merging
204−
205−Semigroup and Monoid instances can be used to fold streams serially or
206−concurrently. In the following example we compose ten actions in the
207−stream, each with a delay of 1 to 10 seconds, respectively. Since all the
208−actions are concurrent we see one output printed every second:
209−
210−``` haskell
211−import qualified Streamly.Prelude as S
212−import Control.Concurrent (threadDelay)
213−
214−main = S.toList $ S.parallely $ foldMap delay [1..10]
215− where delay n = S.yieldM $ threadDelay (n * 1000000) >> print n
216−```
217−
218−Streams can be combined together in many ways. We provide some examples
219−below, see the tutorial for more ways. We use the following `delay`
220−function in the examples to demonstrate the concurrency aspects:
221−
222−``` haskell
223−import qualified Streamly.Prelude as S
224−import Control.Concurrent
225−
226−delay n = S.yieldM $ do
227− threadDelay (n * 1000000)
228− tid <- myThreadId
229− putStrLn (show tid ++ ": Delay " ++ show n)
230−```
231−### Serial
232−
233−``` haskell
234−main = S.drain $ delay 3 <> delay 2 <> delay 1
235−```
236−```
237−ThreadId 36: Delay 3
238−ThreadId 36: Delay 2
239−ThreadId 36: Delay 1
240−```
241−
242−### Parallel
243−
244−``` haskell
245−main = S.drain . S.parallely $ delay 3 <> delay 2 <> delay 1
246−```
247−```
248−ThreadId 42: Delay 1
249−ThreadId 41: Delay 2
250−ThreadId 40: Delay 3
251−```
252−
253−## Nested Loops (aka List Transformer)
254−
255−The monad instance composes like a list monad.
256−
257−``` haskell
258−import qualified Streamly.Prelude as S
259−
260−loops = do
261− x <- S.fromFoldable [1,2]
262− y <- S.fromFoldable [3,4]
263− S.yieldM $ putStrLn $ show (x, y)
264−
265−main = S.drain loops
266−```
267−```
268−(1,3)
269−(1,4)
270−(2,3)
271−(2,4)
272−```
273−
274−## Concurrent Nested Loops
275−
276−To run the above code with speculative concurrency i.e. each iteration in the
277−loop can run concurrently but the results are presented to the consumer of the
278−output in the same order as serial execution:
279−
280−``` haskell
281−main = S.drain $ S.aheadly $ loops
282−```
283−
284−Different stream types execute the loop iterations in different ways. For
285−example, `wSerially` interleaves the loop iterations. There are several
286−concurrent stream styles to execute the loop iterations concurrently in
287−different ways, see the `Streamly.Tutorial` module for a detailed treatment.
288−
289−## Magical Concurrency
290−
291−Streams can perform semigroup (<>) and monadic bind (>>=) operations
292−concurrently using combinators like `asyncly`, `parallelly`. For example,
293−to concurrently generate squares of a stream of numbers and then concurrently
294−sum the square roots of all combinations of two streams:
295−
296−``` haskell
297−import qualified Streamly.Prelude as S
298−
299−main = do
300− s <- S.sum $ S.asyncly $ do
301− -- Each square is performed concurrently, (<>) is concurrent
302− x2 <- foldMap (\x -> return $ x * x) [1..100]
303− y2 <- foldMap (\y -> return $ y * y) [1..100]
304− -- Each addition is performed concurrently, monadic bind is concurrent
305− return $ sqrt (x2 + y2)
306− print s
307−```
308−
309−The concurrency facilities provided by streamly can be compared with
310−[OpenMP](https://en.wikipedia.org/wiki/OpenMP) and
311−[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative
312−expression.
313−
314−## Example: Listing Directories Recursively/Concurrently
315−
316−The following code snippet lists a directory tree recursively, reading multiple
317−directories concurrently:
318−
319−```haskell
320−import Control.Monad.IO.Class (liftIO)
321−import Path.IO (listDir, getCurrentDir) -- from path-io package
322−import Streamly.Prelude (AsyncT, adapt)
323−import qualified Streamly.Prelude as S
324−
325−listDirRecursive :: AsyncT IO ()
326−listDirRecursive = getCurrentDir >>= readdir >>= liftIO . mapM_ putStrLn
327− where
328− readdir dir = do
329− (dirs, files) <- listDir dir
330− S.yield (map show dirs ++ map show files) <> foldMap readdir dirs
331−
332−main :: IO ()
333−main = S.drain $ adapt $ listDirRecursive
334−```
335−
336−`AsyncT` is a stream monad transformer. If you are familiar with a list
337−transformer, it is nothing but `ListT` with concurrency semantics. For example,
338−the semigroup operation `<>` is concurrent. This makes `foldMap` concurrent
339−too. You can replace `AsyncT` with `SerialT` and the above code will become
340−serial, exactly equivalent to a `ListT`.
341−
342−## Rate Limiting
343−
344−For bounded concurrent streams, stream yield rate can be specified. For
345−example, to print hello once every second you can simply write this:
346−
347−``` haskell
348−import Streamly.Prelude as S
349−
350−main = S.drain $ S.asyncly $ S.avgRate 1 $ S.repeatM $ putStrLn "hello"
351−```
352−
353−For some practical uses of rate control, see
354−[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)
355−and
356−[CirclingSquare.hs](https://github.com/composewell/streamly/tree/master/examples/CirclingSquare.hs)
357−.
358−Concurrency of the stream is automatically controlled to match the specified
359−rate. Rate control works precisely even at throughputs as high as millions of
360−yields per second. For more sophisticated rate control see the haddock
361−documentation.
362−
363−## Arrays
364−
365−The `Streamly.Data.Array.Foreign` module provides immutable arrays. Arrays are the
366−computing duals of streams. Streams are good at sequential access and immutable
367−transformations of in-transit data whereas arrays are good at random access and
368−in-place transformations of buffered data. Unlike streams which are potentially
369−infinite, arrays are necessarily finite. Arrays can be used as an efficient
370−interface between streams and external storage systems like memory, files and
371−network. Streams and arrays complete each other to provide a general purpose
372−computing system. The design of streamly as a general purpose computing
373−framework is centered around these two fundamental aspects of computing and
374−storage.
375−
376−`Streamly.Data.Array.Foreign` uses pinned memory outside GC and therefore avoid any
377−GC overhead for the storage in arrays. Streamly allows efficient
378−transformations over arrays using streams. It uses arrays to transfer data to
379−and from the operating system and to store data in memory.
380−
381−## Folds
382−
383−Folds are consumers of streams. `Streamly.Data.Fold` module provides a `Fold`
384−type that represents a `foldl'`. Such folds can be efficiently composed
385−allowing the compiler to perform stream fusion and therefore implement high
386−performance combinators for consuming streams. A stream can be distributed to
387−multiple folds, or it can be partitioned across multiple folds, or
388−demultiplexed over multiple folds, or unzipped to two folds. We can also use
389−folds to fold segments of stream generating a stream of the folded results.
390−
391−If you are familiar with the `foldl` library, these are the same composable
392−left folds but simpler and better integrated with streamly, and with many more
393−powerful ways of composing and applying them.
394−
395−## Unfolds
396−
397−Unfolds are duals of folds. Folds help us compose consumers of streams
398−efficiently and unfolds help us compose producers of streams efficiently.
399−`Streamly.Data.Unfold` provides an `Unfold` type that represents an `unfoldr`
400−or a stream generator. Such generators can be combined together efficiently
401−allowing the compiler to perform stream fusion and implement high performance
402−stream merging combinators.
403−
404−## File IO
405−
406−The following code snippets implement some common Unix command line utilities
407−using streamly. You can compile these with `ghc -O2 -fspec-constr-recursive=16
408−-fmax-worker-args=16` and compare the performance with regular GNU coreutils
409−available on your system. Though many of these are not most optimal solutions
410−to keep them short and elegant. Source file
411−[HandleIO.hs](https://github.com/composewell/streamly/tree/master/examples/HandleIO.hs)
412−in the examples directory includes these examples.
413−
414−``` haskell
415−module Main where
416−
417−import qualified Streamly.Prelude as S
418−import qualified Streamly.Data.Fold as FL
419−import qualified Streamly.Data.Array.Foreign as A
420−import qualified Streamly.FileSystem.Handle as FH
421−import qualified System.IO as FH
422−
423−import Data.Char (ord)
424−import System.Environment (getArgs)
425−import System.IO (openFile, IOMode(..), stdout)
426−
427−withArg f = do
428− (name : _) <- getArgs
429− src <- openFile name ReadMode
430− f src
431−
432−withArg2 f = do
433− (sname : dname : _) <- getArgs
434− src <- openFile sname ReadMode
435− dst <- openFile dname WriteMode
436− f src dst
437−```
438−
439−### cat
440−
441−``` haskell
442−cat = S.fold (FH.writeChunks stdout) . S.unfold FH.readChunks
443−main = withArg cat
444−```
445−
446−### cp
447−
448−``` haskell
449−cp src dst = S.fold (FH.writeChunks dst) $ S.unfold FH.readChunks src
450−main = withArg2 cp
451−```
452−
453−### wc -l
454−
455−``` haskell
456−wcl = S.length . S.splitOn (== 10) FL.drain . S.unfold FH.read
457−main = withArg wcl >>= print
458−```
459−
460−### Average Line Length
461−
462−``` haskell
463−avgll =
464− S.fold avg
465− . S.splitOn (== 10) FL.length
466− . S.unfold FH.read
467−
468− where avg = (/) <$> toDouble FL.sum <*> toDouble FL.length
469− toDouble = fmap (fromIntegral :: Int -> Double)
470−
471−main = withArg avgll >>= print
472−```
473−
474−### Line Length Histogram
475−
476−`classify` is not released yet, and is available in
477−`Streamly.Internal.Data.Fold`
478−
479−``` haskell
480−llhisto =
481− S.fold (FL.classify FL.length)
482− . S.map bucket
483− . S.splitOn (== 10) FL.length
484− . S.unfold FH.read
485−
486− where
487− bucket n = let i = n `mod` 10 in if i > 9 then (9,n) else (i,n)
488−
489−main = withArg llhisto >>= print
490−```
491−
492−## Socket IO
493−
494−Its easy to build concurrent client and server programs using streamly.
495−`Streamly.Network.*` modules provide easy combinators to build network servers
496−and client programs using streamly. See
497−[FromFileClient.hs](https://github.com/composewell/streamly/tree/master/examples/FromFileClient.hs),
498−[EchoServer.hs](https://github.com/composewell/streamly/tree/master/examples/EchoServer.hs),
499−[FileSinkServer.hs](https://github.com/composewell/streamly/tree/master/examples/FileSinkServer.hs)
500−in the examples directory.
501−
502−## Exceptions
503−
504−Exceptions can be thrown at any point using the `MonadThrow` instance. Standard
505−exception handling combinators like `bracket`, `finally`, `handle`,
506−`onException` are provided in `Streamly.Prelude` module.
507−
508−In presence of concurrency, synchronous exceptions work just the way they are
509−supposed to work in non-concurrent code. When concurrent streams
510−are combined together, exceptions from the constituent streams are propagated
511−to the consumer stream. When an exception occurs in any of the constituent
512−streams other concurrent streams are promptly terminated.
513−
514−There is no notion of explicit threads in streamly, therefore, no
515−asynchronous exceptions to deal with. You can just ignore the zillions of
516−blogs, talks, caveats about async exceptions. Async exceptions just don't
517−exist. Please don't use things like `myThreadId` and `throwTo` just for fun!
518−
519−## Reactive Programming (FRP)
520−
521−Streamly is a foundation for first class reactive programming as well by virtue
522−of integrating concurrency and streaming. See
523−[AcidRain.hs](https://github.com/composewell/streamly/tree/master/examples/AcidRain.hs)
524−for a console based FRP game example and
525−[CirclingSquare.hs](https://github.com/composewell/streamly/tree/master/examples/CirclingSquare.hs)
526−for an SDL based animation example.
527−
528−## Conclusion
529−
530−Streamly, short for streaming concurrently, provides monadic streams, with a
531−simple API, almost identical to standard lists, and an in-built
532−support for concurrency. By using stream-style combinators on stream
533−composition, streams can be generated, merged, chained, mapped, zipped, and
534−consumed concurrently – providing a generalized high level programming
535−framework unifying streaming and concurrency. Controlled concurrency allows
536−even infinite streams to be evaluated concurrently. Concurrency is auto scaled
537−based on feedback from the stream consumer. The programmer does not have to be
538−aware of threads, locking or synchronization to write scalable concurrent
539−programs.
540−
541−Streamly is a programmer first library, designed to be useful and friendly to
542−programmers for solving practical problems in a simple and concise manner. Some
543−key points in favor of streamly are:
544−
545− * _Simplicity_: Simple list like streaming API, if you know how to use lists
546− then you know how to use streamly. This library is built with simplicity
547− and ease of use as a design goal.
548− * _Concurrency_: Simple, powerful, and scalable concurrency. Concurrency is
549− built-in, and not intrusive, concurrent programs are written exactly the
550− same way as non-concurrent ones.
551− * _Generality_: Unifies functionality provided by several disparate packages
552− (streaming, concurrency, list transformer, logic programming, reactive
553− programming) in a concise API.
554− * _Performance_: Streamly is designed for high performance. It employs stream
555− fusion optimizations for best possible performance. Serial peformance is
556− equivalent to the venerable `vector` library in most cases and even better
557− in some cases. Concurrent performance is unbeatable. See
558− [streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)
559− for a comparison of popular streaming libraries on micro-benchmarks.
560−
561−The basic streaming functionality of streamly is equivalent to that provided by
562−streaming libraries like
563−[vector](https://hackage.haskell.org/package/vector),
564−[streaming](https://hackage.haskell.org/package/streaming),
565−[pipes](https://hackage.haskell.org/package/pipes), and
566−[conduit](https://hackage.haskell.org/package/conduit).
567−In addition to providing streaming functionality, streamly subsumes
568−the functionality of list transformer libraries like `pipes` or
569−[list-t](https://hackage.haskell.org/package/list-t), and also the logic
570−programming library [logict](https://hackage.haskell.org/package/logict). On
571−the concurrency side, it subsumes the functionality of the
572−[async](https://hackage.haskell.org/package/async) package, and provides even
573−higher level concurrent composition. Because it supports
574−streaming with concurrency we can write FRP applications similar in concept to
575−[Yampa](https://hackage.haskell.org/package/Yampa) or
576−[reflex](https://hackage.haskell.org/package/reflex).
577−
578−See the `Comparison with existing packages` section at the end of the
579−[tutorial](https://hackage.haskell.org/package/streamly/docs/Streamly-Tutorial.html).
580−
581−## Support
582−
583−Please feel free to ask questions on the
584−[streamly gitter channel](https://gitter.im/composewell/streamly).
585−If you require professional support, consulting, training or timely
586−enhancements to the library please contact
587−[support@composewell.com](mailto:support@composewell.com).
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− * Gabriel Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))
596− * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient))
597−
598−See the `credits` directory for full list of contributors, credits and licenses.
599−
600−## Contributing
601−
602−The code is available under BSD-3 license
603−[on github](https://github.com/composewell/streamly). Join the [gitter
604−chat](https://gitter.im/composewell/streamly) channel for discussions. Please
605−ask any questions on the gitter channel or [contact the maintainer
606−directly](mailto:streamly@composewell.com). All contributions are welcome!
@@ -0,0 +1 @@
1+docs/User/Project/README.md
Setup.hs+2−2
@@ -1,6 +1,6 @@
1module Main (main) where
1module Main (main) where
2
2
3−import Distribution.Extra.Doctest (defaultMainAutoconfWithDoctests)
3+import Distribution.Simple
4
4
5main :: IO ()
5main :: IO ()
6−main = defaultMainAutoconfWithDoctests "doctests"
6+main = defaultMainWithHooks autoconfUserHooks
appveyor.yml+7−6
@@ -14,6 +14,8 @@ environment:
14 # ------------------------------------------------------------------------
14 # ------------------------------------------------------------------------
15 # Common options
15 # Common options
16 # ------------------------------------------------------------------------
16 # ------------------------------------------------------------------------
17+ # GHC 9.2.7 onwards redundant constraint warnings are incompatible with
18+ # older versions
17 GHC_OPTIONS: "-Werror"
19 GHC_OPTIONS: "-Werror"
18 CABAL_REINIT_CONFIG: "y"
20 CABAL_REINIT_CONFIG: "y"
19 LC_ALL: "C.UTF-8"
21 LC_ALL: "C.UTF-8"
@@ -34,18 +36,17 @@ environment:
34 # Note requiring a specific version of stack using STACKVER may fail due to
36 # Note requiring a specific version of stack using STACKVER may fail due to
35 # github API limit while checking and upgrading/downgrading to the specific
37 # github API limit while checking and upgrading/downgrading to the specific
36 # version.
38 # version.
37− #STACKVER: "1.6.5"
39+ # STACKVER: "1.6.5"
38 STACK_UPGRADE: "y"
40 STACK_UPGRADE: "y"
39− RESOLVER: "lts-16.12"
41+ # RESOLVER: "lts-18.27"
40 STACK_ROOT: "c:\\sr"
42 STACK_ROOT: "c:\\sr"
41 STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
43 STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
44+ STACK_YAML: "stack.yaml"
42
45
43 # ------------------------------------------------------------------------
46 # ------------------------------------------------------------------------
44 # cabal options
47 # cabal options
45 # ------------------------------------------------------------------------
48 # ------------------------------------------------------------------------
46 CABAL_CHECK_RELAX: "y"
49 CABAL_CHECK_RELAX: "y"
47− CABAL_NO_SANDBOX: "y"
48− CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
49
50
50 # ------------------------------------------------------------------------
51 # ------------------------------------------------------------------------
51 # Where to find the required tools
52 # Where to find the required tools
@@ -63,8 +64,8 @@ environment:
63 PACKCHECK_LOCAL_PATH: "./packcheck.sh"
64 PACKCHECK_LOCAL_PATH: "./packcheck.sh"
64 # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH
65 # If you have not committed packcheck.sh in your repo at PACKCHECK_LOCAL_PATH
65 # then it is automatically pulled from this URL.
66 # then it is automatically pulled from this URL.
66− PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/harendra-kumar/packcheck"
67+ PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
67− PACKCHECK_GITHUB_COMMIT: "563702bd02c41343dcd3dfcfef0845ca428a9240"
68+ PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
68
69
69 # Override the temp directory to avoid sed escaping issues
70 # Override the temp directory to avoid sed escaping issues
70 # See https://github.com/haskell/cabal/issues/5386
71 # See https://github.com/haskell/cabal/issues/5386
benchmark/Chart.hsdeleted−194
@@ -1,194 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−module Main where
5−
6−import Control.Exception (catch, ErrorCall(..))
7−import Control.Monad.Trans.State
8−import Control.Monad.Trans.Maybe
9−import Data.Char (toLower)
10−import Data.List
11−import System.Environment (getArgs)
12−import Control.Monad.IO.Class (liftIO)
13−import Control.Monad (mzero)
14−
15−import BenchShow
16−
17−------------------------------------------------------------------------------
18−-- Command line parsing
19−------------------------------------------------------------------------------
20−
21−data BenchType
22− = Compare String
23− | Standard String
24− deriving Show
25−
26−data Options = Options
27− { genGraphs :: Bool
28− , benchType :: Maybe BenchType
29− , fields :: [String]
30− } deriving Show
31−
32−defaultOptions :: Options
33−defaultOptions = Options False Nothing ["time"]
34−
35−setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
36−setGenGraphs val = do
37− (args, opts) <- get
38− put (args, opts { genGraphs = val })
39−
40−setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
41−setBenchType val = do
42− (args, opts) <- get
43− put (args, opts { benchType = Just val })
44−
45−setFields :: Monad m => [String] -> StateT (a, Options) m ()
46−setFields val = do
47− (args, opts) <- get
48− put (args, opts { fields = val })
49−
50−-- Like the shell "shift" to shift the command line arguments
51−shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
52−shift = do
53− s <- get
54− case s of
55− ([], _) -> return Nothing
56− (x : xs, opts) -> put (xs, opts) >> return (Just x)
57−
58−parseBench :: StateT ([String], Options) (MaybeT IO) ()
59−parseBench = do
60− x <- shift
61− case x of
62− Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
63− Just str -> setBenchType (Standard str)
64− Nothing -> do
65− liftIO $ putStrLn "please provide a benchmark type "
66− mzero
67−
68−parseFields :: StateT ([String], Options) (MaybeT IO) ()
69−parseFields = do
70− x <- shift
71− case x of
72− Just str -> setFields (words str)
73− Nothing -> do
74− liftIO $ putStrLn
75− "please provide a list of fields after --fields"
76− mzero
77−
78−-- totally imperative style option parsing
79−parseOptions :: IO (Maybe Options)
80−parseOptions = do
81− args <- getArgs
82− runMaybeT $ flip evalStateT (args, defaultOptions) $ do
83− parseLoop
84− fmap snd get
85−
86− where
87−
88− parseOpt opt =
89− case opt of
90− "--graphs" -> setGenGraphs True
91− "--benchmark" -> parseBench
92− "--fields" -> parseFields
93− str -> do
94− liftIO $ putStrLn $ "Unrecognized option " <> str
95− mzero
96−
97− parseLoop = do
98− next <- shift
99− case next of
100− Just opt -> parseOpt opt >> parseLoop
101− Nothing -> return ()
102−
103−ignoringErr :: IO () -> IO ()
104−ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
105− putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
106−
107−------------------------------------------------------------------------------
108−-- Generic
109−------------------------------------------------------------------------------
110−
111−makeGraphs :: String -> Config -> String -> IO ()
112−makeGraphs name cfg@Config{..} inputFile =
113− ignoringErr $ graph inputFile name cfg
114−
115−------------------------------------------------------------------------------
116−-- Arrays
117−------------------------------------------------------------------------------
118−
119−showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
120−showComparisons Options{..} cfg inp out =
121− let cfg1 = cfg { classifyBenchmark = classifyComparison }
122− in if genGraphs
123− then ignoringErr $ graph inp "comparison"
124− cfg1 { outputDir = Just out
125− , presentation = Groups Absolute
126− }
127− else ignoringErr $ report inp Nothing cfg1
128−
129− where
130−
131− dropComponent = dropWhile (== '/') . dropWhile (/= '/')
132−
133− classifyComparison b = Just
134− ( takeWhile (/= '/') b
135− , dropComponent b
136− )
137−
138−------------------------------------------------------------------------------
139−-- text reports
140−------------------------------------------------------------------------------
141−
142−selectBench
143− :: (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
144− -> [String]
145−selectBench f =
146− reverse
147− $ fmap fst
148− $ either
149− (const $ either error (sortOn snd) $ f (ColumnIndex 0) (Just PercentDiff))
150− (sortOn snd)
151− $ f (ColumnIndex 1) (Just PercentDiff)
152−
153−benchShow ::
154− Options
155− -> Config
156− -> (Config -> String -> IO ())
157− -> String
158− -> FilePath
159− -> IO ()
160−benchShow Options{..} cfg func inp out =
161− if genGraphs
162− then func cfg {outputDir = Just out} inp
163− else ignoringErr $ report inp Nothing cfg
164−
165−main :: IO ()
166−main = do
167− res <- parseOptions
168− case res of
169− Nothing -> do
170− putStrLn "cannot parse options"
171− return ()
172− Just opts@Options{fields = fs, benchType = btype} ->
173− let cfg = defaultConfig
174− { presentation = Groups PercentDiff
175− , selectBenchmarks = selectBench
176− , selectFields = filter
177− ( flip elem fs
178− . fmap toLower
179− )
180− }
181− in case btype of
182− Just (Compare str) ->
183− showComparisons opts cfg
184− { title = Just str }
185− ("charts/" ++ str ++ "/results.csv")
186− ("charts/" ++ str)
187− Just (Standard str) ->
188− benchShow opts cfg
189− { title = Just str }
190− (makeGraphs str)
191− ("charts/" ++ str ++ "/results.csv")
192− ("charts/" ++ str)
193− Nothing ->
194− error "Please specify a benchmark using --benchmark."
benchmark/NanoBenchmarks.hs+27−22
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-------------------------------------------------------------------------------
3-------------------------------------------------------------------------------
2-- Investigate specific benchmarks more closely in isolation, possibly looking
4-- Investigate specific benchmarks more closely in isolation, possibly looking
3-- at GHC generated code for optimizing specific problematic cases.
5-- at GHC generated code for optimizing specific problematic cases.
@@ -6,30 +8,27 @@
6{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
7{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
8
10
9−import Streamly.Prelude (SerialT)
11+import Data.Char (ord)
10−import Streamly.Internal.Data.SVar (MonadAsync)
12+import Streamly.Internal.Data.Stream (Stream)
13+import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
11
14
12−import qualified Streamly.Data.Array.Foreign as A
15+import qualified Streamly.Data.Array as A
13−import qualified Streamly.FileSystem.Handle as FH
14import qualified Streamly.Internal.FileSystem.Handle as IFH
16import qualified Streamly.Internal.FileSystem.Handle as IFH
15import qualified Streamly.Data.Fold as FL
17import qualified Streamly.Data.Fold as FL
18+import qualified Streamly.Internal.Data.Stream as S
16import qualified Streamly.Internal.Data.Stream.IsStream as Internal
19import 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
19
20
20−import Data.Char (ord)
21+import Test.Tasty.Bench
21−import Gauge
22−import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
23import System.Random
22import System.Random
24
23
25maxValue :: Int
24maxValue :: Int
26maxValue = 100000
25maxValue = 100000
27
26
28−-- type Stream = K.Stream
27+drain :: Monad m => S.Stream m a -> m ()
29−type Stream = SerialT
28+drain = S.fold FL.drain
30
29
31{-# INLINE sourceUnfoldrM #-}
30{-# INLINE sourceUnfoldrM #-}
32−sourceUnfoldrM :: MonadAsync m => Stream m Int
31+sourceUnfoldrM :: Monad m => Stream m Int
33sourceUnfoldrM = S.unfoldrM step 0
32sourceUnfoldrM = S.unfoldrM step 0
34 where
33 where
35 step cnt =
34 step cnt =
@@ -38,7 +37,7 @@ sourceUnfoldrM = S.unfoldrM step 0
38 else return (Just (cnt, cnt + 1))
37 else return (Just (cnt, cnt + 1))
39
38
40{-# INLINE sourceUnfoldrMN #-}
39{-# INLINE sourceUnfoldrMN #-}
41−sourceUnfoldrMN :: MonadAsync m => Int -> Stream m Int
40+sourceUnfoldrMN :: Monad m => Int -> Stream m Int
42sourceUnfoldrMN n = S.unfoldrM step n
41sourceUnfoldrMN n = S.unfoldrM step n
43 where
42 where
44 step cnt =
43 step cnt =
@@ -67,7 +66,7 @@ takeAllDropOne = S.drop 1 . S.take maxValue
67
66
68{-# INLINE takeDrop #-}
67{-# INLINE takeDrop #-}
69takeDrop :: Monad m => Stream m Int -> m ()
68takeDrop :: Monad m => Stream m Int -> m ()
70−takeDrop = S.drain .
69+takeDrop = drain .
71 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
70 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
72
71
73-------------------------------------------------------------------------------
72-------------------------------------------------------------------------------
@@ -82,7 +81,7 @@ dropWhileFalse = S.dropWhile (> maxValue)
82
81
83{-# INLINE dropWhileFalseX4 #-}
82{-# INLINE dropWhileFalseX4 #-}
84dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
83dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
85−dropWhileFalseX4 = S.drain
84+dropWhileFalseX4 = drain
86 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
85 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
87
86
88-------------------------------------------------------------------------------
87-------------------------------------------------------------------------------
@@ -91,7 +90,7 @@ dropWhileFalseX4 = S.drain
91
90
92{-# INLINE iterateSource #-}
91{-# INLINE iterateSource #-}
93iterateSource
92iterateSource
94− :: MonadAsync m
93+ :: Monad m
95 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
94 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
96iterateSource g i n = f i (sourceUnfoldrMN n)
95iterateSource g i n = f i (sourceUnfoldrMN n)
97 where
96 where
@@ -103,20 +102,26 @@ iterateSource g i n = f i (sourceUnfoldrMN n)
103main :: IO ()
102main :: IO ()
104main = do
103main = do
105 defaultMain [bench "unfoldr" $ nfIO $
104 defaultMain [bench "unfoldr" $ nfIO $
106− randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]
105+ randomRIO (1,1) >>= \n -> drain (sourceUnfoldr n)]
107 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
106 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
108 defaultMain [bench "dropWhileFalseX4" $
107 defaultMain [bench "dropWhileFalseX4" $
109 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
108 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
110 defaultMain [bench "iterate-mapM" $
109 defaultMain [bench "iterate-mapM" $
111− nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]
110+ nfIO $ drain $ iterateSource (S.mapM return) 100000 10]
112
111
113 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
112 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
114 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
113 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
114+ S.fold FL.length
115− (S.length $ Internal.splitOnSeq (A.fromList $ map (fromIntegral . ord)
115+ (Internal.splitOnSeq
116+ (A.fromList
116− "abcdefghijklmnopqrstuvwxyz") FL.drain
117+ $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"
118+ )
119+ FL.drain
117− $ IFH.toBytes inText) >>= print
120+ $ IFH.read inText
121+ )
122+ >>= print
118 ]
123 ]
119 where
124 where
120
125
121 mkBenchText name h action =
126 mkBenchText name h action =
122− bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)
127+ env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)
benchmark/README.mdmode 100644 → 120000+1−243
@@ -1,243 +0,0 @@
1−## Building a single benchmark suite
2−
3−```
4−$ cabal build streamly-benchmarks:Prelude.Serial
5−```
6−
7−or:
8−
9−```
10−$ cabal build --enable-benchmarks bench:Prelude.Serial
11−```
12−
13−## Building all benchmarks suites
14−
15−```
16−$ cabal build --enable-benchmarks streamly-benchmarks
17−```
18−
19−or:
20−
21−```
22−$ cabal build --enable-benchmarks all
23−```
24−
25−Disable optimization, quick build:
26−
27−```
28−$ cabal build --flag "-opt" ...
29−```
30−
31−## Build and run single benchmarks:
32−
33−For quick results you may have to use `--quick` and possibly some other
34−`gauge` options, or better use `bench.sh --quick` as described in the
35−following sections.
36−
37−```
38−$ cabal run bench:Prelude.Serial -- --quick
39−```
40−
41−`cabal bench` can be used but you cannot pass arguments (like --quick):
42−
43−```
44−$ cabal bench Prelude.Serial
45−```
46−
47−## Build and run all benchmarks
48−
49−Don't try this, it will take too long, use the `bench.sh` method instead.
50−
51−```
52−$ cabal bench all
53−```
54−
55−or:
56−
57−```
58−$ cd benchmark; cabal bench
59−```
60−
61−or this, note this command does not work from "benchmark" dir:
62−
63−```
64−$ cabal bench streamly-benchmarks
65−```
66−
67−## Building and Running Benchmarks with bench.sh
68−
69−`<streamly repo>/bin/bench.sh` script is the top level driver for
70−running benchmarks. It runs the requested benchmarks and then creates a
71−report from the results using the `bench-show` package. Try `bench.sh
72−--help` for available options to run it.
73−
74−## bench.sh: Quick start
75−
76−Run the default benchmark suites:
77−
78−```
79−$ bench.sh --quick
80−```
81−
82−You can remove the `--quick` option to run benchmark with lower speed but
83−better accuracy, or use `--slow` to even further lower the speed and increase
84−the accuracy a bit.
85−
86−Show available benchmark suites:
87−
88−```
89−$ bench.sh --benchmarks help
90−```
91−
92−Run all benchmark suites in the `serial_grp` group:
93−
94−```
95−$ bench.sh --benchmarks serial_grp
96−```
97−
98−Run `Prelude.Serial` and `Data.Parser` benchmark suites:
99−
100−```
101−$ bench.sh --benchmarks "Prelude.Serial Data.Parser"
102−```
103−
104−Run all O(1) space complexity benchmarks in `Prelude.Serial` suite:
105−
106−```
107−$ bench.sh --benchmarks Prelude.Serial -- Prelude.Serial/o-1-space
108−```
109−
110−Anything after a `--` is passed to the benchmark executable,
111−it basically selects all benchmarks starting with
112−`Prelude.Serial/o-1-space` prefix.
113−
114−Run a specific benchmark in `Prelude.Serial` suite:
115−
116−```
117−$ bench.sh --benchmarks Prelude.Serial -- Prelude.Serial/o-1-space/generation/unfoldr
118−```
119−
120−Run a benchmark directly instead of running it through `bench.sh`:
121−
122−```
123−$ cabal run bench:Prelude.Serial -- --quick Prelude.Serial/o-1-space/generation/unfoldr
124−```
125−
126−The options after `--` are the benchmark executable options.
127−
128−## Comparing results of arbitrary runs
129−
130−Note: use `--quick` and benchmark selection if you do not intend to wait for a
131−while.
132−
133−To compare two sets of results, first run the benchmarks at the baseline
134−commit:
135−
136−```
137−$ bench.sh
138−```
139−
140−And then run with the `--append` option at the commit that you want to compare
141−with the baseline. It will show the comparison with the baseline:
142−
143−```
144−$ bench.sh --append
145−```
146−
147−Append just adds the next set of results in the same results file. You can keep
148−appending more results and all of them will be compared with the baseline.
149−
150−## Comparing results of two commits
151−
152−Note: use `--quick` and benchmark selection if you do not intend to wait for a
153−while.
154−
155−You can use `--compare` to compare the previous commit with the head commit:
156−
157−```
158−$ bench.sh --compare
159−```
160−
161−To compare the head commit with some other base commit:
162−
163−```
164−$ bench.sh --compare --base d918833
165−```
166−
167−To compare two arbitrary commits:
168−
169−```
170−$ bench.sh --compare --base d918833 --candidate 38aa5f2
171−```
172−
173−Note that the above may not always work because the script and the benchmarks
174−themselves might have changed across the commits. The `--append` method is more
175−reliable to compare.
176−
177−## Comparing benchmark suites
178−
179−First see the available benchmark suites:
180−
181−```
182−$ bench.sh --benchmarks help
183−```
184−
185−You will see some benchmark suites end with `_cmp`, these are comparison
186−groups. If you run a comparison group benchmark, comparison of all the
187−benchmark suites in that group will be shown in the end. For example to compare
188−all array benchmark suites:
189−
190−```
191−$ bench.sh --benchmarks array_cmp
192−```
193−
194−## Reporting without measuring
195−
196−You can use the `--no-measure` option to report the already measured results in
197−the benchmarks results file. A results file may collect an arbitrary number of
198−results by running with `--append` multiple times. Each benchmark has its own
199−results file, for example the `Prelude.Serial` benchmark has the results file at
200−`charts/Prelude.Serial/results.csv`.
201−
202−You can also manually edit the file to remove a set of results if you like or
203−to append results from previously saved results or from some other results
204−file. After editing you can run `bench.sh` with the `--no-measure` option to
205−see the reports corresponding to the results.
206−
207−## Additional benchmark configuration
208−
209−### Stream size
210−
211−You can specify the stream size (default is 100000) to be used for
212−benchmarking:
213−
214−```
215−$ cabal run bench:Prelude.Serial -- --quick --stream-size 1000000
216−```
217−
218−### Unicode input
219−
220−In the `FileSystem.Handle` benchmark you can specify the input file as an
221−environment variable:
222−
223−```
224−$ export Benchmark_FileSystem_Handle_InputFile=./gutenberg-500.txt
225−$ cabal run FileSystem.Handle -- --quick FileSystem.Handle/o-1-space/reduce/read/S.splitOnSeq
226−```
227−
228−The automatic tests do not test unicode input, this option is useful to specify
229−a unicode text file manually.
230−
231−## Benchmarking notes
232−
233−We use gauge instead of criterion for benchmarking. We have fixed
234−several issues in gauge inherited from criterion. We have added several
235−features as well e.g. rusage stats, running benchmarks in an isolated
236−process etc which are crucial to our benchmarking analysis process.
237−
238−### Gotchas
239−
240−Gauge forces a GC before and after the measurement. However, we have observed
241−that sometimes the GC stats may not be accurate when the number of iterations
242−in the measurement is small (e.g. 1 iteration). In such cases usually the
243−number of GCs and GC times would also be 0.
@@ -0,0 +1 @@
1+../docs/Developer/Benchmarks.md
benchmark/Streamly/Benchmark/Data/Array.hs+79−140
@@ -1,132 +1,112 @@
1−-- |
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2−-- Module : Main
2+{-# OPTIONS_GHC -Wno-orphans #-}
3−-- Copyright : (c) 2020 Composewell Technologies
4−--
5−-- License : BSD-3-Clause
6−-- Maintainer : streamly@composewell.com
7
3
8{-# LANGUAGE CPP #-}
4{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10
5
11−import Control.DeepSeq (NFData(..))
6+#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
12−import System.Random (randomRIO)
13
7
14−import qualified Streamly.Benchmark.Data.ArrayOps as Ops
8+import Control.DeepSeq (deepseq)
15−import qualified Streamly.Data.Array.Foreign as A
16−import qualified Streamly.Internal.Data.Array.Foreign as IA
17−import qualified Streamly.Prelude as S
18−
19−import Gauge
20−import Streamly.Benchmark.Common hiding (benchPureSrc)
21−import qualified Streamly.Benchmark.Prelude as P
22
9
23−#ifdef MEMORY_ARRAY
10+import qualified Streamly.Internal.Data.Array as IA
24import qualified GHC.Exts as GHC
11import qualified GHC.Exts as GHC
25−import Foreign.Storable (Storable(..))
26−#endif
27
12
28−#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
13+-- import qualified Streamly.Data.Array as A
29−import Control.DeepSeq (deepseq)
14+import qualified Streamly.Internal.Data.Array as A
30−#endif
15+
16+type Stream = A.Array
17+
18+#include "Streamly/Benchmark/Data/Array/Common.hs"
19+
20+instance NFData (A.Array a) where
21+ {-# INLINE rnf #-}
22+ rnf _ = ()
31
23
32-------------------------------------------------------------------------------
24-------------------------------------------------------------------------------
33−--
25+-- Benchmark helpers
34-------------------------------------------------------------------------------
26-------------------------------------------------------------------------------
35
27
36−#ifdef MEMORY_ARRAY
37-- Drain a source that generates a pure array
28-- Drain a source that generates a pure array
38{-# INLINE benchPureSrc #-}
29{-# INLINE benchPureSrc #-}
39−benchPureSrc ::
40− (NFData a, Storable a) => String -> (Int -> Ops.Stream a) -> Benchmark
30+benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
41benchPureSrc name src = benchPure name src id
31benchPureSrc name src = benchPure name src id
42−#endif
43−
44−{-# INLINE benchIO #-}
45−benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
46−benchIO name src f = bench name $ nfIO $
47− randomRIO (1,1) >>= src >>= return . f
48
32
49-- Drain a source that generates an array in the IO monad
33-- Drain a source that generates an array in the IO monad
50{-# INLINE benchIOSrc #-}
34{-# INLINE benchIOSrc #-}
51−benchIOSrc ::
52−#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
53− NFData a =>
54−#endif
55−#ifdef MEMORY_ARRAY
56− Storable a =>
57−#endif
58− String -> (Int -> IO (Ops.Stream a)) -> Benchmark
35+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
59benchIOSrc name src = benchIO name src id
36benchIOSrc name src = benchIO name src id
60
37
61−{-# INLINE benchPureSink #-}
38+-------------------------------------------------------------------------------
62−benchPureSink :: NFData b => Int -> String -> (Ops.Stream Int -> b) -> Benchmark
39+-- Bench Ops
63−benchPureSink value name f = benchIO name (Ops.sourceIntFromTo value) f
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+-}
64+#endif
65+
66+{-# INLINE sourceIsList #-}
67+sourceIsList :: Int -> Int -> Stream Int
68+sourceIsList value n = GHC.fromList [n..n+value]
64
69
65−{-# INLINE benchIO' #-}
70+{-# INLINE sourceIsString #-}
66−benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
71+sourceIsString :: Int -> Int -> Stream P.Char
67−benchIO' name src f = bench name $ nfIO $
72+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
68− randomRIO (1,1) >>= src >>= f
69
73
70−{-# INLINE benchIOSink #-}
74+{-# INLINE sourceIntFromToFromStream #-}
71−benchIOSink :: NFData b => Int -> String -> (Ops.Stream Int -> IO b) -> Benchmark
75+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
72−benchIOSink value name f = benchIO' name (Ops.sourceIntFromTo value) f
76+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
77+
78+-------------------------------------------------------------------------------
79+-- Bench groups
80+-------------------------------------------------------------------------------
73
81
74o_1_space_generation :: Int -> [Benchmark]
82o_1_space_generation :: Int -> [Benchmark]
75o_1_space_generation value =
83o_1_space_generation value =
76 [ bgroup
84 [ bgroup
77 "generation"
85 "generation"
78− [ benchIOSrc "writeN . intFromTo" (Ops.sourceIntFromTo value)
79−#ifndef DATA_SMALLARRAY
80− , benchIOSrc "write . intFromTo" (Ops.sourceIntFromToFromStream value)
86+ [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
81−#endif
87+ , let testStr = "fromList " ++ mkListString value
82− , benchIOSrc
88+ in testStr `deepseq` bench "read" (nf readInstance testStr)
83− "fromList . intFromTo"
84− (Ops.sourceIntFromToFromList value)
85− , benchIOSrc "writeN . unfoldr" (Ops.sourceUnfoldr value)
86− , benchIOSrc "writeN . fromList" (Ops.sourceFromList value)
87−#ifdef MEMORY_ARRAY
88− , benchPureSrc "writeN . IsList.fromList" (Ops.sourceIsList value)
89+ , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)
89 , benchPureSrc
90 , benchPureSrc
90 "writeN . IsString.fromString"
91 "writeN . IsString.fromString"
91− (Ops.sourceIsString value)
92+ (sourceIsString value)
92−#endif
93+
93−#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
94−#ifdef DATA_SMALLARRAY
95− , let testStr =
96− "fromListN " ++
97− show (value + 1) ++
98− "[1" ++ concat (replicate value ",1") ++ "]"
99−#else
100− , let testStr = mkListString value
101−#endif
102− in testStr `deepseq` (bench "read" $ nf Ops.readInstance testStr)
103−#endif
104− , benchPureSink value "show" Ops.showInstance
105 ]
94 ]
106 ]
95 ]
107
96
108o_1_space_elimination :: Int -> [Benchmark]
97o_1_space_elimination :: Int -> [Benchmark]
109o_1_space_elimination value =
98o_1_space_elimination value =
110 [ bgroup "elimination"
99 [ bgroup "elimination"
111− [ benchPureSink value "id" id
112− , benchPureSink value "==" Ops.eqInstance
113− , benchPureSink value "/=" Ops.eqInstanceNotEq
114− , benchPureSink value "<" Ops.ordInstance
115− , benchPureSink value "min" Ops.ordInstanceMin
116−#ifdef MEMORY_ARRAY
117− -- length is used to check for foldr/build fusion
118− , benchPureSink value "length . IsList.toList" (length . GHC.toList)
100+ [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
119−#endif
101+ , benchFold "writeLastN.1"
120− , benchIOSink value "foldl'" Ops.pureFoldl'
121− , benchIOSink value "read" Ops.unfoldReadDrain
122− , benchIOSink value "toStreamRev" Ops.toStreamRevDrain
123− , benchFold "lastN.1" (S.fold (IA.lastN 1)) (P.sourceUnfoldrM value)
102+ (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
103+ , benchFold "writeLastN.10"
124− , benchFold "lastN.10" (S.fold (IA.lastN 10)) (P.sourceUnfoldrM value)
104+ (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
125−#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
126#ifdef DEVBUILD
105#ifdef DEVBUILD
106+{-
127− , benchPureSink value "foldable/foldl'" Ops.foldableFoldl'
107+ benchPureSink value "foldable/foldl'" foldableFoldl'
128− , benchPureSink value "foldable/sum" Ops.foldableSum
108+ , benchPureSink value "foldable/sum" foldableSum
129−#endif
109+-}
130#endif
110#endif
131 ]
111 ]
132 ]
112 ]
@@ -136,66 +116,25 @@ o_n_heap_serial value =
136 [ bgroup "elimination"
116 [ bgroup "elimination"
137 [
117 [
138 -- Converting the stream to an array
118 -- Converting the stream to an array
139− benchFold "lastN.Max" (S.fold (IA.lastN (value + 1)))
119+ benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
140− (P.sourceUnfoldrM value)
141− , benchFold "writeN" (S.fold (A.writeN value))
142 (P.sourceUnfoldrM value)
120 (P.sourceUnfoldrM value)
143 ]
121 ]
144 ]
122 ]
145
123
146−o_1_space_transformation :: Int -> [Benchmark]
147−o_1_space_transformation value =
148− [ bgroup "transformation"
149− [ benchIOSink value "scanl'" (Ops.scanl' value 1)
150− , benchIOSink value "scanl1'" (Ops.scanl1' value 1)
151− , benchIOSink value "map" (Ops.map value 1)
152− ]
153− ]
154−
155−o_1_space_transformationX4 :: Int -> [Benchmark]
156−o_1_space_transformationX4 value =
157− [ bgroup "transformationX4"
158− [ benchIOSink value "scanl'" (Ops.scanl' value 4)
159− , benchIOSink value "scanl1'" (Ops.scanl1' value 4)
160− , benchIOSink value "map" (Ops.map value 4)
161− ]
162− ]
163−
164moduleName :: String
124moduleName :: String
165−#ifdef DATA_SMALLARRAY
166−moduleName = "Data.SmallArray"
167−#elif defined(MEMORY_ARRAY)
168−moduleName = "Memory.Array"
169−#elif defined(DATA_ARRAY_PRIM)
170−moduleName = "Data.Array.Prim"
171−#elif defined(DATA_ARRAY_PRIM_PINNED)
172−moduleName = "Data.Array.Prim.Pinnned"
173−#else
174moduleName = "Data.Array"
125moduleName = "Data.Array"
175−#endif
176
126
177−#ifdef DATA_SMALLARRAY
178−defStreamSize :: Int
179−defStreamSize = 128
180−#else
181defStreamSize :: Int
127defStreamSize :: Int
182defStreamSize = defaultStreamSize
128defStreamSize = defaultStreamSize
183−#endif
184
129
185main :: IO ()
130main :: IO ()
186−main = do
131+main = runWithCLIOpts defStreamSize allBenchmarks
187− (value, cfg, benches) <- parseCLIOpts defStreamSize
188− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
189
132
190 where
133 where
191
134
192 allBenchmarks size =
135 allBenchmarks size =
193− [ bgroup (o_1_space_prefix moduleName) $ concat
136+ [ bgroup (o_1_space_prefix moduleName) $
194− [ o_1_space_generation size
195− , o_1_space_elimination size
137+ o_1_space_generation size ++ o_1_space_elimination size
196− , o_1_space_transformation size
197− , o_1_space_transformationX4 size
198− ]
199 , bgroup (o_n_space_prefix moduleName) $
138 , bgroup (o_n_space_prefix moduleName) $
200 o_n_heap_serial size
139 o_n_heap_serial size
201− ]
140+ ] ++ commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/Common.hsnew file+185
@@ -0,0 +1,185 @@
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.hsnew file+16
@@ -0,0 +1,16 @@
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.hsnew file+119
@@ -0,0 +1,119 @@
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.hsnew file+95
@@ -0,0 +1,95 @@
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.hsnew file+309
@@ -0,0 +1,309 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
3+-- |
4+-- Module : Streamly.Benchmark.Data.ParserD
5+-- Copyright : (c) 2020 Composewell Technologies
6+--
7+-- License : BSD-3-Clause
8+-- Maintainer : streamly@composewell.com
9+
10+{-# LANGUAGE CPP #-}
11+{-# LANGUAGE FlexibleContexts #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
13+
14+#ifdef __HADDOCK_VERSION__
15+#undef INSPECTION
16+#endif
17+
18+#ifdef INSPECTION
19+{-# LANGUAGE TemplateHaskell #-}
20+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21+#endif
22+
23+module Main
24+ (
25+ main
26+ ) where
27+
28+import Control.DeepSeq (NFData(..))
29+import Control.Monad (void, when)
30+import Control.Monad.Catch (MonadCatch)
31+import Data.Functor.Identity (runIdentity)
32+import Data.Maybe (isJust)
33+import Data.Word (Word8)
34+import Streamly.Internal.Data.Stream (Stream)
35+import Streamly.Internal.Data.StreamK (StreamK)
36+import System.IO (Handle)
37+import System.Random (randomRIO)
38+import Prelude hiding ()
39+
40+import qualified Streamly.Data.Stream as Stream
41+import qualified Streamly.Internal.Data.Array as Array
42+import qualified Streamly.Internal.Data.Array.Stream as ArrayStream
43+import qualified Streamly.Internal.Data.Fold as Fold
44+import qualified Streamly.Internal.Data.Parser as Parser
45+import qualified Streamly.Internal.Data.Stream as Stream
46+import qualified Streamly.Internal.Data.StreamK as StreamK
47+import qualified Streamly.Internal.FileSystem.Handle as Handle
48+import qualified Streamly.Internal.Unicode.Stream as Unicode
49+
50+import Test.Tasty.Bench hiding (env)
51+import Streamly.Benchmark.Common
52+import Streamly.Benchmark.Common.Handle
53+import Control.Monad.IO.Class (MonadIO)
54+
55+#ifdef INSPECTION
56+import Streamly.Internal.Data.MutByteArray (Unbox)
57+import Streamly.Internal.Data.Stream (Step(..))
58+import Test.Inspection
59+#endif
60+
61+-------------------------------------------------------------------------------
62+-- Utilities
63+-------------------------------------------------------------------------------
64+
65+-- XXX these can be moved to the common module
66+
67+{-# INLINE sourceUnfoldrM #-}
68+sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
69+sourceUnfoldrM value n = Stream.unfoldrM step n
70+ where
71+ step cnt =
72+ if cnt > n + value
73+ then return Nothing
74+ else return (Just (cnt, cnt + 1))
75+
76+{-# INLINE benchIO #-}
77+benchIO
78+ :: NFData b
79+ => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
80+benchIO name src sink =
81+ bench name $ nfIO $ randomRIO (1,1) >>= sink . src
82+
83+-------------------------------------------------------------------------------
84+-- read chunked using toChunks
85+-------------------------------------------------------------------------------
86+
87+-- | Get the last byte from a file bytestream.
88+toChunksLast :: Handle -> IO (Maybe Word8)
89+toChunksLast inh = do
90+ let s = Handle.readChunks inh
91+ larr <- Stream.last s
92+ return $ case larr of
93+ Nothing -> Nothing
94+ Just arr -> Array.getIndex (Array.length arr - 1) arr
95+
96+#ifdef INSPECTION
97+inspect $ hasNoTypeClasses 'toChunksLast
98+inspect $ 'toChunksLast `hasNoType` ''Step
99+#endif
100+
101+-- | Count the number of bytes in a file.
102+toChunksSumLengths :: Handle -> IO Int
103+toChunksSumLengths inh =
104+ let s = Handle.readChunks inh
105+ in Stream.fold Fold.sum (Stream.map Array.length s)
106+
107+#ifdef INSPECTION
108+inspect $ hasNoTypeClasses 'toChunksSumLengths
109+inspect $ 'toChunksSumLengths `hasNoType` ''Step
110+#endif
111+
112+-- | Sum the bytes in a file.
113+toChunksCountBytes :: Handle -> IO Word8
114+toChunksCountBytes inh = do
115+ let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
116+ let s = Handle.readChunks inh
117+ Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118+
119+#ifdef INSPECTION
120+inspect $ hasNoTypeClasses 'toChunksCountBytes
121+inspect $ 'toChunksCountBytes `hasNoType` ''Step
122+#endif
123+
124+toChunksDecodeUtf8Arrays :: Handle -> IO ()
125+toChunksDecodeUtf8Arrays =
126+ Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
127+
128+#ifdef INSPECTION
129+inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
130+-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
131+#endif
132+
133+-------------------------------------------------------------------------------
134+-- Splitting
135+-------------------------------------------------------------------------------
136+
137+-- | Count the number of lines in a file.
138+toChunksSplitOnSuffix :: Handle -> IO Int
139+toChunksSplitOnSuffix =
140+ Stream.fold Fold.length
141+ . ArrayStream.splitOnSuffix 10
142+ . Handle.readChunks
143+
144+#ifdef INSPECTION
145+inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
146+inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
147+#endif
148+
149+-- XXX use a word splitting combinator instead of splitOn and test it.
150+-- | Count the number of words in a file.
151+toChunksSplitOn :: Handle -> IO Int
152+toChunksSplitOn =
153+ Stream.fold Fold.length
154+ . ArrayStream.splitOn 32
155+ . Handle.readChunks
156+
157+#ifdef INSPECTION
158+inspect $ hasNoTypeClasses 'toChunksSplitOn
159+inspect $ 'toChunksSplitOn `hasNoType` ''Step
160+#endif
161+
162+o_1_space_read_chunked :: BenchEnv -> [Benchmark]
163+o_1_space_read_chunked env =
164+ -- read using toChunks instead of read
165+ [ bgroup "reduce/toChunks"
166+ [ mkBench "Stream.last" env $ \inH _ ->
167+ toChunksLast inH
168+ -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
169+ -- wc uses lseek to just determine the file size rather than reading
170+ -- and counting characters.
171+ , mkBench "Stream.sum . Stream.map Array.length" env $ \inH _ ->
172+ toChunksSumLengths inH
173+ , mkBench "splitOnSuffix" env $ \inH _ ->
174+ toChunksSplitOnSuffix inH
175+ , mkBench "splitOn" env $ \inH _ ->
176+ toChunksSplitOn inH
177+ , mkBench "countBytes" env $ \inH _ ->
178+ toChunksCountBytes inH
179+ , mkBenchSmall "decodeUtf8Arrays" env $ \inH _ ->
180+ toChunksDecodeUtf8Arrays inH
181+ ]
182+ ]
183+
184+-------------------------------------------------------------------------------
185+-- copy with group/ungroup transformations
186+-------------------------------------------------------------------------------
187+
188+-- | Lines and unlines
189+{-# NOINLINE copyChunksSplitInterposeSuffix #-}
190+copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
191+copyChunksSplitInterposeSuffix inh outh =
192+ Stream.fold (Handle.write outh)
193+ $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
194+ $ Handle.readChunks inh
195+
196+#ifdef INSPECTION
197+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
198+inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
199+#endif
200+
201+-- | Words and unwords
202+{-# NOINLINE copyChunksSplitInterpose #-}
203+copyChunksSplitInterpose :: Handle -> Handle -> IO ()
204+copyChunksSplitInterpose inh outh =
205+ Stream.fold (Handle.write outh)
206+ -- XXX this is not correct word splitting combinator
207+ $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
208+ $ Handle.readChunks inh
209+
210+#ifdef INSPECTION
211+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
212+inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
213+#endif
214+
215+o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
216+o_1_space_copy_toChunks_group_ungroup env =
217+ [ bgroup "copy/toChunks/group-ungroup"
218+ [ mkBench "interposeSuffix . splitOnSuffix" env $ \inh outh ->
219+ copyChunksSplitInterposeSuffix inh outh
220+ , mkBenchSmall "interpose . splitOn" env $ \inh outh ->
221+ copyChunksSplitInterpose inh outh
222+ ]
223+ ]
224+
225+-------------------------------------------------------------------------------
226+-- Parsers
227+-------------------------------------------------------------------------------
228+
229+{-# INLINE drainWhile #-}
230+drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
231+drainWhile p = Parser.takeWhile p Fold.drain
232+
233+-------------------------------------------------------------------------------
234+-- Folds and parsers
235+-------------------------------------------------------------------------------
236+
237+{-# INLINE fold #-}
238+fold :: Stream IO (Array.Array Int) -> IO ()
239+fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s
240+
241+{-# INLINE parse #-}
242+parse :: Int -> Stream IO (Array.Array Int) -> IO ()
243+parse value s =
244+ void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s
245+
246+{-# INLINE foldBreak #-}
247+foldBreak :: StreamK IO (Array.Array Int) -> IO ()
248+foldBreak s = do
249+ (r, s1) <- ArrayStream.foldBreak Fold.one s
250+ when (isJust r) $ foldBreak s1
251+
252+{-# INLINE parseBreak #-}
253+parseBreak :: StreamK IO (Array.Array Int) -> IO ()
254+parseBreak s = do
255+ r <- ArrayStream.parseBreak Parser.one s
256+ case r of
257+ (Left _, _) -> return ()
258+ (Right _, s1) -> parseBreak s1
259+
260+o_1_space_serial_array ::
261+ Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
262+o_1_space_serial_array bound arraysSmall arraysBig =
263+ [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
264+ , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265+ , benchIO
266+ "foldBreak (recursive, small arrays)"
267+ (\_ -> Stream.fromList arraysSmall)
268+ (foldBreak . StreamK.fromStream)
269+ , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
270+ $ parse bound
271+ , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
272+ $ parse bound
273+ , benchIO
274+ "parseBreak (recursive, small arrays)"
275+ (\_ -> Stream.fromList arraysSmall)
276+ (parseBreak . StreamK.fromStream)
277+ ]
278+
279+-------------------------------------------------------------------------------
280+-- Driver
281+-------------------------------------------------------------------------------
282+
283+moduleName :: String
284+moduleName = "Data.Array.Stream"
285+
286+main :: IO ()
287+main = do
288+ env <- mkHandleBenchEnv
289+ runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
290+
291+ where
292+
293+ alloc value =
294+ if value <= 0
295+ then return (undefined, undefined)
296+ else
297+ do
298+ small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
299+ big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0
300+ return (small, big)
301+
302+ allBenchmarks env arrays value =
303+ let (arraysSmall, arraysBig) = arrays
304+ in [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
305+ [ o_1_space_read_chunked env
306+ , o_1_space_serial_array value arraysSmall arraysBig
307+ , o_1_space_copy_toChunks_group_ungroup env
308+ ]
309+ ]
benchmark/Streamly/Benchmark/Data/ArrayOps.hsdeleted−242
@@ -1,242 +0,0 @@
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−import qualified Data.Foldable as F
30−#endif
31−#endif
32−
33−#ifdef DATA_SMALLARRAY
34−import qualified Streamly.Internal.Data.SmallArray as A
35−type Stream = A.SmallArray
36−#elif defined(MEMORY_ARRAY)
37−import qualified GHC.Exts as GHC
38−import qualified Streamly.Data.Array.Foreign as A
39−import qualified Streamly.Internal.Data.Array.Foreign as A
40−type Stream = A.Array
41−#elif defined(DATA_ARRAY_PRIM)
42−import qualified Streamly.Internal.Data.Array.Prim as A
43−type Stream = A.Array
44−#elif defined(DATA_ARRAY_PRIM_PINNED)
45−import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
46−type Stream = A.Array
47−#elif defined(DATA_ARRAY)
48−import qualified Streamly.Internal.Data.Array as A
49−type Stream = A.Array
50−#endif
51−
52−-------------------------------------------------------------------------------
53−-- Benchmark ops
54−-------------------------------------------------------------------------------
55−
56−-------------------------------------------------------------------------------
57−-- Stream generation and elimination
58−-------------------------------------------------------------------------------
59−
60−-------------------------------------------------------------------------------
61−-- CPP Common to:
62−-- MEMORY_ARRAY
63−-- DATA_ARRAY
64−-- DATA_ARRAY_PRIM
65−-- DATA_ARRAY_PRIM_PINNED
66−-- DATA_SMALLARRAY
67−-------------------------------------------------------------------------------
68−
69−{-# INLINE sourceUnfoldr #-}
70−sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
71−sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n
72− where
73− step cnt =
74− if cnt > n + value
75− then Nothing
76− else (Just (cnt, cnt + 1))
77−
78−{-# INLINE sourceIntFromTo #-}
79−sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
80−sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)
81−
82−{-# INLINE sourceFromList #-}
83−sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
84−sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]
85−
86−-- Different defination of sourceIntFromToFromList for DATA_SMALLARRAY
87−-- CPP:
88−{-# INLINE sourceIntFromToFromList #-}
89−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
90−#ifndef DATA_SMALLARRAY
91−sourceIntFromToFromList value n = P.return $ A.fromList $ [n..n + value]
92−#else
93−sourceIntFromToFromList value n = P.return $ A.fromListN value $ [n..n + value]
94−#endif
95−
96−-------------------------------------------------------------------------------
97−-- CPP Common to:
98−-- MEMORY_ARRAY
99−-- DATA_ARRAY
100−-- DATA_ARRAY_PRIM
101−-- DATA_ARRAY_PRIM_PINNED
102−-------------------------------------------------------------------------------
103−
104−-- CPP:
105−#ifndef DATA_SMALLARRAY
106−{-# INLINE sourceIntFromToFromStream #-}
107−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
108−sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
109−#endif
110−
111−-------------------------------------------------------------------------------
112−-- CPP Common to:
113−-- MEMORY_ARRAY
114−-------------------------------------------------------------------------------
115−
116−-- CPP:
117−#ifdef MEMORY_ARRAY
118−{-# INLINE sourceIsList #-}
119−sourceIsList :: Int -> Int -> Stream Int
120−sourceIsList value n = GHC.fromList [n..n+value]
121−
122−{-# INLINE sourceIsString #-}
123−sourceIsString :: Int -> Int -> Stream P.Char
124−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
125−#endif
126−
127−-------------------------------------------------------------------------------
128−-- Transformation
129−-------------------------------------------------------------------------------
130−
131−-------------------------------------------------------------------------------
132−-- CPP Common to:
133−-- MEMORY_ARRAY
134−-- DATA_ARRAY
135−-- DATA_ARRAY_PRIM
136−-- DATA_ARRAY_PRIM_PINNED
137−-- DATA_SMALLARRAY
138−-------------------------------------------------------------------------------
139−
140−{-# INLINE composeN #-}
141−composeN :: P.Monad m
142− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
143−composeN n f x =
144− case n of
145− 1 -> f x
146− 2 -> f x P.>>= f
147− 3 -> f x P.>>= f P.>>= f
148− 4 -> f x P.>>= f P.>>= f P.>>= f
149− _ -> undefined
150−
151−{-# INLINE scanl' #-}
152−{-# INLINE scanl1' #-}
153−{-# INLINE map #-}
154−
155−scanl' , scanl1', map
156− :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
157−
158−
159−{-# INLINE onArray #-}
160−onArray
161− :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)
162− -> Stream Int
163− -> m (Stream Int)
164−onArray value f arr = S.fold (A.writeN value) $ f $ (S.unfold A.read arr)
165−
166−scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0
167−scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)
168−map value n = composeN n $ onArray value $ S.map (+1)
169−-- map n = composeN n $ A.map (+1)
170−
171−{-# INLINE eqInstance #-}
172−eqInstance :: Stream Int -> Bool
173−eqInstance src = src == src
174−
175−{-# INLINE eqInstanceNotEq #-}
176−eqInstanceNotEq :: Stream Int -> Bool
177−eqInstanceNotEq src = src P./= src
178−
179−{-# INLINE ordInstance #-}
180−ordInstance :: Stream Int -> Bool
181−ordInstance src = src P.< src
182−
183−{-# INLINE ordInstanceMin #-}
184−ordInstanceMin :: Stream Int -> Stream Int
185−ordInstanceMin src = P.min src src
186−
187−{-# INLINE showInstance #-}
188−showInstance :: Stream Int -> P.String
189−showInstance src = P.show src
190−
191−{-# INLINE pureFoldl' #-}
192−pureFoldl' :: MonadIO m => Stream Int -> m Int
193−pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
194−
195−-------------------------------------------------------------------------------
196−-- CPP Common to:
197−-- MEMORY_ARRAY
198−-- DATA_ARRAY
199−-- DATA_SMALLARRAY
200−-------------------------------------------------------------------------------
201−
202−-- CPP:
203−#if !defined(DATA_ARRAY_PRIM) && !defined(DATA_ARRAY_PRIM_PINNED)
204−{-# INLINE readInstance #-}
205−readInstance :: P.String -> Stream Int
206−readInstance str =
207− let r = P.reads str
208− in case r of
209− [(x,"")] -> x
210− _ -> P.error "readInstance: no parse"
211−
212−#ifdef DEVBUILD
213−{-# INLINE foldableFoldl' #-}
214−foldableFoldl' :: Stream Int -> Int
215−foldableFoldl' = F.foldl' (+) 0
216−
217−{-# INLINE foldableSum #-}
218−foldableSum :: Stream Int -> Int
219−foldableSum = P.sum
220−#endif
221−#endif
222−
223−-------------------------------------------------------------------------------
224−-- Elimination
225−-------------------------------------------------------------------------------
226−
227−-------------------------------------------------------------------------------
228−-- CPP Common to:
229−-- MEMORY_ARRAY
230−-- DATA_ARRAY
231−-- DATA_ARRAY_PRIM
232−-- DATA_ARRAY_PRIM_PINNED
233−-- DATA_SMALLARRAY
234−-------------------------------------------------------------------------------
235−
236−{-# INLINE unfoldReadDrain #-}
237−unfoldReadDrain :: MonadIO m => Stream Int -> m ()
238−unfoldReadDrain = S.drain . S.unfold A.read
239−
240−{-# INLINE toStreamRevDrain #-}
241−toStreamRevDrain :: MonadIO m => Stream Int -> m ()
242−toStreamRevDrain = S.drain . A.toStreamRev
benchmark/Streamly/Benchmark/Data/Fold.hs+328−124
@@ -6,35 +6,51 @@
6-- Maintainer : streamly@composewell.com
6-- Maintainer : streamly@composewell.com
7
7
8{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE FlexibleInstances #-}
10+{-# LANGUAGE RankNTypes #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
13+{-# OPTIONS_GHC -Wno-orphans #-}
14+
15+#undef FUSION_CHECK
16+#ifdef FUSION_CHECK
17+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
18+#endif
9
19
10module Main (main) where
20module Main (main) where
11
21
12import Control.DeepSeq (NFData(..))
22import Control.DeepSeq (NFData(..))
23+import Control.Monad (when)
24+import Control.Monad.IO.Class (MonadIO(..))
25+import Data.Functor.Identity (Identity(..))
13import Data.Map.Strict (Map)
26import Data.Map.Strict (Map)
27+import Data.Hashable (Hashable)
28+import Data.HashMap.Strict (HashMap)
29+import Data.IntMap.Strict (IntMap)
14import Data.Monoid (Last(..), Sum(..))
30import Data.Monoid (Last(..), Sum(..))
15import System.Random (randomRIO)
31import System.Random (randomRIO)
16
32
17−import Streamly.Prelude (SerialT)
33+import Streamly.Internal.Data.Stream (Stream)
18import Streamly.Internal.Data.Fold (Fold(..))
34import Streamly.Internal.Data.Fold (Fold(..))
35+import Streamly.Internal.Data.IsMap.HashMap ()
36+import Streamly.Internal.Data.MutArray (MutArray)
19
37
20−import qualified Data.Map.Strict as Map
21import qualified Streamly.Internal.Data.Fold as FL
38import qualified Streamly.Internal.Data.Fold as FL
22−import qualified Streamly.Internal.Data.Fold.Type as FL
39+import qualified Streamly.Data.Fold.Prelude as Fold
40+import qualified Streamly.Internal.Data.Unfold as Unfold
23import qualified Streamly.Internal.Data.Pipe as Pipe
41import qualified Streamly.Internal.Data.Pipe as Pipe
24−import qualified Streamly.Internal.Data.Sink as Sink
42+import qualified Streamly.Internal.Data.Stream as Stream
25−import qualified Streamly.Internal.Data.Stream.IsStream as IP
26−import qualified Streamly.Prelude as S
27
43
28−import Gauge
44+import Test.Tasty.Bench
29import Streamly.Benchmark.Common
45import Streamly.Benchmark.Common
30−import Prelude hiding (all, any, take, unzip, sequence_)
46+import Prelude hiding (all, any, take, unzip, sequence_, filter)
31
47
32-- We need a monadic bind here to make sure that the function f does not get
48-- We need a monadic bind here to make sure that the function f does not get
33-- completely optimized out by the compiler in some cases.
49-- completely optimized out by the compiler in some cases.
34
50
35{-# INLINE sourceUnfoldrM #-}
51{-# INLINE sourceUnfoldrM #-}
36−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
52+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
37−sourceUnfoldrM value n = S.unfoldrM step n
53+sourceUnfoldrM value n = Stream.unfoldrM step n
38 where
54 where
39 step cnt =
55 step cnt =
40 if cnt > n + value
56 if cnt > n + value
@@ -42,14 +58,14 @@ sourceUnfoldrM value n = S.unfoldrM step n
42 else return (Just (cnt, cnt + 1))
58 else return (Just (cnt, cnt + 1))
43
59
44{-# INLINE source #-}
60{-# INLINE source #-}
45−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
61+source :: Monad m => Int -> Int -> Stream m Int
46source = sourceUnfoldrM
62source = sourceUnfoldrM
47
63
48-- | Takes a fold method, and uses it with a default source.
64-- | Takes a fold method, and uses it with a default source.
49{-# INLINE benchIOSink #-}
65{-# INLINE benchIOSink #-}
50benchIOSink
66benchIOSink
51− :: (S.IsStream t, NFData b)
67+ :: NFData b
52− => Int -> String -> (t IO Int -> IO b) -> Benchmark
68+ => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
53benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
69benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
54
70
55-------------------------------------------------------------------------------
71-------------------------------------------------------------------------------
@@ -57,124 +73,221 @@ benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source va
57-------------------------------------------------------------------------------
73-------------------------------------------------------------------------------
58
74
59{-# INLINE any #-}
75{-# INLINE any #-}
60−any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
76+any :: (Monad m, Ord a) => a -> Stream m a -> m Bool
61−any value = IP.fold (FL.any (> value))
77+any value = Stream.fold (FL.any (> value))
62
78
63{-# INLINE all #-}
79{-# INLINE all #-}
64−all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
80+all :: (Monad m, Ord a) => a -> Stream m a -> m Bool
65−all value = IP.fold (FL.all (<= value))
81+all value = Stream.fold (FL.all (<= value))
66
82
67{-# INLINE take #-}
83{-# INLINE take #-}
68−take :: Monad m => Int -> SerialT m a -> m ()
84+take :: Monad m => Int -> Stream m a -> m ()
69−take value = IP.fold (FL.take value FL.drain)
85+take value = Stream.fold (FL.take value FL.drain)
70
86
71{-# INLINE sequence_ #-}
87{-# INLINE sequence_ #-}
72sequence_ :: Monad m => Int -> Fold m a ()
88sequence_ :: Monad m => Int -> Fold m a ()
73sequence_ value =
89sequence_ value =
74− foldr f (FL.yield ()) (Prelude.replicate value (FL.take 1 FL.drain))
90+ foldr f (FL.fromPure ()) (Prelude.replicate value (FL.take 1 FL.drain))
75
91
76 where
92 where
77
93
78 {-# INLINE f #-}
94 {-# INLINE f #-}
79 f m k = FL.concatMap (const k) m
95 f m k = FL.concatMap (const k) m
80
96
97+-------------------------------------------------------------------------------
98+-- Filter
99+-------------------------------------------------------------------------------
100+
101+{-# INLINE filter #-}
102+filter :: Monad m => Int -> Stream m Int -> m ()
103+filter _ = Stream.fold (FL.filter even FL.drain)
104+
105+{-# INLINE scanMaybe #-}
106+scanMaybe :: Monad m => Int -> Stream m Int -> m ()
107+scanMaybe _ = Stream.fold (FL.scanMaybe (FL.filtering even) FL.drain)
108+
109+{-# INLINE scanMaybe2 #-}
110+scanMaybe2 :: Monad m => Int -> Stream m Int -> m ()
111+scanMaybe2 _ =
112+ Stream.fold
113+ $ FL.scanMaybe (FL.filtering even)
114+ $ FL.scanMaybe (FL.filtering odd) FL.drain
115+
81-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
82-- Splitting by serial application
117-- Splitting by serial application
83-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
84
119
85{-# INLINE takeEndBy_ #-}
120{-# INLINE takeEndBy_ #-}
86−takeEndBy_ :: Monad m => Int -> SerialT m Int -> m ()
121+takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()
87−takeEndBy_ value = IP.fold (FL.takeEndBy_ (>= value) FL.drain)
122+takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)
88
123
89{-# INLINE many #-}
124{-# INLINE many #-}
90−many :: Monad m => SerialT m Int -> m ()
125+many :: Monad m => Stream m Int -> m ()
91−many = IP.fold (FL.many (FL.take 1 FL.drain) FL.drain)
126+many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)
92
127
93{-# INLINE splitAllAny #-}
128{-# INLINE splitAllAny #-}
94−splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)
129+splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool)
95splitAllAny value =
130splitAllAny value =
96− IP.fold
131+ Stream.fold
97− (FL.serialWith (,)
132+ (FL.splitWith (,)
98 (FL.all (<= (value `div` 2)))
133 (FL.all (<= (value `div` 2)))
99 (FL.any (> value))
134 (FL.any (> value))
100 )
135 )
101
136
102−{-
103{-# INLINE split_ #-}
137{-# INLINE split_ #-}
104−split_ :: Monad m
138+split_ :: Monad m => Int -> Stream m Int -> m Bool
105− => Int -> SerialT m Int -> m ()
106split_ value =
139split_ value =
107− IP.fold
140+ Stream.fold
108 (FL.split_
141 (FL.split_
109 (FL.all (<= (value `div` 2)))
142 (FL.all (<= (value `div` 2)))
110 (FL.any (> value))
143 (FL.any (> value))
111 )
144 )
112−-}
145+
146+{-# INLINE shortest #-}
147+shortest :: Monad m => Stream m Int -> m (Either Int Int)
148+shortest = Stream.fold (FL.shortest FL.sum FL.length)
149+
150+{-# INLINE longest #-}
151+longest :: Monad m => Stream m Int -> m (Either Int Int)
152+longest = Stream.fold (FL.longest FL.sum FL.length)
153+
154+{-# INLINE foldBreak #-}
155+foldBreak :: Monad m => Stream m Int -> m ()
156+foldBreak s = do
157+ (r, s1) <- Stream.foldBreak (FL.take 1 FL.length) s
158+ when (r /= 0) $ foldBreak s1
113
159
114-------------------------------------------------------------------------------
160-------------------------------------------------------------------------------
115-- Distributing by parallel application
161-- Distributing by parallel application
116-------------------------------------------------------------------------------
162-------------------------------------------------------------------------------
117
163
118{-# INLINE teeSumLength #-}
164{-# INLINE teeSumLength #-}
119−teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
165+teeSumLength :: Monad m => Stream m Int -> m (Int, Int)
120−teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)
166+teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)
121
167
122{-# INLINE teeAllAny #-}
168{-# INLINE teeAllAny #-}
123−teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)
169+teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)
124−teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
170+teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
125
171
126 where
172 where
127
173
128 all_ = FL.all (<= value)
174 all_ = FL.all (<= value)
129 any_ = FL.any (> value)
175 any_ = FL.any (> value)
130
176
177+{-# INLINE teeWithFst #-}
178+teeWithFst :: Monad m => Stream m Int -> m (Int, Int)
179+teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)
180+
181+{-# INLINE teeWithMin #-}
182+teeWithMin :: Monad m => Stream m Int -> m (Int, Int)
183+teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)
184+
131{-# INLINE distribute #-}
185{-# INLINE distribute #-}
132−distribute :: Monad m => SerialT m Int -> m [Int]
186+distribute :: Monad m => Stream m Int -> m [Int]
133−distribute = IP.fold (FL.distribute [FL.sum, FL.length])
187+distribute = Stream.fold (FL.distribute [FL.sum, FL.length])
134
188
135-------------------------------------------------------------------------------
189-------------------------------------------------------------------------------
136-- Partitioning
190-- Partitioning
137-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
138
192
193+{-# INLINE oddEven #-}
194+oddEven :: Int -> Either Int Int
195+oddEven x = if odd x then Left x else Right x
196+
139{-# INLINE partition #-}
197{-# INLINE partition #-}
140−partition :: Monad m => SerialT m Int -> m (Int, Int)
198+partition :: Monad m => Stream m Int -> m (Int, Int)
141−partition =
199+partition = Stream.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
142− let f a =
200+
143− if odd a
201+{-# INLINE partitionByFstM #-}
144− then Left a
202+partitionByFstM :: Monad m => Stream m Int -> m (Int, Int)
145− else Right a
203+partitionByFstM =
146− in IP.fold $ FL.map f (FL.partition FL.sum FL.length)
204+ Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
147−
205+
206+{-# INLINE partitionByMinM #-}
207+partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)
208+partitionByMinM =
209+ Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
210+
211+{-# INLINE demuxToMap #-}
212+demuxToMap :: (Monad m, Ord k) =>
213+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
214+demuxToMap f g = Stream.fold (FL.demuxToContainer f g)
215+
216+{-# INLINE demuxToIntMap #-}
217+demuxToIntMap :: Monad m =>
218+ (a -> Int) -> (a -> m (Fold m a b)) -> Stream m a -> m (IntMap b)
219+demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g)
220+
221+{-# INLINE demuxToHashMap #-}
222+demuxToHashMap :: (Monad m, Hashable k) =>
223+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
224+demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g)
225+
226+{-# INLINE demuxToMapIO #-}
227+demuxToMapIO :: (MonadIO m, Ord k) =>
228+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
229+demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
230+
231+{-# INLINE demuxToHashMapIO #-}
232+demuxToHashMapIO :: (MonadIO m, Hashable k) =>
233+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
234+demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
235+
236+{-# INLINE toMap #-}
237+toMap ::
238+ (Monad m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
239+toMap f = Stream.fold (FL.toContainer f FL.sum)
240+
148−{-# INLINE demuxWith #-}
241+{-# INLINE toIntMap #-}
149−demuxWith ::
242+toIntMap ::
150− (Monad m, Ord k)
243+ (Monad m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
151− => (a -> (k, a'))
244+toIntMap f = Stream.fold (FL.toContainer f FL.sum)
152− -> Map k (Fold m a' b)
245+
153− -> SerialT m a
246+{-# INLINE toMapIO #-}
154− -> m (Map k b)
247+toMapIO ::
155−demuxWith f mp = S.fold (FL.demuxWith f mp)
248+ (MonadIO m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
156−
249+toMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
157−{-# INLINE demuxDefaultWith #-}
250+
158−demuxDefaultWith ::
251+{-# INLINE toIntMapIO #-}
159− (Monad m, Ord k, Num b)
252+toIntMapIO ::
160− => (a -> (k, b))
253+ (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
161− -> Map k (Fold m b b)
254+toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
162− -> SerialT m a
255+
163− -> m (Map k b, b)
256+{-# INLINE toHashMapIO #-}
164−demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.map snd FL.sum))
257+toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) =>
165−
258+ (a -> k) -> Stream m a -> m (HashMap k a)
166−{-# INLINE classifyWith #-}
259+toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum)
167−classifyWith ::
168− (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)
169−classifyWith f = S.fold (FL.classifyWith f FL.sum)
170
260
171-------------------------------------------------------------------------------
261-------------------------------------------------------------------------------
172-- unzip
262-- unzip
173-------------------------------------------------------------------------------
263-------------------------------------------------------------------------------
174
264
175{-# INLINE unzip #-}
265{-# INLINE unzip #-}
176−unzip :: Monad m => SerialT m Int -> m (Int, Int)
266+unzip :: Monad m => Stream m Int -> m (Int, Int)
177−unzip = IP.fold $ FL.map (\a -> (a, a)) (FL.unzip FL.sum FL.length)
267+unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
268+
269+{-# INLINE unzipWithFstM #-}
270+unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
271+unzipWithFstM = do
272+ let f a = return (a + 1, a)
273+ Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
274+
275+{-# INLINE unzipWithMinM #-}
276+unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
277+unzipWithMinM = do
278+ let f a = return (a + 1, a)
279+ Stream.fold (FL.unzipWithMinM f FL.sum FL.length)
280+
281+-------------------------------------------------------------------------------
282+-- Nested
283+-------------------------------------------------------------------------------
284+
285+{-# INLINE unfoldMany #-}
286+unfoldMany :: Int -> Benchmarkable
287+unfoldMany val =
288+ nfIO
289+ $ Stream.fold (FL.unfoldMany Unfold.replicateM FL.drain)
290+ $ Stream.fromPure (val, randomRIO (1, 1 :: Int))
178
291
179-------------------------------------------------------------------------------
292-------------------------------------------------------------------------------
180-- Benchmarks
293-- Benchmarks
@@ -183,92 +296,113 @@ unzip = IP.fold $ FL.map (\a -> (a, a)) (FL.unzip FL.sum FL.length)
183moduleName :: String
296moduleName :: String
184moduleName = "Data.Fold"
297moduleName = "Data.Fold"
185
298
299+instance NFData (MutArray a) where
300+ {-# INLINE rnf #-}
301+ rnf _ = ()
302+
303+instance NFData a => NFData (Stream Identity a) where
304+ {-# INLINE rnf #-}
305+ rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs
306+
186o_1_space_serial_elimination :: Int -> [Benchmark]
307o_1_space_serial_elimination :: Int -> [Benchmark]
187o_1_space_serial_elimination value =
308o_1_space_serial_elimination value =
188 [ bgroup "elimination"
309 [ bgroup "elimination"
189− [ benchIOSink value "drain" (S.fold FL.drain)
310+ [ benchIOSink value "drain" (Stream.fold FL.drain)
190− , benchIOSink value "drainBy" (S.fold (FL.drainBy return))
311+ , benchIOSink value "drainBy" (Stream.fold (FL.drainBy return))
191− , benchIOSink value "drainN" (S.fold (FL.drainN value))
312+ , benchIOSink value "drainN" (Stream.fold (FL.drainN value))
192− , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
313+ , benchIOSink value "last" (Stream.fold FL.last)
314+ , benchIOSink value "length" (Stream.fold FL.length)
193− , benchIOSink value "last" (S.fold FL.last)
315+ , benchIOSink value "top" (Stream.fold $ FL.top 10)
194− , benchIOSink value "length" (S.fold FL.length)
316+ , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)
195− , benchIOSink value "sum" (S.fold FL.sum)
317+ , benchIOSink value "sum" (Stream.fold FL.sum)
196− , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))
318+ , benchIOSink value "sum (foldMap)" (Stream.fold (FL.foldMap Sum))
197− , benchIOSink value "product" (S.fold FL.product)
319+ , benchIOSink value "product" (Stream.fold FL.product)
198− , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
320+ , benchIOSink value "maximumBy" (Stream.fold (FL.maximumBy compare))
199− , benchIOSink value "maximum" (S.fold FL.maximum)
321+ , benchIOSink value "maximum" (Stream.fold FL.maximum)
200− , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
322+ , benchIOSink value "minimumBy" (Stream.fold (FL.minimumBy compare))
201− , benchIOSink value "minimum" (S.fold FL.minimum)
323+ , benchIOSink value "minimum" (Stream.fold FL.minimum)
202 , benchIOSink
324 , benchIOSink
203 value
325 value
204 "mean"
326 "mean"
205− (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))
327+ (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))
206 , benchIOSink
328 , benchIOSink
207 value
329 value
208 "variance"
330 "variance"
209− (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))
331+ (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))
210 , benchIOSink
332 , benchIOSink
211 value
333 value
212 "stdDev"
334 "stdDev"
213− (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))
335+ (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))
214 , benchIOSink
336 , benchIOSink
215 value
337 value
216 "mconcat"
338 "mconcat"
217− (S.fold FL.mconcat . S.map (Last . Just))
339+ (Stream.fold FL.mconcat . fmap (Last . Just))
218 , benchIOSink
340 , benchIOSink
219 value
341 value
220 "foldMap"
342 "foldMap"
221− (S.fold (FL.foldMap (Last . Just)))
343+ (Stream.fold (FL.foldMap (Last . Just)))
222 , benchIOSink
344 , benchIOSink
223 value
345 value
224 "foldMapM"
346 "foldMapM"
225− (S.fold (FL.foldMapM (return . Last . Just)))
347+ (Stream.fold (FL.foldMapM (return . Last . Just)))
226− , benchIOSink value "index" (S.fold (FL.index (value + 1)))
348+ , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))
227− , benchIOSink value "head" (S.fold FL.head)
349+ , benchIOSink value "head" (Stream.fold FL.head)
228− , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
350+ , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))
229 , benchIOSink
351 , benchIOSink
230 value
352 value
231 "lookup"
353 "lookup"
232− (S.fold (FL.map (\a -> (a, a)) (FL.lookup (value + 1))))
354+ (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
233 , benchIOSink
355 , benchIOSink
234 value
356 value
235 "findIndex"
357 "findIndex"
236− (S.fold (FL.findIndex (== (value + 1))))
358+ (Stream.fold (FL.findIndex (== (value + 1))))
237 , benchIOSink
359 , benchIOSink
238 value
360 value
239 "elemIndex"
361 "elemIndex"
240− (S.fold (FL.elemIndex (value + 1)))
362+ (Stream.fold (FL.elemIndex (value + 1)))
241− , benchIOSink value "null" (S.fold FL.null)
363+ , benchIOSink value "null" (Stream.fold FL.null)
242− , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
364+ , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))
243− , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
365+ , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))
244 , benchIOSink value "all" $ all value
366 , benchIOSink value "all" $ all value
245 , benchIOSink value "any" $ any value
367 , benchIOSink value "any" $ any value
246 , benchIOSink value "take" $ take value
368 , benchIOSink value "take" $ take value
247 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
369 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
248− , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))
370+ , benchIOSink value "and" (Stream.fold FL.and . fmap (<= (value + 1)))
249− , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))
371+ , benchIOSink value "or" (Stream.fold FL.or . fmap (> (value + 1)))
250 ]
372 ]
251 ]
373 ]
252
374
253o_1_space_serial_transformation :: Int -> [Benchmark]
375o_1_space_serial_transformation :: Int -> [Benchmark]
254o_1_space_serial_transformation value =
376o_1_space_serial_transformation value =
255 [ bgroup "transformation"
377 [ bgroup "transformation"
256− [ benchIOSink value "map" (S.fold (FL.map (+ 1) FL.drain))
378+ [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))
257 , let f x = if even x then Just x else Nothing
379 , let f x = if even x then Just x else Nothing
258 fld = FL.mapMaybe f FL.drain
380 fld = FL.mapMaybe f FL.drain
259− in benchIOSink value "mapMaybe" (S.fold fld)
381+ in benchIOSink value "mapMaybe" (Stream.fold fld)
260 , benchIOSink
382 , benchIOSink
261 value
383 value
262 "rsequence"
384 "rsequence"
263− (S.fold (FL.rmapM id (return <$> FL.drain)))
385+ (Stream.fold (FL.rmapM id (return <$> FL.drain)))
264− , benchIOSink value "rmapM" (S.fold (FL.rmapM return FL.drain))
386+ , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))
265 , benchIOSink
387 , benchIOSink
266 value
388 value
267 "pipe-mapM"
389 "pipe-mapM"
268− (S.fold
390+ (Stream.fold
269 (FL.transform
391 (FL.transform
270 (Pipe.mapM (\x -> return $ x + 1))
392 (Pipe.mapM (\x -> return $ x + 1))
271 FL.drain))
393 FL.drain))
394+ , benchIOSink
395+ value
396+ "fold-scan"
397+ (Stream.fold $ FL.scan FL.sum FL.drain)
398+ , benchIOSink
399+ value
400+ "fold-scanMany"
401+ (Stream.fold $ FL.scanMany (FL.take 2 FL.drain) FL.drain)
402+ , benchIOSink
403+ value
404+ "fold-postscan"
405+ (Stream.fold $ FL.postscan FL.sum FL.drain)
272 ]
406 ]
273 ]
407 ]
274
408
@@ -276,30 +410,33 @@ o_1_space_serial_composition :: Int -> [Benchmark]
276o_1_space_serial_composition value =
410o_1_space_serial_composition value =
277 [ bgroup
411 [ bgroup
278 "composition"
412 "composition"
413+ [ benchIOSink value "filter even" $ filter value
414+ , benchIOSink value "scanMaybe even" $ scanMaybe value
415+ , benchIOSink value "scanMaybe even, odd" $ scanMaybe2 value
416+ , benchIOSink value "foldBreak (recursive)" foldBreak
279− [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
417+ , benchIOSink value "splitWith (all, any)" $ splitAllAny value
418+ , benchIOSink value "split_ (all, any)" $ split_ value
280 , benchIOSink value "tee (all, any)" $ teeAllAny value
419 , benchIOSink value "tee (all, any)" $ teeAllAny value
281 , benchIOSink value "many drain (take 1)" many
420 , benchIOSink value "many drain (take 1)" many
421+ , bench "unfoldMany" $ unfoldMany value
422+ , benchIOSink value "shortest (sum, length)" shortest
423+ , benchIOSink value "longest (sum, length)" longest
282 , benchIOSink value "tee (sum, length)" teeSumLength
424 , benchIOSink value "tee (sum, length)" teeSumLength
425+ , benchIOSink value "teeWithFst (sum, length)" teeWithFst
426+ , benchIOSink value "teeWithMin (sum, length)" teeWithMin
283 , benchIOSink value "distribute [sum, length]" distribute
427 , benchIOSink value "distribute [sum, length]" distribute
284 , benchIOSink value "partition (sum, length)" partition
428 , benchIOSink value "partition (sum, length)" partition
429+ , benchIOSink value "partitionByFstM (sum, length)" partitionByFstM
430+ , benchIOSink value "partitionByMinM (sum, length)" partitionByMinM
285 , benchIOSink value "unzip (sum, length)" unzip
431 , benchIOSink value "unzip (sum, length)" unzip
286− , benchIOSink value "demuxDefaultWith [sum, length] sum"
432+ , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
287− $ demuxDefaultWith fn mp
288− , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
433+ , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
289− , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)
290 ]
434 ]
291 ]
435 ]
292
436
293− where
294−
295− -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.
296− fn x = (x `mod` 3, x)
297−
298− mp = Map.fromList [(0, FL.sum), (1, FL.length)]
299−
300o_n_space_serial :: Int -> [Benchmark]
437o_n_space_serial :: Int -> [Benchmark]
301o_n_space_serial value =
438o_n_space_serial value =
302− [ benchIOSink value "sequence_/100" $ S.fold (sequence_ (value `div` 100))
439+ [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))
303 ]
440 ]
304
441
305o_n_heap_serial :: Int -> [Benchmark]
442o_n_heap_serial :: Int -> [Benchmark]
@@ -308,21 +445,71 @@ o_n_heap_serial value =
308 -- Left folds for building a structure are inherently non-streaming
445 -- Left folds for building a structure are inherently non-streaming
309 -- as the structure cannot be lazily consumed until fully built.
446 -- as the structure cannot be lazily consumed until fully built.
310 [
447 [
311− benchIOSink value "toList" (S.fold FL.toList)
448+ benchIOSink value "toList" (Stream.fold FL.toList)
312− , benchIOSink value "toListRev" (S.fold FL.toListRev)
449+ , benchIOSink value "toListRev" (Stream.fold FL.toListRev)
313− , benchIOSink value "toStream" (S.fold FL.toStream)
450+ , benchIOSink value "toStream"
451+ (Stream.fold FL.toStream
452+ :: Stream IO a -> IO (Stream Identity a))
314− , benchIOSink value "toStreamRev" (S.fold FL.toStreamRev)
453+ , benchIOSink value "toStreamRev"
454+ (Stream.fold FL.toStreamRev
455+ :: Stream IO a -> IO (Stream Identity a))
456+ , benchIOSink value "nub" (Stream.fold FL.nub)
457+ ]
458+ , bgroup "key-value"
459+ [
460+ benchIOSink value "demuxToMap (64 buckets) [sum, length]"
461+ $ demuxToMap (getKey 64) (getFold . getKey 64)
462+ , benchIOSink value "demuxToIntMap (64 buckets) [sum, length]"
463+ $ demuxToIntMap (getKey 64) (getFold . getKey 64)
464+ , benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"
465+ $ demuxToHashMap (getKey 64) (getFold . getKey 64)
466+ , benchIOSink value "demuxToMapIO (64 buckets) [sum, length]"
467+ $ demuxToMapIO (getKey 64) (getFold . getKey 64)
468+ , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"
469+ $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)
470+
471+ -- classify: immutable
472+ , benchIOSink value "toMap (64 buckets) sum"
473+ $ toMap (getKey 64)
474+ , benchIOSink value "toIntMap (64 buckets) sum"
475+ $ toIntMap (getKey 64)
476+
477+ -- classify: mutable cells
478+ , benchIOSink value "toMapIO (single bucket) sum"
479+ $ toMapIO (getKey 1)
480+ , benchIOSink value "toMapIO (64 buckets) sum"
481+ $ toMapIO (getKey 64)
482+ , benchIOSink value "toMapIO (max buckets) sum"
483+ $ toMapIO (getKey value)
484+ , benchIOSink value "toIntMapIO (64 buckets) sum"
485+ $ toIntMapIO (getKey 64)
486+ , benchIOSink value "toHashMapIO (single bucket) sum"
487+ $ toHashMapIO (getKey 1)
488+ , benchIOSink value "toHashMapIO (64 buckets) sum"
489+ $ toHashMapIO (getKey 64)
490+ , benchIOSink value "toHashMapIO (max buckets) sum"
491+ $ toHashMapIO (getKey value)
315 ]
492 ]
316 ]
493 ]
317
494
495+ where
496+
497+ getKey buckets = (`mod` buckets)
498+
499+ getFold k =
500+ return $ case k of
501+ 0 -> FL.sum
502+ 1 -> FL.length
503+ _ -> FL.length
504+
318-------------------------------------------------------------------------------
505-------------------------------------------------------------------------------
319-- Driver
506-- Driver
320-------------------------------------------------------------------------------
507-------------------------------------------------------------------------------
321
508
322main :: IO ()
509main :: IO ()
323main = do
510main = do
324− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
511+#ifndef FUSION_CHECK
325− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
512+ runWithCLIOpts defaultStreamSize allBenchmarks
326
513
327 where
514 where
328
515
@@ -335,3 +522,20 @@ main = do
335 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
522 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
336 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
523 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
337 ]
524 ]
525+#else
526+ -- Enable FUSION_CHECK macro at the beginning of the file
527+ -- Enable one benchmark below, and run the benchmark
528+ -- Check the .dump-simpl output
529+ let value = 100000
530+ let input = source value 1
531+ let getKey buckets = (`mod` buckets)
532+ let getFold k =
533+ return $ case k of
534+ 0 -> FL.sum
535+ 1 -> FL.length
536+ _ -> FL.length
537+
538+ -- demuxToMap (getKey 64) (getFold . getKey 64) input
539+ toIntMapIO (getKey 64) input
540+ return ()
541+#endif
benchmark/Streamly/Benchmark/Data/Fold/Window.hsnew file+191
@@ -0,0 +1,191 @@
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.hsnew file+300
@@ -0,0 +1,300 @@
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+652−180
@@ -1,3 +1,10 @@
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+
1-- |
8-- |
2-- Module : Streamly.Benchmark.Data.Parser
9-- Module : Streamly.Benchmark.Data.Parser
3-- Copyright : (c) 2020 Composewell Technologies
10-- Copyright : (c) 2020 Composewell Technologies
@@ -7,43 +14,42 @@
7
14
8{-# LANGUAGE CPP #-}
15{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
16{-# LANGUAGE FlexibleContexts #-}
17+{-# LANGUAGE ScopedTypeVariables #-}
18+{-# OPTIONS_GHC -Wno-orphans #-}
10
19
11module Main
20module Main
12 (
21 (
13 main
22 main
14 ) where
23 ) where
15
24
25+import Control.Applicative ((<|>))
16import Control.DeepSeq (NFData(..))
26import Control.DeepSeq (NFData(..))
17−import Control.Monad.Catch (MonadCatch)
27+import Data.Function ((&))
18−import Data.Foldable (asum)
19import Data.Functor (($>))
28import Data.Functor (($>))
20−import Data.Maybe (fromMaybe)
21import Data.Monoid (Sum(..))
29import Data.Monoid (Sum(..))
22import GHC.Magic (inline)
30import GHC.Magic (inline)
23−#if __GLASGOW_HASKELL__ >= 802
24import GHC.Magic (noinline)
31import GHC.Magic (noinline)
25−#else
26−#define noinline
27−#endif
28import System.IO (Handle)
32import System.IO (Handle)
29import System.Random (randomRIO)
33import 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)
30−import Prelude
38+import Prelude hiding
31− hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)
39+ (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span)
32
40
33−import qualified Data.Traversable as TR
34−import qualified Data.Foldable as F
35import qualified Control.Applicative as AP
41import qualified Control.Applicative as AP
42+import qualified Data.Foldable as F
43+import qualified Data.Traversable as TR
36import qualified Streamly.FileSystem.Handle as Handle
44import qualified Streamly.FileSystem.Handle as Handle
37−import qualified Streamly.Prelude as S
45+import qualified Streamly.Internal.Data.Array as Array
38−import qualified Streamly.Internal.Data.Array.Foreign as Array
39−import qualified Streamly.Internal.Data.Fold as FL
46+import qualified Streamly.Internal.Data.Fold as Fold
40import qualified Streamly.Internal.Data.Parser as PR
47import qualified Streamly.Internal.Data.Parser as PR
41−import qualified Streamly.Internal.Data.Stream.IsStream as IP
48+import qualified Streamly.Data.Stream as Stream
42import qualified Streamly.Internal.Data.Producer as Producer
49import qualified Streamly.Internal.Data.Producer as Producer
43−import qualified Streamly.Internal.Data.Producer.Source as Source
50+import qualified Streamly.Internal.Data.Stream as Stream
44
51
45−import Gauge hiding (env)
52+import Test.Tasty.Bench hiding (env)
46−import Streamly.Prelude (SerialT)
47import Streamly.Benchmark.Common
53import Streamly.Benchmark.Common
48import Streamly.Benchmark.Common.Handle
54import Streamly.Benchmark.Common.Handle
49
55
@@ -54,19 +60,59 @@ import Streamly.Benchmark.Common.Handle
54-- XXX these can be moved to the common module
60-- XXX these can be moved to the common module
55
61
56{-# INLINE sourceUnfoldrM #-}
62{-# INLINE sourceUnfoldrM #-}
57−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
63+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
58−sourceUnfoldrM value n = S.unfoldrM step n
64+sourceUnfoldrM value n = Stream.unfoldrM step n
59 where
65 where
60 step cnt =
66 step cnt =
61 if cnt > n + value
67 if cnt > n + value
62 then return Nothing
68 then return Nothing
63 else return (Just (cnt, cnt + 1))
69 else return (Just (cnt, cnt + 1))
64
70
71+-- | Generates something like this: { { \{ \{ } }. The stream consists of
72+-- three parts, the first part is contains a sequence of `{`. The second part
73+-- contains a sequence pf escaped values `\{`. The third part contains a
74+-- sequence of `}`.
75+{-# INLINE sourceEscapedFrames #-}
76+sourceEscapedFrames ::
77+ Monad m
78+ => Int
79+ -> Int
80+ -> Stream m Char
81+sourceEscapedFrames value n = Stream.unfoldrM step n
82+ where
83+
84+ bs = '\\'
85+ cbOpen = '{'
86+ cbClose = '}'
87+ value1 = value `div` 4
88+
89+ step cnt
90+ | cnt > 4 * value1 = return Nothing
91+ | cnt <= value1 = return $ Just (cbOpen, cnt + 1)
92+ | cnt > 3 * value1 = return $ Just (cbClose, cnt + 1)
93+ | otherwise =
94+ return
95+ $ Just
96+ $ if (cnt - value1) `mod` 2 == 1
97+ then (bs, cnt + 1)
98+ else (cbOpen, cnt + 1)
99+
100+{-# INLINE benchIOSrc #-}
101+benchIOSrc
102+ :: NFData b
103+ => (Int -> Int -> Stream IO a)
104+ -> Int
105+ -> String
106+ -> (Stream IO a -> IO b)
107+ -> Benchmark
108+benchIOSrc src value name f =
109+ bench name $ nfIO $ randomRIO (1,1) >>= f . src value
110+
65-- | Takes a fold method, and uses it with a default source.
111-- | Takes a fold method, and uses it with a default source.
66{-# INLINE benchIOSink #-}
112{-# INLINE benchIOSink #-}
67benchIOSink
113benchIOSink
68− :: (S.IsStream t, NFData b)
114+ :: NFData b
69− => Int -> String -> (t IO Int -> IO b) -> Benchmark
115+ => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
70benchIOSink value name f =
116benchIOSink value name f =
71 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
117 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
72
118
@@ -75,184 +121,451 @@ benchIOSink value name f =
75-------------------------------------------------------------------------------
121-------------------------------------------------------------------------------
76
122
77{-# INLINE takeBetween #-}
123{-# INLINE takeBetween #-}
78−takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()
124+takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())
79−takeBetween value = IP.parse (PR.takeBetween 0 value FL.drain)
125+takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)
80
126
81{-# INLINE takeEQ #-}
127{-# INLINE takeEQ #-}
82−takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
128+takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())
83−takeEQ value = IP.parse (PR.takeEQ value FL.drain)
129+takeEQ value = Stream.parse (PR.takeEQ value Fold.drain)
84
130
85−{-# INLINE drainWhile #-}
131+{-# INLINE takeGE #-}
86−drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
132+takeGE :: Monad m => Int -> Stream m a -> m (Either ParseError ())
87−drainWhile value = IP.parse (PR.drainWhile (<= value))
133+takeGE value = Stream.parse (PR.takeGE value Fold.drain)
88
134
89−{-# INLINE sliceBeginWith #-}
135+{-# INLINE dropWhile #-}
90−sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
136+dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
137+dropWhile value = Stream.parse (PR.dropWhile (<= value))
138+
139+{-# INLINE takeStartBy #-}
140+takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
91−sliceBeginWith value stream = do
141+takeStartBy value stream = do
92− stream1 <- return . fromMaybe (S.yield (value + 1)) =<< S.tail stream
93− let stream2 = value `S.cons` stream1
142+ let stream2 = value `Stream.cons` stream
94− IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2
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))
95
163
96{-# INLINE takeWhile #-}
164{-# INLINE takeWhile #-}
97−takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
165+takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
98−takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
166+takeWhile value = Stream.parse (PR.takeWhile (<= value) Fold.drain)
167+
168+takeWhileP :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
169+takeWhileP value =
170+ Stream.parse (PR.takeWhileP (<= value) (PR.takeWhile (<= value - 1) Fold.drain))
171+
172+{-# INLINE takeP #-}
173+takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())
174+takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))
99
175
100{-# INLINE groupBy #-}
176{-# INLINE groupBy #-}
101−groupBy :: MonadCatch m => SerialT m Int -> m ()
177+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())
102−groupBy = IP.parse (PR.groupBy (<=) FL.drain)
178+groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)
103
179
104{-# INLINE groupByRolling #-}
180{-# INLINE groupByRolling #-}
105−groupByRolling :: MonadCatch m => SerialT m Int -> m ()
181+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())
106−groupByRolling = IP.parse (PR.groupByRolling (<=) FL.drain)
182+groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)
107
183
108{-# INLINE wordBy #-}
184{-# INLINE wordBy #-}
109−wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()
185+wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
110−wordBy value = IP.parse (PR.wordBy (>= value) FL.drain)
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
111
241
112{-# INLINE manyWordByEven #-}
242{-# INLINE manyWordByEven #-}
113−manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
243+manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())
114−manyWordByEven = IP.parse (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
244+manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)
115
245
116{-# INLINE many #-}
246{-# INLINE many #-}
117−many :: MonadCatch m => SerialT m Int -> m Int
247+many :: Monad m => Stream m Int -> m (Either ParseError Int)
118−many = IP.parse (PR.many (PR.satisfy (> 0)) FL.length)
248+many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
119
249
120{-# INLINE manyAlt #-}
250{-# INLINE manyAlt #-}
121−manyAlt :: MonadCatch m => SerialT m Int -> m Int
251+manyAlt :: Monad m => Stream m Int -> m Int
122manyAlt xs = do
252manyAlt xs = do
123− x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
253+ x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
124 return $ Prelude.length x
254 return $ Prelude.length x
125
255
126{-# INLINE some #-}
256{-# INLINE some #-}
127−some :: MonadCatch m => SerialT m Int -> m Int
257+some :: Monad m => Stream m Int -> m (Either ParseError Int)
128−some = IP.parse (PR.some (PR.satisfy (> 0)) FL.length)
258+some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
129
259
130{-# INLINE someAlt #-}
260{-# INLINE someAlt #-}
131−someAlt :: MonadCatch m => SerialT m Int -> m Int
261+someAlt :: Monad m => Stream m Int -> m Int
132someAlt xs = do
262someAlt xs = do
133− x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
263+ x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
134 return $ Prelude.length x
264 return $ Prelude.length x
135
265
136{-# INLINE manyTill #-}
266{-# INLINE manyTill #-}
137−manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
267+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
138manyTill value =
268manyTill value =
139− IP.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) FL.length)
269+ Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)
140
270
141−{-# INLINE splitAp #-}
271+{-# INLINE splitAp2 #-}
142−splitAp :: MonadCatch m
272+splitAp2 :: Monad m
143− => Int -> SerialT m Int -> m ((), ())
273+ => Int -> Stream m Int -> m (Either ParseError ((), ()))
144−splitAp value =
274+splitAp2 value =
145− IP.parse
275+ Stream.parse
146 ((,)
276 ((,)
147− <$> PR.drainWhile (<= (value `div` 2))
277+ <$> PR.dropWhile (<= (value `div` 2))
148− <*> PR.drainWhile (<= value)
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)
149 )
307 )
150
308
151{-# INLINE splitApBefore #-}
309{-# INLINE splitApBefore #-}
152−splitApBefore :: MonadCatch m
310+splitApBefore :: Monad m
153− => Int -> SerialT m Int -> m ()
311+ => Int -> Stream m Int -> m (Either ParseError ())
154splitApBefore value =
312splitApBefore value =
155− IP.parse
313+ Stream.parse
156− ( PR.drainWhile (<= (value `div` 2))
314+ ( PR.dropWhile (<= (value `div` 2))
157− *> PR.drainWhile (<= value)
315+ *> PR.dropWhile (<= value)
158 )
316 )
159
317
160{-# INLINE splitApAfter #-}
318{-# INLINE splitApAfter #-}
161−splitApAfter :: MonadCatch m
319+splitApAfter :: Monad m
162− => Int -> SerialT m Int -> m ()
320+ => Int -> Stream m Int -> m (Either ParseError ())
163splitApAfter value =
321splitApAfter value =
164− IP.parse
322+ Stream.parse
165− ( PR.drainWhile (<= (value `div` 2))
323+ ( PR.dropWhile (<= (value `div` 2))
166− <* PR.drainWhile (<= value)
324+ <* PR.dropWhile (<= value)
167 )
325 )
168
326
169−{-# INLINE serialWith #-}
327+{-# INLINE splitWith2 #-}
170−serialWith :: MonadCatch m
328+splitWith2 :: Monad m
171− => Int -> SerialT m Int -> m ((), ())
329+ => Int -> Stream m Int -> m (Either ParseError ((), ()))
172−serialWith value =
330+splitWith2 value =
173− IP.parse
331+ Stream.parse
174− (PR.serialWith (,)
332+ (PR.splitWith (,)
175− (PR.drainWhile (<= (value `div` 2)))
333+ (PR.dropWhile (<= (value `div` 2)))
176− (PR.drainWhile (<= value))
334+ (PR.dropWhile (<= value))
177 )
335 )
178
336
179{-# INLINE split_ #-}
337{-# INLINE split_ #-}
180−split_ :: MonadCatch m
338+split_ :: Monad m
181− => Int -> SerialT m Int -> m ()
339+ => Int -> Stream m Int -> m (Either ParseError ())
182split_ value =
340split_ value =
183− IP.parse
341+ Stream.parse
184 (PR.split_
342 (PR.split_
185− (PR.drainWhile (<= (value `div` 2)))
343+ (PR.dropWhile (<= (value `div` 2)))
186− (PR.drainWhile (<= value))
344+ (PR.dropWhile (<= value))
345+ )
346+
347+-- XXX dropWhile with applicative does not fuse
348+-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
349+{-# INLINE takeWhileFail #-}
350+takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
351+takeWhileFail predicate (Fold fstep finitial _ ffinal) =
352+ Parser step initial extract
353+
354+ where
355+
356+ initial = do
357+ res <- finitial
358+ return $ case res of
359+ Fold.Partial s -> IPartial s
360+ Fold.Done b -> IDone b
361+
362+ step s a =
363+ if predicate a
364+ then do
365+ fres <- fstep s a
366+ return
367+ $ case fres of
368+ Fold.Partial s1 -> Partial 0 s1
369+ Fold.Done b -> Done 0 b
370+ else return $ Error "fail"
371+
372+ extract s = fmap (Done 0) (ffinal s)
373+
374+{-# INLINE alt2 #-}
375+alt2 :: Monad m
376+ => Int -> Stream m Int -> m (Either ParseError ())
377+alt2 value =
378+ Stream.parse
379+ (PR.alt
380+ (takeWhileFail (<= (value `div` 2)) Fold.drain)
381+ (PR.dropWhile (<= value))
187 )
382 )
188
383
189−{-# INLINE sliceSepByP #-}
384+{-# INLINE alt4 #-}
190−sliceSepByP :: MonadCatch m
385+alt4 :: Monad m
191− => Int -> SerialT m Int -> m()
386+ => Int -> Stream m Int -> m (Either ParseError ())
192−sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
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+ )
193
409
410+{-# INLINE alt16 #-}
411+alt16 :: Monad m
412+ => Int -> Stream m Int -> m (Either ParseError ())
413+alt16 value =
414+ Stream.parse
415+ ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
416+ <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
417+ <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
418+ <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
419+ <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
420+ <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
421+ <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
422+ <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
423+ <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
424+ <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
425+ <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
426+ <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
427+ <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
428+ <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
429+ <|> PR.dropWhile (<= value)
430+ )
431+
432+{-# INLINE altSmall #-}
433+altSmall :: Monad m
434+ => Int -> Stream m Int -> m ()
435+altSmall value =
436+ Stream.fold Fold.drain .
437+ Stream.parseMany
438+ (PR.alt
439+ (PR.satisfy (>= value) *> PR.die "alt")
440+ (PR.satisfy (<= value))
441+ )
442+
443+{-# INLINE monad #-}
444+monad :: Monad m
445+ => Int -> Stream m Int -> m (Either ParseError ())
446+monad value =
447+ Stream.parse
448+ $ do
449+ PR.dropWhile (<= (value `div` 2))
450+ PR.dropWhile (<= value)
451+
452+{-# INLINE monad4 #-}
453+monad4 :: Monad m
454+ => Int -> Stream m Int -> m (Either ParseError ())
455+monad4 value =
456+ Stream.parse $ do
457+ PR.dropWhile (<= (value `div` 4))
458+ PR.dropWhile (<= (value `div` 2))
459+ PR.dropWhile (<= (value * 3 `div` 4))
460+ PR.dropWhile (<= value)
461+
462+{-# INLINE monad8 #-}
463+monad8 :: Monad m
464+ => Int -> Stream m Int -> m (Either ParseError ())
465+monad8 value =
466+ Stream.parse $ do
467+ PR.dropWhile (<= (value * 1 `div` 8))
468+ PR.dropWhile (<= (value * 2 `div` 8))
469+ PR.dropWhile (<= (value * 3 `div` 8))
470+ PR.dropWhile (<= (value * 4 `div` 8))
471+ PR.dropWhile (<= (value * 5 `div` 8))
472+ PR.dropWhile (<= (value * 6 `div` 8))
473+ PR.dropWhile (<= (value * 7 `div` 8))
474+ PR.dropWhile (<= value)
475+
476+{-# INLINE monad16 #-}
477+monad16 :: Monad m
478+ => Int -> Stream m Int -> m (Either ParseError ())
479+monad16 value =
480+ Stream.parse $ do
481+ PR.dropWhile (<= (value * 1 `div` 16))
482+ PR.dropWhile (<= (value * 2 `div` 16))
483+ PR.dropWhile (<= (value * 3 `div` 16))
484+ PR.dropWhile (<= (value * 4 `div` 16))
485+ PR.dropWhile (<= (value * 5 `div` 16))
486+ PR.dropWhile (<= (value * 6 `div` 16))
487+ PR.dropWhile (<= (value * 7 `div` 16))
488+ PR.dropWhile (<= (value * 8 `div` 16))
489+ PR.dropWhile (<= (value * 9 `div` 16))
490+ PR.dropWhile (<= (value * 10 `div` 16))
491+ PR.dropWhile (<= (value * 11 `div` 16))
492+ PR.dropWhile (<= (value * 12 `div` 16))
493+ PR.dropWhile (<= (value * 13 `div` 16))
494+ PR.dropWhile (<= (value * 14 `div` 16))
495+ PR.dropWhile (<= (value * 15 `div` 16))
496+ PR.dropWhile (<= value)
497+
498+{-# INLINE takeEndBy_ #-}
499+takeEndBy_ :: Monad m
500+ => Int -> Stream m Int -> m (Either ParseError ())
501+takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))
502+
503+{-
194{-# INLINE teeAllAny #-}
504{-# INLINE teeAllAny #-}
195−teeAllAny :: MonadCatch m
505+teeAllAny :: Monad m
196− => Int -> SerialT m Int -> m ((), ())
506+ => Int -> Stream m Int -> m ((), ())
197teeAllAny value =
507teeAllAny value =
198− IP.parse
508+ Stream.parse
199 (PR.teeWith (,)
509 (PR.teeWith (,)
200− (PR.drainWhile (<= value))
510+ (PR.dropWhile (<= value))
201− (PR.drainWhile (<= value))
511+ (PR.dropWhile (<= value))
202 )
512 )
203
513
204{-# INLINE teeFstAllAny #-}
514{-# INLINE teeFstAllAny #-}
205−teeFstAllAny :: MonadCatch m
515+teeFstAllAny :: Monad m
206− => Int -> SerialT m Int -> m ((), ())
516+ => Int -> Stream m Int -> m ((), ())
207teeFstAllAny value =
517teeFstAllAny value =
208− IP.parse
518+ Stream.parse
209 (PR.teeWithFst (,)
519 (PR.teeWithFst (,)
210− (PR.drainWhile (<= value))
520+ (PR.dropWhile (<= value))
211− (PR.drainWhile (<= value))
521+ (PR.dropWhile (<= value))
212 )
522 )
213
523
214{-# INLINE shortestAllAny #-}
524{-# INLINE shortestAllAny #-}
215−shortestAllAny :: MonadCatch m
525+shortestAllAny :: Monad m
216− => Int -> SerialT m Int -> m ()
526+ => Int -> Stream m Int -> m (Either ParseError ())
217shortestAllAny value =
527shortestAllAny value =
218− IP.parse
528+ Stream.parse
219 (PR.shortest
529 (PR.shortest
220− (PR.drainWhile (<= value))
530+ (PR.dropWhile (<= value))
221− (PR.drainWhile (<= value))
531+ (PR.dropWhile (<= value))
222 )
532 )
223
533
224{-# INLINE longestAllAny #-}
534{-# INLINE longestAllAny #-}
225−longestAllAny :: MonadCatch m
535+longestAllAny :: Monad m
226− => Int -> SerialT m Int -> m ()
536+ => Int -> Stream m Int -> m (Either ParseError ())
227longestAllAny value =
537longestAllAny value =
228− IP.parse
538+ Stream.parse
229 (PR.longest
539 (PR.longest
230− (PR.drainWhile (<= value))
540+ (PR.dropWhile (<= value))
231− (PR.drainWhile (<= value))
541+ (PR.dropWhile (<= value))
232 )
542 )
233−
543+-}
234−parseManyChunksOfSum :: Int -> Handle -> IO Int
235−parseManyChunksOfSum n inh =
236− S.length
237− $ IP.parseMany
238− (PR.fromFold $ FL.take n FL.sum)
239− (S.unfold Handle.read inh)
240
544
241-------------------------------------------------------------------------------
545-------------------------------------------------------------------------------
242−-- Parsing with unfolds
546+-- Spanning
243-------------------------------------------------------------------------------
547-------------------------------------------------------------------------------
244
548
245−{-# INLINE parseManyUnfoldArrays #-}
549+{-# INLINE span #-}
246−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
550+span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
247−parseManyUnfoldArrays count arrays = do
551+span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)
248− let src = Source.source (Just (Producer.OuterLoop arrays))
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
249− let parser = PR.fromFold (FL.take count FL.drain)
567+ (PR.fromFold $ Fold.take n Fold.sum)
250− let readSrc =
568+ (Stream.unfold Handle.reader inh)
251− Source.producer
252− $ Producer.concat Producer.fromList Array.producer
253− let streamParser =
254− Producer.simplify (Source.parseMany parser readSrc)
255− S.drain $ S.unfold streamParser src
256
569
257-------------------------------------------------------------------------------
570-------------------------------------------------------------------------------
258-- Parsers in which -fspec-constr-recursive=16 is problematic
571-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -263,57 +576,129 @@ parseManyUnfoldArrays count arrays = do
263-- not have to rely on it.
576-- not have to rely on it.
264--
577--
265{-# INLINE lookAhead #-}
578{-# INLINE lookAhead #-}
266−lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
579+lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
267lookAhead value =
580lookAhead value =
268− IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
581+ Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
269
582
583+-- XXX The timing of this increased 3x after the stepify extract changes.
584+{-# INLINE sequenceA_ #-}
585+sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
586+sequenceA_ value =
587+ Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
588+
589+-- quadratic complexity
270{-# INLINE sequenceA #-}
590{-# INLINE sequenceA #-}
271−sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
591+sequenceA :: Monad m => Int -> Stream m Int -> m Int
272sequenceA value xs = do
592sequenceA value xs = do
273− x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
593+ x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
274 return $ length x
594 return $ length x
275
595
276−{-# INLINE sequenceA_ #-}
596+-- quadratic complexity
277−sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
278−sequenceA_ value =
279− IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
280−
281{-# INLINE sequence #-}
597{-# INLINE sequence #-}
282−sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
598+sequence :: Monad m => Int -> Stream m Int -> m Int
283sequence value xs = do
599sequence value xs = do
284− x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
600+ x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
285 return $ length x
601 return $ length x
286
602
287{-# INLINE sequence_ #-}
603{-# INLINE sequence_ #-}
288−sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
604+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
289−sequence_ value =
605+sequence_ value xs =
290− IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))
606+ Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs
607+
608+ where
609+
610+ {-# INLINE f #-}
611+ f m k = m >>= (\_ -> k)
291
612
613+-- choice using the "Alternative" instance with direct style parser type has
614+-- quadratic performance complexity.
615+--
616+{-# INLINE choiceAsum #-}
617+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
618+choiceAsum value =
619+ Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
620+ AP.<|> PR.satisfy (> 0))
621+
622+{-
292{-# INLINE choice #-}
623{-# INLINE choice #-}
293−choice :: MonadCatch m => Int -> SerialT m Int -> m Int
624+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
294choice value =
625choice value =
626+ Stream.parse
295− IP.parse (asum (replicate value (PR.satisfy (< 0)))
627+ (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
296− 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
297
645
298-------------------------------------------------------------------------------
646-------------------------------------------------------------------------------
299-- Stream transformation
647-- Stream transformation
300-------------------------------------------------------------------------------
648-------------------------------------------------------------------------------
301
649
302{-# INLINE parseMany #-}
650{-# INLINE parseMany #-}
303−parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()
651+parseMany :: Monad m => Int -> Stream m Int -> m ()
304parseMany n =
652parseMany n =
305− S.drain
653+ Stream.fold Fold.drain
306− . S.map getSum
654+ . fmap getSum
307− . IP.parseMany (PR.fromFold $ FL.take n FL.mconcat)
655+ . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)
308− . S.map Sum
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
309
686
310{-# INLINE parseIterate #-}
687{-# INLINE parseIterate #-}
311−parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()
688+parseIterate :: Monad m => Int -> Stream m Int -> m ()
312parseIterate n =
689parseIterate n =
313− S.drain
690+ Stream.fold Fold.drain
314− . S.map getSum
691+ . fmap getSum
692+ . Stream.catRights
693+ . Stream.parseIterate
315− . IP.parseIterate (PR.fromFold . FL.take n . FL.sconcat) (Sum 0)
694+ (PR.fromFold . Fold.take n . Fold.sconcat)
695+ (Sum 0)
316− . S.map Sum
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
317
702
318-------------------------------------------------------------------------------
703-------------------------------------------------------------------------------
319-- Benchmarks
704-- Benchmarks
@@ -322,40 +707,95 @@ parseIterate n =
322moduleName :: String
707moduleName :: String
323moduleName = "Data.Parser"
708moduleName = "Data.Parser"
324
709
710+instance NFData ParseError where
711+ {-# INLINE rnf #-}
712+ rnf (ParseError x) = rnf x
713+
325o_1_space_serial :: Int -> [Benchmark]
714o_1_space_serial :: Int -> [Benchmark]
326o_1_space_serial value =
715o_1_space_serial value =
327 [ benchIOSink value "takeBetween" $ takeBetween value
716 [ benchIOSink value "takeBetween" $ takeBetween value
328− , benchIOSink value "takeEQ" $ takeEQ value
329 , benchIOSink value "takeWhile" $ takeWhile value
717 , benchIOSink value "takeWhile" $ takeWhile value
330− , benchIOSink value "drainWhile" $ drainWhile value
718+ , benchIOSink value "takeWhileP" $ takeWhileP value
331− , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
719+ , benchIOSink value "takeP" $ takeP value
720+ , benchIOSink value "dropWhile" $ dropWhile value
721+ , benchIOSink value "takeStartBy" $ takeStartBy value
722+ , benchIOSink value "takeEndBy_" $ takeEndBy_ value
332 , benchIOSink value "groupBy" $ groupBy
723 , benchIOSink value "groupBy" $ groupBy
333 , benchIOSink value "groupByRolling" $ groupByRolling
724 , benchIOSink value "groupByRolling" $ groupByRolling
334 , benchIOSink value "wordBy" $ wordBy value
725 , benchIOSink value "wordBy" $ wordBy value
335− , benchIOSink value "splitAp" $ splitAp 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
336 , benchIOSink value "splitApBefore" $ splitApBefore value
736 , benchIOSink value "splitApBefore" $ splitApBefore value
337 , benchIOSink value "splitApAfter" $ splitApAfter value
737 , benchIOSink value "splitApAfter" $ splitApAfter value
338− , benchIOSink value "serialWith" $ serialWith 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
339− , benchIOSink value "sliceSepByP" $ sliceSepByP 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
340 , benchIOSink value "many" many
751 , benchIOSink value "many" many
341 , benchIOSink value "many (wordBy even)" $ manyWordByEven
752 , benchIOSink value "many (wordBy even)" $ manyWordByEven
342 , benchIOSink value "some" some
753 , benchIOSink value "some" some
343 , benchIOSink value "manyTill" $ manyTill value
754 , benchIOSink value "manyTill" $ manyTill value
344− , benchIOSink value "tee" $ teeAllAny value
755+ , benchIOSink value "parseMany" $ parseMany value
345− , benchIOSink value "teeFst" $ teeFstAllAny value
346− , benchIOSink value "shortest" $ shortestAllAny value
347− , benchIOSink value "longest" $ longestAllAny value
348 , benchIOSink value "parseMany (take 1)" (parseMany 1)
756 , benchIOSink value "parseMany (take 1)" (parseMany 1)
349 , benchIOSink value "parseMany (take all)" (parseMany value)
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
350 , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
770 , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
351 , benchIOSink value "parseIterate (take all)" (parseIterate value)
771 , benchIOSink value "parseIterate (take all)" (parseIterate value)
772+ , benchIOSink value "concatSequence" concatSequence
773+ {-
774+ , benchIOSink value "tee" $ teeAllAny value
775+ , benchIOSink value "teeFst" $ teeFstAllAny value
776+ , benchIOSink value "shortest" $ shortestAllAny value
777+ , benchIOSink value "longest" $ longestAllAny value
778+ -}
779+ , benchIOSink value "streamEqBy" (streamEqBy value)
352 ]
780 ]
353
781
782+ where
783+
784+ {-# NOINLINE parseManyGroupsRollingEitherLeft #-}
785+ parseManyGroupsRollingEitherLeft = parseManyGroupsRollingEither (<) value
786+
787+ {-# NOINLINE parseManyGroupsRollingEitherRight #-}
788+ parseManyGroupsRollingEitherRight = parseManyGroupsRollingEither (>) value
789+
790+ {-# NOINLINE parseManyGroupsRollingEitherAlt1 #-}
791+ parseManyGroupsRollingEitherAlt1 =
792+ parseManyGroupsRollingEitherAlt (>) value
793+
354o_1_space_filesystem :: BenchEnv -> [Benchmark]
794o_1_space_filesystem :: BenchEnv -> [Benchmark]
355o_1_space_filesystem env =
795o_1_space_filesystem env =
356− [ mkBench ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") env
796+ [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env
357 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
797 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
358− , mkBench "S.parseMany (FL.take 1 FL.sum)" env
798+ , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env
359 $ \inh _ -> inline parseManyChunksOfSum 1 inh
799 $ \inh _ -> inline parseManyChunksOfSum 1 inh
360 ]
800 ]
361
801
@@ -370,25 +810,38 @@ o_1_space_serial_unfold bound arrays =
370o_n_heap_serial :: Int -> [Benchmark]
810o_n_heap_serial :: Int -> [Benchmark]
371o_n_heap_serial value =
811o_n_heap_serial value =
372 [
812 [
813+ benchIOSink value "takeEQ" $ takeEQ value
814+ , benchIOSink value "takeGE" $ takeGE value
815+
373 -- lookahead benchmark holds the entire input till end
816 -- lookahead benchmark holds the entire input till end
374− benchIOSink value "lookAhead" $ lookAhead value
817+ , benchIOSink value "lookAhead" $ lookAhead value
375
818
376− -- accumulates the results in a list
819+ -- o-n-heap because of backtracking
377− , benchIOSink value "sequence" $ sequence value
820+ , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
378− , benchIOSink value "sequenceA" $ sequenceA value
821+ $ takeFramedByEsc_ value
379
822
380− -- XXX why should this take O(n) heap, it discards the results?
381− , benchIOSink value "sequence_" $ sequence_ value
382− , benchIOSink value "sequenceA_" $ sequenceA_ value
383 -- non-linear time complexity (parserD)
823 -- non-linear time complexity (parserD)
384 , benchIOSink value "split_" $ split_ value
824 , benchIOSink value "split_" $ split_ value
385− -- XXX why O(n) heap?
825+ -- XXX Takes lot of space when run on a long stream, why?
386− , benchIOSink value "choice" $ choice value
826+ , benchIOSink value "monad16" $ monad16 value
387
827
388 -- These show non-linear time complexity.
828 -- These show non-linear time complexity.
389 -- They accumulate the results in a list.
829 -- They accumulate the results in a list.
830+ , benchIOSink value "sepBy1" sepBy1
390 , benchIOSink value "manyAlt" manyAlt
831 , benchIOSink value "manyAlt" manyAlt
391 , benchIOSink value "someAlt" someAlt
832 , benchIOSink value "someAlt" someAlt
833+ , benchIOSink value "listEqBy" (listEqBy value)
834+ ]
835+
836+-- accumulate results in a list in IO
837+o_n_space_serial :: Int -> [Benchmark]
838+o_n_space_serial value =
839+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
840+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
841+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)
842+ , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
843+ , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
844+ -- , benchIOSink value "choice/100" $ choice (value `div` 100)
392 ]
845 ]
393
846
394-------------------------------------------------------------------------------
847-------------------------------------------------------------------------------
@@ -397,14 +850,15 @@ o_n_heap_serial value =
397
850
398main :: IO ()
851main :: IO ()
399main = do
852main = do
400− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
853+#ifndef FUSION_CHECK
401 env <- mkHandleBenchEnv
854 env <- mkHandleBenchEnv
402− arrays <- IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
855+ runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
403− value `seq` runMode (mode cfg) cfg benches (allBenchmarks env value arrays)
404
856
405 where
857 where
406
858
859+ alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
860+
407− allBenchmarks env value arrays =
861+ allBenchmarks env arrays value =
408 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
862 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
409 , bgroup
863 , bgroup
410 (o_1_space_prefix moduleName ++ "/filesystem")
864 (o_1_space_prefix moduleName ++ "/filesystem")
@@ -412,4 +866,22 @@ main = do
412 , bgroup (o_1_space_prefix moduleName)
866 , bgroup (o_1_space_prefix moduleName)
413 (o_1_space_serial_unfold value arrays)
867 (o_1_space_serial_unfold value arrays)
414 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
868 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
869+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
415 ]
870 ]
871+#else
872+ -- Enable FUSION_CHECK macro at the beginning of the file
873+ -- Enable one benchmark below, and run the benchmark
874+ -- Check the .dump-simpl output
875+ let value = 100000
876+ -- let input = sourceUnfoldrM value 1
877+ -- manyTill value input
878+ -- deintercalate value input
879+ -- deintercalate1 value input
880+ -- deintercalateAll value input
881+ -- sepByWords input
882+ -- sepByAllWords input
883+ -- sepBy1 input
884+ -- sepByWords1 input
885+ takeFramedByEsc_ value (sourceEscapedFrames value 1)
886+ return ()
887+#endif
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hsdeleted−377
@@ -1,377 +0,0 @@
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−-------------------------------------------------------------------------------
64−-- Parsers
65−-------------------------------------------------------------------------------
66−
67−{-# INLINE drainWhile #-}
68−drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
69−drainWhile p = PR.takeWhile p FL.drain
70−
71−{-# INLINE sliceBeginWith #-}
72−sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
73−sliceBeginWith value stream = do
74− stream1 <- return . fromMaybe (S.yield (value + 1)) =<< S.tail stream
75− let stream2 = value `S.cons` stream1
76− IP.parseD (PR.sliceBeginWith (== value) FL.drain) stream2
77−
78−{-# INLINE takeWhile #-}
79−takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
80−takeWhile value = IP.parseD (drainWhile (<= value))
81−
82−{-# INLINE groupBy #-}
83−groupBy :: MonadThrow m => SerialT m Int -> m ()
84−groupBy = IP.parseD (PR.groupBy (<=) FL.drain)
85−
86−{-# INLINE groupByRolling #-}
87−groupByRolling :: MonadThrow m => SerialT m Int -> m ()
88−groupByRolling = IP.parseD (PR.groupByRolling (<=) FL.drain)
89−
90−{-# INLINE wordBy #-}
91−wordBy :: MonadThrow m => Int -> SerialT m Int -> m ()
92−wordBy value = IP.parseD (PR.wordBy (>= value) FL.drain)
93−
94−{-# INLINE manyWordByEven #-}
95−manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
96−manyWordByEven =
97− IP.parseD (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
98−
99−{-# INLINE many #-}
100−many :: MonadCatch m => SerialT m Int -> m Int
101−many = IP.parseD (PR.many (PR.satisfy (> 0)) FL.length)
102−
103−{-# INLINE manyAlt #-}
104−manyAlt :: MonadCatch m => SerialT m Int -> m Int
105−manyAlt xs = do
106− x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
107− return $ Prelude.length x
108−
109−{-# INLINE some #-}
110−some :: MonadCatch m => SerialT m Int -> m Int
111−some = IP.parseD (PR.some (PR.satisfy (> 0)) FL.length)
112−
113−{-# INLINE someAlt #-}
114−someAlt :: MonadCatch m => SerialT m Int -> m Int
115−someAlt xs = do
116− x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
117− return $ Prelude.length x
118−
119−{-#INLINE sliceSepByP #-}
120−sliceSepByP :: MonadCatch m => Int -> SerialT m Int -> m ()
121−sliceSepByP value = IP.parseD (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
122−
123−{-# INLINE manyTill #-}
124−manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
125−manyTill value =
126− let p = PR.satisfy (> 0)
127− pcond = PR.satisfy (== value)
128− in IP.parseD (PR.manyTill FL.length p pcond)
129−
130−{-# INLINE serialWith #-}
131−serialWith :: MonadThrow m
132− => Int -> SerialT m Int -> m ((), ())
133−serialWith value =
134− IP.parseD
135− ((,)
136− <$> drainWhile (<= (value `div` 2))
137− <*> drainWhile (<= value)
138− )
139−
140−{-# INLINE teeAllAny #-}
141−teeAllAny :: MonadThrow m
142− => Int -> SerialT m Int -> m ((), ())
143−teeAllAny value =
144− IP.parseD
145− (PR.teeWith (,)
146− (drainWhile (<= value))
147− (drainWhile (<= value))
148− )
149−
150−{-# INLINE teeFstAllAny #-}
151−teeFstAllAny :: MonadThrow m
152− => Int -> SerialT m Int -> m ((), ())
153−teeFstAllAny value =
154− IP.parseD
155− (PR.teeWithFst (,)
156− (drainWhile (<= value))
157− (drainWhile (<= value))
158− )
159−
160−{-# INLINE shortestAllAny #-}
161−shortestAllAny :: MonadThrow m
162− => Int -> SerialT m Int -> m ()
163−shortestAllAny value =
164− IP.parseD
165− (PR.shortest
166− (drainWhile (<= value))
167− (drainWhile (<= value))
168− )
169−
170−{-# INLINE longestAllAny #-}
171−longestAllAny :: MonadCatch m
172− => Int -> SerialT m Int -> m ()
173−longestAllAny value =
174− IP.parseD
175− (PR.longest
176− (drainWhile (<= value))
177− (drainWhile (<= value))
178− )
179−
180−-------------------------------------------------------------------------------
181−-- Spanning
182−-------------------------------------------------------------------------------
183−
184−{-# INLINE span #-}
185−span :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
186−span value = IP.parseD (PR.span (<= (value `div` 2)) FL.drain FL.drain)
187−
188−{-# INLINE spanBy #-}
189−spanBy :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
190−spanBy value =
191− IP.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) FL.drain FL.drain)
192−
193−{-# INLINE spanByRolling #-}
194−spanByRolling :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
195−spanByRolling value =
196− IP.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) FL.drain FL.drain)
197−
198−-------------------------------------------------------------------------------
199−-- Nested
200−-------------------------------------------------------------------------------
201−
202−{-# INLINE parseMany #-}
203−parseMany :: MonadThrow m => Int -> SerialT m Int -> m ()
204−parseMany value = IP.drain . IP.parseManyD (drainWhile (<= value + 1))
205−
206−{-# INLINE parseManyGroups #-}
207−parseManyGroups :: MonadThrow m => Bool -> SerialT m Int -> m ()
208−parseManyGroups b = IP.drain . IP.parseManyD (PR.groupBy (\_ _ -> b) FL.drain)
209−
210−{-# INLINE parseManyGroupsRolling #-}
211−parseManyGroupsRolling :: MonadThrow m => Bool -> SerialT m Int -> m ()
212−parseManyGroupsRolling b =
213− IP.drain . IP.parseManyD (PR.groupByRolling (\_ _ -> b) FL.drain)
214−
215−-------------------------------------------------------------------------------
216−-- Parsing with unfolds
217−-------------------------------------------------------------------------------
218−
219−{-# INLINE parseManyUnfoldArrays #-}
220−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
221−parseManyUnfoldArrays count arrays = do
222− let src = Source.source (Just (Producer.OuterLoop arrays))
223− let parser = PR.fromFold (FL.take count FL.drain)
224− let readSrc =
225− Source.producer
226− $ Producer.concat Producer.fromList Array.producer
227− let streamParser =
228− Producer.simplify (Source.parseManyD parser readSrc)
229− S.drain $ S.unfold streamParser src
230−
231−-------------------------------------------------------------------------------
232−-- Parsers in which -fspec-constr-recursive=16 is problematic
233−-------------------------------------------------------------------------------
234−
235−-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
236−-- We need to fix GHC so that we can have better control over that option or do
237−-- not have to rely on it.
238−--
239−{-# INLINE lookAhead #-}
240−lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
241−lookAhead value =
242− IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
243−
244−{-# INLINE sequenceA_ #-}
245−sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
246−sequenceA_ value =
247− IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
248−
249−-- quadratic complexity
250−{-# INLINE sequenceA #-}
251−sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
252−sequenceA value xs = do
253− x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
254− return $ length x
255−
256−-- quadratic complexity
257−{-# INLINE sequence #-}
258−sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
259−sequence value xs = do
260− x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
261− return $ length x
262−
263−{-# INLINE sequence_ #-}
264−sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
265−sequence_ value xs =
266− IP.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 FL.drain))) xs
267−
268− where
269−
270− {-# INLINE f #-}
271− f m k = m >>= (\_ -> k)
272−
273−-- choice using the "Alternative" instance with direct style parser type has
274−-- quadratic performance complexity.
275−--
276−{-# INLINE choice #-}
277−choice :: MonadCatch m => Int -> SerialT m Int -> m Int
278−choice value =
279− IP.parseD (asum (replicate value (PR.satisfy (< 0)))
280− AP.<|> PR.satisfy (> 0))
281−
282−-------------------------------------------------------------------------------
283−-- Benchmarks
284−-------------------------------------------------------------------------------
285−
286−moduleName :: String
287−moduleName = "Data.Parser.ParserD"
288−
289−o_1_space_serial :: Int -> [Benchmark]
290−o_1_space_serial value =
291− [ benchIOSink value "takeWhile" $ takeWhile value
292− , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
293− , benchIOSink value "groupBy" $ groupBy
294− , benchIOSink value "groupByRolling" $ groupByRolling
295− , benchIOSink value "wordBy" $ wordBy value
296− , benchIOSink value "serialWith" $ serialWith value
297− , benchIOSink value "many" many
298− , benchIOSink value "many (wordBy even)" $ manyWordByEven
299− , benchIOSink value "some" some
300− , benchIOSink value "sliceSepByP" $ sliceSepByP value
301− , benchIOSink value "manyTill" $ manyTill value
302− , benchIOSink value "tee (all,any)" $ teeAllAny value
303− , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
304− , benchIOSink value "shortest (all,any)" $ shortestAllAny value
305− , benchIOSink value "longest (all,any)" $ longestAllAny value
306− ]
307−
308−o_1_space_serial_spanning :: Int -> [Benchmark]
309−o_1_space_serial_spanning value =
310− [ benchIOSink value "span" $ span value
311− , benchIOSink value "spanBy" $ spanBy value
312− , benchIOSink value "spanByRolling" $ spanByRolling value
313− ]
314−
315−o_1_space_serial_nested :: Int -> [Benchmark]
316−o_1_space_serial_nested value =
317− [ benchIOSink value "parseMany" $ parseMany value
318− , benchIOSink value "parseMany groupBy (bound groups)"
319− $ (parseManyGroups False)
320− , benchIOSink value "parseMany groupRollingBy (bound groups)"
321− $ (parseManyGroupsRolling False)
322− , benchIOSink value "parseMany groupBy (1 group)" $ (parseManyGroups True)
323− , benchIOSink value "parseMany groupRollingBy (1 group)"
324− $ (parseManyGroupsRolling True)
325− ]
326−
327−o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]
328−o_1_space_serial_unfold bound arrays =
329− [ bench "parseMany/Unfold/1000 arrays/1 parse"
330− $ nfIO $ parseManyUnfoldArrays bound arrays
331− , bench "parseMany/Unfold/1000 arrays/100000 parses"
332− $ nfIO $ parseManyUnfoldArrays 1 arrays
333− ]
334−
335−o_n_heap_serial :: Int -> [Benchmark]
336−o_n_heap_serial value =
337− [
338− -- lookahead benchmark holds the entire input till end
339− benchIOSink value "lookAhead" $ lookAhead value
340−
341− -- These show non-linear time complexity
342− -- They accumulate the results in a list.
343− , benchIOSink value "manyAlt" manyAlt
344− , benchIOSink value "someAlt" someAlt
345− ]
346−
347−-- accumulate results in a list in IO
348−o_n_space_serial :: Int -> [Benchmark]
349−o_n_space_serial value =
350− [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
351− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
352− , benchIOSink value "sequence/100" $ sequence (value `div` 100)
353− , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
354− , benchIOSink value "choice/100" $ choice (value `div` 100)
355− ]
356−
357−-------------------------------------------------------------------------------
358−-- Driver
359−-------------------------------------------------------------------------------
360−
361−main :: IO ()
362−main = do
363− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
364− arrays <- IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
365− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value arrays)
366−
367− where
368−
369− allBenchmarks value arrays =
370− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
371− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)
372− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)
373− , bgroup (o_1_space_prefix moduleName)
374− (o_1_space_serial_unfold value arrays)
375− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
376− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
377− ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hsdeleted−165
@@ -1,165 +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−{-# 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 = do
157− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
158− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
159−
160− where
161−
162− allBenchmarks value =
163− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
164− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
165− ]
benchmark/Streamly/Benchmark/Data/ParserK.hsnew file+437
@@ -0,0 +1,437 @@
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.hsnew file+69
@@ -0,0 +1,69 @@
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.hsnew file+591
@@ -0,0 +1,591 @@
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.hsnew file+24
@@ -0,0 +1,24 @@
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.hsnew file+21
@@ -0,0 +1,21 @@
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.hsnew file+76
@@ -0,0 +1,76 @@
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.hsnew file+114
@@ -0,0 +1,114 @@
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.hsnew file+518
@@ -0,0 +1,518 @@
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.hsnew file+20
@@ -0,0 +1,20 @@
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.hsnew file+208
@@ -0,0 +1,208 @@
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.hsnew file+25
@@ -0,0 +1,25 @@
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.hsnew file+25
@@ -0,0 +1,25 @@
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.hsnew file+25
@@ -0,0 +1,25 @@
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/Prelude/Serial/Elimination.hs → benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hsrenamed+188−123
@@ -1,14 +1,20 @@
1-- |
1-- |
2−-- Module : Serial.Elimination
2+-- Module : Stream.Eliminate
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
6
6
7{-# LANGUAGE CPP #-}
7{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE FlexibleInstances #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RankNTypes #-}
11
12
13+{-# OPTIONS_GHC -Wno-orphans #-}
14+#ifdef USE_PRELUDE
15+{-# OPTIONS_GHC -Wno-deprecations #-}
16+#endif
17+
12#ifdef __HADDOCK_VERSION__
18#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
19#undef INSPECTION
14#endif
20#endif
@@ -18,7 +24,7 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
25#endif
20
26
21−module Serial.Elimination (benchmarks) where
27+module Stream.Eliminate (benchmarks) where
22
28
23import Control.DeepSeq (NFData(..))
29import Control.DeepSeq (NFData(..))
24import Data.Functor.Identity (Identity, runIdentity)
30import Data.Functor.Identity (Identity, runIdentity)
@@ -26,28 +32,45 @@ import System.Random (randomRIO)
26
32
27import qualified Data.Foldable as F
33import qualified Data.Foldable as F
28import qualified GHC.Exts as GHC
34import qualified GHC.Exts as GHC
35+import qualified Streamly.Internal.Data.Fold as Fold
29
36
30#ifdef INSPECTION
37#ifdef INSPECTION
31import GHC.Types (SPEC(..))
38import GHC.Types (SPEC(..))
32import Test.Inspection
39import Test.Inspection
33−
34−import qualified Streamly.Internal.Data.Stream.StreamD as D
40+import qualified Streamly.Internal.Data.Stream as D
35#endif
41#endif
36
42
43+#ifdef USE_PRELUDE
44+import Streamly.Prelude (fromSerial)
37−import qualified Streamly.Prelude as S
45+import Streamly.Benchmark.Prelude
46+import qualified Streamly.Internal.Data.Stream.IsStream as S
38−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
47+import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
48+#else
49+import Stream.Common
50+import Streamly.Internal.Data.Stream (Stream)
51+import qualified Streamly.Internal.Data.Stream as S
52+#ifdef USE_STREAMK
53+import Streamly.Internal.Data.StreamK (StreamK)
54+import qualified Streamly.Data.StreamK as StreamK
55+#else
56+import qualified Streamly.Internal.Data.Stream as StreamK
57+#endif
58+#endif
39
59
40−import Gauge
60+import Test.Tasty.Bench
41−import Streamly.Prelude (SerialT, IsStream, serially)
42import Streamly.Benchmark.Common
61import Streamly.Benchmark.Common
43−import Streamly.Benchmark.Prelude
44import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
62import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
45 lookup, repeat, minimum, maximum, product, last, mapM_, init)
63 lookup, repeat, minimum, maximum, product, last, mapM_, init)
46import qualified Prelude
64import qualified Prelude
47
65
66+#ifdef USE_PRELUDE
67+type Stream = S.SerialT
68+fromStream = id
69+
48{-# INLINE repeat #-}
70{-# INLINE repeat #-}
49repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
71repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
50repeat count = S.take count . S.repeat
72repeat count = S.take count . S.repeat
73+#endif
51
74
52-------------------------------------------------------------------------------
75-------------------------------------------------------------------------------
53-- Elimination
76-- Elimination
@@ -60,90 +83,92 @@ repeat count = S.take count . S.repeat
60{-# INLINE foldableFoldl' #-}
83{-# INLINE foldableFoldl' #-}
61foldableFoldl' :: Int -> Int -> Int
84foldableFoldl' :: Int -> Int -> Int
62foldableFoldl' value n =
85foldableFoldl' value n =
63− F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
86+ F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int)
64
87
65{-# INLINE foldableFoldrElem #-}
88{-# INLINE foldableFoldrElem #-}
66foldableFoldrElem :: Int -> Int -> Bool
89foldableFoldrElem :: Int -> Int -> Bool
67foldableFoldrElem value n =
90foldableFoldrElem value n =
68 F.foldr (\x xs -> x == value || xs)
91 F.foldr (\x xs -> x == value || xs)
69 False
92 False
70− (sourceUnfoldr value n :: S.SerialT Identity Int)
93+ (sourceUnfoldr value n :: Stream Identity Int)
71
94
72{-# INLINE foldableSum #-}
95{-# INLINE foldableSum #-}
73foldableSum :: Int -> Int -> Int
96foldableSum :: Int -> Int -> Int
74foldableSum value n =
97foldableSum value n =
75− Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
98+ Prelude.sum (sourceUnfoldr value n :: Stream Identity Int)
76
99
77{-# INLINE foldableProduct #-}
100{-# INLINE foldableProduct #-}
78foldableProduct :: Int -> Int -> Int
101foldableProduct :: Int -> Int -> Int
79foldableProduct value n =
102foldableProduct value n =
80− Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)
103+ Prelude.product (sourceUnfoldr value n :: Stream Identity Int)
81
104
82{-# INLINE _foldableNull #-}
105{-# INLINE _foldableNull #-}
83_foldableNull :: Int -> Int -> Bool
106_foldableNull :: Int -> Int -> Bool
84_foldableNull value n =
107_foldableNull value n =
85− Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)
108+ Prelude.null (sourceUnfoldr value n :: Stream Identity Int)
86
109
87{-# INLINE foldableElem #-}
110{-# INLINE foldableElem #-}
88foldableElem :: Int -> Int -> Bool
111foldableElem :: Int -> Int -> Bool
89foldableElem value n =
112foldableElem value n =
90− value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
113+ value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int)
91
114
92{-# INLINE foldableNotElem #-}
115{-# INLINE foldableNotElem #-}
93foldableNotElem :: Int -> Int -> Bool
116foldableNotElem :: Int -> Int -> Bool
94foldableNotElem value n =
117foldableNotElem value n =
95− value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
118+ value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int)
96
119
97{-# INLINE foldableFind #-}
120{-# INLINE foldableFind #-}
98foldableFind :: Int -> Int -> Maybe Int
121foldableFind :: Int -> Int -> Maybe Int
99foldableFind value n =
122foldableFind value n =
100− F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
123+ F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
101
124
102{-# INLINE foldableAll #-}
125{-# INLINE foldableAll #-}
103foldableAll :: Int -> Int -> Bool
126foldableAll :: Int -> Int -> Bool
104foldableAll value n =
127foldableAll value n =
105− Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
128+ Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
106
129
107{-# INLINE foldableAny #-}
130{-# INLINE foldableAny #-}
108foldableAny :: Int -> Int -> Bool
131foldableAny :: Int -> Int -> Bool
109foldableAny value n =
132foldableAny value n =
110− Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
133+ Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
111
134
135+{- HLINT ignore "Use all"-}
112{-# INLINE foldableAnd #-}
136{-# INLINE foldableAnd #-}
113foldableAnd :: Int -> Int -> Bool
137foldableAnd :: Int -> Int -> Bool
114foldableAnd value n =
138foldableAnd value n =
115− Prelude.and $ S.map
139+ Prelude.and $ fmap
116− (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
140+ (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
117
141
142+{- HLINT ignore "Use any"-}
118{-# INLINE foldableOr #-}
143{-# INLINE foldableOr #-}
119foldableOr :: Int -> Int -> Bool
144foldableOr :: Int -> Int -> Bool
120foldableOr value n =
145foldableOr value n =
121− Prelude.or $ S.map
146+ Prelude.or $ fmap
122− (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
147+ (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
123
148
124{-# INLINE foldableLength #-}
149{-# INLINE foldableLength #-}
125foldableLength :: Int -> Int -> Int
150foldableLength :: Int -> Int -> Int
126foldableLength value n =
151foldableLength value n =
127− Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)
152+ Prelude.length (sourceUnfoldr value n :: Stream Identity Int)
128
153
129{-# INLINE foldableMin #-}
154{-# INLINE foldableMin #-}
130foldableMin :: Int -> Int -> Int
155foldableMin :: Int -> Int -> Int
131foldableMin value n =
156foldableMin value n =
132− Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
157+ Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int)
133
158
134{-# INLINE ordInstanceMin #-}
159{-# INLINE ordInstanceMin #-}
135−ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
160+ordInstanceMin :: Stream Identity Int -> Stream Identity Int
136ordInstanceMin src = min src src
161ordInstanceMin src = min src src
137
162
138{-# INLINE foldableMax #-}
163{-# INLINE foldableMax #-}
139foldableMax :: Int -> Int -> Int
164foldableMax :: Int -> Int -> Int
140foldableMax value n =
165foldableMax value n =
141− Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
166+ Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int)
142
167
143{-# INLINE foldableMinBy #-}
168{-# INLINE foldableMinBy #-}
144foldableMinBy :: Int -> Int -> Int
169foldableMinBy :: Int -> Int -> Int
145foldableMinBy value n =
170foldableMinBy value n =
146− F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
171+ F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int)
147
172
148{-# INLINE foldableListMinBy #-}
173{-# INLINE foldableListMinBy #-}
149foldableListMinBy :: Int -> Int -> Int
174foldableListMinBy :: Int -> Int -> Int
@@ -152,30 +177,30 @@ foldableListMinBy value n = F.minimumBy compare [1..value+n]
152{-# INLINE foldableMaxBy #-}
177{-# INLINE foldableMaxBy #-}
153foldableMaxBy :: Int -> Int -> Int
178foldableMaxBy :: Int -> Int -> Int
154foldableMaxBy value n =
179foldableMaxBy value n =
155− F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
180+ F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int)
156
181
157{-# INLINE foldableToList #-}
182{-# INLINE foldableToList #-}
158foldableToList :: Int -> Int -> [Int]
183foldableToList :: Int -> Int -> [Int]
159foldableToList value n =
184foldableToList value n =
160− F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
185+ F.toList (sourceUnfoldr value n :: Stream Identity Int)
161
186
162{-# INLINE foldableMapM_ #-}
187{-# INLINE foldableMapM_ #-}
163foldableMapM_ :: Monad m => Int -> Int -> m ()
188foldableMapM_ :: Monad m => Int -> Int -> m ()
164foldableMapM_ value n =
189foldableMapM_ value n =
165− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
190+ F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int)
166
191
167{-# INLINE foldableSequence_ #-}
192{-# INLINE foldableSequence_ #-}
168foldableSequence_ :: Int -> Int -> IO ()
193foldableSequence_ :: Int -> Int -> IO ()
169foldableSequence_ value n =
194foldableSequence_ value n =
170− F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
195+ F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int))
171
196
172{-# INLINE _foldableMsum #-}
197{-# INLINE _foldableMsum #-}
173_foldableMsum :: Int -> Int -> IO Int
198_foldableMsum :: Int -> Int -> IO Int
174_foldableMsum value n =
199_foldableMsum value n =
175− F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
200+ F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int))
176
201
177{-# INLINE showInstance #-}
202{-# INLINE showInstance #-}
178−showInstance :: SerialT Identity Int -> String
203+showInstance :: Stream Identity Int -> String
179showInstance = show
204showInstance = show
180
205
181o_1_space_elimination_foldable :: Int -> [Benchmark]
206o_1_space_elimination_foldable :: Int -> [Benchmark]
@@ -192,6 +217,9 @@ o_1_space_elimination_foldable value =
192 , bench "minimum" $ nf (foldableMin value) 1
217 , bench "minimum" $ nf (foldableMin value) 1
193 , benchPureSink value "min (ord)" ordInstanceMin
218 , benchPureSink value "min (ord)" ordInstanceMin
194 , bench "maximum" $ nf (foldableMax value) 1
219 , bench "maximum" $ nf (foldableMax value) 1
220+ , bench "minimumBy" $ nf (`foldableMinBy` 1) value
221+ , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
222+ , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
195 , bench "length . toList"
223 , bench "length . toList"
196 $ nf (Prelude.length . foldableToList value) 1
224 $ nf (Prelude.length . foldableToList value) 1
197 , bench "notElem" $ nf (foldableNotElem value) 1
225 , bench "notElem" $ nf (foldableNotElem value) 1
@@ -214,34 +242,25 @@ o_1_space_elimination_foldable value =
214 ]
242 ]
215 ]
243 ]
216
244
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−
232-------------------------------------------------------------------------------
245-------------------------------------------------------------------------------
233-- Stream folds
246-- Stream folds
234-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
235
248
249+#ifndef USE_PRELUDE
250+instance NFData a => NFData (Stream Identity a) where
251+ {-# INLINE rnf #-}
252+ rnf xs = runIdentity $ S.fold (Fold.foldl' (\_ x -> rnf x) ()) xs
253+#endif
254+
236{-# INLINE benchPureSink #-}
255{-# INLINE benchPureSink #-}
237benchPureSink :: NFData b
256benchPureSink :: NFData b
238− => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
257+ => Int -> String -> (Stream Identity Int -> b) -> Benchmark
239benchPureSink value name = benchPure name (sourceUnfoldr value)
258benchPureSink value name = benchPure name (sourceUnfoldr value)
240
259
241{-# INLINE benchHoistSink #-}
260{-# INLINE benchHoistSink #-}
242benchHoistSink
261benchHoistSink
243− :: (IsStream t, NFData b)
262+ :: (NFData b)
244− => Int -> String -> (t Identity Int -> IO b) -> Benchmark
263+ => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
245benchHoistSink value name f =
264benchHoistSink value name f =
246 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
265 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
247
266
@@ -249,8 +268,8 @@ benchHoistSink value name f =
249-- we can't use it as it requires MonadAsync constraint.
268-- we can't use it as it requires MonadAsync constraint.
250{-# INLINE benchIdentitySink #-}
269{-# INLINE benchIdentitySink #-}
251benchIdentitySink
270benchIdentitySink
252− :: (IsStream t, NFData b)
271+ :: (NFData b)
253− => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
272+ => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark
254benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
273benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
255
274
256-------------------------------------------------------------------------------
275-------------------------------------------------------------------------------
@@ -258,23 +277,29 @@ benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
258-------------------------------------------------------------------------------
277-------------------------------------------------------------------------------
259
278
260{-# INLINE uncons #-}
279{-# INLINE uncons #-}
280+#ifdef USE_STREAMK
281+uncons :: Monad m => StreamK m Int -> m ()
282+#else
261−uncons :: Monad m => SerialT m Int -> m ()
283+uncons :: Monad m => Stream m Int -> m ()
284+#endif
262uncons s = do
285uncons s = do
263− r <- S.uncons s
286+ r <- StreamK.uncons s
264 case r of
287 case r of
265 Nothing -> return ()
288 Nothing -> return ()
266 Just (_, t) -> uncons t
289 Just (_, t) -> uncons t
267
290
291+#ifdef USE_PRELUDE
268{-# INLINE init #-}
292{-# INLINE init #-}
269−init :: Monad m => SerialT m a -> m ()
293+init :: Monad m => Stream m a -> m ()
270init s = S.init s >>= Prelude.mapM_ S.drain
294init s = S.init s >>= Prelude.mapM_ S.drain
271
295
272{-# INLINE mapM_ #-}
296{-# INLINE mapM_ #-}
273−mapM_ :: Monad m => SerialT m Int -> m ()
297+mapM_ :: Monad m => Stream m Int -> m ()
274mapM_ = S.mapM_ (\_ -> return ())
298mapM_ = S.mapM_ (\_ -> return ())
299+#endif
275
300
276{-# INLINE foldrMElem #-}
301{-# INLINE foldrMElem #-}
277−foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
302+foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
278foldrMElem e =
303foldrMElem e =
279 S.foldrM
304 S.foldrM
280 (\x xs ->
305 (\x xs ->
@@ -283,159 +308,191 @@ foldrMElem e =
283 else xs)
308 else xs)
284 (return False)
309 (return False)
285
310
311+#ifdef USE_STREAMK
286{-# INLINE foldrToStream #-}
312{-# INLINE foldrToStream #-}
287−foldrToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)
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)
288−foldrToStream = S.foldr S.cons S.nil
318+-- foldrToStream = S.foldr S.cons S.nil
319+#endif
289
320
290{-# INLINE foldrMBuild #-}
321{-# INLINE foldrMBuild #-}
291−foldrMBuild :: Monad m => SerialT m Int -> m [Int]
322+foldrMBuild :: Monad m => Stream m Int -> m [Int]
292foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
323foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
293
324
325+#ifdef USE_PRELUDE
294{-# INLINE foldl'Reduce #-}
326{-# INLINE foldl'Reduce #-}
295−foldl'Reduce :: Monad m => SerialT m Int -> m Int
327+foldl'Reduce :: Monad m => Stream m Int -> m Int
296foldl'Reduce = S.foldl' (+) 0
328foldl'Reduce = S.foldl' (+) 0
297
329
298{-# INLINE foldl1'Reduce #-}
330{-# INLINE foldl1'Reduce #-}
299−foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)
331+foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
300foldl1'Reduce = S.foldl1' (+)
332foldl1'Reduce = S.foldl1' (+)
301
333
302{-# INLINE foldlM'Reduce #-}
334{-# INLINE foldlM'Reduce #-}
303−foldlM'Reduce :: Monad m => SerialT m Int -> m Int
335+foldlM'Reduce :: Monad m => Stream m Int -> m Int
304foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
336foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
305
337
306{-# INLINE last #-}
338{-# INLINE last #-}
307−last :: Monad m => SerialT m Int -> m (Maybe Int)
339+last :: Monad m => Stream m Int -> m (Maybe Int)
308last = S.last
340last = S.last
309
341
310{-# INLINE _head #-}
342{-# INLINE _head #-}
311−_head :: Monad m => SerialT m Int -> m (Maybe Int)
343+_head :: Monad m => Stream m Int -> m (Maybe Int)
312_head = S.head
344_head = S.head
313
345
314{-# INLINE elem #-}
346{-# INLINE elem #-}
315−elem :: Monad m => Int -> SerialT m Int -> m Bool
347+elem :: Monad m => Int -> Stream m Int -> m Bool
316elem value = S.elem (value + 1)
348elem value = S.elem (value + 1)
317
349
318{-# INLINE notElem #-}
350{-# INLINE notElem #-}
319−notElem :: Monad m => Int -> SerialT m Int -> m Bool
351+notElem :: Monad m => Int -> Stream m Int -> m Bool
320notElem value = S.notElem (value + 1)
352notElem value = S.notElem (value + 1)
321
353
322{-# INLINE length #-}
354{-# INLINE length #-}
323−length :: Monad m => SerialT m Int -> m Int
355+length :: Monad m => Stream m Int -> m Int
324length = S.length
356length = S.length
325
357
326{-# INLINE all #-}
358{-# INLINE all #-}
327−all :: Monad m => Int -> SerialT m Int -> m Bool
359+all :: Monad m => Int -> Stream m Int -> m Bool
328all value = S.all (<= (value + 1))
360all value = S.all (<= (value + 1))
329
361
330{-# INLINE any #-}
362{-# INLINE any #-}
331−any :: Monad m => Int -> SerialT m Int -> m Bool
363+any :: Monad m => Int -> Stream m Int -> m Bool
332any value = S.any (> (value + 1))
364any value = S.any (> (value + 1))
333
365
334{-# INLINE and #-}
366{-# INLINE and #-}
335−and :: Monad m => Int -> SerialT m Int -> m Bool
367+and :: Monad m => Int -> Stream m Int -> m Bool
336and value = S.and . S.map (<= (value + 1))
368and value = S.and . S.map (<= (value + 1))
337
369
338{-# INLINE or #-}
370{-# INLINE or #-}
339−or :: Monad m => Int -> SerialT m Int -> m Bool
371+or :: Monad m => Int -> Stream m Int -> m Bool
340or value = S.or . S.map (> (value + 1))
372or value = S.or . S.map (> (value + 1))
341
373
342{-# INLINE find #-}
374{-# INLINE find #-}
343−find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
375+find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
344find value = S.find (== (value + 1))
376find value = S.find (== (value + 1))
345
377
346{-# INLINE findM #-}
378{-# INLINE findM #-}
347−findM :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
379+findM :: Monad m => Int -> Stream m Int -> m (Maybe Int)
348findM value = S.findM (\z -> return $ z == (value + 1))
380findM value = S.findM (\z -> return $ z == (value + 1))
349
381
350{-# INLINE findIndex #-}
382{-# INLINE findIndex #-}
351−findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
383+findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
352findIndex value = S.findIndex (== (value + 1))
384findIndex value = S.findIndex (== (value + 1))
353
385
354{-# INLINE elemIndex #-}
386{-# INLINE elemIndex #-}
355−elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
387+elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
356elemIndex value = S.elemIndex (value + 1)
388elemIndex value = S.elemIndex (value + 1)
357
389
358{-# INLINE maximum #-}
390{-# INLINE maximum #-}
359−maximum :: Monad m => SerialT m Int -> m (Maybe Int)
391+maximum :: Monad m => Stream m Int -> m (Maybe Int)
360maximum = S.maximum
392maximum = S.maximum
361
393
362{-# INLINE minimum #-}
394{-# INLINE minimum #-}
363−minimum :: Monad m => SerialT m Int -> m (Maybe Int)
395+minimum :: Monad m => Stream m Int -> m (Maybe Int)
364minimum = S.minimum
396minimum = S.minimum
365
397
366{-# INLINE sum #-}
398{-# INLINE sum #-}
367−sum :: Monad m => SerialT m Int -> m Int
399+sum :: Monad m => Stream m Int -> m Int
368sum = S.sum
400sum = S.sum
369
401
370{-# INLINE product #-}
402{-# INLINE product #-}
371−product :: Monad m => SerialT m Int -> m Int
403+product :: Monad m => Stream m Int -> m Int
372product = S.product
404product = S.product
373
405
374{-# INLINE minimumBy #-}
406{-# INLINE minimumBy #-}
375−minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)
407+minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
376minimumBy = S.minimumBy compare
408minimumBy = S.minimumBy compare
377
409
378{-# INLINE maximumBy #-}
410{-# INLINE maximumBy #-}
379−maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
411+maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
380maximumBy = S.maximumBy compare
412maximumBy = S.maximumBy compare
381
413
382{-# INLINE the #-}
414{-# INLINE the #-}
383−the :: Monad m => SerialT m Int -> m (Maybe Int)
415+the :: Monad m => Stream m Int -> m (Maybe Int)
384the = S.the
416the = S.the
385
417
386{-# INLINE drainN #-}
418{-# INLINE drainN #-}
387−drainN :: Monad m => Int -> SerialT m Int -> m ()
419+drainN :: Monad m => Int -> Stream m Int -> m ()
388drainN = S.drainN
420drainN = S.drainN
389
421
390{-# INLINE drainWhile #-}
422{-# INLINE drainWhile #-}
391−drainWhile :: Monad m => SerialT m Int -> m ()
423+drainWhile :: Monad m => Stream m Int -> m ()
392drainWhile = S.drainWhile (const True)
424drainWhile = S.drainWhile (const True)
393
425
394{-# INLINE (!!) #-}
426{-# INLINE (!!) #-}
395−(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
427+(!!) :: Monad m => Int -> Stream m Int -> m (Maybe Int)
396−(!!) = flip (Internal.!!)
428+(!!) = flip (S.!!)
397
429
398{-# INLINE lookup #-}
430{-# INLINE lookup #-}
399−lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
431+lookup :: Monad m => Int -> Stream m Int -> m (Maybe Int)
400lookup val = S.lookup val . S.map (\x -> (x, x))
432lookup val = S.lookup val . S.map (\x -> (x, x))
433+#endif
401
434
402o_1_space_elimination_folds :: Int -> [Benchmark]
435o_1_space_elimination_folds :: Int -> [Benchmark]
403o_1_space_elimination_folds value =
436o_1_space_elimination_folds value =
404 [ bgroup "elimination"
437 [ bgroup "elimination"
405 -- Basic folds
438 -- Basic folds
439+ [
440+#ifdef USE_PRELUDE
406− [ bgroup "reduce"
441+ bgroup "reduce"
407 [ bgroup
442 [ bgroup
408 "IO"
443 "IO"
409 [ benchIOSink value "foldl'" foldl'Reduce
444 [ benchIOSink value "foldl'" foldl'Reduce
410 , benchIOSink value "foldl1'" foldl1'Reduce
445 , benchIOSink value "foldl1'" foldl1'Reduce
411 , benchIOSink value "foldlM'" foldlM'Reduce
446 , benchIOSink value "foldlM'" foldlM'Reduce
412 ]
447 ]
448+
413 , bgroup
449 , bgroup
414 "Identity"
450 "Identity"
415 [ benchIdentitySink value "foldl'" foldl'Reduce
451 [ benchIdentitySink value "foldl'" foldl'Reduce
416 , benchIdentitySink value "foldl1'" foldl1'Reduce
452 , benchIdentitySink value "foldl1'" foldl1'Reduce
417 , benchIdentitySink value "foldlM'" foldlM'Reduce
453 , benchIdentitySink value "foldlM'" foldlM'Reduce
418 ]
454 ]
419− ]
455+ ] ,
456+#endif
420− , bgroup "build"
457+ bgroup "build"
421 [ bgroup "IO"
458 [ bgroup "IO"
422 [ benchIOSink value "foldrMElem" (foldrMElem value)
459 [ benchIOSink value "foldrMElem" (foldrMElem value)
423 ]
460 ]
424 , bgroup "Identity"
461 , bgroup "Identity"
425 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
462 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
463+#ifdef USE_STREAMK
426 , benchIdentitySink value "foldrToStreamLength"
464 , benchIdentitySink value "foldrToStreamLength"
465+ (S.fold Fold.length . toStream . runIdentity . foldrToStream)
466+ {-
467+ , benchIdentitySink 16 "foldrToStreamLength (16)"
468+ (S.fold Fold.length . toStream . runIdentity . foldrToStream)
469+ -}
470+#else
471+ {-
472+ , benchIdentitySink 16 "foldrToStreamLength (16)"
427− (S.length . runIdentity . foldrToStream)
473+ (S.fold Fold.length . runIdentity . foldrToStream)
474+ -}
475+#endif
476+ {-
477+ , benchPureSink 16 "foldrMToListLength (16)"
478+ (Prelude.length . runIdentity . foldrMBuild)
479+ -}
428 , benchPureSink value "foldrMToListLength"
480 , benchPureSink value "foldrMToListLength"
429 (Prelude.length . runIdentity . foldrMBuild)
481 (Prelude.length . runIdentity . foldrMBuild)
430 ]
482 ]
431 ]
483 ]
432
484
433 -- deconstruction
485 -- deconstruction
434− , benchIOSink value "uncons" uncons
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
435 , benchIOSink value "init" init
492 , benchIOSink value "init" init
436
493
437 -- draining
494 -- draining
438− , benchIOSink value "drain" $ toNull serially
495+ , benchIOSink value "drain" $ toNull fromSerial
439 , benchIOSink value "drainN" $ drainN value
496 , benchIOSink value "drainN" $ drainN value
440 , benchIOSink value "drainWhile" drainWhile
497 , benchIOSink value "drainWhile" drainWhile
441 , benchPureSink value "drain (pure)" id
498 , benchPureSink value "drain (pure)" id
@@ -445,8 +502,6 @@ o_1_space_elimination_folds value =
445 -- , benchIOSink value "head" head
502 -- , benchIOSink value "head" head
446 , benchIOSink value "last" last
503 , benchIOSink value "last" last
447 , benchIOSink value "length" length
504 , benchIOSink value "length" length
448− , benchHoistSink value "length . generally"
449− (length . Internal.generally)
450 , benchIOSink value "sum" sum
505 , benchIOSink value "sum" sum
451 , benchIOSink value "product" product
506 , benchIOSink value "product" product
452 , benchIOSink value "maximumBy" maximumBy
507 , benchIOSink value "maximumBy" maximumBy
@@ -470,8 +525,8 @@ o_1_space_elimination_folds value =
470 , benchIOSink value "any" (any value)
525 , benchIOSink value "any" (any value)
471 , benchIOSink value "and" (and value)
526 , benchIOSink value "and" (and value)
472 , benchIOSink value "or" (or value)
527 , benchIOSink value "or" (or value)
528+#endif
473
529
474− , benchPureSink value "showsPrec pure streams" showInstance
475 -- length is used to check for foldr/build fusion
530 -- length is used to check for foldr/build fusion
476 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
531 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
477 ]
532 ]
@@ -481,12 +536,13 @@ o_1_space_elimination_folds value =
481-- Buffered Transformations by fold
536-- Buffered Transformations by fold
482-------------------------------------------------------------------------------
537-------------------------------------------------------------------------------
483
538
539+#ifdef USE_PRELUDE
484{-# INLINE foldl'Build #-}
540{-# INLINE foldl'Build #-}
485−foldl'Build :: Monad m => SerialT m Int -> m [Int]
541+foldl'Build :: Monad m => Stream m Int -> m [Int]
486foldl'Build = S.foldl' (flip (:)) []
542foldl'Build = S.foldl' (flip (:)) []
487
543
488{-# INLINE foldlM'Build #-}
544{-# INLINE foldlM'Build #-}
489−foldlM'Build :: Monad m => SerialT m Int -> m [Int]
545+foldlM'Build :: Monad m => Stream m Int -> m [Int]
490foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
546foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
491
547
492o_n_heap_elimination_foldl :: Int -> [Benchmark]
548o_n_heap_elimination_foldl :: Int -> [Benchmark]
@@ -500,6 +556,7 @@ o_n_heap_elimination_foldl value =
500 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
556 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
501 ]
557 ]
502 ]
558 ]
559+#endif
503
560
504-- For comparisons
561-- For comparisons
505{-# INLINE showInstanceList #-}
562{-# INLINE showInstanceList #-}
@@ -513,11 +570,13 @@ o_n_heap_elimination_buffered value =
513 -- XXX can the outputs be streaming? Can we have special read/show
570 -- XXX can the outputs be streaming? Can we have special read/show
514 -- style type classes, readM/showM supporting streaming effects?
571 -- style type classes, readM/showM supporting streaming effects?
515 [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)
572 [ bench "showPrec Haskell lists" $ nf showInstanceList (mkList value)
573+ -- XXX This is not o-1-space for GHC-8.10
574+ , benchPureSink value "showsPrec pure streams" showInstance
516 ]
575 ]
517 ]
576 ]
518
577
519{-# INLINE foldrMReduce #-}
578{-# INLINE foldrMReduce #-}
520−foldrMReduce :: Monad m => SerialT m Int -> m Int
579+foldrMReduce :: Monad m => Stream m Int -> m Int
521foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
580foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
522
581
523o_n_space_elimination_foldr :: Int -> [Benchmark]
582o_n_space_elimination_foldr :: Int -> [Benchmark]
@@ -533,12 +592,14 @@ o_n_space_elimination_foldr value =
533 ]
592 ]
534 ]
593 ]
535
594
595+#ifdef USE_PRELUDE
536o_n_heap_elimination_toList :: Int -> [Benchmark]
596o_n_heap_elimination_toList :: Int -> [Benchmark]
537o_n_heap_elimination_toList value =
597o_n_heap_elimination_toList value =
538 [ bgroup "toList"
598 [ bgroup "toList"
539 -- Converting the stream to a list or pure stream in a strict monad
599 -- Converting the stream to a list or pure stream in a strict monad
540− [ benchIOSink value "toListRev" Internal.toListRev
600+ [ benchIOSink value "toListRev" S.toListRev
541− , benchIOSink value "toStreamRev" Internal.toStreamRev
601+ , benchIOSink value "toStreamRev"
602+ (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))
542 ]
603 ]
543 ]
604 ]
544
605
@@ -547,9 +608,13 @@ o_n_space_elimination_toList value =
547 [ bgroup "toList"
608 [ bgroup "toList"
548 -- Converting the stream to a list or pure stream in a strict monad
609 -- Converting the stream to a list or pure stream in a strict monad
549 [ benchIOSink value "toList" S.toList
610 [ benchIOSink value "toList" S.toList
611+#ifndef USE_PRELUDE
550− , benchIOSink value "toStream" Internal.toStream
612+ , benchIOSink value "toStream"
613+ (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))
614+#endif
551 ]
615 ]
552 ]
616 ]
617+#endif
553
618
554-------------------------------------------------------------------------------
619-------------------------------------------------------------------------------
555-- Multi-stream folds
620-- Multi-stream folds
@@ -560,7 +625,7 @@ o_n_space_elimination_toList value =
560-------------------------------------------------------------------------------
625-------------------------------------------------------------------------------
561
626
562{-# INLINE eqBy' #-}
627{-# INLINE eqBy' #-}
563−eqBy' :: (Monad m, Eq a) => SerialT m a -> m Bool
628+eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool
564eqBy' src = S.eqBy (==) src src
629eqBy' src = S.eqBy (==) src src
565
630
566{-# INLINE eqByPure #-}
631{-# INLINE eqByPure #-}
@@ -574,15 +639,15 @@ inspect $ 'eqByPure `hasNoType` ''D.Step
574#endif
639#endif
575
640
576{-# INLINE eqInstance #-}
641{-# INLINE eqInstance #-}
577−eqInstance :: SerialT Identity Int -> Bool
642+eqInstance :: Stream Identity Int -> Bool
578eqInstance src = src == src
643eqInstance src = src == src
579
644
580{-# INLINE eqInstanceNotEq #-}
645{-# INLINE eqInstanceNotEq #-}
581−eqInstanceNotEq :: SerialT Identity Int -> Bool
646+eqInstanceNotEq :: Stream Identity Int -> Bool
582eqInstanceNotEq src = src /= src
647eqInstanceNotEq src = src /= src
583
648
584{-# INLINE cmpBy' #-}
649{-# INLINE cmpBy' #-}
585−cmpBy' :: (Monad m, Ord a) => SerialT m a -> m Ordering
650+cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering
586cmpBy' src = S.cmpBy compare src src
651cmpBy' src = S.cmpBy compare src src
587
652
588{-# INLINE cmpByPure #-}
653{-# INLINE cmpByPure #-}
@@ -596,7 +661,7 @@ inspect $ 'cmpByPure `hasNoType` ''D.Step
596#endif
661#endif
597
662
598{-# INLINE ordInstance #-}
663{-# INLINE ordInstance #-}
599−ordInstance :: SerialT Identity Int -> Bool
664+ordInstance :: Stream Identity Int -> Bool
600ordInstance src = src < src
665ordInstance src = src < src
601
666
602o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
667o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
@@ -611,15 +676,15 @@ o_1_space_elimination_multi_stream_pure value =
611 ]
676 ]
612
677
613{-# INLINE isPrefixOf #-}
678{-# INLINE isPrefixOf #-}
614−isPrefixOf :: Monad m => SerialT m Int -> m Bool
679+isPrefixOf :: Monad m => Stream m Int -> m Bool
615isPrefixOf src = S.isPrefixOf src src
680isPrefixOf src = S.isPrefixOf src src
616
681
617{-# INLINE isSubsequenceOf #-}
682{-# INLINE isSubsequenceOf #-}
618−isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
683+isSubsequenceOf :: Monad m => Stream m Int -> m Bool
619isSubsequenceOf src = S.isSubsequenceOf src src
684isSubsequenceOf src = S.isSubsequenceOf src src
620
685
621{-# INLINE stripPrefix #-}
686{-# INLINE stripPrefix #-}
622−stripPrefix :: Monad m => SerialT m Int -> m ()
687+stripPrefix :: Monad m => Stream m Int -> m ()
623stripPrefix src = do
688stripPrefix src = do
624 _ <- S.stripPrefix src src
689 _ <- S.stripPrefix src src
625 return ()
690 return ()
@@ -670,14 +735,14 @@ benchmarks moduleName size =
670 , o_1_space_elimination_multi_stream_pure size
735 , o_1_space_elimination_multi_stream_pure size
671 , o_1_space_elimination_multi_stream size
736 , o_1_space_elimination_multi_stream size
672 ]
737 ]
738+
673− , bgroup (o_n_heap_prefix moduleName) $ concat
739+ , bgroup (o_n_heap_prefix moduleName) $
740+ o_n_heap_elimination_buffered size
741+#ifdef USE_PRELUDE
674− [ o_n_heap_elimination_foldl size
742+ ++ o_n_heap_elimination_foldl size
675− , o_n_heap_elimination_toList size
743+ ++ o_n_heap_elimination_toList size
676− , o_n_heap_elimination_buffered size
744+ ++ o_n_space_elimination_toList size
677− ]
745+#endif
678− , bgroup (o_n_space_prefix moduleName) $ concat
746+ , bgroup (o_n_space_prefix moduleName) $
679− [ o_n_space_elimination_foldable size
680− , o_n_space_elimination_toList size
681− , o_n_space_elimination_foldr size
747+ o_n_space_elimination_foldr size
682− ]
683 ]
748 ]
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hsnew file+371
@@ -0,0 +1,371 @@
1+-- |
2+-- Module : Stream.Exceptions
3+-- Copyright : (c) 2019 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+-- Stability : experimental
7+-- Portability : GHC
8+
9+{-# LANGUAGE CPP #-}
10+{-# LANGUAGE FlexibleContexts #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+
13+#ifdef USE_PRELUDE
14+{-# OPTIONS_GHC -Wno-deprecations #-}
15+#endif
16+
17+#ifdef __HADDOCK_VERSION__
18+#undef INSPECTION
19+#endif
20+
21+#ifdef INSPECTION
22+{-# LANGUAGE TemplateHaskell #-}
23+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24+#endif
25+
26+module Stream.Exceptions (benchmarks) where
27+
28+import Control.Exception (Exception, throwIO)
29+import Stream.Common (drain)
30+
31+import qualified Data.IORef as Ref
32+import qualified Data.Map.Strict as Map
33+
34+import Control.Exception (SomeException)
35+import System.IO (Handle, hClose, hPutChar)
36+import qualified Streamly.FileSystem.Handle as FH
37+import qualified Streamly.Internal.FileSystem.Handle as IFH
38+import qualified Streamly.Internal.Data.Unfold as IUF
39+import qualified Streamly.Internal.Data.Unfold.Prelude as IUF
40+
41+#ifdef USE_PRELUDE
42+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
43+#else
44+import qualified Streamly.Internal.Data.Stream as Stream
45+import qualified Streamly.Internal.Data.Stream.Prelude as Stream
46+#endif
47+
48+import Test.Tasty.Bench hiding (env)
49+import Prelude hiding (last, length)
50+import Streamly.Benchmark.Common
51+import Streamly.Benchmark.Common.Handle
52+
53+#ifdef INSPECTION
54+import Control.Monad.Catch (MonadCatch)
55+import Test.Inspection
56+
57+import qualified Streamly.Internal.Data.Stream as D
58+#endif
59+
60+#ifdef USE_PRELUDE
61+type Stream = Stream.SerialT
62+toStreamD = Stream.toStream
63+fromStreamD = Stream.fromStream
64+#else
65+type Stream = Stream.Stream
66+toStreamD :: a -> a
67+toStreamD = id
68+fromStreamD :: a -> a
69+fromStreamD = id
70+#endif
71+
72+afterUnsafe :: IO b -> Stream IO a -> Stream IO a
73+finallyUnsafe :: IO b -> Stream IO a -> Stream IO a
74+bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a
75+#ifdef USE_PRELUDE
76+afterUnsafe = Stream.after_
77+finallyUnsafe = Stream.finally_
78+bracketUnsafe = Stream.bracket_
79+#else
80+afterUnsafe = Stream.afterUnsafe
81+finallyUnsafe = Stream.finallyUnsafe
82+bracketUnsafe = Stream.bracketUnsafe
83+#endif
84+
85+-------------------------------------------------------------------------------
86+-- stream exceptions
87+-------------------------------------------------------------------------------
88+
89+data BenchException
90+ = BenchException1
91+ | BenchException2
92+ deriving (Show, Eq, Ord)
93+
94+instance Exception BenchException
95+
96+retryNoneSimple :: Int -> Int -> IO ()
97+retryNoneSimple length from =
98+ drain
99+ $ Stream.retry
100+ (Map.singleton BenchException1 length)
101+ (const Stream.nil)
102+ source
103+
104+ where
105+
106+ source = Stream.enumerateFromTo from (from + length)
107+
108+retryNone :: Int -> Int -> IO ()
109+retryNone length from = do
110+ ref <- Ref.newIORef (0 :: Int)
111+ drain
112+ $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
113+ $ source ref
114+
115+ where
116+
117+ source ref =
118+ Stream.replicateM (from + length)
119+ $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
120+
121+retryAll :: Int -> Int -> IO ()
122+retryAll length from = do
123+ ref <- Ref.newIORef 0
124+ drain
125+ $ Stream.retry
126+ (Map.singleton BenchException1 (length + from)) (const Stream.nil)
127+ $ source ref
128+
129+ where
130+
131+ source ref =
132+ Stream.fromEffect
133+ $ do
134+ Ref.modifyIORef' ref (+ 1)
135+ val <- Ref.readIORef ref
136+ if val >= length
137+ then return length
138+ else throwIO BenchException1
139+
140+retryUnknown :: Int -> Int -> IO ()
141+retryUnknown length from = do
142+ drain
143+ $ Stream.retry (Map.singleton BenchException1 length) (const source)
144+ $ throwIO BenchException2 `Stream.before` Stream.nil
145+
146+ where
147+
148+ source = Stream.enumerateFromTo from (from + length)
149+
150+
151+o_1_space_serial_exceptions :: Int -> [Benchmark]
152+o_1_space_serial_exceptions length =
153+ [ bgroup
154+ "exceptions/serial"
155+ [ benchIOSrc1 "retryNoneSimple" (retryNoneSimple length)
156+ , benchIOSrc1 "retryNone" (retryNone length)
157+ , benchIOSrc1 "retryAll" (retryAll length)
158+ , benchIOSrc1 "retryUnknown" (retryUnknown length)
159+ ]
160+ ]
161+
162+-- XXX Move these to FileSystem.Handle benchmarks
163+
164+-------------------------------------------------------------------------------
165+-- copy stream exceptions
166+-------------------------------------------------------------------------------
167+
168+-- | Send the file contents to /dev/null with exception handling
169+readWriteOnExceptionStream :: Handle -> Handle -> IO ()
170+readWriteOnExceptionStream inh devNull =
171+ let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
172+ in Stream.fold (FH.write devNull) readEx
173+
174+#ifdef INSPECTION
175+inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
176+#endif
177+
178+-- | Send the file contents to /dev/null with exception handling
179+readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
180+readWriteHandleExceptionStream inh devNull =
181+ let handler (_e :: SomeException) =
182+ return $ Stream.fromEffect (hClose inh >> return 10)
183+ readEx = Stream.handle handler (Stream.unfold FH.reader inh)
184+ in Stream.fold (FH.write devNull) readEx
185+
186+#ifdef INSPECTION
187+inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
188+#endif
189+
190+-- | Send the file contents to /dev/null with exception handling
191+readWriteFinally_Stream :: Handle -> Handle -> IO ()
192+readWriteFinally_Stream inh devNull =
193+ let readEx =
194+ finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
195+ in Stream.fold (FH.write devNull) readEx
196+
197+#ifdef INSPECTION
198+inspect $ hasNoTypeClasses 'readWriteFinally_Stream
199+#endif
200+
201+readWriteFinallyStream :: Handle -> Handle -> IO ()
202+readWriteFinallyStream inh devNull =
203+ let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
204+ in Stream.fold (FH.write devNull) readEx
205+
206+-- | Send the file contents to /dev/null with exception handling
207+fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
208+fromToBytesBracket_Stream inh devNull =
209+ let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
210+ (\_ -> fromStreamD $ IFH.read inh)
211+ in IFH.putBytes devNull (toStreamD readEx)
212+
213+#ifdef INSPECTION
214+inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
215+#endif
216+
217+fromToBytesBracketStream :: Handle -> Handle -> IO ()
218+fromToBytesBracketStream inh devNull =
219+ let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
220+ (\_ -> fromStreamD $ IFH.read inh)
221+ in IFH.putBytes devNull (toStreamD readEx)
222+
223+readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
224+readWriteBeforeAfterStream inh devNull =
225+ let readEx =
226+ Stream.after (hClose inh)
227+ $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
228+ in Stream.fold (FH.write devNull) readEx
229+
230+#ifdef INSPECTION
231+inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
232+#endif
233+
234+readWriteAfterStream :: Handle -> Handle -> IO ()
235+readWriteAfterStream inh devNull =
236+ let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
237+ in Stream.fold (FH.write devNull) readEx
238+
239+#ifdef INSPECTION
240+inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
241+#endif
242+
243+readWriteAfter_Stream :: Handle -> Handle -> IO ()
244+readWriteAfter_Stream inh devNull =
245+ let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
246+ in Stream.fold (FH.write devNull) readEx
247+
248+#ifdef INSPECTION
249+inspect $ hasNoTypeClasses 'readWriteAfter_Stream
250+inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
251+#endif
252+
253+o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
254+o_1_space_copy_stream_exceptions env =
255+ [ bgroup "exceptions"
256+ [ mkBenchSmall "Stream.onException" env $ \inh _ ->
257+ readWriteOnExceptionStream inh (nullH env)
258+ , mkBenchSmall "Stream.handle" env $ \inh _ ->
259+ readWriteHandleExceptionStream inh (nullH env)
260+ , mkBenchSmall "Stream.finally_" env $ \inh _ ->
261+ readWriteFinally_Stream inh (nullH env)
262+ , mkBenchSmall "Stream.finally" env $ \inh _ ->
263+ readWriteFinallyStream inh (nullH env)
264+ , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
265+ readWriteBeforeAfterStream inh (nullH env)
266+ , mkBenchSmall "Stream.after" env $ \inh _ ->
267+ readWriteAfterStream inh (nullH env)
268+ , mkBenchSmall "Stream.after_" env $ \inh _ ->
269+ readWriteAfter_Stream inh (nullH env)
270+ ]
271+ , bgroup "exceptions/fromToBytes"
272+ [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
273+ fromToBytesBracket_Stream inh (nullH env)
274+ , mkBenchSmall "Stream.bracket" env $ \inh _ ->
275+ fromToBytesBracketStream inh (nullH env)
276+ ]
277+ ]
278+
279+ -------------------------------------------------------------------------------
280+-- Exceptions readChunks
281+-------------------------------------------------------------------------------
282+
283+-- | Send the file contents to /dev/null with exception handling
284+readChunksOnException :: Handle -> Handle -> IO ()
285+readChunksOnException inh devNull =
286+ let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
287+ in IUF.fold (IFH.writeChunks devNull) readEx inh
288+
289+#ifdef INSPECTION
290+#if __GLASGOW_HASKELL__ >= 906
291+inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
292+#else
293+inspect $ hasNoTypeClasses 'readChunksOnException
294+#endif
295+#endif
296+
297+-- | Send the file contents to /dev/null with exception handling
298+readChunksBracket_ :: Handle -> Handle -> IO ()
299+readChunksBracket_ inh devNull =
300+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
301+ in IUF.fold (IFH.writeChunks devNull) readEx inh
302+
303+#ifdef INSPECTION
304+#if __GLASGOW_HASKELL__ >= 906
305+inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
306+#else
307+inspect $ hasNoTypeClasses 'readChunksBracket_
308+#endif
309+#endif
310+
311+readChunksBracket :: Handle -> Handle -> IO ()
312+readChunksBracket inh devNull =
313+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
314+ in IUF.fold (IFH.writeChunks devNull) readEx inh
315+
316+o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
317+o_1_space_copy_exceptions_readChunks env =
318+ [ bgroup "exceptions/readChunks"
319+ [ mkBench "UF.onException" env $ \inH _ ->
320+ readChunksOnException inH (nullH env)
321+ , mkBench "UF.bracket_" env $ \inH _ ->
322+ readChunksBracket_ inH (nullH env)
323+ , mkBench "UF.bracket" env $ \inH _ ->
324+ readChunksBracket inH (nullH env)
325+ ]
326+ ]
327+
328+-------------------------------------------------------------------------------
329+-- Exceptions toChunks
330+-------------------------------------------------------------------------------
331+
332+-- | Send the file contents to /dev/null with exception handling
333+toChunksBracket_ :: Handle -> Handle -> IO ()
334+toChunksBracket_ inh devNull =
335+ let readEx = bracketUnsafe
336+ (return ())
337+ (\_ -> hClose inh)
338+ (\_ -> fromStreamD $ IFH.readChunks inh)
339+ in Stream.fold (IFH.writeChunks devNull) readEx
340+
341+#ifdef INSPECTION
342+inspect $ hasNoTypeClasses 'toChunksBracket_
343+#endif
344+
345+toChunksBracket :: Handle -> Handle -> IO ()
346+toChunksBracket inh devNull =
347+ let readEx = Stream.bracket
348+ (return ())
349+ (\_ -> hClose inh)
350+ (\_ -> fromStreamD $ IFH.readChunks inh)
351+ in Stream.fold (IFH.writeChunks devNull) readEx
352+
353+o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
354+o_1_space_copy_exceptions_toChunks env =
355+ [ bgroup "exceptions/toChunks"
356+ [ mkBench "Stream.bracket_" env $ \inH _ ->
357+ toChunksBracket_ inH (nullH env)
358+ , mkBench "Stream.bracket" env $ \inH _ ->
359+ toChunksBracket inH (nullH env)
360+ ]
361+ ]
362+
363+benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
364+benchmarks moduleName _env size =
365+ [ bgroup (o_1_space_prefix moduleName) $ concat
366+ [ o_1_space_serial_exceptions size
367+ , o_1_space_copy_exceptions_readChunks _env
368+ , o_1_space_copy_exceptions_toChunks _env
369+ , o_1_space_copy_stream_exceptions _env
370+ ]
371+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs → benchmark/Streamly/Benchmark/Data/Stream/Expand.hsrenamed+281−158
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Serial.Nested
2+-- Module : Stream.Expand
3-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -8,6 +8,11 @@
8{-# LANGUAGE FlexibleContexts #-}
8{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
11+{-# LANGUAGE TupleSections #-}
12+
13+#ifdef USE_PRELUDE
14+{-# OPTIONS_GHC -Wno-deprecations #-}
15+#endif
11
16
12#ifdef __HADDOCK_VERSION__
17#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
18#undef INSPECTION
@@ -18,33 +23,47 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
24#endif
20
25
21−module Serial.Nested (benchmarks) where
26+module Stream.Expand (benchmarks) where
22−
23−import Control.Monad.Trans.Class (lift)
24−
25−import qualified Control.Applicative as AP
26
27
27#ifdef INSPECTION
28#ifdef INSPECTION
28import GHC.Types (SPEC(..))
29import GHC.Types (SPEC(..))
29import Test.Inspection
30import Test.Inspection
30
31
31−import qualified Streamly.Internal.Data.Stream.StreamD as D
32+import qualified Streamly.Internal.Data.Stream as D
32#endif
33#endif
33
34
34−import qualified Streamly.Prelude as S
35+import qualified Stream.Common as Common
35−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
36import qualified Streamly.Internal.Data.Unfold as UF
36import qualified Streamly.Internal.Data.Unfold as UF
37
37
38−import Gauge
38+#ifdef USE_PRELUDE
39−import Streamly.Prelude (SerialT, serially, serial)
39+import qualified Streamly.Internal.Data.Stream.IsStream as S
40−import Streamly.Benchmark.Common
40+import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
41import Streamly.Benchmark.Prelude
41import Streamly.Benchmark.Prelude
42+ ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM
43+ , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith)
44+#else
45+import qualified Streamly.Internal.Data.Stream as S
46+#ifdef USE_STREAMK
47+import Streamly.Internal.Data.Stream (Stream)
48+import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)
49+import qualified Control.Applicative as AP
50+import qualified Streamly.Internal.Data.Fold as Fold
51+import qualified Streamly.Internal.Data.StreamK as StreamK
52+#else
53+import qualified Streamly.Internal.Data.Stream as StreamK
54+#endif
55+#endif
56+
57+import Test.Tasty.Bench
58+import Stream.Common
59+import Streamly.Benchmark.Common
42import Prelude hiding (concatMap)
60import Prelude hiding (concatMap)
43
61
44-------------------------------------------------------------------------------
62-------------------------------------------------------------------------------
45-- Iteration/looping utilities
63-- Iteration/looping utilities
46-------------------------------------------------------------------------------
64-------------------------------------------------------------------------------
47
65
66+#ifdef USE_STREAMK
48{-# INLINE iterateN #-}
67{-# INLINE iterateN #-}
49iterateN :: (Int -> a -> a) -> a -> Int -> a
68iterateN :: (Int -> a -> a) -> a -> Int -> a
50iterateN g initial count = f count initial
69iterateN g initial count = f count initial
@@ -56,13 +75,18 @@ iterateN g initial count = f count initial
56
75
57-- Iterate a transformation over a singleton stream
76-- Iterate a transformation over a singleton stream
58{-# INLINE iterateSingleton #-}
77{-# INLINE iterateSingleton #-}
59−iterateSingleton :: S.MonadAsync m
78+iterateSingleton :: Applicative m =>
60− => (Int -> SerialT m Int -> SerialT m Int)
79+ (Int -> CrossStreamK m Int -> CrossStreamK m Int)
61 -> Int
80 -> Int
62 -> Int
81 -> Int
63− -> SerialT m Int
82+ -> Stream m Int
64−iterateSingleton g count n = iterateN g (return n) count
83+iterateSingleton g count n =
84+ toStream
85+ $ StreamK.unCross
86+ $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count
87+#endif
65
88
89+{-
66-- XXX need to check why this is slower than the explicit recursion above, even
90-- XXX need to check why this is slower than the explicit recursion above, even
67-- if the above code is written in a foldr like head recursive way. We also
91-- if the above code is written in a foldr like head recursive way. We also
68-- need to try this with foldlM' once #150 is fixed.
92-- need to try this with foldlM' once #150 is fixed.
@@ -70,12 +94,13 @@ iterateSingleton g count n = iterateN g (return n) count
70-- foldrM and any related fusion issues.
94-- foldrM and any related fusion issues.
71{-# INLINE _iterateSingleton #-}
95{-# INLINE _iterateSingleton #-}
72_iterateSingleton ::
96_iterateSingleton ::
73− S.MonadAsync m
97+ Monad m
74− => (Int -> SerialT m Int -> SerialT m Int)
98+ => (Int -> Stream m Int -> Stream m Int)
75 -> Int
99 -> Int
76 -> Int
100 -> Int
77− -> SerialT m Int
101+ -> Stream m Int
78_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
102_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
103+-}
79
104
80-------------------------------------------------------------------------------
105-------------------------------------------------------------------------------
81-- Multi-Stream
106-- Multi-Stream
@@ -88,84 +113,28 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
88{-# INLINE serial2 #-}
113{-# INLINE serial2 #-}
89serial2 :: Int -> Int -> IO ()
114serial2 :: Int -> Int -> IO ()
90serial2 count n =
115serial2 count n =
91− S.drain $
116+ drain $ toStream $
117+ Common.append
118+ (fromStream $ sourceUnfoldrM count n)
92− S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
119+ (fromStream $ sourceUnfoldrM count (n + 1))
93
120
94{-# INLINE serial4 #-}
121{-# INLINE serial4 #-}
95serial4 :: Int -> Int -> IO ()
122serial4 :: Int -> Int -> IO ()
96serial4 count n =
123serial4 count n =
97− S.drain $
124+ drain $ toStream $
98− S.serial
125+ Common.append
99− (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
126+ (Common.append
100− (S.serial
101− (sourceUnfoldrM count (n + 2))
102− (sourceUnfoldrM count (n + 3)))
127+ (fromStream $ sourceUnfoldrM count n)
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))
128+ (fromStream $ 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
129+ (Common.append
116− (sourceUnfoldrM count n)
117− (sourceUnfoldrM count (n + 1)))
130+ (fromStream $ sourceUnfoldrM count (n + 2))
118− (Internal.append
119− (sourceUnfoldrM count (n + 2))
120− (sourceUnfoldrM count (n + 3)))
131+ (fromStream $ 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
127−
128−-------------------------------------------------------------------------------
129−-- Merging
130−-------------------------------------------------------------------------------
131−
132−{-# INLINE mergeBy #-}
133−mergeBy :: Int -> Int -> IO ()
134−mergeBy count n =
135− S.drain $
136− S.mergeBy
137− compare
138− (sourceUnfoldrM count n)
139− (sourceUnfoldrM count (n + 1))
140−
141−{-# INLINE mergeByM #-}
142−mergeByM :: Int -> Int -> IO ()
143−mergeByM count n =
144− S.drain $
145− S.mergeByM
146− (\a b -> return $ compare a b)
147− (sourceUnfoldrM count n)
148− (sourceUnfoldrM count (n + 1))
149−
150−#ifdef INSPECTION
151−inspect $ hasNoTypeClasses 'mergeBy
152−inspect $ 'mergeBy `hasNoType` ''SPEC
153−inspect $ 'mergeBy `hasNoType` ''D.Step
154−
155−inspect $ hasNoTypeClasses 'mergeByM
156−inspect $ 'mergeByM `hasNoType` ''SPEC
157−inspect $ 'mergeByM `hasNoType` ''D.Step
158−#endif
159
132
160o_1_space_joining :: Int -> [Benchmark]
133o_1_space_joining :: Int -> [Benchmark]
161o_1_space_joining value =
134o_1_space_joining value =
162 [ bgroup "joining"
135 [ bgroup "joining"
163 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
136 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
164− , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
165 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
137 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
166− , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
167− , benchIOSrc1 "mergeBy (2,x/2)" (mergeBy (value `div` 2))
168− , benchIOSrc1 "mergeByM (2,x/2)" (mergeByM (value `div` 2))
169 ]
138 ]
170 ]
139 ]
171
140
@@ -173,22 +142,24 @@ o_1_space_joining value =
173-- Concat Foldable containers
142-- Concat Foldable containers
174-------------------------------------------------------------------------------
143-------------------------------------------------------------------------------
175
144
145+#ifdef USE_PRELUDE
176o_1_space_concatFoldable :: Int -> [Benchmark]
146o_1_space_concatFoldable :: Int -> [Benchmark]
177o_1_space_concatFoldable value =
147o_1_space_concatFoldable value =
178 [ bgroup "concat-foldable"
148 [ bgroup "concat-foldable"
179− [ benchIOSrc serially "foldMapWith (<>) (List)"
149+ [ benchIOSrc "foldMapWith (<>) (List)"
180 (sourceFoldMapWith value)
150 (sourceFoldMapWith value)
181− , benchIOSrc serially "foldMapWith (<>) (Stream)"
151+ , benchIOSrc "foldMapWith (<>) (Stream)"
182 (sourceFoldMapWithStream value)
152 (sourceFoldMapWithStream value)
183− , benchIOSrc serially "foldMapWithM (<>) (List)"
153+ , benchIOSrc "foldMapWithM (<>) (List)"
184 (sourceFoldMapWithM value)
154 (sourceFoldMapWithM value)
185− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
155+ , benchIOSrc "S.concatFoldableWith (<>) (List)"
186 (concatFoldableWith value)
156 (concatFoldableWith value)
187− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
157+ , benchIOSrc "S.concatForFoldableWith (<>) (List)"
188 (concatForFoldableWith value)
158 (concatForFoldableWith value)
189− , benchIOSrc serially "foldMapM (List)" (sourceFoldMapM value)
159+ , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
190 ]
160 ]
191 ]
161 ]
162+#endif
192
163
193-------------------------------------------------------------------------------
164-------------------------------------------------------------------------------
194-- Concat
165-- Concat
@@ -199,14 +170,15 @@ o_1_space_concatFoldable value =
199{-# INLINE concatMap #-}
170{-# INLINE concatMap #-}
200concatMap :: Int -> Int -> Int -> IO ()
171concatMap :: Int -> Int -> Int -> IO ()
201concatMap outer inner n =
172concatMap outer inner n =
202− S.drain $ S.concatMap
173+ drain $ toStream $ StreamK.concatMap
203− (\_ -> sourceUnfoldrM inner n)
174+ (\_ -> fromStream $ sourceUnfoldrM inner n)
204− (sourceUnfoldrM outer n)
175+ (fromStream $ sourceUnfoldrM outer n)
205
176
177+#ifndef USE_STREAMK
206{-# INLINE concatMapM #-}
178{-# INLINE concatMapM #-}
207concatMapM :: Int -> Int -> Int -> IO ()
179concatMapM :: Int -> Int -> Int -> IO ()
208concatMapM outer inner n =
180concatMapM outer inner n =
209− S.drain $ S.concatMapM
181+ drain $ S.concatMapM
210 (\_ -> return $ sourceUnfoldrM inner n)
182 (\_ -> return $ sourceUnfoldrM inner n)
211 (sourceUnfoldrM outer n)
183 (sourceUnfoldrM outer n)
212
184
@@ -214,18 +186,23 @@ concatMapM outer inner n =
214inspect $ hasNoTypeClasses 'concatMap
186inspect $ hasNoTypeClasses 'concatMap
215inspect $ 'concatMap `hasNoType` ''SPEC
187inspect $ 'concatMap `hasNoType` ''SPEC
216#endif
188#endif
189+#endif
217
190
218-- concatMap unfoldr/unfoldr
191-- concatMap unfoldr/unfoldr
219
192
220{-# INLINE concatMapPure #-}
193{-# INLINE concatMapPure #-}
221concatMapPure :: Int -> Int -> Int -> IO ()
194concatMapPure :: Int -> Int -> Int -> IO ()
222concatMapPure outer inner n =
195concatMapPure outer inner n =
223− S.drain $ S.concatMap
196+ drain $ toStream $ StreamK.concatMap
224− (\_ -> sourceUnfoldr inner n)
197+ (\_ -> fromStream $ sourceUnfoldr inner n)
225− (sourceUnfoldr outer n)
198+ (fromStream $ sourceUnfoldr outer n)
226
199
227#ifdef INSPECTION
200#ifdef INSPECTION
201+#if __GLASGOW_HASKELL__ >= 906
202+inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]
203+#else
228inspect $ hasNoTypeClasses 'concatMapPure
204inspect $ hasNoTypeClasses 'concatMapPure
205+#endif
229inspect $ 'concatMapPure `hasNoType` ''SPEC
206inspect $ 'concatMapPure `hasNoType` ''SPEC
230#endif
207#endif
231
208
@@ -234,49 +211,71 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
234{-# INLINE concatMapRepl #-}
211{-# INLINE concatMapRepl #-}
235concatMapRepl :: Int -> Int -> Int -> IO ()
212concatMapRepl :: Int -> Int -> Int -> IO ()
236concatMapRepl outer inner n =
213concatMapRepl outer inner n =
214+ drain $ toStream $ StreamK.concatMap
237− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
215+ (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)
238
216
239#ifdef INSPECTION
217#ifdef INSPECTION
218+#if __GLASGOW_HASKELL__ >= 906
219+inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]
220+#else
240inspect $ hasNoTypeClasses 'concatMapRepl
221inspect $ hasNoTypeClasses 'concatMapRepl
222+#endif
241inspect $ 'concatMapRepl `hasNoType` ''SPEC
223inspect $ 'concatMapRepl `hasNoType` ''SPEC
242#endif
224#endif
243
225
244-- concatMapWith
226-- concatMapWith
245
227
228+#ifdef USE_STREAMK
246{-# INLINE concatMapWithSerial #-}
229{-# INLINE concatMapWithSerial #-}
247concatMapWithSerial :: Int -> Int -> Int -> IO ()
230concatMapWithSerial :: Int -> Int -> Int -> IO ()
248−concatMapWithSerial = concatStreamsWith S.serial
231+concatMapWithSerial = concatStreamsWith Common.append
249
232
250#ifdef INSPECTION
233#ifdef INSPECTION
251inspect $ hasNoTypeClasses 'concatMapWithSerial
234inspect $ hasNoTypeClasses 'concatMapWithSerial
252inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
235inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
253#endif
236#endif
254
237
238+{-
255{-# INLINE concatMapWithAppend #-}
239{-# INLINE concatMapWithAppend #-}
256concatMapWithAppend :: Int -> Int -> Int -> IO ()
240concatMapWithAppend :: Int -> Int -> Int -> IO ()
257−concatMapWithAppend = concatStreamsWith Internal.append
241+concatMapWithAppend = concatStreamsWith Common.append2
258
242
259#ifdef INSPECTION
243#ifdef INSPECTION
260inspect $ hasNoTypeClasses 'concatMapWithAppend
244inspect $ hasNoTypeClasses 'concatMapWithAppend
261inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
245inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
262#endif
246#endif
247+-}
248+
249+-- mergeMapWith
250+
251+{-# INLINE mergeMapWithSerial #-}
252+mergeMapWithSerial :: Int -> Int -> Int -> IO ()
253+mergeMapWithSerial = mergeMapWith Common.append
254+
255+{-
256+{-# INLINE mergeMapWithAppend #-}
257+mergeMapWithAppend :: Int -> Int -> Int -> IO ()
258+mergeMapWithAppend = mergeMapWith Common.append2
259+-}
260+#endif
261+
262+-- unfoldMany
263
263
264−-- concatUnfold
264+-- unfoldMany replicate/unfoldrM
265
265
266−-- concatUnfold replicate/unfoldrM
266+{-# INLINE unfoldManyRepl #-}
267+unfoldManyRepl :: Int -> Int -> Int -> IO ()
268+unfoldManyRepl outer inner n =
269+ drain
270+ $ S.unfoldMany
271+ UF.replicateM
272+ (fmap ((inner,) . return) (sourceUnfoldrM outer n))
267
273
268−{-# INLINE concatUnfoldRepl #-}
269−concatUnfoldRepl :: Int -> Int -> Int -> IO ()
270−concatUnfoldRepl outer inner n =
271− S.drain
272− $ S.concatUnfold
273− (UF.lmap return (UF.replicateM inner))
274− (sourceUnfoldrM outer n)
275
274
276#ifdef INSPECTION
275#ifdef INSPECTION
277−inspect $ hasNoTypeClasses 'concatUnfoldRepl
276+inspect $ hasNoTypeClasses 'unfoldManyRepl
278−inspect $ 'concatUnfoldRepl `hasNoType` ''D.ConcatMapUState
277+inspect $ 'unfoldManyRepl `hasNoType` ''D.ConcatMapUState
279−inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
278+inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
280#endif
279#endif
281
280
282o_1_space_concat :: Int -> [Benchmark]
281o_1_space_concat :: Int -> [Benchmark]
@@ -289,10 +288,6 @@ o_1_space_concat value = sqrtVal `seq`
289 , benchIOSrc1 "concatMapPure (1 of n)"
288 , benchIOSrc1 "concatMapPure (1 of n)"
290 (concatMapPure 1 value)
289 (concatMapPure 1 value)
291
290
292− -- This is for comparison with foldMapWith
293− , benchIOSrc serially "concatMapId (n of 1) (fromFoldable)"
294− (S.concatMap id . sourceConcatMapId value)
295−
296 , benchIOSrc1 "concatMap (n of 1)"
291 , benchIOSrc1 "concatMap (n of 1)"
297 (concatMap value 1)
292 (concatMap value 1)
298 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
293 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
@@ -300,16 +295,25 @@ o_1_space_concat value = sqrtVal `seq`
300 , benchIOSrc1 "concatMap (1 of n)"
295 , benchIOSrc1 "concatMap (1 of n)"
301 (concatMap 1 value)
296 (concatMap 1 value)
302
297
298+#ifndef USE_STREAMK
299+ -- This is for comparison with foldMapWith
300+ , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
301+ (S.concatMap id . sourceConcatMapId value)
302+
303 , benchIOSrc1 "concatMapM (n of 1)"
303 , benchIOSrc1 "concatMapM (n of 1)"
304 (concatMapM value 1)
304 (concatMapM value 1)
305 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
305 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
306 (concatMapM sqrtVal sqrtVal)
306 (concatMapM sqrtVal sqrtVal)
307 , benchIOSrc1 "concatMapM (1 of n)"
307 , benchIOSrc1 "concatMapM (1 of n)"
308 (concatMapM 1 value)
308 (concatMapM 1 value)
309+#endif
309
310
311+#ifdef USE_STREAMK
312+ {-
310 -- This is for comparison with foldMapWith
313 -- This is for comparison with foldMapWith
311− , benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
314+ , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
312− (S.concatMapWith serial id . sourceConcatMapId value)
315+ (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
316+ -}
313
317
314 , benchIOSrc1 "concatMapWith (n of 1)"
318 , benchIOSrc1 "concatMapWith (n of 1)"
315 (concatMapWithSerial value 1)
319 (concatMapWithSerial value 1)
@@ -318,21 +322,54 @@ o_1_space_concat value = sqrtVal `seq`
318 , benchIOSrc1 "concatMapWith (1 of n)"
322 , benchIOSrc1 "concatMapWith (1 of n)"
319 (concatMapWithSerial 1 value)
323 (concatMapWithSerial 1 value)
320
324
325+ {-
321 -- quadratic with number of outer streams
326 -- quadratic with number of outer streams
322 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
327 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
323 (concatMapWithAppend 2 (value `div` 2))
328 (concatMapWithAppend 2 (value `div` 2))
329+ -}
330+#endif
324
331
325− -- concatMap vs concatUnfold
332+ -- concatMap vs unfoldMany
326 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
333 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
327 (concatMapRepl sqrtVal sqrtVal)
334 (concatMapRepl sqrtVal sqrtVal)
328− , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
335+ , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
329− (concatUnfoldRepl sqrtVal sqrtVal)
336+ (unfoldManyRepl sqrtVal sqrtVal)
337+ ]
338+ ]
339+
340+ where
341+
342+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
343+
344+#ifdef USE_STREAMK
345+o_n_space_merge :: Int -> [Benchmark]
346+o_n_space_merge value = sqrtVal `seq`
347+ [ bgroup "concat"
348+ [
349+ -------------------mergeMapWith-----------------
350+
351+ -- Use large number of streams to check scalability
352+
353+ benchIOSrc1 "mergeMapWithSerial (n of 1)"
354+ (mergeMapWithSerial value 1)
355+ , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"
356+ (mergeMapWithSerial sqrtVal sqrtVal)
357+ , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"
358+ (mergeMapWithSerial 2 (value `div` 2))
359+
360+ {-
361+ , benchIOSrc1 "mergeMapWithAppend (n of 1)"
362+ (mergeMapWithAppend value 1)
363+ , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"
364+ (mergeMapWithAppend sqrtVal sqrtVal)
365+ -}
330 ]
366 ]
331 ]
367 ]
332
368
333 where
369 where
334
370
335 sqrtVal = round $ sqrt (fromIntegral value :: Double)
371 sqrtVal = round $ sqrt (fromIntegral value :: Double)
372+#endif
336
373
337-------------------------------------------------------------------------------
374-------------------------------------------------------------------------------
338-- Applicative
375-- Applicative
@@ -341,26 +378,28 @@ o_1_space_concat value = sqrtVal `seq`
341o_1_space_applicative :: Int -> [Benchmark]
378o_1_space_applicative :: Int -> [Benchmark]
342o_1_space_applicative value =
379o_1_space_applicative value =
343 [ bgroup "Applicative"
380 [ bgroup "Applicative"
344− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value serially
381+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
345− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value serially
382+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
346− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value serially
383+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
347− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value serially
384+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
348 ]
385 ]
349 ]
386 ]
350
387
388+#ifdef USE_STREAMK
351o_n_space_applicative :: Int -> [Benchmark]
389o_n_space_applicative :: Int -> [Benchmark]
352o_n_space_applicative value =
390o_n_space_applicative value =
353− [ bgroup "Applicative"
391+ [ bgroup "iterated"
354− [ benchIOSrc serially "(*>) (n times)" $
392+ [ benchIOSrc "(*>) (n times)" $
355 iterateSingleton ((*>) . pure) value
393 iterateSingleton ((*>) . pure) value
356− , benchIOSrc serially "(<*) (n times)" $
394+ , benchIOSrc "(<*) (n times)" $
357 iterateSingleton (\x xs -> xs <* pure x) value
395 iterateSingleton (\x xs -> xs <* pure x) value
358− , benchIOSrc serially "(<*>) (n times)" $
396+ , benchIOSrc "(<*>) (n times)" $
359 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
397 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
360− , benchIOSrc serially "liftA2 (n times)" $
398+ , benchIOSrc "liftA2 (n times)" $
361 iterateSingleton (AP.liftA2 (+) . pure) value
399 iterateSingleton (AP.liftA2 (+) . pure) value
362 ]
400 ]
363 ]
401 ]
402+#endif
364
403
365-------------------------------------------------------------------------------
404-------------------------------------------------------------------------------
366-- Monad
405-- Monad
@@ -369,48 +408,122 @@ o_n_space_applicative value =
369o_1_space_monad :: Int -> [Benchmark]
408o_1_space_monad :: Int -> [Benchmark]
370o_1_space_monad value =
409o_1_space_monad value =
371 [ bgroup "Monad"
410 [ bgroup "Monad"
372− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value serially
411+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
373− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value serially
412+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
374 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
413 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
375− filterAllOutM value serially
414+ filterAllOutM value
376 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
415 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
377− filterAllInM value serially
416+ filterAllInM value
378 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
417 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
379− filterSome value serially
418+ filterSome value
380 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
419 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
381− breakAfterSome value serially
420+ breakAfterSome value
382 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
421 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
383− toNullM3 value serially
422+ toNullM3 value
384 ]
423 ]
385 ]
424 ]
386
425
426+#ifdef USE_STREAMK
387-- This is a good benchmark but inefficient way to compute primes. As we see a
427-- This is a good benchmark but inefficient way to compute primes. As we see a
388-- new prime we keep appending a division filter for all the future numbers.
428-- new prime we keep appending a division filter for all the future numbers.
389{-# INLINE sieve #-}
429{-# INLINE sieve #-}
390−sieve :: Monad m => SerialT m Int -> SerialT m Int
430+sieve :: Monad m => StreamK m Int -> StreamK m Int
391−sieve s = do
431+sieve s = StreamK.concatEffect $ do
392− r <- lift $ S.uncons s
432+ r <- StreamK.uncons s
393 case r of
433 case r of
394 Just (prime, rest) ->
434 Just (prime, rest) ->
435+ -- XXX Use K.filter or rewrite to K.filter
395− prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest)
436+ let f = S.filter (\n -> n `mod` prime /= 0)
437+ in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest)
396− Nothing -> S.nil
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
458
398o_n_space_monad :: Int -> [Benchmark]
459o_n_space_monad :: Int -> [Benchmark]
399o_n_space_monad value =
460o_n_space_monad value =
400 [ bgroup "Monad"
461 [ bgroup "Monad"
401− [ benchIOSrc serially "(>>) (n times)" $
402− iterateSingleton ((>>) . pure) value
403− , benchIOSrc serially "(>>=) (n times)" $
404− iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
405− , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
462+ [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
406− toListM value serially
463+ toListM value
407 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
464 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
408− toListSome value serially
465+ toListSome value
409− , benchIO "naive prime sieve (n/4)"
466+ ]
410− (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
467+ ]
468+
469+-------------------------------------------------------------------------------
470+-- Joining
471+-------------------------------------------------------------------------------
472+
473+{-
474+toKv :: Int -> (Int, Int)
475+toKv p = (p, p)
476+
477+{-# INLINE joinWith #-}
478+joinWith :: Common.MonadAsync m =>
479+ ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)
480+ -> Int
481+ -> Int
482+ -> m ()
483+joinWith j val i =
484+ drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
485+
486+{-# INLINE joinMapWith #-}
487+joinMapWith :: Common.MonadAsync m =>
488+ (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)
489+ -> Int
490+ -> Int
491+ -> m ()
492+joinMapWith j val i =
493+ drain
494+ $ j
495+ (fmap toKv (sourceUnfoldrM val i))
496+ (fmap toKv (sourceUnfoldrM val (val `div` 2)))
497+
498+o_n_heap_buffering :: Int -> [Benchmark]
499+o_n_heap_buffering value =
500+ [ bgroup "buffered"
501+ [
502+ benchIOSrc1 "joinInnerGeneric (sqrtVal)"
503+ $ joinWith S.joinInnerGeneric sqrtVal
504+ , benchIOSrc1 "joinInner"
505+ $ joinMapWith S.joinInner halfVal
506+ , benchIOSrc1 "joinLeftGeneric (sqrtVal)"
507+ $ joinWith S.joinLeftGeneric sqrtVal
508+ , benchIOSrc1 "joinLeft "
509+ $ joinMapWith S.joinLeft halfVal
510+ , benchIOSrc1 "joinOuterGeneric (sqrtVal)"
511+ $ joinWith S.joinOuterGeneric sqrtVal
512+ , benchIOSrc1 "joinOuter"
513+ $ joinMapWith S.joinOuter halfVal
514+ , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"
515+ $ joinWith S.filterInStreamGenericBy sqrtVal
516+ , benchIOSrc1 "filterInStreamAscBy"
517+ $ joinMapWith (S.filterInStreamAscBy compare) halfVal
411 ]
518 ]
412 ]
519 ]
413
520
521+ where
522+
523+ halfVal = value `div` 2
524+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
525+-}
526+
414-------------------------------------------------------------------------------
527-------------------------------------------------------------------------------
415-- Main
528-- Main
416-------------------------------------------------------------------------------
529-------------------------------------------------------------------------------
@@ -418,23 +531,33 @@ o_n_space_monad value =
418-- In addition to gauge options, the number of elements in the stream can be
531-- In addition to gauge options, the number of elements in the stream can be
419-- passed using the --stream-size option.
532-- passed using the --stream-size option.
420--
533--
534+{-# ANN benchmarks "HLint: ignore" #-}
421benchmarks :: String -> Int -> [Benchmark]
535benchmarks :: String -> Int -> [Benchmark]
422benchmarks moduleName size =
536benchmarks moduleName size =
423 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
537 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
424 [
538 [
425 -- multi-stream
539 -- multi-stream
426 o_1_space_joining size
540 o_1_space_joining size
541+#ifdef USE_PRELUDE
427 , o_1_space_concatFoldable size
542 , o_1_space_concatFoldable size
543+#endif
428 , o_1_space_concat size
544 , o_1_space_concat size
429−
430 , o_1_space_applicative size
545 , o_1_space_applicative size
431 , o_1_space_monad size
546 , o_1_space_monad size
432−
433 ]
547 ]
434 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
548 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
435 [
549 [
436 -- multi-stream
550 -- multi-stream
551+ o_n_space_monad size
552+#ifdef USE_STREAMK
553+ , o_n_space_merge size
554+ , o_n_space_iterated size
437− o_n_space_applicative size
555+ , o_n_space_applicative size
438− , o_n_space_monad size
556+#endif
439 ]
557 ]
558+ {-
559+ , bgroup (o_n_heap_prefix moduleName) $
560+ -- multi-stream
561+ o_n_heap_buffering size
562+ -}
440 ]
563 ]
benchmark/Streamly/Benchmark/Data/Stream/Generate.hsnew file+278
@@ -0,0 +1,278 @@
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.hsnew file+146
@@ -0,0 +1,146 @@
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.hsnew file+588
@@ -0,0 +1,588 @@
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/Prelude/Serial/Split.hs → benchmark/Streamly/Benchmark/Data/Stream/Split.hsrenamed+29−16
@@ -1,5 +1,7 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2−-- Module : Streamly.Benchmark.Prelude.Serial.Split
4+-- Module : Stream.Split
3-- Copyright : (c) 2019 Composewell Technologies
5-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
6-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
7-- Maintainer : streamly@composewell.com
@@ -18,14 +20,14 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
21#endif
20
22
21−module Serial.Split (benchmarks) where
23+module Stream.Split (benchmarks) where
22
24
23import Data.Char (ord)
25import Data.Char (ord)
24import Data.Word (Word8)
26import Data.Word (Word8)
25import System.IO (Handle)
27import System.IO (Handle)
26
28
27import qualified Streamly.FileSystem.Handle as FH
29import qualified Streamly.FileSystem.Handle as FH
28−import qualified Streamly.Internal.Data.Array.Foreign as A
30+import qualified Streamly.Internal.Data.Array as A
29import qualified Streamly.Internal.Data.Fold as FL
31import qualified Streamly.Internal.Data.Fold as FL
30import qualified Streamly.Internal.Data.Parser as PR
32import qualified Streamly.Internal.Data.Parser as PR
31import qualified Streamly.Internal.Data.Stream.IsStream as IP
33import qualified Streamly.Internal.Data.Stream.IsStream as IP
@@ -33,15 +35,15 @@ import qualified Streamly.Internal.FileSystem.Handle as IFH
33import qualified Streamly.Internal.Unicode.Stream as IUS
35import qualified Streamly.Internal.Unicode.Stream as IUS
34import qualified Streamly.Prelude as S
36import qualified Streamly.Prelude as S
35
37
36−import Gauge hiding (env)
38+import Test.Tasty.Bench hiding (env)
37import Prelude hiding (last, length)
39import Prelude hiding (last, length)
38import Streamly.Benchmark.Common
40import Streamly.Benchmark.Common
39import Streamly.Benchmark.Common.Handle
41import Streamly.Benchmark.Common.Handle
40
42
41#ifdef INSPECTION
43#ifdef INSPECTION
42−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
44+import Streamly.Internal.Data.Stream (Step(..))
43
45
44−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
46+import qualified Streamly.Internal.Data.MutArray as MA
45import qualified Streamly.Internal.Data.Unfold as IUF
47import qualified Streamly.Internal.Data.Unfold as IUF
46
48
47import Test.Inspection
49import Test.Inspection
@@ -66,8 +68,8 @@ splitOn inh =
66#ifdef INSPECTION
68#ifdef INSPECTION
67inspect $ hasNoTypeClasses 'splitOn
69inspect $ hasNoTypeClasses 'splitOn
68inspect $ 'splitOn `hasNoType` ''Step
70inspect $ 'splitOn `hasNoType` ''Step
69−inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
71+inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
70−inspect $ 'splitOn `hasNoType` ''MA.ReadUState -- FH.read/A.read
72+inspect $ 'splitOn `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
71#endif
73#endif
72
74
73-- | Split suffix on line feed.
75-- | Split suffix on line feed.
@@ -79,8 +81,8 @@ splitOnSuffix inh =
79#ifdef INSPECTION
81#ifdef INSPECTION
80inspect $ hasNoTypeClasses 'splitOnSuffix
82inspect $ hasNoTypeClasses 'splitOnSuffix
81inspect $ 'splitOnSuffix `hasNoType` ''Step
83inspect $ 'splitOnSuffix `hasNoType` ''Step
82−inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
84+inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
83−inspect $ 'splitOnSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
85+inspect $ 'splitOnSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
84#endif
86#endif
85
87
86-- | Split suffix with line feed.
88-- | Split suffix with line feed.
@@ -92,8 +94,8 @@ splitWithSuffix inh =
92#ifdef INSPECTION
94#ifdef INSPECTION
93inspect $ hasNoTypeClasses 'splitWithSuffix
95inspect $ hasNoTypeClasses 'splitWithSuffix
94inspect $ 'splitWithSuffix `hasNoType` ''Step
96inspect $ 'splitWithSuffix `hasNoType` ''Step
95−inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
97+inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
96−inspect $ 'splitWithSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
98+inspect $ 'splitWithSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
97#endif
99#endif
98
100
99-- | Split on line feed.
101-- | Split on line feed.
@@ -123,8 +125,8 @@ wordsBy inh =
123#ifdef INSPECTION
125#ifdef INSPECTION
124inspect $ hasNoTypeClasses 'wordsBy
126inspect $ hasNoTypeClasses 'wordsBy
125inspect $ 'wordsBy `hasNoType` ''Step
127inspect $ 'wordsBy `hasNoType` ''Step
126−inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
128+inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
127−inspect $ 'wordsBy `hasNoType` ''MA.ReadUState -- FH.read/A.read
129+inspect $ 'wordsBy `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
128#endif
130#endif
129
131
130-- | Split on a word8 sequence.
132-- | Split on a word8 sequence.
@@ -141,7 +143,7 @@ splitOnSeq str inh =
141-- | Split on a word8 sequence.
143-- | Split on a word8 sequence.
142splitOnSeq100k :: Handle -> IO Int
144splitOnSeq100k :: Handle -> IO Int
143splitOnSeq100k inh = do
145splitOnSeq100k inh = do
144− arr <- A.fromStream $ S.replicate 100000 123
146+ arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123
145 (S.length $ IP.splitOnSeq arr FL.drain
147 (S.length $ IP.splitOnSeq arr FL.drain
146 $ S.unfold FH.read inh) -- >>= print
148 $ S.unfold FH.read inh) -- >>= print
147
149
@@ -156,6 +158,12 @@ splitOnSuffixSeq str inh =
156-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
158-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
157#endif
159#endif
158
160
161+-- | Split on suffix sequence.
162+splitWithSuffixSeq :: String -> Handle -> IO Int
163+splitWithSuffixSeq str inh =
164+ S.length $ IP.splitWithSuffixSeq (toarr str) FL.drain
165+ $ S.unfold FH.read inh -- >>= print
166+
159o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
167o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
160o_1_space_reduce_read_split env =
168o_1_space_reduce_read_split env =
161 [ bgroup "split"
169 [ bgroup "split"
@@ -185,6 +193,8 @@ o_1_space_reduce_read_split env =
185 splitOnSeq "\r\n" inh
193 splitOnSeq "\r\n" inh
186 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
194 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
187 splitOnSuffixSeq "\r\n" inh
195 splitOnSuffixSeq "\r\n" inh
196+ , mkBench "S.splitWithSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
197+ splitWithSuffixSeq "\r\n" inh
188 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
198 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
189 splitOnSeq "aa" inh
199 splitOnSeq "aa" inh
190 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
200 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
@@ -201,6 +211,8 @@ o_1_space_reduce_read_split env =
201 env $ \inh _ -> splitOnSeq100k inh
211 env $ \inh _ -> splitOnSeq100k inh
202 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
212 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
203 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
213 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
214+ , mkBenchSmall "S.splitWithSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
215+ env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
204 ]
216 ]
205 ]
217 ]
206
218
@@ -208,8 +220,9 @@ o_1_space_reduce_read_split env =
208splitOnSeqUtf8 :: String -> Handle -> IO Int
220splitOnSeqUtf8 :: String -> Handle -> IO Int
209splitOnSeqUtf8 str inh =
221splitOnSeqUtf8 str inh =
210 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
222 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
223+ $ IP.fromStream
211 $ IUS.decodeUtf8Arrays
224 $ IUS.decodeUtf8Arrays
212− $ IFH.toChunks inh) -- >>= print
225+ $ IFH.readChunks inh) -- >>= print
213
226
214o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
227o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
215o_1_space_reduce_toChunks_split env =
228o_1_space_reduce_toChunks_split env =
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs+57−16
@@ -8,6 +8,8 @@
8{-# LANGUAGE CPP #-}
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE TupleSections #-}
12+{-# OPTIONS_GHC -Wno-orphans #-}
11
13
12#ifdef __HADDOCK_VERSION__
14#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
15#undef INSPECTION
@@ -20,15 +22,19 @@
20
22
21module Main (main) where
23module Main (main) where
22
24
25+#if !MIN_VERSION_base(4,18,0)
26+import Control.Applicative (liftA2)
27+#endif
23import Control.Monad (when)
28import Control.Monad (when)
24import Data.Maybe (isJust)
29import Data.Maybe (isJust)
25−import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
30+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
26import System.Random (randomRIO)
31import System.Random (randomRIO)
27import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
32import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
28
33
29import qualified Prelude as P
34import qualified Prelude as P
30−import qualified Streamly.Internal.Data.Stream.StreamD as S
35+import qualified Streamly.Internal.Data.Stream as S
31import qualified Streamly.Internal.Data.Unfold as UF
36import qualified Streamly.Internal.Data.Unfold as UF
37+import qualified Streamly.Internal.Data.Fold as FL
32
38
33import Streamly.Benchmark.Common
39import Streamly.Benchmark.Common
34
40
@@ -125,6 +131,12 @@ uncons s = do
125 Nothing -> return ()
131 Nothing -> return ()
126 Just (_, t) -> uncons t
132 Just (_, t) -> uncons t
127
133
134+{-# INLINE foldBreak #-}
135+foldBreak :: Monad m => Stream m Int -> m ()
136+foldBreak s = do
137+ (r, s1) <- S.foldBreak (FL.take 1 FL.length) s
138+ when (r /= 0) $ foldBreak s1
139+
128{-# INLINE tail #-}
140{-# INLINE tail #-}
129tail :: Monad m => Stream m a -> m ()
141tail :: Monad m => Stream m a -> m ()
130tail s = S.tail s >>= P.mapM_ tail
142tail s = S.tail s >>= P.mapM_ tail
@@ -314,6 +326,34 @@ filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
314-- Nested Composition
326-- Nested Composition
315-------------------------------------------------------------------------------
327-------------------------------------------------------------------------------
316
328
329+instance Monad f => Applicative (S.Stream f) where
330+ {-# INLINE pure #-}
331+ pure = S.fromPure
332+
333+ {-# INLINE (<*>) #-}
334+ (<*>) = S.crossApply
335+
336+ {-# INLINE liftA2 #-}
337+ liftA2 f x = (<*>) (fmap f x)
338+
339+ {-# INLINE (*>) #-}
340+ (*>) = S.crossApplySnd
341+
342+ {-# INLINE (<*) #-}
343+ (<*) = S.crossApplyFst
344+
345+-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,
346+-- the monad instance does not seem to be significantly faster.
347+instance Monad m => Monad (S.Stream m) where
348+ {-# INLINE return #-}
349+ return = pure
350+
351+ {-# INLINE (>>=) #-}
352+ (>>=) = flip S.concatMap
353+
354+ {-# INLINE (>>) #-}
355+ (>>) = (*>)
356+
317{-# INLINE toNullApNested #-}
357{-# INLINE toNullApNested #-}
318toNullApNested :: Monad m => Stream m Int -> m ()
358toNullApNested :: Monad m => Stream m Int -> m ()
319toNullApNested s = runStream $ do
359toNullApNested s = runStream $ do
@@ -402,20 +442,20 @@ inspect $ hasNoTypeClasses 'concatMapRepl
402inspect $ 'concatMapRepl `hasNoType` ''SPEC
442inspect $ 'concatMapRepl `hasNoType` ''SPEC
403#endif
443#endif
404
444
405−-- concatUnfold replicate/unfoldrM
445+-- unfoldMany replicate/unfoldrM
406
446
407−{-# INLINE concatUnfoldRepl #-}
447+{-# INLINE unfoldManyRepl #-}
408−concatUnfoldRepl :: Int -> Int -> Int -> IO ()
448+unfoldManyRepl :: Int -> Int -> Int -> IO ()
409−concatUnfoldRepl outer inner n =
449+unfoldManyRepl outer inner n =
410 S.drain
450 S.drain
411− $ S.concatUnfold
451+ $ S.unfoldMany
412− (UF.lmap return (UF.replicateM inner))
452+ UF.replicateM
413− (sourceUnfoldrMN outer n)
453+ (S.map ((inner,) . return) (sourceUnfoldrMN outer n))
414
454
415#ifdef INSPECTION
455#ifdef INSPECTION
416−inspect $ hasNoTypeClasses 'concatUnfoldRepl
456+inspect $ hasNoTypeClasses 'unfoldManyRepl
417−inspect $ 'concatUnfoldRepl `hasNoType` ''S.ConcatMapUState
457+inspect $ 'unfoldManyRepl `hasNoType` ''S.ConcatMapUState
418−inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
458+inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
419#endif
459#endif
420
460
421-------------------------------------------------------------------------------
461-------------------------------------------------------------------------------
@@ -423,7 +463,7 @@ inspect $ 'concatUnfoldRepl `hasNoType` ''SPEC
423-------------------------------------------------------------------------------
463-------------------------------------------------------------------------------
424
464
425moduleName :: String
465moduleName :: String
426−moduleName = "Data.Stream.StreamD"
466+moduleName = "Data.StreamD"
427
467
428o_1_space :: [Benchmark]
468o_1_space :: [Benchmark]
429o_1_space =
469o_1_space =
@@ -439,6 +479,7 @@ o_1_space =
439 [ benchFold "toNull" toNull sourceUnfoldrM
479 [ benchFold "toNull" toNull sourceUnfoldrM
440 , benchFold "mapM_" mapM_ sourceUnfoldrM
480 , benchFold "mapM_" mapM_ sourceUnfoldrM
441 , benchFold "uncons" uncons sourceUnfoldrM
481 , benchFold "uncons" uncons sourceUnfoldrM
482+ , benchFold "foldBreak" foldBreak sourceUnfoldrM
442 , benchFold "foldl'" foldl sourceUnfoldrM
483 , benchFold "foldl'" foldl sourceUnfoldrM
443 , benchFold "last" last sourceUnfoldrM
484 , benchFold "last" last sourceUnfoldrM
444 ]
485 ]
@@ -488,11 +529,11 @@ o_1_space =
488 , benchIOSrc1 "concatMap (1 of n)"
529 , benchIOSrc1 "concatMap (1 of n)"
489 (concatMap 1 value)
530 (concatMap 1 value)
490
531
491− -- concatMap vs concatUnfold
532+ -- concatMap vs unfoldMany
492 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
533 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
493 (concatMapRepl value2 value2)
534 (concatMapRepl value2 value2)
494− , benchIOSrc1 "concatUnfoldRepl (sqrt n of sqrt n)"
535+ , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
495− (concatUnfoldRepl value2 value2)
536+ (unfoldManyRepl value2 value2)
496 ]
537 ]
497 , bgroup "filtering"
538 , bgroup "filtering"
498 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
539 [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+586−356
@@ -8,6 +8,7 @@
8{-# LANGUAGE CPP #-}
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
11
12
12#ifdef __HADDOCK_VERSION__
13#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
14#undef INSPECTION
@@ -20,19 +21,23 @@
20
21
21module Main (main) where
22module Main (main) where
22
23
24+#if !MIN_VERSION_base(4,18,0)
25+import Control.Applicative (liftA2)
26+#endif
23import Control.Monad (when)
27import Control.Monad (when)
24import Data.Maybe (isJust)
28import Data.Maybe (isJust)
25import System.Random (randomRIO)
29import System.Random (randomRIO)
26import Prelude hiding
30import Prelude hiding
27− (tail, mapM_, foldl, last, map, mapM, concatMap, zip, init)
31+ ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
32+ , repeat, replicate
33+ )
28
34
29import qualified Prelude as P
35import qualified Prelude as P
30import qualified Data.List as List
36import qualified Data.List as List
31
37
32−import qualified Streamly.Internal.Data.Stream.StreamK as S
38+import qualified Streamly.Internal.Data.StreamK as S
33−import qualified Streamly.Internal.Data.SVar as S
34
39
35−import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
40+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
36
41
37import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common
38
43
@@ -40,112 +45,163 @@ import Streamly.Benchmark.Common
40import Test.Inspection
45import Test.Inspection
41#endif
46#endif
42
47
43−value, value2, value3, value16, maxValue :: Int
48+{-
44−value = 100000
49+
45−value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop
50+Benchmarks that need to be added
46−value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop
51+
47−value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop
52+-- fromList
48−maxValue = value
53+
49−
54+-- bindWith
50−-------------------------------------------------------------------------------
55+-- concatPairsWith
51−-- Benchmark ops
56+-- apWith
52−-------------------------------------------------------------------------------
57+-- apSerial
53−
58+-- apSerialDiscardFst
54−{-# INLINE toNull #-}
59+-- apSerialDiscardSnd
55−{-# INLINE uncons #-}
60+
56−{-# INLINE nullTail #-}
61+-- the
57−{-# INLINE headTail #-}
62+-- serial
58−{-# INLINE zip #-}
63+-- consMStream
59−toNull, uncons, nullTail, headTail, zip
64+-- withLocal
60− :: Monad m
65+-- mfix
61− => Stream m Int -> m ()
66+
62−
67+-- elem
63−{-# INLINE toList #-}
68+-- notElem
64−toList :: Monad m => Stream m Int -> m [Int]
69+-- all
65−{-# INLINE foldl #-}
70+-- any
66−foldl :: Monad m => Stream m Int -> m Int
71+-- minimum
67−{-# INLINE last #-}
72+-- minimumBy
68−last :: Monad m => Stream m Int -> m (Maybe Int)
73+-- maximum
74+-- maximumBy
75+-- findIndices
76+-- lookup
77+-- findM
78+-- find
79+-- (!!)
80+
81+-- foldlM'
82+-- foldlT
83+-- foldlx'
84+-- foldlMx'
85+-- fold
86+
87+-- sequence
88+
89+-- foldrSM
90+-- buildS
91+-- buildM
92+-- augmentS
93+-- augmentSM
94+-- foldr
95+-- foldr1
96+-- foldrM
97+-- foldrT
98+
99+-- intersperseM
100+-- insertBy
101+-- deleteBy
102+-- reverse
103+-- mapMaybe
104+
105+-- zipWithM
106+-- mergeBy
107+-- mergeByM
108+
109+-- toStreamK (Probably can be skipped)
110+-- hoist
111+
112+-- scanlx'
113+
114+-}
69
115
70-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
71-- Stream generation and elimination
117-- Stream generation and elimination
72-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
73
119
74−type Stream m a = S.Stream m a
120+type Stream m a = S.StreamK m a
75−
76−{-# INLINE sourceUnfoldr #-}
77−sourceUnfoldr :: Int -> Stream m Int
78−sourceUnfoldr n = S.unfoldr step n
79− where
80− step cnt =
81− if cnt > n + value
82− then Nothing
83− else Just (cnt, cnt + 1)
84
121
85−{-# INLINE sourceUnfoldrN #-}
122+{-# INLINE unfoldr #-}
86−sourceUnfoldrN :: Int -> Int -> Stream m Int
123+unfoldr :: Int -> Int -> Stream m Int
87−sourceUnfoldrN m n = S.unfoldr step n
124+unfoldr streamLen n = S.unfoldr step n
88 where
125 where
89 step cnt =
126 step cnt =
90− if cnt > n + m
127+ if cnt > n + streamLen
91 then Nothing
128 then Nothing
92 else Just (cnt, cnt + 1)
129 else Just (cnt, cnt + 1)
93
130
94−{-# INLINE sourceUnfoldrM #-}
131+{-# INLINE unfoldrM #-}
95−sourceUnfoldrM :: S.MonadAsync m => Int -> Stream m Int
132+unfoldrM :: Monad m => Int -> Int -> Stream m Int
96−sourceUnfoldrM n = S.unfoldrM step n
133+unfoldrM streamLen n = S.unfoldrMWith S.consM step n
97 where
134 where
98 step cnt =
135 step cnt =
99− if cnt > n + value
136+ if cnt > n + streamLen
100 then return Nothing
137 then return Nothing
101 else return (Just (cnt, cnt + 1))
138 else return (Just (cnt, cnt + 1))
102
139
103−{-# INLINE sourceUnfoldrMN #-}
140+{-# INLINE repeat #-}
104−sourceUnfoldrMN :: S.MonadAsync m => Int -> Int -> Stream m Int
141+repeat :: Int -> Int -> Stream m Int
105−sourceUnfoldrMN m n = S.unfoldrM step n
142+repeat streamLen = S.take streamLen . S.repeat
106− where
107− step cnt =
108− if cnt > n + m
109− then return Nothing
110− else return (Just (cnt, cnt + 1))
111
143
112−{-# INLINE sourceFromFoldable #-}
144+{-# INLINE repeatM #-}
113−sourceFromFoldable :: Int -> Stream m Int
145+repeatM :: Monad m => Int -> Int -> Stream m Int
114−sourceFromFoldable n = S.fromFoldable [n..n+value]
146+repeatM streamLen = S.take streamLen . S.repeatM . return
115
147
116−{-# INLINE sourceFromFoldableM #-}
148+{-# INLINE replicate #-}
117−sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int
149+replicate :: Int -> Int -> Stream m Int
118−sourceFromFoldableM n =
150+replicate = S.replicate
119− Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+value])
120
151
121−{-# INLINABLE concatMapFoldableWith #-}
152+{-# INLINE replicateM #-}
122−concatMapFoldableWith :: (S.IsStream t, Foldable f)
153+replicateM :: Monad m => Int -> Int -> Stream m Int
123− => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b
154+replicateM streamLen = S.replicateMWith S.consM streamLen . return
124−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
155+
156+{-# INLINE iterate #-}
157+iterate :: Int -> Int -> Stream m Int
158+iterate streamLen = S.take streamLen . S.iterate (+1)
125
159
126−{-# INLINE sourceFoldMapWith #-}
160+{-# INLINE iterateM #-}
127−sourceFoldMapWith :: Int -> Stream m Int
161+iterateM :: Monad m => Int -> Int -> Stream m Int
128−sourceFoldMapWith n = concatMapFoldableWith S.serial S.yield [n..n+value]
162+iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
129
163
130−{-# INLINE sourceFoldMapWithM #-}
164+{-# INLINE fromFoldable #-}
165+fromFoldable :: Int -> Int -> Stream m Int
166+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
167+
168+{-# INLINE fromFoldableM #-}
131−sourceFoldMapWithM :: Monad m => Int -> Stream m Int
169+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
132−sourceFoldMapWithM n =
170+fromFoldableM streamLen n =
171+ List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
172+
173+{-# INLINABLE concatMapFoldableWith #-}
133− concatMapFoldableWith S.serial (S.yieldM . return) [n..n+value]
174+concatMapFoldableWith :: P.Foldable f
175+ => (Stream m b -> Stream m b -> Stream m b)
176+ -> (a -> Stream m b)
177+ -> f a
178+ -> Stream m b
179+concatMapFoldableWith f g = P.foldr (f . g) S.nil
180+
181+{-# INLINE concatMapFoldableSerial #-}
182+concatMapFoldableSerial :: Int -> Int -> Stream m Int
183+concatMapFoldableSerial streamLen n =
184+ concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
185+
186+{-# INLINE concatMapFoldableSerialM #-}
187+concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
188+concatMapFoldableSerialM streamLen n =
189+ concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
134
190
135-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
136-- Elimination
192-- Elimination
137-------------------------------------------------------------------------------
193-------------------------------------------------------------------------------
138
194
139−{-# INLINE runStream #-}
195+{-# INLINE drain #-}
140−runStream :: Monad m => Stream m a -> m ()
196+drain :: Monad m => Stream m a -> m ()
141−runStream = S.drain
197+drain = S.drain
142−-- runStream = S.mapM_ (\_ -> return ())
143
198
144{-# INLINE mapM_ #-}
199{-# INLINE mapM_ #-}
145mapM_ :: Monad m => Stream m a -> m ()
200mapM_ :: Monad m => Stream m a -> m ()
146mapM_ = S.mapM_ (\_ -> return ())
201mapM_ = S.mapM_ (\_ -> return ())
147
202
148−toNull = runStream
203+{-# INLINE uncons #-}
204+uncons :: Monad m => Stream m Int -> m ()
149uncons s = do
205uncons s = do
150 r <- S.uncons s
206 r <- S.uncons s
151 case r of
207 case r of
@@ -153,167 +209,238 @@ uncons s = do
153 Just (_, t) -> uncons t
209 Just (_, t) -> uncons t
154
210
155{-# INLINE init #-}
211{-# INLINE init #-}
156−init :: (Monad m, S.IsStream t) => t m a -> m ()
212+init :: Monad m => Stream m a -> m ()
157init s = do
213init s = do
158 t <- S.init s
214 t <- S.init s
159 P.mapM_ S.drain t
215 P.mapM_ S.drain t
160
216
161{-# INLINE tail #-}
217{-# INLINE tail #-}
162−tail :: (Monad m, S.IsStream t) => t m a -> m ()
218+tail :: Monad m => Stream m a -> m ()
163tail s = S.tail s >>= P.mapM_ tail
219tail s = S.tail s >>= P.mapM_ tail
164
220
221+{-# INLINE nullTail #-}
222+nullTail :: Monad m => Stream m Int -> m ()
165nullTail s = do
223nullTail s = do
166 r <- S.null s
224 r <- S.null s
167 when (not r) $ S.tail s >>= P.mapM_ nullTail
225 when (not r) $ S.tail s >>= P.mapM_ nullTail
168
226
227+{-# INLINE headTail #-}
228+headTail :: Monad m => Stream m Int -> m ()
169headTail s = do
229headTail s = do
170 h <- S.head s
230 h <- S.head s
171 when (isJust h) $ S.tail s >>= P.mapM_ headTail
231 when (isJust h) $ S.tail s >>= P.mapM_ headTail
172
232
233+{-# INLINE toList #-}
234+toList :: Monad m => Stream m Int -> m [Int]
173toList = S.toList
235toList = S.toList
236+
237+{-# INLINE foldl' #-}
238+foldl' :: Monad m => Stream m Int -> m Int
174−foldl = S.foldl' (+) 0
239+foldl' = S.foldl' (+) 0
240+
241+{-# INLINE last #-}
242+last :: Monad m => Stream m Int -> m (Maybe Int)
175−last = S.last
243+last = S.last
176
244
177-------------------------------------------------------------------------------
245-------------------------------------------------------------------------------
178-- Transformation
246-- Transformation
179-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
180
248
181−{-# INLINE transform #-}
182−transform :: Monad m => Stream m a -> m ()
183−transform = runStream
184−
185{-# INLINE composeN #-}
249{-# INLINE composeN #-}
186composeN
250composeN
187 :: Monad m
251 :: Monad m
188 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
252 => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
189composeN n f =
253composeN n f =
190 case n of
254 case n of
191− 1 -> transform . f
255+ 1 -> drain . f
192− 2 -> transform . f . f
256+ 2 -> drain . f . f
193− 3 -> transform . f . f . f
257+ 3 -> drain . f . f . f
194− 4 -> transform . f . f . f . f
258+ 4 -> drain . f . f . f . f
195 _ -> undefined
259 _ -> undefined
196
260
197−{-# INLINE scan #-}
261+{-# INLINE scanl' #-}
262+scanl' :: Monad m => Int -> Stream m Int -> m ()
263+scanl' n = composeN n $ S.scanl' (+) 0
264+
198{-# INLINE map #-}
265{-# INLINE map #-}
266+map :: Monad m => Int -> Stream m Int -> m ()
267+map n = composeN n $ S.map (+ 1)
268+
199{-# INLINE fmapK #-}
269{-# INLINE fmapK #-}
270+fmapK :: Monad m => Int -> Stream m Int -> m ()
271+fmapK n = composeN n $ P.fmap (+ 1)
272+
273+{-# INLINE mapM #-}
274+mapM :: Monad m => Int -> Stream m Int -> m ()
275+mapM n = composeN n $ S.mapMWith S.consM return
276+
277+{-# INLINE mapMSerial #-}
278+mapMSerial :: Monad m => Int -> Stream m Int -> m ()
279+mapMSerial n = composeN n $ S.mapMSerial return
280+
200{-# INLINE filterEven #-}
281{-# INLINE filterEven #-}
282+filterEven :: Monad m => Int -> Stream m Int -> m ()
283+filterEven n = composeN n $ S.filter even
284+
201{-# INLINE filterAllOut #-}
285{-# INLINE filterAllOut #-}
286+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
287+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
288+
202{-# INLINE filterAllIn #-}
289{-# INLINE filterAllIn #-}
290+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
291+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
292+
203{-# INLINE _takeOne #-}
293{-# INLINE _takeOne #-}
294+_takeOne :: Monad m => Int -> Stream m Int -> m ()
295+_takeOne n = composeN n $ S.take 1
296+
204{-# INLINE takeAll #-}
297{-# INLINE takeAll #-}
298+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
299+takeAll streamLen n = composeN n $ S.take streamLen
300+
205{-# INLINE takeWhileTrue #-}
301{-# INLINE takeWhileTrue #-}
302+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
303+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
304+
206{-# INLINE dropOne #-}
305{-# INLINE dropOne #-}
306+dropOne :: Monad m => Int -> Stream m Int -> m ()
307+dropOne n = composeN n $ S.drop 1
308+
207{-# INLINE dropAll #-}
309{-# INLINE dropAll #-}
310+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
311+dropAll streamLen n = composeN n $ S.drop streamLen
312+
208{-# INLINE dropWhileTrue #-}
313{-# INLINE dropWhileTrue #-}
314+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
315+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
316+
209{-# INLINE dropWhileFalse #-}
317{-# INLINE dropWhileFalse #-}
318+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
319+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
320+
210{-# INLINE foldrS #-}
321{-# INLINE foldrS #-}
322+foldrS :: Monad m => Int -> Stream m Int -> m ()
323+foldrS n = composeN n $ S.foldrS S.cons S.nil
324+
211{-# INLINE foldlS #-}
325{-# INLINE foldlS #-}
212−scan, map, fmapK, filterEven, filterAllOut,
213− filterAllIn, _takeOne, takeAll, takeWhileTrue, dropAll, dropOne,
214− dropWhileTrue, dropWhileFalse, foldrS, foldlS
215− :: Monad m
216− => Int -> Stream m Int -> m ()
326+foldlS :: Monad m => Int -> Stream m Int -> m ()
327+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
217
328
218−{-# INLINE mapM #-}
219−{-# INLINE mapMSerial #-}
220{-# INLINE intersperse #-}
329{-# INLINE intersperse #-}
221−mapM, mapMSerial, intersperse
222− :: S.MonadAsync m => Int -> Stream m Int -> m ()
330+intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
223−
331+intersperse streamLen n = composeN n $ S.intersperse streamLen
224−scan n = composeN n $ S.scanl' (+) 0
225−map n = composeN n $ P.fmap (+1)
226−fmapK n = composeN n $ P.fmap (+1)
227−mapM n = composeN n $ S.mapM return
228−mapMSerial n = composeN n $ S.mapMSerial return
229−filterEven n = composeN n $ S.filter even
230−filterAllOut n = composeN n $ S.filter (> maxValue)
231−filterAllIn n = composeN n $ S.filter (<= maxValue)
232−_takeOne n = composeN n $ S.take 1
233−takeAll n = composeN n $ S.take maxValue
234−takeWhileTrue n = composeN n $ S.takeWhile (<= maxValue)
235−dropOne n = composeN n $ S.drop 1
236−dropAll n = composeN n $ S.drop maxValue
237−dropWhileTrue n = composeN n $ S.dropWhile (<= maxValue)
238−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
239−foldrS n = composeN n $ S.foldrS S.cons S.nil
240−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
241−intersperse n = composeN n $ S.intersperse maxValue
242
332
243-------------------------------------------------------------------------------
333-------------------------------------------------------------------------------
244-- Iteration
334-- Iteration
245-------------------------------------------------------------------------------
335-------------------------------------------------------------------------------
246
336
247−iterStreamLen, maxIters :: Int
248−iterStreamLen = 10
249−maxIters = 10000
250−
251{-# INLINE iterateSource #-}
337{-# INLINE iterateSource #-}
252iterateSource
338iterateSource
253− :: S.MonadAsync m
254− => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
339+ :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
255−iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)
340+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
256 where
341 where
257 f (0 :: Int) m = g m
342 f (0 :: Int) m = g m
258 f x m = g (f (x P.- 1) m)
343 f x m = g (f (x P.- 1) m)
259
344
260−{-# INLINE iterateMapM #-}
345+-- this is quadratic
261{-# INLINE iterateScan #-}
346{-# INLINE iterateScan #-}
347+iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
348+iterateScan iterStreamLen maxIters =
349+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
350+
351+-- this is quadratic
352+{-# INLINE iterateDropWhileFalse #-}
353+iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
354+iterateDropWhileFalse streamLen iterStreamLen maxIters =
355+ iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
356+
357+{-# INLINE iterateMapM #-}
358+iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
359+iterateMapM iterStreamLen =
360+ iterateSource iterStreamLen (S.mapMWith S.consM return)
361+
262{-# INLINE iterateFilterEven #-}
362{-# INLINE iterateFilterEven #-}
363+iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
364+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365+
263{-# INLINE iterateTakeAll #-}
366{-# INLINE iterateTakeAll #-}
264−{-# INLINE iterateDropOne #-}
265−{-# INLINE iterateDropWhileFalse #-}
266−{-# INLINE iterateDropWhileTrue #-}
267−iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,
268− iterateDropWhileFalse, iterateDropWhileTrue
269− :: S.MonadAsync m
270− => Int -> Stream m Int
367+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
368+iterateTakeAll streamLen iterStreamLen =
369+ iterateSource iterStreamLen (S.take streamLen)
271
370
272−-- this is quadratic
371+{-# INLINE iterateDropOne #-}
273−iterateScan = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)
372+iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
274−iterateDropWhileFalse = iterateSource (S.dropWhile (> maxValue))
373+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
275− (maxIters `div` 10)
276
374
277−iterateMapM = iterateSource (S.mapM return) maxIters
375+{-# INLINE iterateDropWhileTrue #-}
278−iterateFilterEven = iterateSource (S.filter even) maxIters
376+iterateDropWhileTrue ::
279−iterateTakeAll = iterateSource (S.take maxValue) maxIters
377+ Monad m => Int -> Int -> Int -> Int -> Stream m Int
280−iterateDropOne = iterateSource (S.drop 1) maxIters
378+iterateDropWhileTrue streamLen iterStreamLen =
281−iterateDropWhileTrue = iterateSource (S.dropWhile (<= maxValue)) maxIters
379+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
282
380
283-------------------------------------------------------------------------------
381-------------------------------------------------------------------------------
284-- Zipping
382-- Zipping
285-------------------------------------------------------------------------------
383-------------------------------------------------------------------------------
286
384
385+{-# INLINE zipWith #-}
386+zipWith :: Monad m => Stream m Int -> m ()
287−zip src = transform $ S.zipWith (,) src src
387+zipWith src = drain $ S.zipWith (,) src src
388+
389+{-# INLINE zipWithM #-}
390+zipWithM :: Monad m => Stream m Int -> m ()
391+zipWithM src = drain $ S.zipWithM (curry return) src src
392+
393+{-# INLINE sortByK #-}
394+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395+sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
396+
397+{-# INLINE sortBy #-}
398+sortBy :: Monad m => Stream m Int -> m ()
399+sortBy = drain . sortByK compare
288
400
289-------------------------------------------------------------------------------
401-------------------------------------------------------------------------------
290-- Mixed Composition
402-- Mixed Composition
291-------------------------------------------------------------------------------
403-------------------------------------------------------------------------------
292
404
293{-# INLINE scanMap #-}
405{-# INLINE scanMap #-}
406+scanMap :: Monad m => Int -> Stream m Int -> m ()
407+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
408+
294{-# INLINE dropMap #-}
409{-# INLINE dropMap #-}
410+dropMap :: Monad m => Int -> Stream m Int -> m ()
411+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
412+
295{-# INLINE dropScan #-}
413{-# INLINE dropScan #-}
414+dropScan :: Monad m => Int -> Stream m Int -> m ()
415+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
416+
296{-# INLINE takeDrop #-}
417{-# INLINE takeDrop #-}
418+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
419+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
420+
297{-# INLINE takeScan #-}
421{-# INLINE takeScan #-}
422+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
423+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
424+
298{-# INLINE takeMap #-}
425{-# INLINE takeMap #-}
426+takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
427+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
428+
299{-# INLINE filterDrop #-}
429{-# INLINE filterDrop #-}
430+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
431+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
432+
300{-# INLINE filterTake #-}
433{-# INLINE filterTake #-}
434+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
435+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
436+
301{-# INLINE filterScan #-}
437{-# INLINE filterScan #-}
302−{-# INLINE filterMap #-}
303−scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,
304− filterTake, filterScan, filterMap
305− :: Monad m => Int -> Stream m Int -> m ()
438+filterScan :: Monad m => Int -> Stream m Int -> m ()
306−
307−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
308−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
309−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
310−takeDrop n = composeN n $ S.drop 1 . S.take maxValue
311−takeScan n = composeN n $ S.scanl' (+) 0 . S.take maxValue
312−takeMap n = composeN n $ S.map (subtract 1) . S.take maxValue
313−filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)
314−filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)
315filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
439filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
440+
441+{-# INLINE filterMap #-}
442+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
316−filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
443+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
317
444
318-------------------------------------------------------------------------------
445-------------------------------------------------------------------------------
319-- ConcatMap
446-- ConcatMap
@@ -325,8 +452,8 @@ filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
325concatMap :: Int -> Int -> Int -> IO ()
452concatMap :: Int -> Int -> Int -> IO ()
326concatMap outer inner n =
453concatMap outer inner n =
327 S.drain $ S.concatMap
454 S.drain $ S.concatMap
328− (\_ -> sourceUnfoldrMN inner n)
455+ (\_ -> unfoldrM inner n)
329− (sourceUnfoldrMN outer n)
456+ (unfoldrM outer n)
330
457
331#ifdef INSPECTION
458#ifdef INSPECTION
332inspect $ hasNoTypeClasses 'concatMap
459inspect $ hasNoTypeClasses 'concatMap
@@ -338,8 +465,8 @@ inspect $ hasNoTypeClasses 'concatMap
338concatMapPure :: Int -> Int -> Int -> IO ()
465concatMapPure :: Int -> Int -> Int -> IO ()
339concatMapPure outer inner n =
466concatMapPure outer inner n =
340 S.drain $ S.concatMap
467 S.drain $ S.concatMap
341− (\_ -> sourceUnfoldrN inner n)
468+ (\_ -> unfoldr inner n)
342− (sourceUnfoldrN outer n)
469+ (unfoldr outer n)
343
470
344#ifdef INSPECTION
471#ifdef INSPECTION
345inspect $ hasNoTypeClasses 'concatMapPure
472inspect $ hasNoTypeClasses 'concatMapPure
@@ -350,7 +477,7 @@ inspect $ hasNoTypeClasses 'concatMapPure
350{-# INLINE concatMapRepl #-}
477{-# INLINE concatMapRepl #-}
351concatMapRepl :: Int -> Int -> Int -> IO ()
478concatMapRepl :: Int -> Int -> Int -> IO ()
352concatMapRepl outer inner n =
479concatMapRepl outer inner n =
353− S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrMN outer n)
480+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
354
481
355#ifdef INSPECTION
482#ifdef INSPECTION
356inspect $ hasNoTypeClasses 'concatMapRepl
483inspect $ hasNoTypeClasses 'concatMapRepl
@@ -362,44 +489,70 @@ inspect $ hasNoTypeClasses 'concatMapRepl
362sourceConcatMapId :: Monad m
489sourceConcatMapId :: Monad m
363 => Int -> Int -> Stream m (Stream m Int)
490 => Int -> Int -> Stream m (Stream m Int)
364sourceConcatMapId val n =
491sourceConcatMapId val n =
365− S.fromFoldable $ fmap (S.yieldM . return) [n..n+val]
492+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
366
493
367−{-# INLINE concatStreamsWith #-}
494+{-# INLINE concatMapBySerial #-}
368−concatStreamsWith :: Int -> Int -> Int -> IO ()
495+concatMapBySerial :: Int -> Int -> Int -> IO ()
369−concatStreamsWith outer inner n =
496+concatMapBySerial outer inner n =
370− S.drain $ S.concatMapBy S.serial
497+ S.drain $ S.concatMapWith S.append
371− (sourceUnfoldrMN inner)
498+ (unfoldrM inner)
372− (sourceUnfoldrMN outer n)
499+ (unfoldrM outer n)
373
500
374-------------------------------------------------------------------------------
501-------------------------------------------------------------------------------
375-- Nested Composition
502-- Nested Composition
376-------------------------------------------------------------------------------
503-------------------------------------------------------------------------------
377
504
378−{-# INLINE toNullApNested #-}
505+instance Monad m => Applicative (S.StreamK m) where
506+ {-# INLINE pure #-}
507+ pure = S.fromPure
508+
509+ {-# INLINE (<*>) #-}
510+ (<*>) = S.crossApply
511+
512+ {-# INLINE liftA2 #-}
513+ liftA2 f x = (<*>) (fmap f x)
514+
515+ {-# INLINE (*>) #-}
516+ (*>) = S.crossApplySnd
517+
518+ {-# INLINE (<*) #-}
519+ (<*) = S.crossApplyFst
520+
521+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
522+-- the monad instance of StreamD is slower than StreamK after foldr/build
523+-- fusion.
524+instance Monad m => Monad (S.StreamK m) where
525+ {-# INLINE return #-}
526+ return = pure
527+
528+ {-# INLINE (>>=) #-}
529+ (>>=) = flip S.concatMap
530+
531+{-# INLINE drainApplicative #-}
379−toNullApNested :: Monad m => Stream m Int -> m ()
532+drainApplicative :: Monad m => Stream m Int -> m ()
380−toNullApNested s = runStream $ do
533+drainApplicative s = drain $ do
381 (+) <$> s <*> s
534 (+) <$> s <*> s
382
535
383−{-# INLINE toNullNested #-}
536+{-# INLINE drainMonad #-}
384−toNullNested :: Monad m => Stream m Int -> m ()
537+drainMonad :: Monad m => Stream m Int -> m ()
385−toNullNested s = runStream $ do
538+drainMonad s = drain $ do
386 x <- s
539 x <- s
387 y <- s
540 y <- s
388 return $ x + y
541 return $ x + y
389
542
390−{-# INLINE toNullNested3 #-}
543+{-# INLINE drainMonad3 #-}
391−toNullNested3 :: Monad m => Stream m Int -> m ()
544+drainMonad3 :: Monad m => Stream m Int -> m ()
392−toNullNested3 s = runStream $ do
545+drainMonad3 s = drain $ do
393 x <- s
546 x <- s
394 y <- s
547 y <- s
395 z <- s
548 z <- s
396 return $ x + y + z
549 return $ x + y + z
397
550
398−{-# INLINE filterAllOutNested #-}
551+{-# INLINE filterAllOutMonad #-}
399−filterAllOutNested
552+filterAllOutMonad
400 :: Monad m
553 :: Monad m
401 => Stream m Int -> m ()
554 => Stream m Int -> m ()
402−filterAllOutNested str = runStream $ do
555+filterAllOutMonad str = drain $ do
403 x <- str
556 x <- str
404 y <- str
557 y <- str
405 let s = x + y
558 let s = x + y
@@ -407,11 +560,11 @@ filterAllOutNested str = runStream $ do
407 then return s
560 then return s
408 else S.nil
561 else S.nil
409
562
410−{-# INLINE filterAllInNested #-}
563+{-# INLINE filterAllInMonad #-}
411−filterAllInNested
564+filterAllInMonad
412 :: Monad m
565 :: Monad m
413 => Stream m Int -> m ()
566 => Stream m Int -> m ()
414−filterAllInNested str = runStream $ do
567+filterAllInMonad str = drain $ do
415 x <- str
568 x <- str
416 y <- str
569 y <- str
417 let s = x + y
570 let s = x + y
@@ -423,9 +576,14 @@ filterAllInNested str = runStream $ do
423-- Nested Composition Pure lists
576-- Nested Composition Pure lists
424-------------------------------------------------------------------------------
577-------------------------------------------------------------------------------
425
578
426−{-# INLINE sourceUnfoldrList #-}
579+-- There are several list benchmarks here for comparison with lists. It is easy
427−sourceUnfoldrList :: Int -> Int -> [Int]
580+-- and convenient to see the comparisons when they are here, otherwise we'll
581+-- have to add a separate module for list benchmarks with the same names and
582+-- then add a comparison in bench.sh.
583+
584+{-# INLINE unfoldrList #-}
585+unfoldrList :: Int -> Int -> [Int]
428−sourceUnfoldrList maxval n = List.unfoldr step n
586+unfoldrList maxval n = List.unfoldr step n
429 where
587 where
430 step cnt =
588 step cnt =
431 if cnt > n + maxval
589 if cnt > n + maxval
@@ -476,229 +634,301 @@ filterAllInNestedList str = do
476-------------------------------------------------------------------------------
634-------------------------------------------------------------------------------
477
635
478moduleName :: String
636moduleName :: String
479−moduleName = "Data.Stream.StreamK"
637+moduleName = "Data.StreamK"
480−
638+
481−o_1_space :: [Benchmark]
639+o_1_space_generation :: Int -> Benchmark
482−o_1_space =
640+o_1_space_generation streamLen =
483− [ bgroup (o_1_space_prefix moduleName)
484− [ bgroup "generation"
641+ bgroup "generation"
485− [ benchFold "unfoldr" toNull sourceUnfoldr
642+ [ benchFold "unfoldr" drain (unfoldr streamLen)
486− , benchFold "unfoldrM" toNull sourceUnfoldrM
643+ , benchFold "unfoldrM" drain (unfoldrM streamLen)
487−
644+ , benchFold "repeat" drain (repeat streamLen)
645+ , benchFold "repeatM" drain (repeatM streamLen)
646+ , benchFold "replicate" drain (replicate streamLen)
647+ , benchFold "replicateM" drain (replicateM streamLen)
648+ , benchFold "iterate" drain (iterate streamLen)
649+ , benchFold "iterateM" drain (iterateM streamLen)
650+
488− , benchFold "fromFoldable" toNull sourceFromFoldable
651+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
489− , benchFold "fromFoldableM" toNull sourceFromFoldableM
652+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
490
653
491 -- appends
654 -- appends
492− , benchFold "concatMapFoldableWith" toNull sourceFoldMapWith
655+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
493− , benchFold "concatMapFoldableWithM" toNull sourceFoldMapWithM
656+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
494 ]
657 ]
658+
659+o_1_space_elimination :: Int -> Benchmark
660+o_1_space_elimination streamLen =
495− , bgroup "elimination"
661+ bgroup "elimination"
496− [ benchFold "toNull" toNull sourceUnfoldrM
662+ [ benchFold "toNull" drain (unfoldrM streamLen)
497− , benchFold "mapM_" mapM_ sourceUnfoldrM
663+ , benchFold "mapM_" mapM_ (unfoldrM streamLen)
498− , benchFold "uncons" uncons sourceUnfoldrM
664+ , benchFold "uncons" uncons (unfoldrM streamLen)
499− , benchFold "init" init sourceUnfoldrM
665+ , benchFold "init" init (unfoldrM streamLen)
500− , benchFold "foldl'" foldl sourceUnfoldrM
666+ , benchFold "foldl'" foldl' (unfoldrM streamLen)
501− , benchFold "last" last sourceUnfoldrM
667+ , benchFold "last" last (unfoldrM streamLen)
502 ]
668 ]
669+
670+o_1_space_nested :: Int -> Benchmark
671+o_1_space_nested streamLen =
503− , bgroup "nested"
672+ bgroup "nested"
504− [ benchFold "toNullAp" toNullApNested (sourceUnfoldrMN value2)
673+ [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
505− , benchFold "toNull" toNullNested (sourceUnfoldrMN value2)
674+ , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
506− , benchFold "toNull3" toNullNested3 (sourceUnfoldrMN value3)
675+ , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
507− , benchFold "filterAllIn" filterAllInNested (sourceUnfoldrMN value2)
676+ , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
508− , benchFold "filterAllOut" filterAllOutNested (sourceUnfoldrMN value2)
677+ , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
509− , benchFold "toNullApPure" toNullApNested (sourceUnfoldrN value2)
678+ , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
510− , benchFold "toNullPure" toNullNested (sourceUnfoldrN value2)
679+ , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
511− , benchFold "toNull3Pure" toNullNested3 (sourceUnfoldrN value3)
680+ , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
512− , benchFold "filterAllInPure" filterAllInNested (sourceUnfoldrN value2)
681+ , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
513− , benchFold "filterAllOutPure" filterAllOutNested (sourceUnfoldrN value2)
682+ , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
514 ]
683 ]
684+ where
685+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
686+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
687+
688+o_1_space_transformation :: Int -> Benchmark
689+o_1_space_transformation streamLen =
515− , bgroup "transformation"
690+ bgroup "transformation"
516− [ benchFold "foldrS" (foldrS 1) sourceUnfoldrM
691+ [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
517− , benchFold "scan" (scan 1) sourceUnfoldrM
692+ , benchFold "scanl'" (scanl' 1) (unfoldrM streamLen)
518− , benchFold "map" (map 1) sourceUnfoldrM
693+ , benchFold "map" (map 1) (unfoldrM streamLen)
519− , benchFold "fmap" (fmapK 1) sourceUnfoldrM
694+ , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
520− , benchFold "mapM" (mapM 1) sourceUnfoldrM
695+ , benchFold "mapM" (mapM 1) (unfoldrM streamLen)
521− , benchFold "mapMSerial" (mapMSerial 1) sourceUnfoldrM
696+ , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
522 ]
697 ]
698+
699+o_1_space_transformationX4 :: Int -> Benchmark
700+o_1_space_transformationX4 streamLen =
523− , bgroup "transformationX4"
701+ bgroup "transformationX4"
524− [ benchFold "scan" (scan 4) sourceUnfoldrM
702+ [ benchFold "scanl'" (scanl' 4) (unfoldrM streamLen)
525− , benchFold "map" (map 4) sourceUnfoldrM
703+ , benchFold "map" (map 4) (unfoldrM streamLen)
526− , benchFold "fmap" (fmapK 4) sourceUnfoldrM
704+ , benchFold "fmap" (fmapK 4) (unfoldrM streamLen)
527− , benchFold "mapM" (mapM 4) sourceUnfoldrM
705+ , benchFold "mapM" (mapM 4) (unfoldrM streamLen)
528− , benchFold "mapMSerial" (mapMSerial 4) sourceUnfoldrM
706+ , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
529 -- XXX this is horribly slow
707 -- XXX this is horribly slow
530− -- , benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)
708+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
531 ]
709 ]
710+
711+o_1_space_concat :: Int -> Benchmark
712+o_1_space_concat streamLen =
532− , bgroup "concat"
713+ bgroup "concat"
533 [ benchIOSrc1 "concatMapPure (n of 1)"
714 [ benchIOSrc1 "concatMapPure (n of 1)"
534− (concatMapPure value 1)
715+ (concatMapPure streamLen 1)
535 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
716 , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
536− (concatMapPure value2 value2)
717+ (concatMapPure streamLen2 streamLen2)
537 , benchIOSrc1 "concatMapPure (1 of n)"
718 , benchIOSrc1 "concatMapPure (1 of n)"
538− (concatMapPure 1 value)
719+ (concatMapPure 1 streamLen)
539
720
540 , benchIOSrc1 "concatMap (n of 1)"
721 , benchIOSrc1 "concatMap (n of 1)"
541− (concatMap value 1)
722+ (concatMap streamLen 1)
542 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
723 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
543− (concatMap value2 value2)
724+ (concatMap streamLen2 streamLen2)
544 , benchIOSrc1 "concatMap (1 of n)"
725 , benchIOSrc1 "concatMap (1 of n)"
545− (concatMap 1 value)
726+ (concatMap 1 streamLen)
546
727
547 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
728 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
548− (concatMapRepl value2 value2)
729+ (concatMapRepl streamLen2 streamLen2)
549
730
550 -- This is for comparison with concatMapFoldableWith
731 -- This is for comparison with concatMapFoldableWith
551 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
732 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
733+ (S.drain
734+ . S.concatMapWith S.append id
552− (S.drain . S.concatMapBy S.serial id . sourceConcatMapId value)
735+ . sourceConcatMapId streamLen)
553−
736+
554− , benchIOSrc1 "concatMapWith (n of 1)"
737+ , benchIOSrc1 "concatMapBy serial (n of 1)"
555− (concatStreamsWith value 1)
738+ (concatMapBySerial streamLen 1)
556− , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"
739+ , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
557− (concatStreamsWith value2 value2)
740+ (concatMapBySerial streamLen2 streamLen2)
558− , benchIOSrc1 "concatMapWith (1 of n)"
741+ , benchIOSrc1 "concatMapBy serial (1 of n)"
559− (concatStreamsWith 1 value)
742+ (concatMapBySerial 1 streamLen)
743+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
560 ]
744 ]
745+ where
746+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
747+
748+o_1_space_filtering :: Int -> Benchmark
749+o_1_space_filtering streamLen =
561− , bgroup "filtering"
750+ bgroup "filtering"
562− [ benchFold "filter-even" (filterEven 1) sourceUnfoldrM
751+ [ benchFold "filter-even" (filterEven 1) (unfoldrM streamLen)
563− , benchFold "filter-all-out" (filterAllOut 1) sourceUnfoldrM
752+ , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
564− , benchFold "filter-all-in" (filterAllIn 1) sourceUnfoldrM
753+ , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
565− , benchFold "take-all" (takeAll 1) sourceUnfoldrM
754+ , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
566− , benchFold "takeWhile-true" (takeWhileTrue 1) sourceUnfoldrM
755+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
567− , benchFold "drop-one" (dropOne 1) sourceUnfoldrM
756+ , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
568− , benchFold "drop-all" (dropAll 1) sourceUnfoldrM
757+ , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
569− , benchFold "dropWhile-true" (dropWhileTrue 1) sourceUnfoldrM
758+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
570− , benchFold "dropWhile-false" (dropWhileFalse 1) sourceUnfoldrM
759+ , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
571 ]
760 ]
761+
762+o_1_space_filteringX4 :: Int -> Benchmark
763+o_1_space_filteringX4 streamLen =
572− , bgroup "filteringX4"
764+ bgroup "filteringX4"
573− [ benchFold "filter-even" (filterEven 4) sourceUnfoldrM
765+ [ benchFold "filter-even" (filterEven 4) (unfoldrM streamLen)
574− , benchFold "filter-all-out" (filterAllOut 4) sourceUnfoldrM
766+ , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
575− , benchFold "filter-all-in" (filterAllIn 4) sourceUnfoldrM
767+ , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
576− , benchFold "take-all" (takeAll 4) sourceUnfoldrM
768+ , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
577− , benchFold "takeWhile-true" (takeWhileTrue 4) sourceUnfoldrM
769+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
578− , benchFold "drop-one" (dropOne 4) sourceUnfoldrM
770+ , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
579− , benchFold "drop-all" (dropAll 4) sourceUnfoldrM
771+ , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
580− , benchFold "dropWhile-true" (dropWhileTrue 4) sourceUnfoldrM
772+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
581− , benchFold "dropWhile-false" (dropWhileFalse 4) sourceUnfoldrM
773+ , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
582 ]
774 ]
775+
776+o_1_space_zipping :: Int -> Benchmark
777+o_1_space_zipping streamLen =
583− , bgroup "zipping"
778+ bgroup "zipping"
584− [ benchFold "zip" zip sourceUnfoldrM
779+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
585 ]
781 ]
782+
783+o_1_space_mixed :: Int -> Benchmark
784+o_1_space_mixed streamLen =
586− , bgroup "mixed"
785+ bgroup "mixed"
587− [ benchFold "scan-map" (scanMap 1) sourceUnfoldrM
786+ [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
588− , benchFold "drop-map" (dropMap 1) sourceUnfoldrM
787+ , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
589− , benchFold "drop-scan" (dropScan 1) sourceUnfoldrM
788+ , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
590− , benchFold "take-drop" (takeDrop 1) sourceUnfoldrM
789+ , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
591− , benchFold "take-scan" (takeScan 1) sourceUnfoldrM
790+ , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
592− , benchFold "take-map" (takeMap 1) sourceUnfoldrM
791+ , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
593− , benchFold "filter-drop" (filterDrop 1) sourceUnfoldrM
792+ , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
594− , benchFold "filter-take" (filterTake 1) sourceUnfoldrM
793+ , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
595− , benchFold "filter-scan" (filterScan 1) sourceUnfoldrM
794+ , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
596− , benchFold "filter-map" (filterMap 1) sourceUnfoldrM
795+ , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
597 ]
796 ]
797+
798+o_1_space_mixedX2 :: Int -> Benchmark
799+o_1_space_mixedX2 streamLen =
598− , bgroup "mixedX2"
800+ bgroup "mixedX2"
599− [ benchFold "scan-map" (scanMap 2) sourceUnfoldrM
801+ [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
600− , benchFold "drop-map" (dropMap 2) sourceUnfoldrM
802+ , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
601− , benchFold "drop-scan" (dropScan 2) sourceUnfoldrM
803+ , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
602− , benchFold "take-drop" (takeDrop 2) sourceUnfoldrM
804+ , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
603− , benchFold "take-scan" (takeScan 2) sourceUnfoldrM
805+ , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
604− , benchFold "take-map" (takeMap 2) sourceUnfoldrM
806+ , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
605− , benchFold "filter-drop" (filterDrop 2) sourceUnfoldrM
807+ , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
606− , benchFold "filter-take" (filterTake 2) sourceUnfoldrM
808+ , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
607− , benchFold "filter-scan" (filterScan 2) sourceUnfoldrM
809+ , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
608− , benchFold "filter-map" (filterMap 2) sourceUnfoldrM
810+ , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
609 ]
811 ]
812+
813+o_1_space_mixedX4 :: Int -> Benchmark
814+o_1_space_mixedX4 streamLen =
610− , bgroup "mixedX4"
815+ bgroup "mixedX4"
611− [ benchFold "scan-map" (scanMap 4) sourceUnfoldrM
816+ [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
612− , benchFold "drop-map" (dropMap 4) sourceUnfoldrM
817+ , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
613− , benchFold "drop-scan" (dropScan 4) sourceUnfoldrM
818+ , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
614− , benchFold "take-drop" (takeDrop 4) sourceUnfoldrM
819+ , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
615− , benchFold "take-scan" (takeScan 4) sourceUnfoldrM
820+ , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
616− , benchFold "take-map" (takeMap 4) sourceUnfoldrM
821+ , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
617− , benchFold "filter-drop" (filterDrop 4) sourceUnfoldrM
822+ , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
618− , benchFold "filter-take" (filterTake 4) sourceUnfoldrM
823+ , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
619− , benchFold "filter-scan" (filterScan 4) sourceUnfoldrM
824+ , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
620− , benchFold "filter-map" (filterMap 4) sourceUnfoldrM
825+ , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
826+ ]
827+
828+o_1_space_list :: Int -> Benchmark
829+o_1_space_list streamLen =
830+ bgroup "list"
831+ [ bgroup "elimination"
832+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
833+ ]
834+ , bgroup "nested"
835+ [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
836+ , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
837+ , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
838+ , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
839+ , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
621 ]
840 ]
622 ]
841 ]
842+ where
843+
844+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
845+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
846+
847+o_1_space :: Int -> Benchmark
848+o_1_space streamLen =
849+ bgroup (o_1_space_prefix moduleName)
850+ [ o_1_space_generation streamLen
851+ , o_1_space_elimination streamLen
852+ , o_1_space_nested streamLen
853+ , o_1_space_transformation streamLen
854+ , o_1_space_transformationX4 streamLen
855+ , o_1_space_concat streamLen
856+ , o_1_space_filtering streamLen
857+ , o_1_space_filteringX4 streamLen
858+ , o_1_space_zipping streamLen
859+ , o_1_space_mixed streamLen
860+ , o_1_space_mixedX2 streamLen
861+ , o_1_space_mixedX4 streamLen
862+ , o_1_space_list streamLen
623− ]
863+ ]
624
864
625−o_n_heap :: [Benchmark]
865+o_n_heap :: Int -> Benchmark
626−o_n_heap =
866+o_n_heap streamLen =
627− [ bgroup (o_n_heap_prefix moduleName)
867+ bgroup (o_n_heap_prefix moduleName)
628 [ bgroup "transformation"
868 [ bgroup "transformation"
629− [ benchFold "foldlS" (foldlS 1) sourceUnfoldrM
869+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
630 ]
870 ]
631 ]
871 ]
632− ]
633
872
634{-# INLINE benchK #-}
873{-# INLINE benchK #-}
635benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
874benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
636−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= toNull . f
875+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
637
876
638−o_n_stack :: [Benchmark]
877+o_n_stack :: Int -> Int -> Int -> Benchmark
639−o_n_stack =
878+o_n_stack streamLen iterStreamLen maxIters =
640− [ bgroup (o_n_stack_prefix moduleName)
879+ bgroup (o_n_stack_prefix moduleName)
641 [ bgroup "elimination"
880 [ bgroup "elimination"
642− [ benchFold "tail" tail sourceUnfoldrM
881+ [ benchFold "tail" tail (unfoldrM streamLen)
643− , benchFold "nullTail" nullTail sourceUnfoldrM
882+ , benchFold "nullTail" nullTail (unfoldrM streamLen)
644− , benchFold "headTail" headTail sourceUnfoldrM
883+ , benchFold "headTail" headTail (unfoldrM streamLen)
645 ]
884 ]
646 , bgroup "transformation"
885 , bgroup "transformation"
647 [
886 [
648 -- XXX why do these need so much stack
887 -- XXX why do these need so much stack
649− benchFold "intersperse" (intersperse 1) (sourceUnfoldrMN value2)
888+ benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
650− , benchFold "interspersePure" (intersperse 1) (sourceUnfoldrN value2)
889+ , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
651 ]
890 ]
652 , bgroup "transformationX4"
891 , bgroup "transformationX4"
653 [
892 [
654− benchFold "intersperse" (intersperse 4) (sourceUnfoldrMN value16)
893+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
655 ]
894 ]
656 , bgroup "iterated"
895 , bgroup "iterated"
657− [ benchK "mapM" iterateMapM
896+ [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
658− , benchK "scan(1/10)" iterateScan
897+ , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
659− , benchK "filterEven" iterateFilterEven
898+ , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
660− , benchK "takeAll" iterateTakeAll
899+ , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
661− , benchK "dropOne" iterateDropOne
900+ , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
662− , benchK "dropWhileFalse(1/10)" iterateDropWhileFalse
901+ , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
663− , benchK "dropWhileTrue" iterateDropWhileTrue
902+ , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
664 ]
903 ]
665 ]
904 ]
666− ]
905+ where
906+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
907+ streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
667
908
668−o_n_space :: [Benchmark]
909+o_n_space :: Int -> Benchmark
669−o_n_space =
910+o_n_space streamLen =
670− [ bgroup (o_n_space_prefix moduleName)
911+ bgroup (o_n_space_prefix moduleName)
671 [ bgroup "elimination"
912 [ bgroup "elimination"
672− [ benchFold "toList" toList sourceUnfoldrM
913+ [ benchFold "toList" toList (unfoldrM streamLen)
673 ]
914 ]
674 ]
915 ]
675− ]
676
916
677{-# INLINE benchList #-}
917{-# INLINE benchList #-}
678benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
918benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
679benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
919benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
680
920
681−o_1_space_list :: [Benchmark]
921+main :: IO ()
682−o_1_space_list =
922+main =
683− [ bgroup "list"
923+ defaultMain
684− [ bgroup "elimination"
924+ [ o_1_space streamLen
685− [ benchList "last" (\xs -> [List.last xs]) (sourceUnfoldrList value)
925+ , o_n_stack streamLen iterStreamLen maxIters
686− ]
926+ , o_n_heap streamLen
687− , bgroup "nested"
927+ , o_n_space streamLen
688− [ benchList "toNullAp" toNullApNestedList (sourceUnfoldrList value2)
689− , benchList "toNull" toNullNestedList (sourceUnfoldrList value2)
690− , benchList "toNull3" toNullNestedList3 (sourceUnfoldrList value3)
691− , benchList "filterAllIn" filterAllInNestedList (sourceUnfoldrList value2)
692− , benchList "filterAllOut" filterAllOutNestedList (sourceUnfoldrList value2)
693 ]
928 ]
694− ]
695− ]
696
929
697−main :: IO ()
930+ where
698−main = defaultMain $ concat
931+
699− [ o_1_space
932+ streamLen = 100000
700− , [bgroup (o_1_space_prefix moduleName) o_1_space_list]
933+ maxIters = 10000
701− , o_n_stack
934+ iterStreamLen = 10
702− , o_n_heap
703− , o_n_space
704− ]
benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hsrenamed+8−6
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Streamly.Benchmark.Data.Stream.StreamDK
4-- Module : Streamly.Benchmark.Data.Stream.StreamDK
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -16,12 +18,12 @@ import Prelude hiding ()
16-- import qualified Prelude as P
18-- import qualified Prelude as P
17-- import qualified Data.List as List
19-- import qualified Data.List as List
18
20
19−import qualified Streamly.Internal.Data.Stream.StreamDK as S
21+import qualified Streamly.Internal.Data.StreamK.Alt as S
20−-- import qualified Streamly.Internal.Data.Stream.Prelude as SP
22+-- import qualified Streamly.Internal.Data.Stream.Common as SP
21-- import qualified Streamly.Internal.Data.SVar as S
23-- import qualified Streamly.Internal.Data.SVar as S
22
24
23import Streamly.Benchmark.Common
25import Streamly.Benchmark.Common
24−import Gauge (bgroup, Benchmark, defaultMain)
26+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
25
27
26value :: Int
28value :: Int
27value = 100000
29value = 100000
@@ -104,11 +106,11 @@ sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])
104{-
106{-
105{-# INLINE sourceFoldMapWith #-}
107{-# INLINE sourceFoldMapWith #-}
106sourceFoldMapWith :: Int -> Stream m Int
108sourceFoldMapWith :: Int -> Stream m Int
107−sourceFoldMapWith n = SP.foldMapWith S.serial S.yield [n..n+value]
109+sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]
108
110
109{-# INLINE sourceFoldMapWithM #-}
111{-# INLINE sourceFoldMapWithM #-}
110sourceFoldMapWithM :: Monad m => Int -> Stream m Int
112sourceFoldMapWithM :: Monad m => Int -> Stream m Int
111−sourceFoldMapWithM n = SP.foldMapWith S.serial (S.yieldM . return) [n..n+value]
113+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]
112-}
114-}
113
115
114-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
@@ -450,4 +452,4 @@ o_1_space =
450 ]
452 ]
451
453
452main :: IO ()
454main :: IO ()
453−main = defaultMain $ concat [o_1_space]
455+main = defaultMain [o_1_space]
benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hsnew file+938
@@ -0,0 +1,938 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.StreamK
3+-- Copyright : (c) 2018 Composewell Technologies
4+--
5+-- License : BSD3
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
12+
13+#ifdef __HADDOCK_VERSION__
14+#undef INSPECTION
15+#endif
16+
17+#ifdef INSPECTION
18+{-# LANGUAGE TemplateHaskell #-}
19+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20+#endif
21+
22+module Main (main) where
23+
24+-- import Control.Applicative (liftA2)
25+-- import Control.Monad (when)
26+-- import Data.Maybe (isJust)
27+-- import System.Random (randomRIO)
28+import Prelude hiding
29+ ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
30+ , repeat, replicate
31+ )
32+
33+import qualified Prelude as P
34+-- import qualified Data.List as List
35+
36+import qualified Streamly.Internal.Data.StreamK as S
37+import qualified Streamly.Internal.Data.Stream as D
38+import qualified Streamly.Internal.Data.Fold as Fold
39+
40+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
41+
42+import Streamly.Benchmark.Common
43+
44+#ifdef INSPECTION
45+import Test.Inspection
46+#endif
47+
48+-------------------------------------------------------------------------------
49+-- Stream generation and elimination
50+-------------------------------------------------------------------------------
51+
52+type Stream m a = S.Stream m a
53+
54+{-# INLINE unfoldrD #-}
55+unfoldrD :: Monad m => Int -> Int -> Stream m Int
56+unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
57+ where
58+ step cnt =
59+ if cnt > n + streamLen
60+ then Nothing
61+ else Just (cnt, cnt + 1)
62+
63+{-# INLINE unfoldrMD #-}
64+unfoldrMD :: Monad m => Int -> Int -> Stream m Int
65+unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
66+ where
67+ step cnt =
68+ if cnt > n + streamLen
69+ then return Nothing
70+ else return (Just (cnt, cnt + 1))
71+
72+{-
73+{-# INLINE unfoldrK #-}
74+unfoldrK :: Int -> Int -> Stream m Int
75+unfoldrK streamLen n = S.unfoldr step n
76+ where
77+ step cnt =
78+ if cnt > n + streamLen
79+ then Nothing
80+ else Just (cnt, cnt + 1)
81+-}
82+
83+{-# INLINE unfoldrMK #-}
84+unfoldrMK :: Monad m => Int -> Int -> Stream m Int
85+unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
86+ where
87+ step cnt =
88+ if cnt > n + streamLen
89+ then return Nothing
90+ else return (Just (cnt, cnt + 1))
91+
92+{-# INLINE repeat #-}
93+repeat :: Monad m => Int -> Int -> Stream m Int
94+repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
95+
96+{-# INLINE repeatM #-}
97+repeatM :: Monad m => Int -> Int -> Stream m Int
98+repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
99+
100+{-# INLINE replicate #-}
101+replicate :: Monad m => Int -> Int -> Stream m Int
102+replicate x y = D.toStreamK $ D.replicate x y
103+
104+{-# INLINE replicateM #-}
105+replicateM :: Monad m => Int -> Int -> Stream m Int
106+replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
107+
108+{-# INLINE iterate #-}
109+iterate :: Monad m => Int -> Int -> Stream m Int
110+iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
111+
112+{-# INLINE iterateM #-}
113+iterateM :: Monad m => Int -> Int -> Stream m Int
114+iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
115+
116+{-# INLINE fromFoldable #-}
117+fromFoldable :: Int -> Int -> Stream m Int
118+fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
119+
120+{-# INLINE fromFoldableM #-}
121+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
122+fromFoldableM streamLen n =
123+ Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
124+
125+{-
126+{-# INLINABLE concatMapFoldableWith #-}
127+concatMapFoldableWith :: Foldable f
128+ => (Stream m b -> Stream m b -> Stream m b)
129+ -> (a -> Stream m b)
130+ -> f a
131+ -> Stream m b
132+concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
133+-}
134+
135+{-# INLINE concatMapFoldableSerial #-}
136+concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
137+concatMapFoldableSerial streamLen n =
138+ D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
139+
140+{-# INLINE concatMapFoldableSerialM #-}
141+concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
142+concatMapFoldableSerialM streamLen n =
143+ -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
144+ D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
145+
146+-------------------------------------------------------------------------------
147+-- Elimination
148+-------------------------------------------------------------------------------
149+
150+{-# INLINE drainD #-}
151+drainD :: Monad m => Stream m a -> m ()
152+drainD = D.drain . D.fromStreamK
153+
154+{-# INLINE drain #-}
155+drain :: Monad m => Stream m a -> m ()
156+drain = S.drain
157+
158+{-# INLINE mapM_ #-}
159+mapM_ :: Monad m => Stream m a -> m ()
160+mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
161+
162+{-
163+{-# INLINE uncons #-}
164+uncons :: Monad m => Stream m Int -> m ()
165+uncons s = do
166+ r <- D.uncons $ D.fromStreamK s
167+ case r of
168+ Nothing -> return ()
169+ Just (_, t) -> uncons (D.toStreamK t)
170+
171+{-# INLINE init #-}
172+init :: Monad m => Stream m a -> m ()
173+init s = do
174+ t <- S.init s
175+ P.mapM_ S.drain t
176+
177+{-# INLINE tail #-}
178+tail :: Monad m => Stream m a -> m ()
179+tail s = S.tail s >>= P.mapM_ tail
180+
181+{-# INLINE nullTail #-}
182+nullTail :: Monad m => Stream m Int -> m ()
183+nullTail s = do
184+ r <- S.null s
185+ when (not r) $ S.tail s >>= P.mapM_ nullTail
186+
187+{-# INLINE headTail #-}
188+headTail :: Monad m => Stream m Int -> m ()
189+headTail s = do
190+ h <- S.head s
191+ when (isJust h) $ S.tail s >>= P.mapM_ headTail
192+-}
193+
194+{-# INLINE toList #-}
195+toList :: Monad m => Stream m Int -> m [Int]
196+toList = D.fold Fold.toList . D.fromStreamK
197+
198+{-# INLINE foldl' #-}
199+foldl' :: Monad m => Stream m Int -> m Int
200+foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
201+
202+{-# INLINE last #-}
203+last :: Monad m => Stream m Int -> m (Maybe Int)
204+last = D.fold Fold.latest . D.fromStreamK
205+
206+-------------------------------------------------------------------------------
207+-- Transformation
208+-------------------------------------------------------------------------------
209+
210+{-# INLINE composeN #-}
211+composeN
212+ :: Monad m
213+ => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
214+composeN n f =
215+ case n of
216+ 1 -> drain . f
217+ 2 -> drain . f . f
218+ 3 -> drain . f . f . f
219+ 4 -> drain . f . f . f . f
220+ _ -> undefined
221+
222+{-# INLINE scanl' #-}
223+scanl' :: Monad m => Int -> Stream m Int -> m ()
224+scanl' n =
225+ composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)
226+
227+{-# INLINE map #-}
228+map :: Monad m => Int -> Stream m Int -> m ()
229+map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
230+
231+{-
232+{-# INLINE fmapK #-}
233+fmapK :: Monad m => Int -> Stream m Int -> m ()
234+fmapK n = composeN n $ P.fmap (+ 1)
235+-}
236+
237+{-# INLINE mapM #-}
238+mapM :: Monad m => Int -> Stream m Int -> m ()
239+mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
240+
241+{-
242+{-# INLINE mapMSerial #-}
243+mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
244+mapMSerial n = composeN n $ S.mapMSerial return
245+-}
246+
247+{-# INLINE filterEven #-}
248+filterEven :: Monad m => Int -> Stream m Int -> m ()
249+filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
250+
251+{-
252+{-# INLINE filterAllOut #-}
253+filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
254+filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
255+
256+{-# INLINE filterAllIn #-}
257+filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
258+filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
259+
260+{-# INLINE _takeOne #-}
261+_takeOne :: Monad m => Int -> Stream m Int -> m ()
262+_takeOne n = composeN n $ S.take 1
263+
264+{-# INLINE takeAll #-}
265+takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
266+takeAll streamLen n = composeN n $ S.take streamLen
267+
268+{-# INLINE takeWhileTrue #-}
269+takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
270+takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
271+
272+{-# INLINE dropOne #-}
273+dropOne :: Monad m => Int -> Stream m Int -> m ()
274+dropOne n = composeN n $ S.drop 1
275+
276+{-# INLINE dropAll #-}
277+dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
278+dropAll streamLen n = composeN n $ S.drop streamLen
279+
280+{-# INLINE dropWhileTrue #-}
281+dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
282+dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
283+
284+{-# INLINE dropWhileFalse #-}
285+dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
286+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
287+-}
288+
289+{-
290+{-# INLINE foldrS #-}
291+foldrS :: Monad m => Int -> Stream m Int -> m ()
292+foldrS n = composeN n $ S.foldrS S.cons S.nil
293+
294+{-# INLINE foldlS #-}
295+foldlS :: Monad m => Int -> Stream m Int -> m ()
296+foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
297+-}
298+
299+{-
300+{-# INLINE intersperse #-}
301+intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
302+intersperse streamLen n = composeN n $ S.intersperse streamLen
303+-}
304+
305+-------------------------------------------------------------------------------
306+-- Iteration
307+-------------------------------------------------------------------------------
308+
309+{-
310+{-# INLINE iterateSource #-}
311+iterateSource
312+ :: S.MonadAsync m
313+ => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
314+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
315+ where
316+ f (0 :: Int) m = g m
317+ f x m = g (f (x P.- 1) m)
318+
319+-- this is quadratic
320+{-# INLINE iterateScan #-}
321+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
322+iterateScan iterStreamLen maxIters =
323+ iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
324+
325+-- this is quadratic
326+{-# INLINE iterateDropWhileFalse #-}
327+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
328+iterateDropWhileFalse streamLen iterStreamLen maxIters =
329+ iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
330+
331+{-# INLINE iterateMapM #-}
332+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
333+iterateMapM iterStreamLen =
334+ iterateSource iterStreamLen (S.mapMWith S.consM return)
335+
336+{-# INLINE iterateFilterEven #-}
337+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
338+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
339+
340+{-# INLINE iterateTakeAll #-}
341+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
342+iterateTakeAll streamLen iterStreamLen =
343+ iterateSource iterStreamLen (S.take streamLen)
344+
345+{-# INLINE iterateDropOne #-}
346+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347+iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
348+
349+{-# INLINE iterateDropWhileTrue #-}
350+iterateDropWhileTrue :: S.MonadAsync m =>
351+ Int -> Int -> Int -> Int -> Stream m Int
352+iterateDropWhileTrue streamLen iterStreamLen =
353+ iterateSource iterStreamLen (S.dropWhile (<= streamLen))
354+-}
355+
356+-------------------------------------------------------------------------------
357+-- Zipping
358+-------------------------------------------------------------------------------
359+
360+{-
361+{-# INLINE zipWith #-}
362+zipWith :: Monad m => Stream m Int -> m ()
363+zipWith src = drain $ S.zipWith (,) src src
364+
365+{-# INLINE zipWithM #-}
366+zipWithM :: Monad m => Stream m Int -> m ()
367+zipWithM src = drain $ S.zipWithM (curry return) src src
368+
369+{-# INLINE sortByK #-}
370+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
371+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
372+
373+{-# INLINE sortBy #-}
374+sortBy :: Monad m => Stream m Int -> m ()
375+sortBy = drain . sortByK compare
376+
377+-------------------------------------------------------------------------------
378+-- Mixed Composition
379+-------------------------------------------------------------------------------
380+
381+{-# INLINE scanMap #-}
382+scanMap :: Monad m => Int -> Stream m Int -> m ()
383+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
384+
385+{-# INLINE dropMap #-}
386+dropMap :: Monad m => Int -> Stream m Int -> m ()
387+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
388+
389+{-# INLINE dropScan #-}
390+dropScan :: Monad m => Int -> Stream m Int -> m ()
391+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
392+
393+{-# INLINE takeDrop #-}
394+takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
395+takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
396+
397+{-# INLINE takeScan #-}
398+takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
399+takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
400+
401+{-# INLINE takeMap #-}
402+takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
403+takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
404+
405+{-# INLINE filterDrop #-}
406+filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
407+filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
408+
409+{-# INLINE filterTake #-}
410+filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
411+filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
412+
413+{-# INLINE filterScan #-}
414+filterScan :: Monad m => Int -> Stream m Int -> m ()
415+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
416+
417+{-# INLINE filterMap #-}
418+filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
419+filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
420+-}
421+
422+-------------------------------------------------------------------------------
423+-- ConcatMap
424+-------------------------------------------------------------------------------
425+
426+-- concatMap unfoldrM/unfoldrM
427+
428+{-# INLINE concatMap #-}
429+concatMap :: Int -> Int -> Int -> IO ()
430+concatMap outer inner n =
431+ S.drain $ D.toStreamK $ D.concatMap
432+ (\_ -> D.fromStreamK $ unfoldrMK inner n)
433+ (D.fromStreamK $ unfoldrMK outer n)
434+
435+#ifdef INSPECTION
436+inspect $ hasNoTypeClasses 'concatMap
437+#endif
438+
439+-- concatMap unfoldr/unfoldr
440+
441+{-
442+{-# INLINE concatMapPure #-}
443+concatMapPure :: Int -> Int -> Int -> IO ()
444+concatMapPure outer inner n =
445+ S.drain $ S.concatMap
446+ (\_ -> unfoldr inner n)
447+ (unfoldr outer n)
448+
449+#ifdef INSPECTION
450+inspect $ hasNoTypeClasses 'concatMapPure
451+#endif
452+
453+-- concatMap replicate/unfoldrM
454+
455+{-# INLINE concatMapRepl #-}
456+concatMapRepl :: Int -> Int -> Int -> IO ()
457+concatMapRepl outer inner n =
458+ S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459+
460+#ifdef INSPECTION
461+inspect $ hasNoTypeClasses 'concatMapRepl
462+#endif
463+
464+-- concatMapWith
465+
466+{-# INLINE sourceConcatMapId #-}
467+sourceConcatMapId :: Monad m
468+ => Int -> Int -> Stream m (Stream m Int)
469+sourceConcatMapId val n =
470+ S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471+
472+{-# INLINE concatMapBySerial #-}
473+concatMapBySerial :: Int -> Int -> Int -> IO ()
474+concatMapBySerial outer inner n =
475+ S.drain $ S.concatMapWith S.serial
476+ (unfoldrM inner)
477+ (unfoldrM outer n)
478+-}
479+
480+{-
481+-------------------------------------------------------------------------------
482+-- Nested Composition
483+-------------------------------------------------------------------------------
484+
485+instance Monad m => Applicative (S.Stream m) where
486+ {-# INLINE pure #-}
487+ pure = S.fromPure
488+
489+ {-# INLINE (<*>) #-}
490+ (<*>) = S.crossApply
491+
492+ {-# INLINE liftA2 #-}
493+ liftA2 f x = (<*>) (fmap f x)
494+
495+ {-# INLINE (*>) #-}
496+ (*>) = S.crossApplySnd
497+
498+ {-# INLINE (<*) #-}
499+ (<*) = S.crossApplyFst
500+
501+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
502+-- the monad instance of StreamD is slower than StreamK after foldr/build
503+-- fusion.
504+instance Monad m => Monad (S.Stream m) where
505+ {-# INLINE return #-}
506+ return = pure
507+
508+ {-# INLINE (>>=) #-}
509+ (>>=) = flip S.concatMap
510+
511+{-# INLINE drainApplicative #-}
512+drainApplicative :: Monad m => Stream m Int -> m ()
513+drainApplicative s = drain $ do
514+ (+) <$> s <*> s
515+
516+{-# INLINE drainMonad #-}
517+drainMonad :: Monad m => Stream m Int -> m ()
518+drainMonad s = drain $ do
519+ x <- s
520+ y <- s
521+ return $ x + y
522+
523+{-# INLINE drainMonad3 #-}
524+drainMonad3 :: Monad m => Stream m Int -> m ()
525+drainMonad3 s = drain $ do
526+ x <- s
527+ y <- s
528+ z <- s
529+ return $ x + y + z
530+
531+{-# INLINE filterAllOutMonad #-}
532+filterAllOutMonad
533+ :: Monad m
534+ => Stream m Int -> m ()
535+filterAllOutMonad str = drain $ do
536+ x <- str
537+ y <- str
538+ let s = x + y
539+ if s < 0
540+ then return s
541+ else S.nil
542+
543+{-# INLINE filterAllInMonad #-}
544+filterAllInMonad
545+ :: Monad m
546+ => Stream m Int -> m ()
547+filterAllInMonad str = drain $ do
548+ x <- str
549+ y <- str
550+ let s = x + y
551+ if s > 0
552+ then return s
553+ else S.nil
554+
555+-------------------------------------------------------------------------------
556+-- Nested Composition Pure lists
557+-------------------------------------------------------------------------------
558+
559+-- There are several list benchmarks here for comparison with lists. It is easy
560+-- and convenient to see the comparisons when they are here, otherwise we'll
561+-- have to add a separate module for list benchmarks with the same names and
562+-- then add a comparison in bench.sh.
563+
564+{-# INLINE unfoldrList #-}
565+unfoldrList :: Int -> Int -> [Int]
566+unfoldrList maxval n = List.unfoldr step n
567+ where
568+ step cnt =
569+ if cnt > n + maxval
570+ then Nothing
571+ else Just (cnt, cnt + 1)
572+
573+{-# INLINE toNullApNestedList #-}
574+toNullApNestedList :: [Int] -> [Int]
575+toNullApNestedList s = (+) <$> s <*> s
576+
577+{-# INLINE toNullNestedList #-}
578+toNullNestedList :: [Int] -> [Int]
579+toNullNestedList s = do
580+ x <- s
581+ y <- s
582+ return $ x + y
583+
584+{-# INLINE toNullNestedList3 #-}
585+toNullNestedList3 :: [Int] -> [Int]
586+toNullNestedList3 s = do
587+ x <- s
588+ y <- s
589+ z <- s
590+ return $ x + y + z
591+
592+{-# INLINE filterAllOutNestedList #-}
593+filterAllOutNestedList :: [Int] -> [Int]
594+filterAllOutNestedList str = do
595+ x <- str
596+ y <- str
597+ let s = x + y
598+ if s < 0
599+ then return s
600+ else []
601+
602+{-# INLINE filterAllInNestedList #-}
603+filterAllInNestedList :: [Int] -> [Int]
604+filterAllInNestedList str = do
605+ x <- str
606+ y <- str
607+ let s = x + y
608+ if s > 0
609+ then return s
610+ else []
611+ -}
612+
613+-------------------------------------------------------------------------------
614+-- Benchmarks
615+-------------------------------------------------------------------------------
616+
617+moduleName :: String
618+moduleName = "Data.Stream.ToStreamK"
619+
620+-- Generation of StreamK using StreamD generation functions and eleminating
621+-- using StreamK drain.
622+o_1_space_generation :: Int -> Benchmark
623+o_1_space_generation streamLen =
624+ bgroup "generation"
625+ [ benchFold "unfoldr" drain (unfoldrD streamLen)
626+ , benchFold "unfoldrM" drain (unfoldrMD streamLen)
627+ , benchFold "repeat" drain (repeat streamLen)
628+ , benchFold "repeatM" drain (repeatM streamLen)
629+ , benchFold "replicate" drain (replicate streamLen)
630+ , benchFold "replicateM" drain (replicateM streamLen)
631+ , benchFold "iterate" drain (iterate streamLen)
632+ , benchFold "iterateM" drain (iterateM streamLen)
633+
634+ , benchFold "fromFoldable" drain (fromFoldable streamLen)
635+ , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
636+
637+ -- appends
638+ , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
639+ , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
640+ ]
641+
642+-- Generating using StreamK and eliminating using StreamD folds.
643+o_1_space_elimination :: Int -> Benchmark
644+o_1_space_elimination streamLen =
645+ bgroup "elimination"
646+ [ benchFold "toNull" drainD (unfoldrMK streamLen)
647+ , benchFold "mapM_" mapM_ (unfoldrMK streamLen)
648+ -- , benchFold "uncons" uncons (unfoldrMK streamLen)
649+ -- , benchFold "init" init (unfoldrM streamLen)
650+ , benchFold "foldl'" foldl' (unfoldrMK streamLen)
651+ , benchFold "last" last (unfoldrMK streamLen)
652+ ]
653+
654+{-
655+o_1_space_nested :: Int -> Benchmark
656+o_1_space_nested streamLen =
657+ bgroup "nested"
658+ [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
659+ , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
660+ , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
661+ , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
662+ , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
663+ , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
664+ , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
665+ , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
666+ , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
667+ , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
668+ ]
669+ where
670+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
671+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
672+-}
673+
674+-- Generate using StreamK and transform using StreamD transformation functions
675+-- and then drain using StreamK.
676+o_1_space_transformation :: Int -> Benchmark
677+o_1_space_transformation streamLen =
678+ bgroup "transformation"
679+ [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
680+ benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
681+ , benchFold "map" (map 1) (unfoldrMK streamLen)
682+ -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
683+ , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
684+ -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685+ ]
686+
687+o_1_space_transformationX4 :: Int -> Benchmark
688+o_1_space_transformationX4 streamLen =
689+ bgroup "transformationX4"
690+ [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
691+ , benchFold "map" (map 4) (unfoldrMK streamLen)
692+ -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
693+ , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
694+ -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
695+ -- XXX this is horribly slow
696+ -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697+ ]
698+
699+-- Generate using K, fold using K, concat using D.concatMap
700+o_1_space_concat :: Int -> Benchmark
701+o_1_space_concat streamLen =
702+ bgroup "concat"
703+ [ {- benchIOSrc1 "concatMapPure (n of 1)"
704+ (concatMapPure streamLen 1)
705+ , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
706+ (concatMapPure streamLen2 streamLen2)
707+ , benchIOSrc1 "concatMapPure (1 of n)"
708+ (concatMapPure 1 streamLen)
709+ -}
710+
711+ benchIOSrc1 "concatMap (n of 1)"
712+ (concatMap streamLen 1)
713+ , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
714+ (concatMap streamLen2 streamLen2)
715+ , benchIOSrc1 "concatMap (1 of n)"
716+ (concatMap 1 streamLen)
717+
718+{-
719+ , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
720+ (concatMapRepl streamLen2 streamLen2)
721+
722+ -- This is for comparison with concatMapFoldableWith
723+ , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
724+ (S.drain
725+ . S.concatMapWith S.serial id
726+ . sourceConcatMapId streamLen)
727+
728+ , benchIOSrc1 "concatMapBy serial (n of 1)"
729+ (concatMapBySerial streamLen 1)
730+ , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
731+ (concatMapBySerial streamLen2 streamLen2)
732+ , benchIOSrc1 "concatMapBy serial (1 of n)"
733+ (concatMapBySerial 1 streamLen)
734+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
735+ -}
736+ ]
737+ where
738+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
739+
740+o_1_space_filtering :: Int -> Benchmark
741+o_1_space_filtering streamLen =
742+ bgroup "filtering"
743+ [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
744+ {-
745+ , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
746+ , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
747+ , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
748+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
749+ , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
750+ , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
751+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
752+ , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753+ -}
754+ ]
755+
756+o_1_space_filteringX4 :: Int -> Benchmark
757+o_1_space_filteringX4 streamLen =
758+ bgroup "filteringX4"
759+ [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
760+ {-
761+ , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
762+ , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
763+ , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
764+ , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
765+ , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
766+ , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
767+ , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
768+ , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
769+ -}
770+ ]
771+
772+{-
773+o_1_space_zipping :: Int -> Benchmark
774+o_1_space_zipping streamLen =
775+ bgroup "zipping"
776+ [ benchFold "zipWith" zipWith (unfoldrM streamLen)
777+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
778+ ]
779+
780+o_1_space_mixed :: Int -> Benchmark
781+o_1_space_mixed streamLen =
782+ bgroup "mixed"
783+ [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
784+ , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
785+ , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
786+ , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
787+ , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
788+ , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
789+ , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
790+ , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
791+ , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
792+ , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
793+ ]
794+
795+o_1_space_mixedX2 :: Int -> Benchmark
796+o_1_space_mixedX2 streamLen =
797+ bgroup "mixedX2"
798+ [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
799+ , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
800+ , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
801+ , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
802+ , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
803+ , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
804+ , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
805+ , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
806+ , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
807+ , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
808+ ]
809+
810+o_1_space_mixedX4 :: Int -> Benchmark
811+o_1_space_mixedX4 streamLen =
812+ bgroup "mixedX4"
813+ [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
814+ , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
815+ , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
816+ , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
817+ , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
818+ , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
819+ , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
820+ , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
821+ , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
822+ , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
823+ ]
824+ -}
825+
826+{-
827+o_1_space_list :: Int -> Benchmark
828+o_1_space_list streamLen =
829+ bgroup "list"
830+ [ bgroup "elimination"
831+ [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
832+ ]
833+ , bgroup "nested"
834+ [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
835+ , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
836+ , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
837+ , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
838+ , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
839+ ]
840+ ]
841+ where
842+
843+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
844+ streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845+-}
846+
847+o_1_space :: Int -> Benchmark
848+o_1_space streamLen =
849+ bgroup (o_1_space_prefix moduleName)
850+ [ o_1_space_generation streamLen
851+ , o_1_space_elimination streamLen
852+ -- , o_1_space_nested streamLen
853+ , o_1_space_transformation streamLen
854+ , o_1_space_transformationX4 streamLen
855+ , o_1_space_concat streamLen
856+ , o_1_space_filtering streamLen
857+ , o_1_space_filteringX4 streamLen
858+ -- , o_1_space_zipping streamLen
859+ -- , o_1_space_mixed streamLen
860+ -- , o_1_space_mixedX2 streamLen
861+ -- , o_1_space_mixedX4 streamLen
862+ -- , o_1_space_list streamLen
863+ ]
864+
865+{-
866+o_n_heap :: Int -> Benchmark
867+o_n_heap streamLen =
868+ bgroup (o_n_heap_prefix moduleName)
869+ [ bgroup "transformation"
870+ [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871+ ]
872+ ]
873+
874+{-# INLINE benchK #-}
875+benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
876+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
877+
878+o_n_stack :: Int -> Int -> Int -> Benchmark
879+o_n_stack streamLen iterStreamLen maxIters =
880+ bgroup (o_n_stack_prefix moduleName)
881+ [ bgroup "elimination"
882+ [ benchFold "tail" tail (unfoldrM streamLen)
883+ , benchFold "nullTail" nullTail (unfoldrM streamLen)
884+ , benchFold "headTail" headTail (unfoldrM streamLen)
885+ ]
886+ , bgroup "transformation"
887+ [
888+ -- XXX why do these need so much stack
889+ benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
890+ , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
891+ ]
892+ , bgroup "transformationX4"
893+ [
894+ benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
895+ ]
896+ , bgroup "iterated"
897+ [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
898+ , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
899+ , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
900+ , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
901+ , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
902+ , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
903+ , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
904+ ]
905+ ]
906+ where
907+ streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
908+ streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
909+-}
910+
911+o_n_space :: Int -> Benchmark
912+o_n_space streamLen =
913+ bgroup (o_n_space_prefix moduleName)
914+ [ bgroup "elimination"
915+ [ benchFold "toList" toList (unfoldrMK streamLen)
916+ ]
917+ ]
918+
919+{-
920+{-# INLINE benchList #-}
921+benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
922+benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
923+-}
924+
925+main :: IO ()
926+main =
927+ defaultMain
928+ [ o_1_space streamLen
929+ -- , o_n_stack streamLen iterStreamLen maxIters
930+ -- , o_n_heap streamLen
931+ , o_n_space streamLen
932+ ]
933+
934+ where
935+
936+ streamLen = 100000
937+ -- maxIters = 10000
938+ -- iterStreamLen = 10
benchmark/Streamly/Benchmark/Data/Stream/Transform.hsnew file+687
@@ -0,0 +1,687 @@
1+-- |
2+-- Module : Stream.Transform
3+-- Copyright : (c) 2018 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE FlexibleInstances #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# LANGUAGE RankNTypes #-}
12+
13+{-# OPTIONS_GHC -Wno-orphans #-}
14+#ifdef USE_PRELUDE
15+{-# OPTIONS_GHC -Wno-deprecations #-}
16+#endif
17+
18+#ifdef __HADDOCK_VERSION__
19+#undef INSPECTION
20+#endif
21+
22+#ifdef INSPECTION
23+{-# LANGUAGE TemplateHaskell #-}
24+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25+#endif
26+
27+module Stream.Transform (benchmarks) where
28+
29+import Control.Monad.IO.Class (MonadIO(..))
30+
31+import System.Random (randomRIO)
32+
33+import qualified Streamly.Internal.Data.Fold as FL
34+
35+import qualified Stream.Common as Common
36+import qualified Streamly.Internal.Data.Unfold as Unfold
37+
38+#ifdef USE_PRELUDE
39+import Control.DeepSeq (NFData(..))
40+import Data.Functor.Identity (Identity(..))
41+import qualified Prelude
42+import qualified Streamly.Internal.Data.Fold as Fold
43+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
44+import Streamly.Internal.Data.Time.Units
45+#else
46+import Streamly.Internal.Data.Stream (Stream)
47+import qualified Streamly.Internal.Data.Stream as Stream
48+#ifndef USE_STREAMLY_CORE
49+import qualified Streamly.Internal.Data.Stream.Prelude as Stream
50+#endif
51+#ifdef USE_STREAMK
52+import Control.DeepSeq (NFData(..))
53+import Data.Functor.Identity (Identity(..))
54+import qualified Prelude
55+import qualified Streamly.Internal.Data.Fold as Fold
56+import Streamly.Internal.Data.StreamK (StreamK)
57+import qualified Streamly.Internal.Data.StreamK as StreamK
58+#endif
59+#endif
60+
61+import Test.Tasty.Bench
62+import Stream.Common hiding (scanl')
63+import Streamly.Benchmark.Common
64+import Prelude hiding (sequence, mapM)
65+
66+#ifdef USE_PRELUDE
67+type Stream = Stream.SerialT
68+#endif
69+
70+-------------------------------------------------------------------------------
71+-- Pipelines (stream-to-stream transformations)
72+-------------------------------------------------------------------------------
73+
74+-------------------------------------------------------------------------------
75+-- one-to-one transformations
76+-------------------------------------------------------------------------------
77+
78+-------------------------------------------------------------------------------
79+-- Traversable Instance
80+-------------------------------------------------------------------------------
81+
82+#ifdef USE_STREAMK
83+{-# INLINE traversableTraverse #-}
84+traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)
85+traversableTraverse = traverse return
86+
87+{-# INLINE traversableSequenceA #-}
88+traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)
89+traversableSequenceA = sequenceA . Prelude.fmap return
90+
91+{-# INLINE traversableMapM #-}
92+traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)
93+traversableMapM = Prelude.mapM return
94+
95+{-# INLINE traversableSequence #-}
96+traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)
97+traversableSequence = Prelude.sequence . Prelude.fmap return
98+
99+{-# INLINE benchPureSinkIO #-}
100+benchPureSinkIO
101+ :: NFData b
102+ => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark
103+benchPureSinkIO value name f =
104+ bench name
105+ $ nfIO $ randomRIO (1, 1) >>= f . fromStream . sourceUnfoldr value
106+
107+instance NFData a => NFData (StreamK Identity a) where
108+ {-# INLINE rnf #-}
109+ rnf xs =
110+ runIdentity
111+ $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (toStream xs)
112+
113+o_n_space_traversable :: Int -> [Benchmark]
114+o_n_space_traversable value =
115+ -- Buffering operations using heap proportional to number of elements.
116+ [ bgroup "traversable"
117+ -- Traversable instance
118+ [ benchPureSinkIO value "traverse" traversableTraverse
119+ , benchPureSinkIO value "sequenceA" traversableSequenceA
120+ , benchPureSinkIO value "mapM" traversableMapM
121+ , benchPureSinkIO value "sequence" traversableSequence
122+ ]
123+ ]
124+#endif
125+
126+-------------------------------------------------------------------------------
127+-- maps and scans
128+-------------------------------------------------------------------------------
129+
130+#ifdef USE_PRELUDE
131+{-# INLINE scanl' #-}
132+scanl' :: MonadIO m => Int -> Stream m Int -> m ()
133+scanl' n = composeN n $ Stream.scanl' (+) 0
134+
135+{-# INLINE scanlM' #-}
136+scanlM' :: MonadIO m => Int -> Stream m Int -> m ()
137+scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
138+
139+{-# INLINE scanl1' #-}
140+scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
141+scanl1' n = composeN n $ Stream.scanl1' (+)
142+
143+{-# INLINE scanl1M' #-}
144+scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()
145+scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
146+#endif
147+
148+{-# INLINE scan #-}
149+scan :: MonadIO m => Int -> Stream m Int -> m ()
150+scan n = composeN n $ Stream.scan FL.sum
151+
152+#ifdef USE_PRELUDE
153+{-# INLINE postscanl' #-}
154+postscanl' :: MonadIO m => Int -> Stream m Int -> m ()
155+postscanl' n = composeN n $ Stream.postscanl' (+) 0
156+
157+{-# INLINE postscanlM' #-}
158+postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()
159+postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
160+#endif
161+
162+{-# INLINE postscan #-}
163+postscan :: MonadIO m => Int -> Stream m Int -> m ()
164+postscan n = composeN n $ Stream.postscan FL.sum
165+
166+{-# INLINE sequence #-}
167+sequence :: MonadAsync m => Stream m (m Int) -> m ()
168+sequence = Common.drain . Stream.sequence
169+
170+{-# INLINE tap #-}
171+tap :: MonadIO m => Int -> Stream m Int -> m ()
172+tap n = composeN n $ Stream.tap FL.sum
173+
174+#ifdef USE_PRELUDE
175+{-# INLINE pollCounts #-}
176+pollCounts :: Int -> Stream IO Int -> IO ()
177+pollCounts n =
178+ composeN n (Stream.pollCounts (const True) f)
179+
180+ where
181+
182+ f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
183+
184+{-# INLINE timestamped #-}
185+timestamped :: (MonadAsync m) => Stream m Int -> m ()
186+timestamped = Stream.drain . Stream.timestamped
187+#endif
188+
189+#ifdef USE_STREAMK
190+{-# INLINE foldrS #-}
191+foldrS :: MonadIO m => Int -> Stream m Int -> m ()
192+foldrS n =
193+ composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream)
194+
195+{-# INLINE foldrSMap #-}
196+foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
197+foldrSMap n =
198+ composeN n
199+ ( toStream
200+ . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil
201+ . fromStream
202+ )
203+#endif
204+
205+{-
206+{-# INLINE foldrT #-}
207+foldrT :: MonadIO m => Int -> Stream m Int -> m ()
208+foldrT n = composeN n (unCrossStream . Stream.foldrT cns (CrossStream Stream.nil))
209+
210+ where cns x (CrossStream xs) = CrossStream (Stream.cons x xs)
211+
212+{-# INLINE foldrTMap #-}
213+foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()
214+foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
215+-}
216+
217+{-# INLINE trace #-}
218+trace :: MonadAsync m => Int -> Stream m Int -> m ()
219+trace n = composeN n $ Stream.trace return
220+
221+o_1_space_mapping :: Int -> [Benchmark]
222+o_1_space_mapping value =
223+ [ bgroup
224+ "mapping"
225+ [
226+#ifdef USE_STREAMK
227+ -- Right folds
228+ benchIOSink value "foldrS" (foldrS 1)
229+ , benchIOSink value "foldrSMap" (foldrSMap 1)
230+ ,
231+#endif
232+ -- , benchIOSink value "foldrT" (foldrT 1)
233+ -- , benchIOSink value "foldrTMap" (foldrTMap 1)
234+
235+ -- Mapping
236+ benchIOSink value "map" (mapN 1)
237+ , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
238+ sequence (sourceUnfoldrAction value n)
239+ , benchIOSink value "mapM" (mapM 1)
240+ , benchIOSink value "tap" (tap 1)
241+#ifdef USE_PRELUDE
242+ , benchIOSink value "pollCounts 1 second" (pollCounts 1)
243+ , benchIOSink value "timestamped" timestamped
244+
245+ -- Scanning
246+ , benchIOSink value "scanl'" (scanl' 1)
247+ , benchIOSink value "scanl1'" (scanl1' 1)
248+ , benchIOSink value "scanlM'" (scanlM' 1)
249+ , benchIOSink value "scanl1M'" (scanl1M' 1)
250+ , benchIOSink value "postscanl'" (postscanl' 1)
251+ , benchIOSink value "postscanlM'" (postscanlM' 1)
252+#endif
253+ , benchIOSink value "scan" (scan 1)
254+ , benchIOSink value "postscan" (postscan 1)
255+ ]
256+ ]
257+
258+o_1_space_mappingX4 :: Int -> [Benchmark]
259+o_1_space_mappingX4 value =
260+ [ bgroup "mappingX4"
261+ [ benchIOSink value "map" (mapN 4)
262+ , benchIOSink value "mapM" (mapM 4)
263+ , benchIOSink value "trace" (trace 4)
264+
265+#ifdef USE_PRELUDE
266+ , benchIOSink value "scanl'" (scanl' 4)
267+ , benchIOSink value "scanl1'" (scanl1' 4)
268+ , benchIOSink value "scanlM'" (scanlM' 4)
269+ , benchIOSink value "scanl1M'" (scanl1M' 4)
270+ , benchIOSink value "postscanl'" (postscanl' 4)
271+ , benchIOSink value "postscanlM'" (postscanlM' 4)
272+#endif
273+ ]
274+ ]
275+
276+{-# INLINE sieveScan #-}
277+sieveScan :: Monad m => Stream m Int -> Stream m Int
278+sieveScan =
279+ Stream.mapMaybe snd
280+ . Stream.scan (FL.foldlM' (\(primes, _) n -> do
281+ return $
282+ let ps = takeWhile (\p -> p * p <= n) primes
283+ in if all (\p -> n `mod` p /= 0) ps
284+ then (primes ++ [n], Just n)
285+ else (primes, Nothing)) (return ([2], Just 2)))
286+
287+o_n_space_mapping :: Int -> [Benchmark]
288+o_n_space_mapping value =
289+ [ bgroup "mapping"
290+ [ benchIO "naive prime sieve"
291+ (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))
292+ ]
293+ ]
294+
295+-------------------------------------------------------------------------------
296+-- Functor
297+-------------------------------------------------------------------------------
298+
299+o_1_space_functor :: Int -> [Benchmark]
300+o_1_space_functor value =
301+ [ bgroup "Functor"
302+ [ benchIOSink value "fmap" (mapN 1)
303+ , benchIOSink value "fmap x 4" (mapN 4)
304+ ]
305+ ]
306+
307+-------------------------------------------------------------------------------
308+-- Iteration/looping utilities
309+-------------------------------------------------------------------------------
310+
311+{-# INLINE iterateN #-}
312+iterateN :: (Int -> a -> a) -> a -> Int -> a
313+iterateN g initial count = f count initial
314+
315+ where
316+
317+ f (0 :: Int) x = x
318+ f i x = f (i - 1) (g i x)
319+
320+#ifdef USE_STREAMK
321+-- Iterate a transformation over a singleton stream
322+{-# INLINE iterateSingleton #-}
323+iterateSingleton :: Applicative m =>
324+ (Int -> StreamK m Int -> StreamK m Int)
325+ -> Int
326+ -> Int
327+ -> Stream m Int
328+iterateSingleton g count n = toStream $ iterateN g (StreamK.fromPure n) count
329+#else
330+-- Iterate a transformation over a singleton stream
331+{-# INLINE iterateSingleton #-}
332+iterateSingleton :: Applicative m =>
333+ (Int -> Stream m Int -> Stream m Int)
334+ -> Int
335+ -> Int
336+ -> Stream m Int
337+iterateSingleton g count n = iterateN g (Stream.fromPure n) count
338+#endif
339+
340+{-
341+-- XXX need to check why this is slower than the explicit recursion above, even
342+-- if the above code is written in a foldr like head recursive way. We also
343+-- need to try this with foldlM' once #150 is fixed.
344+-- However, it is perhaps best to keep the iteration benchmarks independent of
345+-- foldrM and any related fusion issues.
346+{-# INLINE _iterateSingleton #-}
347+_iterateSingleton ::
348+ Monad m
349+ => (Int -> Stream m Int -> Stream m Int)
350+ -> Int
351+ -> Int
352+ -> Stream m Int
353+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
354+-}
355+
356+o_n_space_iterated :: Int -> [Benchmark]
357+o_n_space_iterated value =
358+ [ bgroup "iterated"
359+ [ benchIO "(+) (n times) (baseline)" $ \i0 ->
360+ iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
361+ , benchIOSrc "(<$) (n times)" $
362+ iterateSingleton (<$) value
363+ , benchIOSrc "fmap (n times)" $
364+ iterateSingleton (fmap . (+)) value
365+ {-
366+ , benchIOSrc fromSerial "_(<$) (n times)" $
367+ _iterateSingleton (<$) value
368+ , benchIOSrc fromSerial "_fmap (n times)" $
369+ _iterateSingleton (fmap . (+)) value
370+ -}
371+ ]
372+ ]
373+
374+-------------------------------------------------------------------------------
375+-- Size reducing transformations (filtering)
376+-------------------------------------------------------------------------------
377+
378+{-# INLINE filterEven #-}
379+filterEven :: MonadIO m => Int -> Stream m Int -> m ()
380+filterEven n = composeN n $ Stream.filter even
381+
382+{-# INLINE filterAllOut #-}
383+filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
384+filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
385+
386+{-# INLINE filterAllIn #-}
387+filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
388+filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
389+
390+{-# INLINE filterMEven #-}
391+filterMEven :: MonadIO m => Int -> Stream m Int -> m ()
392+filterMEven n = composeN n $ Stream.filterM (return . even)
393+
394+{-# INLINE filterMAllOut #-}
395+filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
396+filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
397+
398+{-# INLINE filterMAllIn #-}
399+filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
400+filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
401+
402+{-# INLINE _takeOne #-}
403+_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
404+_takeOne n = composeN n $ Stream.take 1
405+
406+{-# INLINE takeAll #-}
407+takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
408+takeAll value n = composeN n $ Stream.take (value + 1)
409+
410+{-# INLINE takeWhileTrue #-}
411+takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
412+takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
413+
414+{-# INLINE takeWhileMTrue #-}
415+takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
416+takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
417+
418+#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
419+{-# INLINE takeInterval #-}
420+takeInterval :: Double -> Int -> Stream IO Int -> IO ()
421+takeInterval i n = composeN n (Stream.takeInterval i)
422+
423+-- Inspection testing is disabled for takeInterval
424+-- Enable it when looking at it throughly
425+#ifdef INSPECTION
426+-- inspect $ hasNoType 'takeInterval ''SPEC
427+-- inspect $ hasNoTypeClasses 'takeInterval
428+-- inspect $ 'takeInterval `hasNoType` ''D.Step
429+#endif
430+
431+{-# INLINE dropInterval #-}
432+dropInterval :: Double -> Int -> Stream IO Int -> IO ()
433+dropInterval i n = composeN n (Stream.dropInterval i)
434+
435+-- Inspection testing is disabled for dropInterval
436+-- Enable it when looking at it throughly
437+#ifdef INSPECTION
438+-- inspect $ hasNoTypeClasses 'dropInterval
439+-- inspect $ 'dropInterval `hasNoType` ''D.Step
440+#endif
441+#endif
442+
443+{-# INLINE dropOne #-}
444+dropOne :: MonadIO m => Int -> Stream m Int -> m ()
445+dropOne n = composeN n $ Stream.drop 1
446+
447+{-# INLINE dropAll #-}
448+dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
449+dropAll value n = composeN n $ Stream.drop (value + 1)
450+
451+{-# INLINE dropWhileTrue #-}
452+dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
453+dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
454+
455+{-# INLINE dropWhileMTrue #-}
456+dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
457+dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
458+
459+{-# INLINE dropWhileFalse #-}
460+dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
461+dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
462+
463+#ifdef USE_PRELUDE
464+-- XXX Decide on the time interval
465+{-# INLINE _intervalsOfSum #-}
466+_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()
467+_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
468+#endif
469+
470+{-# INLINE findIndices #-}
471+findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
472+findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
473+
474+{-# INLINE elemIndices #-}
475+elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
476+elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
477+
478+{-# INLINE deleteBy #-}
479+deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
480+deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
481+
482+-- uniq . uniq == uniq, composeN 2 ~ composeN 1
483+{-# INLINE uniq #-}
484+uniq :: MonadIO m => Int -> Stream m Int -> m ()
485+uniq n = composeN n Stream.uniq
486+
487+{-# INLINE mapMaybe #-}
488+mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
489+mapMaybe n =
490+ composeN n $
491+ Stream.mapMaybe
492+ (\x ->
493+ if odd x
494+ then Nothing
495+ else Just x)
496+
497+{-# INLINE mapMaybeM #-}
498+mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()
499+mapMaybeM n =
500+ composeN n $
501+ Stream.mapMaybeM
502+ (\x ->
503+ if odd x
504+ then return Nothing
505+ else return $ Just x)
506+
507+o_1_space_filtering :: Int -> [Benchmark]
508+o_1_space_filtering value =
509+ [ bgroup "filtering"
510+ [ benchIOSink value "filter-even" (filterEven 1)
511+ , benchIOSink value "filter-all-out" (filterAllOut value 1)
512+ , benchIOSink value "filter-all-in" (filterAllIn value 1)
513+
514+ , benchIOSink value "filterM-even" (filterMEven 1)
515+ , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
516+ , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
517+
518+ -- Trimming
519+ , benchIOSink value "take-all" (takeAll value 1)
520+ , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
521+ -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
522+ , benchIOSink value "drop-one" (dropOne 1)
523+ , benchIOSink value "drop-all" (dropAll value 1)
524+#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
525+ , benchIOSink value "takeInterval-all" (takeInterval 10000 1)
526+ , benchIOSink value "dropInterval-all" (dropInterval 10000 1)
527+#endif
528+ , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
529+ -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
530+ , benchIOSink
531+ value
532+ "dropWhile-false"
533+ (dropWhileFalse value 1)
534+ , benchIOSink value "deleteBy" (deleteBy value 1)
535+
536+ , benchIOSink value "uniq" (uniq 1)
537+
538+ -- Map and filter
539+ , benchIOSink value "mapMaybe" (mapMaybe 1)
540+ , benchIOSink value "mapMaybeM" (mapMaybeM 1)
541+
542+ -- Searching (stateful map and filter)
543+ , benchIOSink value "findIndices" (findIndices value 1)
544+ , benchIOSink value "elemIndices" (elemIndices value 1)
545+ ]
546+ ]
547+
548+o_1_space_filteringX4 :: Int -> [Benchmark]
549+o_1_space_filteringX4 value =
550+ [ bgroup "filteringX4"
551+ [ benchIOSink value "filter-even" (filterEven 4)
552+ , benchIOSink value "filter-all-out" (filterAllOut value 4)
553+ , benchIOSink value "filter-all-in" (filterAllIn value 4)
554+
555+ , benchIOSink value "filterM-even" (filterMEven 4)
556+ , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
557+ , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
558+
559+ -- trimming
560+ , benchIOSink value "take-all" (takeAll value 4)
561+ , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
562+ , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)
563+ , benchIOSink value "drop-one" (dropOne 4)
564+ , benchIOSink value "drop-all" (dropAll value 4)
565+ , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
566+ , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)
567+ , benchIOSink
568+ value
569+ "dropWhile-false"
570+ (dropWhileFalse value 4)
571+ , benchIOSink value "deleteBy" (deleteBy value 4)
572+
573+ , benchIOSink value "uniq" (uniq 4)
574+
575+ -- map and filter
576+ , benchIOSink value "mapMaybe" (mapMaybe 4)
577+ , benchIOSink value "mapMaybeM" (mapMaybeM 4)
578+
579+ -- searching
580+ , benchIOSink value "findIndices" (findIndices value 4)
581+ , benchIOSink value "elemIndices" (elemIndices value 4)
582+ ]
583+ ]
584+
585+-------------------------------------------------------------------------------
586+-- Size increasing transformations (insertions)
587+-------------------------------------------------------------------------------
588+
589+{-# INLINE intersperse #-}
590+intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
591+intersperse value n = composeN n $ Stream.intersperse (value + 1)
592+
593+{-# INLINE intersperseM #-}
594+intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
595+intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
596+
597+{-# INLINE insertBy #-}
598+insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
599+insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
600+
601+{-# INLINE interposeSuffix #-}
602+interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
603+interposeSuffix value n =
604+ composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
605+
606+{-# INLINE intercalateSuffix #-}
607+intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
608+intercalateSuffix value n =
609+ composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
610+
611+o_1_space_inserting :: Int -> [Benchmark]
612+o_1_space_inserting value =
613+ [ bgroup "inserting"
614+ [ benchIOSink value "intersperse" (intersperse value 1)
615+ , benchIOSink value "intersperseM" (intersperseM value 1)
616+ , benchIOSink value "insertBy" (insertBy value 1)
617+ , benchIOSink value "interposeSuffix" (interposeSuffix value 1)
618+ , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)
619+ ]
620+ ]
621+
622+o_1_space_insertingX4 :: Int -> [Benchmark]
623+o_1_space_insertingX4 value =
624+ [ bgroup "insertingX4"
625+ [ benchIOSink value "intersperse" (intersperse value 4)
626+ , benchIOSink value "insertBy" (insertBy value 4)
627+ ]
628+ ]
629+
630+-------------------------------------------------------------------------------
631+-- Indexing
632+-------------------------------------------------------------------------------
633+
634+{-# INLINE indexed #-}
635+indexed :: MonadIO m => Int -> Stream m Int -> m ()
636+indexed n = composeN n (fmap snd . Stream.indexed)
637+
638+{-# INLINE indexedR #-}
639+indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()
640+indexedR value n = composeN n (fmap snd . Stream.indexedR value)
641+
642+o_1_space_indexing :: Int -> [Benchmark]
643+o_1_space_indexing value =
644+ [ bgroup "indexing"
645+ [ benchIOSink value "indexed" (indexed 1)
646+ , benchIOSink value "indexedR" (indexedR value 1)
647+ ]
648+ ]
649+
650+o_1_space_indexingX4 :: Int -> [Benchmark]
651+o_1_space_indexingX4 value =
652+ [ bgroup "indexingx4"
653+ [ benchIOSink value "indexed" (indexed 4)
654+ , benchIOSink value "indexedR" (indexedR value 4)
655+ ]
656+ ]
657+
658+-------------------------------------------------------------------------------
659+-- Main
660+-------------------------------------------------------------------------------
661+
662+-- In addition to gauge options, the number of elements in the stream can be
663+-- passed using the --stream-size option.
664+--
665+benchmarks :: String -> Int -> [Benchmark]
666+benchmarks moduleName size =
667+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
668+ [ o_1_space_functor size
669+ , o_1_space_mapping size
670+ , o_1_space_mappingX4 size
671+ , o_1_space_filtering size
672+ , o_1_space_filteringX4 size
673+ , o_1_space_inserting size
674+ , o_1_space_insertingX4 size
675+ , o_1_space_indexing size
676+ , o_1_space_indexingX4 size
677+ ]
678+ , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
679+ [
680+#ifdef USE_STREAMK
681+ o_n_space_traversable size
682+ ,
683+#endif
684+ o_n_space_mapping size
685+ , o_n_space_iterated size
686+ ]
687+ ]
benchmark/Streamly/Benchmark/Data/Unfold.hs+182−118
@@ -21,6 +21,8 @@ module Main (main) where
21
21
22import Control.DeepSeq (NFData(..))
22import Control.DeepSeq (NFData(..))
23import Control.Exception (SomeException, ErrorCall, try)
23import Control.Exception (SomeException, ErrorCall, try)
24+import Data.Char (ord)
25+import Data.Word (Word8)
24import Streamly.Internal.Data.Unfold (Unfold)
26import Streamly.Internal.Data.Unfold (Unfold)
25import System.IO (Handle, hClose)
27import System.IO (Handle, hClose)
26import System.Random (randomRIO)
28import System.Random (randomRIO)
@@ -29,17 +31,18 @@ import qualified Prelude
29import qualified Streamly.FileSystem.Handle as FH
31import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Fold as FL
32import qualified Streamly.Internal.Data.Fold as FL
31import qualified Streamly.Internal.Data.Unfold as UF
33import qualified Streamly.Internal.Data.Unfold as UF
32−import qualified Streamly.Internal.Data.Stream.IsStream as S
34+import qualified Streamly.Internal.Data.Unfold.Prelude as UF
35+import qualified Streamly.Internal.Data.Stream as S
33−import qualified Streamly.Internal.Data.Stream.StreamD as D
36+import qualified Streamly.Internal.Data.Stream as D
34−import qualified Streamly.Internal.Data.Stream.StreamK as K
37+import qualified Streamly.Internal.Data.StreamK as K
35−import qualified Streamly.Prelude as SP
36
38
37−import Gauge hiding (env)
39+import Test.Tasty.Bench hiding (env)
38−import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
40+import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile)
39import Streamly.Benchmark.Common
41import Streamly.Benchmark.Common
40import Streamly.Benchmark.Common.Handle
42import Streamly.Benchmark.Common.Handle
41
43
42#ifdef INSPECTION
44#ifdef INSPECTION
45+import Control.Monad.Catch (MonadCatch)
43import Test.Inspection
46import Test.Inspection
44#endif
47#endif
45
48
@@ -54,7 +57,7 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
54-- generate numbers up to the argument value
57-- generate numbers up to the argument value
55{-# INLINE source #-}
58{-# INLINE source #-}
56source :: Monad m => Int -> Unfold m Int Int
59source :: Monad m => Int -> Unfold m Int Int
57−source n = UF.enumerateFromToIntegral n
60+source n = UF.second n UF.enumerateFromToIntegral
58
61
59-------------------------------------------------------------------------------
62-------------------------------------------------------------------------------
60-- Benchmark helpers
63-- Benchmark helpers
@@ -62,7 +65,7 @@ source n = UF.enumerateFromToIntegral n
62
65
63{-# INLINE drainGeneration #-}
66{-# INLINE drainGeneration #-}
64drainGeneration :: Monad m => Unfold m a b -> a -> m ()
67drainGeneration :: Monad m => Unfold m a b -> a -> m ()
65−drainGeneration unf seed = UF.fold unf FL.drain seed
68+drainGeneration unf seed = UF.fold FL.drain unf seed
66
69
67{-# INLINE drainTransformation #-}
70{-# INLINE drainTransformation #-}
68drainTransformation ::
71drainTransformation ::
@@ -73,7 +76,7 @@ drainTransformation unf f seed = drainGeneration (f unf) seed
73drainTransformationDefault ::
76drainTransformationDefault ::
74 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
77 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
75drainTransformationDefault to =
78drainTransformationDefault to =
76− drainTransformation (UF.enumerateFromToIntegral to)
79+ drainTransformation (UF.second to UF.enumerateFromToIntegral)
77
80
78{-# INLINE drainProduct #-}
81{-# INLINE drainProduct #-}
79drainProduct ::
82drainProduct ::
@@ -96,7 +99,7 @@ drainProductDefault to = drainProduct src src
96
99
97 where
100 where
98
101
99− src = UF.enumerateFromToIntegral to
102+ src = UF.second to UF.enumerateFromToIntegral
100
103
101-------------------------------------------------------------------------------
104-------------------------------------------------------------------------------
102-- Operations on input
105-- Operations on input
@@ -112,26 +115,26 @@ lmapM :: Monad m => Int -> Int -> m ()
112lmapM size start =
115lmapM size start =
113 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
116 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
114
117
115−{-# INLINE supply #-}
118+{-# INLINE both #-}
116−supply :: Monad m => Int -> Int -> m ()
119+both :: Monad m => Int -> Int -> m ()
117−supply size start =
120+both size start =
118− drainTransformationDefault (size + start) (flip UF.supply start) undefined
121+ drainTransformationDefault (size + start) (UF.both start) undefined
119
122
120
123
121−{-# INLINE supplyFirst #-}
124+{-# INLINE first #-}
122−supplyFirst :: Monad m => Int -> Int -> m ()
125+first :: Monad m => Int -> Int -> m ()
123−supplyFirst size start =
126+first size start =
124 drainTransformation
127 drainTransformation
125− (UF.take size UF.enumerateFromStepIntegral)
128+ (UF.take size UF.enumerateFromThenIntegral)
126− (flip UF.supplyFirst start)
129+ (UF.first start)
127 1
130 1
128
131
129−{-# INLINE supplySecond #-}
132+{-# INLINE second #-}
130−supplySecond :: Monad m => Int -> Int -> m ()
133+second :: Monad m => Int -> Int -> m ()
131−supplySecond size start =
134+second size start =
132 drainTransformation
135 drainTransformation
133− (UF.take size UF.enumerateFromStepIntegral)
136+ (UF.take size UF.enumerateFromThenIntegral)
134− (flip UF.supplySecond 1)
137+ (UF.second 1)
135 start
138 start
136
139
137{-# INLINE discardFirst #-}
140{-# INLINE discardFirst #-}
@@ -148,7 +151,7 @@ discardSecond size start =
148swap :: Monad m => Int -> Int -> m ()
151swap :: Monad m => Int -> Int -> m ()
149swap size start =
152swap size start =
150 drainTransformation
153 drainTransformation
151− (UF.take size UF.enumerateFromStepIntegral)
154+ (UF.take size UF.enumerateFromThenIntegral)
152 UF.swap
155 UF.swap
153 (1, start)
156 (1, start)
154
157
@@ -159,7 +162,7 @@ swap size start =
159{-# INLINE fromStream #-}
162{-# INLINE fromStream #-}
160fromStream :: Int -> Int -> IO ()
163fromStream :: Int -> Int -> IO ()
161fromStream size start =
164fromStream size start =
162− drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
165+ drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)
163
166
164-- XXX INVESTIGATE: Although the performance of this should be equivalant to
167-- XXX INVESTIGATE: Although the performance of this should be equivalant to
165-- fromStream, this is considerably worse. More than 4x worse.
168-- fromStream, this is considerably worse. More than 4x worse.
@@ -181,18 +184,13 @@ consM :: Monad m => Int -> Int -> m ()
181consM size start =
184consM size start =
182 drainTransformationDefault (size + start) (UF.consM return) start
185 drainTransformationDefault (size + start) (UF.consM return) start
183
186
184−{-# INLINE _effect #-}
187+{-# INLINE _functionM #-}
185−_effect :: Monad m => Int -> Int -> m ()
188+_functionM :: Monad m => Int -> Int -> m ()
186−_effect _ start =
187− drainGeneration (UF.effect (return start)) undefined
189+_functionM _ start = drainGeneration (UF.functionM return) start
188
190
189−{-# INLINE _singletonM #-}
191+{-# INLINE _function #-}
190−_singletonM :: Monad m => Int -> Int -> m ()
192+_function :: Monad m => Int -> Int -> m ()
191−_singletonM _ start = drainGeneration (UF.singletonM return) start
193+_function _ start = drainGeneration (UF.function id) start
192−
193−{-# INLINE _singleton #-}
194−_singleton :: Monad m => Int -> Int -> m ()
195−_singleton _ start = drainGeneration (UF.singleton id) start
196
194
197{-# INLINE _identity #-}
195{-# INLINE _identity #-}
198_identity :: Monad m => Int -> Int -> m ()
196_identity :: Monad m => Int -> Int -> m ()
@@ -201,7 +199,7 @@ _identity _ start = drainGeneration UF.identity start
201{-# INLINE _const #-}
199{-# INLINE _const #-}
202_const :: Monad m => Int -> Int -> m ()
200_const :: Monad m => Int -> Int -> m ()
203_const size start =
201_const size start =
204− drainGeneration (UF.take size (UF.const (return start))) undefined
202+ drainGeneration (UF.take size (UF.fromEffect (return start))) undefined
205
203
206{-# INLINE unfoldrM #-}
204{-# INLINE unfoldrM #-}
207unfoldrM :: Monad m => Int -> Int -> m ()
205unfoldrM :: Monad m => Int -> Int -> m ()
@@ -234,7 +232,7 @@ _fromProducer = undefined
234
232
235{-# INLINE replicateM #-}
233{-# INLINE replicateM #-}
236replicateM :: Monad m => Int -> Int -> m ()
234replicateM :: Monad m => Int -> Int -> m ()
237−replicateM size start = drainGeneration (UF.replicateM size) (return start)
235+replicateM size start = drainGeneration UF.replicateM (size, return start)
238
236
239{-# INLINE repeatM #-}
237{-# INLINE repeatM #-}
240repeatM :: Monad m => Int -> Int -> m ()
238repeatM :: Monad m => Int -> Int -> m ()
@@ -250,15 +248,19 @@ fromIndicesM :: Monad m => Int -> Int -> m ()
250fromIndicesM size start =
248fromIndicesM size start =
251 drainGeneration (UF.take size (UF.fromIndicesM return)) start
249 drainGeneration (UF.take size (UF.fromIndicesM return)) start
252
250
253−{-# INLINE enumerateFromStepIntegral #-}
251+{-# INLINE enumerateFromThenIntegral #-}
254−enumerateFromStepIntegral :: Monad m => Int -> Int -> m ()
252+enumerateFromThenIntegral :: Monad m => Int -> Int -> m ()
255−enumerateFromStepIntegral size start =
253+enumerateFromThenIntegral size start =
256− drainGeneration (UF.take size UF.enumerateFromStepIntegral) (start, 1)
254+ drainGeneration (UF.take size UF.enumerateFromThenIntegral) (start, 1)
257
255
258{-# INLINE enumerateFromToIntegral #-}
256{-# INLINE enumerateFromToIntegral #-}
259enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
257enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
260enumerateFromToIntegral size start =
258enumerateFromToIntegral size start =
261− drainGeneration (UF.enumerateFromToIntegral (size + start)) start
259+ drainGeneration
260+ ( UF.second
261+ (size + start)
262+ UF.enumerateFromToIntegral
263+ ) start
262
264
263{-# INLINE enumerateFromIntegral #-}
265{-# INLINE enumerateFromIntegral #-}
264enumerateFromIntegral :: Monad m => Int -> Int -> m ()
266enumerateFromIntegral :: Monad m => Int -> Int -> m ()
@@ -268,24 +270,32 @@ enumerateFromIntegral size start =
268{-# INLINE enumerateFromStepNum #-}
270{-# INLINE enumerateFromStepNum #-}
269enumerateFromStepNum :: Monad m => Int -> Int -> m ()
271enumerateFromStepNum :: Monad m => Int -> Int -> m ()
270enumerateFromStepNum size start =
272enumerateFromStepNum size start =
271− drainGeneration (UF.take size (UF.enumerateFromStepNum 1)) start
273+ drainGeneration (UF.take size (UF.enumerateFromThenNum)) (start, 1)
272
274
273−{-# INLINE numFrom #-}
275+{-# INLINE enumerateFromNum #-}
274−numFrom :: Monad m => Int -> Int -> m ()
276+enumerateFromNum :: Monad m => Int -> Int -> m ()
275−numFrom size start = drainGeneration (UF.take size UF.numFrom) start
277+enumerateFromNum size start = drainGeneration (UF.take size UF.enumerateFromNum) start
276
278
277{-# INLINE enumerateFromToFractional #-}
279{-# INLINE enumerateFromToFractional #-}
278enumerateFromToFractional :: Monad m => Int -> Int -> m ()
280enumerateFromToFractional :: Monad m => Int -> Int -> m ()
279enumerateFromToFractional size start =
281enumerateFromToFractional size start =
280 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
282 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
281 in drainGeneration
283 in drainGeneration
284+ ( UF.second
282− (UF.enumerateFromToFractional (intToDouble $ start + size))
285+ (intToDouble $ start + size)
286+ UF.enumerateFromToFractional
287+ )
283 (intToDouble start)
288 (intToDouble start)
284
289
285-------------------------------------------------------------------------------
290-------------------------------------------------------------------------------
286-- Stream transformation
291-- Stream transformation
287-------------------------------------------------------------------------------
292-------------------------------------------------------------------------------
288
293
294+{-# INLINE postscan #-}
295+postscan :: Monad m => Int -> Int -> m ()
296+postscan size start =
297+ drainTransformationDefault (size + start) (UF.postscan FL.sum) start
298+
289{-# INLINE map #-}
299{-# INLINE map #-}
290map :: Monad m => Int -> Int -> m ()
300map :: Monad m => Int -> Int -> m ()
291map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
301map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
@@ -295,12 +305,12 @@ mapM :: Monad m => Int -> Int -> m ()
295mapM size start =
305mapM size start =
296 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
306 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
297
307
298−{-# INLINE mapMWithInput #-}
308+{-# INLINE mapM2 #-}
299−mapMWithInput :: Monad m => Int -> Int -> m ()
309+mapM2 :: Monad m => Int -> Int -> m ()
300−mapMWithInput size start =
310+mapM2 size start =
301 drainTransformationDefault
311 drainTransformationDefault
302 size
312 size
303− (UF.mapMWithInput (\a b -> return $ a + b))
313+ (UF.mapM2 (\a b -> return $ a + b))
304 start
314 start
305
315
306-------------------------------------------------------------------------------
316-------------------------------------------------------------------------------
@@ -389,7 +399,7 @@ dropWhileMFalse size start =
389{-# INLINE zipWith #-}
399{-# INLINE zipWith #-}
390zipWith :: Monad m => Int -> Int -> m ()
400zipWith :: Monad m => Int -> Int -> m ()
391zipWith size start =
401zipWith size start =
392− drainProductDefault (size + start) (UF.zipWith (+)) (start, start + 1)
402+ drainProductDefault (size + start) (UF.zipWith (+)) start
393
403
394{-# INLINE zipWithM #-}
404{-# INLINE zipWithM #-}
395zipWithM :: Monad m => Int -> Int -> m ()
405zipWithM :: Monad m => Int -> Int -> m ()
@@ -397,23 +407,27 @@ zipWithM size start =
397 drainProductDefault
407 drainProductDefault
398 (size + start)
408 (size + start)
399 (UF.zipWithM (\a b -> return $ a + b))
409 (UF.zipWithM (\a b -> return $ a + b))
400− (start, start + 1)
410+ start
401
411
402{-# INLINE teeZipWith #-}
412{-# INLINE teeZipWith #-}
403teeZipWith :: Monad m => Int -> Int -> m ()
413teeZipWith :: Monad m => Int -> Int -> m ()
404teeZipWith size start =
414teeZipWith size start =
405− drainProductDefault (size + start) (UF.teeZipWith (+)) start
415+ drainProductDefault (size + start) (UF.zipWith (+)) start
406
416
407-------------------------------------------------------------------------------
417-------------------------------------------------------------------------------
408-- Applicative
418-- Applicative
409-------------------------------------------------------------------------------
419-------------------------------------------------------------------------------
410
420
421+nthRoot :: Double -> Int -> Int
422+nthRoot n value = round (fromIntegral value**(1/n))
423+
411{-# INLINE toNullAp #-}
424{-# INLINE toNullAp #-}
412toNullAp :: Monad m => Int -> Int -> m ()
425toNullAp :: Monad m => Int -> Int -> m ()
413toNullAp value start =
426toNullAp value start =
414 let end = start + nthRoot 2 value
427 let end = start + nthRoot 2 value
415 s = source end
428 s = source end
416− in UF.fold ((+) <$> s <*> s) FL.drain start
429+ -- in UF.fold ((+) <$> s <*> s) FL.drain start
430+ in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start
417
431
418{-# INLINE _apDiscardFst #-}
432{-# INLINE _apDiscardFst #-}
419_apDiscardFst :: Int -> Int -> m ()
433_apDiscardFst :: Int -> Int -> m ()
@@ -427,9 +441,6 @@ _apDiscardSnd = undefined
427-- Monad
441-- Monad
428-------------------------------------------------------------------------------
442-------------------------------------------------------------------------------
429
443
430−nthRoot :: Double -> Int -> Int
431−nthRoot n value = round (fromIntegral value**(1/n))
432−
433{-# INLINE concatMapM #-}
444{-# INLINE concatMapM #-}
434concatMapM :: Monad m => Int -> Int -> m ()
445concatMapM :: Monad m => Int -> Int -> m ()
435concatMapM value start =
446concatMapM value start =
@@ -438,19 +449,24 @@ concatMapM value start =
438 where
449 where
439
450
440 val = nthRoot 2 value
451 val = nthRoot 2 value
441− unfoldInGen i = return (UF.enumerateFromToIntegral (i + val))
452+ unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
442− unfoldOut = UF.enumerateFromToIntegral (start + val)
453+ unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
443
454
444{-# INLINE toNull #-}
455{-# INLINE toNull #-}
445toNull :: Monad m => Int -> Int -> m ()
456toNull :: Monad m => Int -> Int -> m ()
446toNull value start =
457toNull value start =
447 let end = start + nthRoot 2 value
458 let end = start + nthRoot 2 value
448 src = source end
459 src = source end
460+ {-
449 u = do
461 u = do
450 x <- src
462 x <- src
451 y <- src
463 y <- src
452 return (x + y)
464 return (x + y)
465+ -}
466+ u = src `UF.bind` \x ->
467+ src `UF.bind` \y ->
468+ UF.fromPure (x + y)
453− in UF.fold u FL.drain start
469+ in UF.fold FL.drain u start
454
470
455
471
456{-# INLINE toNull3 #-}
472{-# INLINE toNull3 #-}
@@ -458,91 +474,122 @@ toNull3 :: Monad m => Int -> Int -> m ()
458toNull3 value start =
474toNull3 value start =
459 let end = start + nthRoot 3 value
475 let end = start + nthRoot 3 value
460 src = source end
476 src = source end
477+ {-
461 u = do
478 u = do
462 x <- src
479 x <- src
463 y <- src
480 y <- src
464 z <- src
481 z <- src
465 return (x + y + z)
482 return (x + y + z)
483+ -}
484+ u = src `UF.bind` \x ->
485+ src `UF.bind` \y ->
486+ UF.fromPure (x + y)
466− in UF.fold u FL.drain start
487+ in UF.fold FL.drain u start
467
488
468{-# INLINE toList #-}
489{-# INLINE toList #-}
469toList :: Monad m => Int -> Int -> m [Int]
490toList :: Monad m => Int -> Int -> m [Int]
470toList value start = do
491toList value start = do
471 let end = start + nthRoot 2 value
492 let end = start + nthRoot 2 value
472 src = source end
493 src = source end
494+ {-
473 u = do
495 u = do
474 x <- src
496 x <- src
475 y <- src
497 y <- src
476 return (x + y)
498 return (x + y)
499+ -}
500+ u = src `UF.bind` \x ->
501+ src `UF.bind` \y ->
502+ UF.fromPure (x + y)
477− in UF.fold u FL.toList start
503+ in UF.fold FL.toList u start
478
504
479{-# INLINE toListSome #-}
505{-# INLINE toListSome #-}
480toListSome :: Monad m => Int -> Int -> m [Int]
506toListSome :: Monad m => Int -> Int -> m [Int]
481toListSome value start = do
507toListSome value start = do
482 let end = start + nthRoot 2 value
508 let end = start + nthRoot 2 value
483 src = source end
509 src = source end
510+ {-
484 u = do
511 u = do
485 x <- src
512 x <- src
486 y <- src
513 y <- src
487 return (x + y)
514 return (x + y)
515+ -}
516+ u = src `UF.bind` \x ->
517+ src `UF.bind` \y ->
518+ UF.fromPure (x + y)
488− in UF.fold (UF.take 1000 u) FL.toList start
519+ in UF.fold FL.toList (UF.take 1000 u) start
489
520
490{-# INLINE filterAllOut #-}
521{-# INLINE filterAllOut #-}
491filterAllOut :: Monad m => Int -> Int -> m ()
522filterAllOut :: Monad m => Int -> Int -> m ()
492filterAllOut value start = do
523filterAllOut value start = do
493 let end = start + nthRoot 2 value
524 let end = start + nthRoot 2 value
494 src = source end
525 src = source end
526+ {-
495 u = do
527 u = do
496 x <- src
528 x <- src
497 y <- src
529 y <- src
530+ -}
531+ u = src `UF.bind` \x ->
532+ src `UF.bind` \y ->
498 let s = x + y
533 let s = x + y
499− if s < 0
534+ in if s < 0
500− then return s
535+ then UF.fromPure s
501− else UF.nilM (return . const ())
536+ else UF.nilM (return . const ())
502− in UF.fold u FL.drain start
537+ in UF.fold FL.drain u start
503
538
504{-# INLINE filterAllIn #-}
539{-# INLINE filterAllIn #-}
505filterAllIn :: Monad m => Int -> Int -> m ()
540filterAllIn :: Monad m => Int -> Int -> m ()
506filterAllIn value start = do
541filterAllIn value start = do
507 let end = start + nthRoot 2 value
542 let end = start + nthRoot 2 value
508 src = source end
543 src = source end
544+ {-
509 u = do
545 u = do
510 x <- src
546 x <- src
511 y <- src
547 y <- src
548+ -}
549+ u = src `UF.bind` \x ->
550+ src `UF.bind` \y ->
512 let s = x + y
551 let s = x + y
513− if s > 0
552+ in if s > 0
514− then return s
553+ then UF.fromPure s
515− else UF.nilM (return . const ())
554+ else UF.nilM (return . const ())
516− in UF.fold u FL.drain start
555+ in UF.fold FL.drain u start
517
556
518{-# INLINE filterSome #-}
557{-# INLINE filterSome #-}
519filterSome :: Monad m => Int -> Int -> m ()
558filterSome :: Monad m => Int -> Int -> m ()
520filterSome value start = do
559filterSome value start = do
521 let end = start + nthRoot 2 value
560 let end = start + nthRoot 2 value
522 src = source end
561 src = source end
562+ {-
523 u = do
563 u = do
524 x <- src
564 x <- src
525 y <- src
565 y <- src
566+ -}
567+ u = src `UF.bind` \x ->
568+ src `UF.bind` \y ->
526 let s = x + y
569 let s = x + y
527− if s > 1100000
570+ in if s > 1100000
528− then return s
571+ then UF.fromPure s
529− else UF.nilM (return . const ())
572+ else UF.nilM (return . const ())
530− in UF.fold u FL.drain start
573+ in UF.fold FL.drain u start
531
574
532{-# INLINE breakAfterSome #-}
575{-# INLINE breakAfterSome #-}
533breakAfterSome :: Int -> Int -> IO ()
576breakAfterSome :: Int -> Int -> IO ()
534breakAfterSome value start =
577breakAfterSome value start =
535 let end = start + nthRoot 2 value
578 let end = start + nthRoot 2 value
536 src = source end
579 src = source end
580+ {-
537 u = do
581 u = do
538 x <- src
582 x <- src
539 y <- src
583 y <- src
584+ -}
585+ u = src `UF.bind` \x ->
586+ src `UF.bind` \y ->
540 let s = x + y
587 let s = x + y
541− if s > 1100000
588+ in if s > 1100000
542− then error "break"
589+ then error "break"
543− else return s
590+ else UF.fromPure s
544 in do
591 in do
545− (_ :: Either ErrorCall ()) <- try $ UF.fold u FL.drain start
592+ (_ :: Either ErrorCall ()) <- try $ UF.fold FL.drain u start
546 return ()
593 return ()
547
594
548-------------------------------------------------------------------------------
595-------------------------------------------------------------------------------
@@ -554,13 +601,11 @@ concatCount :: Int -> Int
554concatCount linearCount =
601concatCount linearCount =
555 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
602 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
556
603
557−{-# INLINE concat #-}
604+{-# INLINE many #-}
558−concat :: Monad m => Int -> Int -> m ()
605+many :: Monad m => Int -> Int -> m ()
559−concat linearCount start = do
606+many linearCount start = do
560 let end = start + concatCount linearCount
607 let end = start + concatCount linearCount
561− UF.fold
562− (UF.concat (source end) (source end))
563− FL.drain start
608+ UF.fold FL.drain (UF.many (source end) (source end)) start
564
609
565-------------------------------------------------------------------------------
610-------------------------------------------------------------------------------
566-- Benchmarks
611-- Benchmarks
@@ -575,9 +620,9 @@ o_1_space_transformation_input size =
575 "transformation/input"
620 "transformation/input"
576 [ benchIO "lmap" $ lmap size
621 [ benchIO "lmap" $ lmap size
577 , benchIO "lmapM" $ lmapM size
622 , benchIO "lmapM" $ lmapM size
578− , benchIO "supply" $ supply size
623+ , benchIO "both" $ both size
579− , benchIO "supplyFirst" $ supplyFirst size
624+ , benchIO "first" $ first size
580− , benchIO "supplySecond" $ supplySecond size
625+ , benchIO "second" $ second size
581 , benchIO "discardFirst" $ discardFirst size
626 , benchIO "discardFirst" $ discardFirst size
582 , benchIO "discardSecond" $ discardSecond size
627 , benchIO "discardSecond" $ discardSecond size
583 , benchIO "swap" $ swap size
628 , benchIO "swap" $ swap size
@@ -594,9 +639,8 @@ o_1_space_generation size =
594 -- Very small benchmarks, reporting in ns
639 -- Very small benchmarks, reporting in ns
595 -- , benchIO "nilM" $ nilM size
640 -- , benchIO "nilM" $ nilM size
596 , benchIO "consM" $ consM size
641 , benchIO "consM" $ consM size
597− -- , benchIO "effect" $ effect size
642+ -- , benchIO "functionM" $ functionM size
598− -- , benchIO "singletonM" $ singletonM size
643+ -- , benchIO "function" $ function size
599− -- , benchIO "singleton" $ singleton size
600 -- , benchIO "identity" $ identity size
644 -- , benchIO "identity" $ identity size
601 -- , benchIO "const" $ const size
645 -- , benchIO "const" $ const size
602 , benchIO "unfoldrM" $ unfoldrM size
646 , benchIO "unfoldrM" $ unfoldrM size
@@ -609,11 +653,11 @@ o_1_space_generation size =
609 , benchIO "repeatM" $ repeatM size
653 , benchIO "repeatM" $ repeatM size
610 , benchIO "iterateM" $ iterateM size
654 , benchIO "iterateM" $ iterateM size
611 , benchIO "fromIndicesM" $ fromIndicesM size
655 , benchIO "fromIndicesM" $ fromIndicesM size
612− , benchIO "enumerateFromStepIntegral" $ enumerateFromStepIntegral size
656+ , benchIO "enumerateFromThenIntegral" $ enumerateFromThenIntegral size
613 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
657 , benchIO "enumerateFromToIntegral" $ enumerateFromToIntegral size
614 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
658 , benchIO "enumerateFromIntegral" $ enumerateFromIntegral size
615 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
659 , benchIO "enumerateFromStepNum" $ enumerateFromStepNum size
616− , benchIO "numFrom" $ numFrom size
660+ , benchIO "enumerateFromNum" $ enumerateFromNum size
617 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
661 , benchIO "enumerateFromToFractional" $ enumerateFromToFractional size
618 ]
662 ]
619 ]
663 ]
@@ -624,7 +668,8 @@ o_1_space_transformation size =
624 "transformation"
668 "transformation"
625 [ benchIO "map" $ map size
669 [ benchIO "map" $ map size
626 , benchIO "mapM" $ mapM size
670 , benchIO "mapM" $ mapM size
627− , benchIO "mapMWithInput" $ mapMWithInput size
671+ , benchIO "mapM2" $ mapM2 size
672+ , benchIO "postscan" $ postscan size
628 ]
673 ]
629 ]
674 ]
630
675
@@ -657,8 +702,17 @@ o_1_space_zip size =
657 ]
702 ]
658 ]
703 ]
659
704
705+lf :: Word8
706+lf = fromIntegral (ord '\n')
707+
708+-- | Split on line feed.
709+foldManySepBy :: Handle -> IO Int
710+foldManySepBy =
711+ let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.reader
712+ in UF.fold FL.length u
713+
660−o_1_space_nested :: Int -> [Benchmark]
714+o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
661−o_1_space_nested size =
715+o_1_space_nested env size =
662 [ bgroup
716 [ bgroup
663 "nested"
717 "nested"
664 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
718 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -674,7 +728,9 @@ o_1_space_nested size =
674 , benchIO "filterAllIn" $ filterAllIn size
728 , benchIO "filterAllIn" $ filterAllIn size
675 , benchIO "filterSome" $ filterSome size
729 , benchIO "filterSome" $ filterSome size
676
730
677− , benchIO "concat" $ concat size
731+ , benchIO "many" $ many size
732+ , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
733+ $ \inh _ -> foldManySepBy inh
678 ]
734 ]
679 ]
735 ]
680
736
@@ -693,11 +749,11 @@ o_n_space_nested size =
693-- | Send the file contents to /dev/null with exception handling
749-- | Send the file contents to /dev/null with exception handling
694readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
750readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
695readWriteOnExceptionUnfold inh devNull =
751readWriteOnExceptionUnfold inh devNull =
696− let readEx = UF.onException (\_ -> hClose inh) FH.read
752+ let readEx = UF.onException (\_ -> hClose inh) FH.reader
697− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
753+ in S.fold (FH.write devNull) $ S.unfold readEx inh
698
754
699#ifdef INSPECTION
755#ifdef INSPECTION
700−inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
756+-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
701-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
757-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
702#endif
758#endif
703
759
@@ -705,45 +761,54 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
705readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
761readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
706readWriteHandleExceptionUnfold inh devNull =
762readWriteHandleExceptionUnfold inh devNull =
707 let handler (_e :: SomeException) = hClose inh >> return 10
763 let handler (_e :: SomeException) = hClose inh >> return 10
708− readEx = UF.handle (UF.singletonM handler) FH.read
764+ readEx = UF.handle (UF.functionM handler) FH.reader
709− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
765+ in S.fold (FH.write devNull) $ S.unfold readEx inh
710
766
711#ifdef INSPECTION
767#ifdef INSPECTION
768+-- hasNoTypeClasses started failing in GHC 9.4.4
712−inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
769+-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
713-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
770-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
714#endif
771#endif
715
772
716-- | Send the file contents to /dev/null with exception handling
773-- | Send the file contents to /dev/null with exception handling
717readWriteFinally_Unfold :: Handle -> Handle -> IO ()
774readWriteFinally_Unfold :: Handle -> Handle -> IO ()
718readWriteFinally_Unfold inh devNull =
775readWriteFinally_Unfold inh devNull =
719− let readEx = UF.finally_ (\_ -> hClose inh) FH.read
776+ let readEx = UF.finally_ (\_ -> hClose inh) FH.reader
720− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
777+ in S.fold (FH.write devNull) $ S.unfold readEx inh
721
778
722#ifdef INSPECTION
779#ifdef INSPECTION
780+#if __GLASGOW_HASKELL__ >= 906
781+inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]
782+#else
723inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
783inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
784+#endif
724-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
785-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
725#endif
786#endif
726
787
727readWriteFinallyUnfold :: Handle -> Handle -> IO ()
788readWriteFinallyUnfold :: Handle -> Handle -> IO ()
728readWriteFinallyUnfold inh devNull =
789readWriteFinallyUnfold inh devNull =
729− let readEx = UF.finally (\_ -> hClose inh) FH.read
790+ let readEx = UF.finally (\_ -> hClose inh) FH.reader
730− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
791+ in S.fold (FH.write devNull) $ S.unfold readEx inh
731
792
732-- | Send the file contents to /dev/null with exception handling
793-- | Send the file contents to /dev/null with exception handling
733readWriteBracket_Unfold :: Handle -> Handle -> IO ()
794readWriteBracket_Unfold :: Handle -> Handle -> IO ()
734readWriteBracket_Unfold inh devNull =
795readWriteBracket_Unfold inh devNull =
735− let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
796+ let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader
736− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
797+ in S.fold (FH.write devNull) $ S.unfold readEx inh
737
798
738#ifdef INSPECTION
799#ifdef INSPECTION
800+#if __GLASGOW_HASKELL__ >= 906
801+inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]
802+#else
739inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
803inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
804+#endif
740-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
805-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
741#endif
806#endif
742
807
743readWriteBracketUnfold :: Handle -> Handle -> IO ()
808readWriteBracketUnfold :: Handle -> Handle -> IO ()
744readWriteBracketUnfold inh devNull =
809readWriteBracketUnfold inh devNull =
745− let readEx = UF.bracket return (\_ -> hClose inh) FH.read
810+ let readEx = UF.bracket return (\_ -> hClose inh) FH.reader
746− in SP.fold (FH.write devNull) $ S.unfold readEx inh
811+ in S.fold (FH.write devNull) $ S.unfold readEx inh
747
812
748o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
813o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
749o_1_space_copy_read_exceptions env =
814o_1_space_copy_read_exceptions env =
@@ -770,13 +835,12 @@ o_1_space_copy_read_exceptions env =
770
835
771main :: IO ()
836main :: IO ()
772main = do
837main = do
773− (size, cfg, benches) <- parseCLIOpts defaultStreamSize
774 env <- mkHandleBenchEnv
838 env <- mkHandleBenchEnv
775− size `seq` runMode (mode cfg) cfg benches (allBenchmarks size env)
839+ runWithCLIOpts defaultStreamSize (allBenchmarks env)
776
840
777 where
841 where
778
842
779− allBenchmarks size env =
843+ allBenchmarks env size =
780 [ bgroup (o_1_space_prefix moduleName)
844 [ bgroup (o_1_space_prefix moduleName)
781 $ Prelude.concat
845 $ Prelude.concat
782 [ o_1_space_transformation_input size
846 [ o_1_space_transformation_input size
@@ -784,7 +848,7 @@ main = do
784 , o_1_space_transformation size
848 , o_1_space_transformation size
785 , o_1_space_filtering size
849 , o_1_space_filtering size
786 , o_1_space_zip size
850 , o_1_space_zip size
787− , o_1_space_nested size
851+ , o_1_space_nested env size
788 , o_1_space_copy_read_exceptions env
852 , o_1_space_copy_read_exceptions env
789 ]
853 ]
790 , bgroup (o_n_space_prefix moduleName)
854 , bgroup (o_n_space_prefix moduleName)
benchmark/Streamly/Benchmark/FileSystem/Handle.hs+2−7
@@ -17,16 +17,12 @@
17{-# LANGUAGE TemplateHaskell #-}
17{-# LANGUAGE TemplateHaskell #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
19#endif
20−
21−#if __GLASGOW_HASKELL__ >= 800
22−#endif
23−
24import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
20import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
25
21
26import qualified Handle.ReadWrite as RW
22import qualified Handle.ReadWrite as RW
27import qualified Handle.Read as RO
23import qualified Handle.Read as RO
28
24
29−import Gauge hiding (env)
25+import Test.Tasty.Bench hiding (env)
30import Prelude hiding (last, length)
26import Prelude hiding (last, length)
31import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
32
28
@@ -43,9 +39,8 @@ moduleName = "FileSystem.Handle"
43
39
44main :: IO ()
40main :: IO ()
45main = do
41main = do
46− (_, cfg, benches) <- parseCLIOpts defaultStreamSize
47 env <- mkHandleBenchEnv
42 env <- mkHandleBenchEnv
48− runMode (mode cfg) cfg benches (allBenchmarks env)
43+ defaultMain (allBenchmarks env)
49
44
50 where
45 where
51
46
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+71−161
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Streamly.Benchmark.FileSystem.Handle
4-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
5-- Copyright : (c) 2019 Composewell Technologies
@@ -22,132 +24,36 @@ module Handle.Read
22 (allBenchmarks)
24 (allBenchmarks)
23where
25where
24
26
25−import Data.Functor.Identity (runIdentity)
26import Data.Word (Word8)
27import Data.Word (Word8)
27import GHC.Magic (inline)
28import GHC.Magic (inline)
28−#if __GLASGOW_HASKELL__ >= 802
29import GHC.Magic (noinline)
29import GHC.Magic (noinline)
30−#else
31−#define noinline
32−#endif
33import System.IO (Handle)
30import System.IO (Handle)
34
31
32+import qualified Streamly.Data.Stream as Stream
33+import qualified Streamly.Data.Fold as Fold
35import qualified Streamly.FileSystem.Handle as FH
34import qualified Streamly.FileSystem.Handle as FH
36−import qualified Streamly.Internal.Data.Array.Foreign as A
35+import qualified Streamly.Internal.Data.Array as A
37−import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
38import qualified Streamly.Internal.Data.Fold as FL
36import qualified Streamly.Internal.Data.Fold as FL
39−import qualified Streamly.Internal.Data.Stream.IsStream as IP
37+import qualified Streamly.Internal.Data.Stream as IP
40import qualified Streamly.Internal.FileSystem.Handle as IFH
38import qualified Streamly.Internal.FileSystem.Handle as IFH
41−import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
42import qualified Streamly.Internal.Unicode.Stream as IUS
39import qualified Streamly.Internal.Unicode.Stream as IUS
43−import qualified Streamly.Prelude as S
40+import qualified Streamly.Data.Stream.Prelude as S
44import qualified Streamly.Unicode.Stream as SS
41import qualified Streamly.Unicode.Stream as SS
45
42
46−import Gauge hiding (env)
43+import Test.Tasty.Bench hiding (env)
47import Prelude hiding (last, length)
44import Prelude hiding (last, length)
48import Streamly.Benchmark.Common.Handle
45import Streamly.Benchmark.Common.Handle
49
46
50#ifdef INSPECTION
47#ifdef INSPECTION
51−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)
48+import Streamly.Internal.Data.Stream (Step(..), FoldMany)
52
49
53−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
50+import qualified Streamly.Internal.Data.MutArray as MutArray
54−import qualified Streamly.Internal.Data.Stream.StreamD as D
51+import qualified Streamly.Internal.Data.Stream as D
55import qualified Streamly.Internal.Data.Unfold as IUF
52import qualified Streamly.Internal.Data.Unfold as IUF
56
53
57import Test.Inspection
54import Test.Inspection
58#endif
55#endif
59
56
60−-------------------------------------------------------------------------------
61−-- read chunked using toChunks
62−-------------------------------------------------------------------------------
63−
64−-- | Get the last byte from a file bytestream.
65−toChunksLast :: Handle -> IO (Maybe Word8)
66−toChunksLast inh = do
67− let s = IFH.toChunks inh
68− larr <- S.last s
69− return $ case larr of
70− Nothing -> Nothing
71− Just arr -> A.readIndex arr (A.length arr - 1)
72−
73−#ifdef INSPECTION
74−inspect $ hasNoTypeClasses 'toChunksLast
75−inspect $ 'toChunksLast `hasNoType` ''Step
76−#endif
77−
78−-- | Count the number of bytes in a file.
79−toChunksSumLengths :: Handle -> IO Int
80−toChunksSumLengths inh =
81− let s = IFH.toChunks inh
82− in S.sum (S.map A.length s)
83−
84−#ifdef INSPECTION
85−inspect $ hasNoTypeClasses 'toChunksSumLengths
86−inspect $ 'toChunksSumLengths `hasNoType` ''Step
87−#endif
88−
89−-- | Count the number of lines in a file.
90−toChunksSplitOnSuffix :: Handle -> IO Int
91−toChunksSplitOnSuffix = S.length . AS.splitOnSuffix 10 . IFH.toChunks
92−
93−#ifdef INSPECTION
94−inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
95−inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
96−#endif
97−
98−-- XXX use a word splitting combinator instead of splitOn and test it.
99−-- | Count the number of words in a file.
100−toChunksSplitOn :: Handle -> IO Int
101−toChunksSplitOn = S.length . AS.splitOn 32 . IFH.toChunks
102−
103−#ifdef INSPECTION
104−inspect $ hasNoTypeClasses 'toChunksSplitOn
105−inspect $ 'toChunksSplitOn `hasNoType` ''Step
106−#endif
107−
108−-- | Sum the bytes in a file.
109−toChunksCountBytes :: Handle -> IO Word8
110−toChunksCountBytes inh = do
111− let foldlArr' f z = runIdentity . S.foldl' f z . A.toStream
112− let s = IFH.toChunks inh
113− S.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
114−
115−#ifdef INSPECTION
116−inspect $ hasNoTypeClasses 'toChunksCountBytes
117−inspect $ 'toChunksCountBytes `hasNoType` ''Step
118−#endif
119−
120−toChunksDecodeUtf8Arrays :: Handle -> IO ()
121−toChunksDecodeUtf8Arrays =
122− S.drain . IUS.decodeUtf8Arrays . IFH.toChunks
123−
124−#ifdef INSPECTION
125−inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
126−-- inspect $ 'toChunksDecodeUtf8ArraysLenient `hasNoType` ''Step
127−#endif
128−
129−o_1_space_read_chunked :: BenchEnv -> [Benchmark]
130−o_1_space_read_chunked env =
131− -- read using toChunks instead of read
132− [ bgroup "reduce/toChunks"
133− [ mkBench "S.last" env $ \inH _ ->
134− toChunksLast inH
135− -- Note: this cannot be fairly compared with GNU wc -c or wc -m as
136− -- wc uses lseek to just determine the file size rather than reading
137− -- and counting characters.
138− , mkBench "S.sum . S.map A.length" env $ \inH _ ->
139− toChunksSumLengths inH
140− , mkBench "AS.splitOnSuffix" env $ \inH _ ->
141− toChunksSplitOnSuffix inH
142− , mkBench "AS.splitOn" env $ \inH _ ->
143− toChunksSplitOn inH
144− , mkBench "countBytes" env $ \inH _ ->
145− toChunksCountBytes inH
146− , mkBenchSmall "US.decodeUtf8Arrays" env $ \inH _ ->
147− toChunksDecodeUtf8Arrays inH
148− ]
149− ]
150−
151-- TBD reading with unfold
57-- TBD reading with unfold
152
58
153-------------------------------------------------------------------------------
59-------------------------------------------------------------------------------
@@ -156,49 +62,49 @@ o_1_space_read_chunked env =
156
62
157-- | Get the last byte from a file bytestream.
63-- | Get the last byte from a file bytestream.
158readLast :: Handle -> IO (Maybe Word8)
64readLast :: Handle -> IO (Maybe Word8)
159−readLast = S.last . S.unfold FH.read
65+readLast = S.fold Fold.last . S.unfold FH.reader
160
66
161#ifdef INSPECTION
67#ifdef INSPECTION
162inspect $ hasNoTypeClasses 'readLast
68inspect $ hasNoTypeClasses 'readLast
163inspect $ 'readLast `hasNoType` ''Step -- S.unfold
69inspect $ 'readLast `hasNoType` ''Step -- S.unfold
164−inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
70+inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
165−inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
71+inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
166#endif
72#endif
167
73
168-- assert that flattenArrays constructors are not present
74-- assert that flattenArrays constructors are not present
169-- | Count the number of bytes in a file.
75-- | Count the number of bytes in a file.
170readCountBytes :: Handle -> IO Int
76readCountBytes :: Handle -> IO Int
171−readCountBytes = S.length . S.unfold FH.read
77+readCountBytes = S.fold Fold.length . S.unfold FH.reader
172
78
173#ifdef INSPECTION
79#ifdef INSPECTION
174inspect $ hasNoTypeClasses 'readCountBytes
80inspect $ hasNoTypeClasses 'readCountBytes
175inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
81inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
176−inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
82+inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
177−inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
83+inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
178#endif
84#endif
179
85
180-- | Count the number of lines in a file.
86-- | Count the number of lines in a file.
181readCountLines :: Handle -> IO Int
87readCountLines :: Handle -> IO Int
182readCountLines =
88readCountLines =
183− S.length
89+ S.fold Fold.length
184 . IUS.lines FL.drain
90 . IUS.lines FL.drain
185 . SS.decodeLatin1
91 . SS.decodeLatin1
186− . S.unfold FH.read
92+ . S.unfold FH.reader
187
93
188#ifdef INSPECTION
94#ifdef INSPECTION
189inspect $ hasNoTypeClasses 'readCountLines
95inspect $ hasNoTypeClasses 'readCountLines
190inspect $ 'readCountLines `hasNoType` ''Step
96inspect $ 'readCountLines `hasNoType` ''Step
191−inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
97+inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
192−inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
98+inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
193#endif
99#endif
194
100
195-- | Count the number of words in a file.
101-- | Count the number of words in a file.
196readCountWords :: Handle -> IO Int
102readCountWords :: Handle -> IO Int
197readCountWords =
103readCountWords =
198− S.length
104+ S.fold Fold.length
199 . IUS.words FL.drain
105 . IUS.words FL.drain
200 . SS.decodeLatin1
106 . SS.decodeLatin1
201− . S.unfold FH.read
107+ . S.unfold FH.reader
202
108
203#ifdef INSPECTION
109#ifdef INSPECTION
204inspect $ hasNoTypeClasses 'readCountWords
110inspect $ hasNoTypeClasses 'readCountWords
@@ -207,13 +113,13 @@ inspect $ hasNoTypeClasses 'readCountWords
207
113
208-- | Sum the bytes in a file.
114-- | Sum the bytes in a file.
209readSumBytes :: Handle -> IO Word8
115readSumBytes :: Handle -> IO Word8
210−readSumBytes = S.sum . S.unfold FH.read
116+readSumBytes = S.fold Fold.sum . S.unfold FH.reader
211
117
212#ifdef INSPECTION
118#ifdef INSPECTION
213inspect $ hasNoTypeClasses 'readSumBytes
119inspect $ hasNoTypeClasses 'readSumBytes
214inspect $ 'readSumBytes `hasNoType` ''Step
120inspect $ 'readSumBytes `hasNoType` ''Step
215−inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
121+inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
216−inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
122+inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
217#endif
123#endif
218
124
219-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
125-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
@@ -227,21 +133,21 @@ inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
227-- fusion-plugin to propagate INLINE phase information such that this problem
133-- fusion-plugin to propagate INLINE phase information such that this problem
228-- does not occur.
134-- does not occur.
229readDrain :: Handle -> IO ()
135readDrain :: Handle -> IO ()
230−readDrain inh = S.drain $ S.unfold FH.read inh
136+readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh
231
137
232-- XXX investigate why we need an INLINE in this case (GHC)
138-- XXX investigate why we need an INLINE in this case (GHC)
233{-# INLINE readDecodeLatin1 #-}
139{-# INLINE readDecodeLatin1 #-}
234readDecodeLatin1 :: Handle -> IO ()
140readDecodeLatin1 :: Handle -> IO ()
235readDecodeLatin1 inh =
141readDecodeLatin1 inh =
236− S.drain
142+ S.fold Fold.drain
237 $ SS.decodeLatin1
143 $ SS.decodeLatin1
238− $ S.unfold FH.read inh
144+ $ S.unfold FH.reader inh
239
145
240readDecodeUtf8 :: Handle -> IO ()
146readDecodeUtf8 :: Handle -> IO ()
241readDecodeUtf8 inh =
147readDecodeUtf8 inh =
242− S.drain
148+ S.fold Fold.drain
243 $ SS.decodeUtf8
149 $ SS.decodeUtf8
244− $ S.unfold FH.read inh
150+ $ S.unfold FH.reader inh
245
151
246#ifdef INSPECTION
152#ifdef INSPECTION
247inspect $ hasNoTypeClasses 'readDecodeUtf8
153inspect $ hasNoTypeClasses 'readDecodeUtf8
@@ -280,25 +186,25 @@ o_1_space_reduce_read env =
280-------------------------------------------------------------------------------
186-------------------------------------------------------------------------------
281
187
282-- | Count the number of lines in a file.
188-- | Count the number of lines in a file.
283−toChunksConcatUnfoldCountLines :: Handle -> IO Int
189+getChunksConcatUnfoldCountLines :: Handle -> IO Int
284−toChunksConcatUnfoldCountLines inh =
190+getChunksConcatUnfoldCountLines inh =
285− S.length
191+ S.fold Fold.length
286 $ IUS.lines FL.drain
192 $ IUS.lines FL.drain
287 $ SS.decodeLatin1
193 $ SS.decodeLatin1
288 -- XXX replace with toBytes
194 -- XXX replace with toBytes
289− $ S.concatUnfold A.read (IFH.toChunks inh)
195+ $ S.unfoldMany A.reader (IFH.readChunks inh)
290
196
291#ifdef INSPECTION
197#ifdef INSPECTION
292−inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
198+inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines
293−inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
199+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step
294−inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
200+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
295#endif
201#endif
296
202
297o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
203o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
298o_1_space_reduce_toBytes env =
204o_1_space_reduce_toBytes env =
299 [ bgroup "reduce/toBytes"
205 [ bgroup "reduce/toBytes"
300 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
206 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
301− toChunksConcatUnfoldCountLines inh
207+ getChunksConcatUnfoldCountLines inh
302 ]
208 ]
303 ]
209 ]
304
210
@@ -307,46 +213,51 @@ o_1_space_reduce_toBytes env =
307-------------------------------------------------------------------------------
213-------------------------------------------------------------------------------
308
214
309chunksOfSum :: Int -> Handle -> IO Int
215chunksOfSum :: Int -> Handle -> IO Int
216+chunksOfSum n inh =
310−chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
217+ S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh)
311
218
312foldManyPostChunksOfSum :: Int -> Handle -> IO Int
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
313foldManyPostChunksOfSum n inh =
220foldManyPostChunksOfSum n inh =
221+ S.fold Fold.length
314− S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.read inh)
222+ $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh)
315
223
316foldManyChunksOfSum :: Int -> Handle -> IO Int
224foldManyChunksOfSum :: Int -> Handle -> IO Int
317foldManyChunksOfSum n inh =
225foldManyChunksOfSum n inh =
226+ S.fold Fold.length
318− S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.read inh)
227+ $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh)
319
228
320-- XXX investigate why we need an INLINE in this case (GHC)
229-- XXX investigate why we need an INLINE in this case (GHC)
321-- Even though allocations remain the same in both cases inlining improves time
230-- Even though allocations remain the same in both cases inlining improves time
322-- by 4x.
231-- by 4x.
323-- | Slice in chunks of size n and get the count of chunks.
232-- | Slice in chunks of size n and get the count of chunks.
324−{-# INLINE chunksOf #-}
233+{-# INLINE groupsOf #-}
325−chunksOf :: Int -> Handle -> IO Int
234+groupsOf :: Int -> Handle -> IO Int
326−chunksOf n inh =
235+groupsOf n inh =
327 -- writeNUnsafe gives 2.5x boost here over writeN.
236 -- writeNUnsafe gives 2.5x boost here over writeN.
237+ S.fold Fold.length
328− S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
238+ $ IP.groupsOf n (A.writeNUnsafe n) (S.unfold FH.reader inh)
329
239
330#ifdef INSPECTION
240#ifdef INSPECTION
331−inspect $ hasNoTypeClasses 'chunksOf
241+inspect $ hasNoTypeClasses 'groupsOf
332−inspect $ 'chunksOf `hasNoType` ''Step
242+inspect $ 'groupsOf `hasNoType` ''Step
333−inspect $ 'chunksOf `hasNoType` ''FoldMany
243+inspect $ 'groupsOf `hasNoType` ''FoldMany
334−inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
244+inspect $ 'groupsOf `hasNoType` ''MutArray.ArrayUnsafe -- AT.writeNUnsafe
245+ -- FH.read/A.read
335−inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
246+inspect $ 'groupsOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
336−inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
337#endif
247#endif
338
248
339−{-# INLINE arraysOf #-}
249+{-# INLINE chunksOf #-}
340−arraysOf :: Int -> Handle -> IO Int
250+chunksOf :: Int -> Handle -> IO Int
251+chunksOf n inh =
341−arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)
252+ S.fold Fold.length $ Stream.chunksOf n (S.unfold FH.reader inh)
342
253
343o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
254o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
344o_1_space_reduce_read_grouped env =
255o_1_space_reduce_read_grouped env =
345 [ bgroup "reduce/read/chunks"
256 [ bgroup "reduce/read/chunks"
346− [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
257+ [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $
347 \inh _ ->
258 \inh _ ->
348 chunksOfSum (bigSize env) inh
259 chunksOfSum (bigSize env) inh
349− , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
260+ , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->
350 chunksOfSum 1 inh
261 chunksOfSum 1 inh
351
262
352 -- XXX investigate why we need inline/noinline in these cases (GHC)
263 -- XXX investigate why we need inline/noinline in these cases (GHC)
@@ -369,27 +280,26 @@ o_1_space_reduce_read_grouped env =
369 $ \inh _ -> inline foldManyChunksOfSum 1 inh
280 $ \inh _ -> inline foldManyChunksOfSum 1 inh
370
281
371 -- folding chunks to arrays
282 -- 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
372 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
291 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
373 chunksOf 1 inh
292 chunksOf 1 inh
374 , mkBench "S.chunksOf 10" env $ \inh _ ->
293 , mkBench "S.chunksOf 10" env $ \inh _ ->
375 chunksOf 10 inh
294 chunksOf 10 inh
376 , mkBench "S.chunksOf 1000" env $ \inh _ ->
295 , mkBench "S.chunksOf 1000" env $ \inh _ ->
377 chunksOf 1000 inh
296 chunksOf 1000 inh
378−
379− -- arraysOf may use a different impl than chunksOf
380− , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
381− arraysOf 1 inh
382− , mkBench "S.arraysOf 10" env $ \inh _ ->
383− arraysOf 10 inh
384− , mkBench "S.arraysOf 1000" env $ \inh _ ->
385− arraysOf 1000 inh
386 ]
297 ]
387 ]
298 ]
388
299
389allBenchmarks :: BenchEnv -> [Benchmark]
300allBenchmarks :: BenchEnv -> [Benchmark]
390allBenchmarks env = Prelude.concat
301allBenchmarks env = Prelude.concat
391− [ o_1_space_read_chunked env
392− , o_1_space_reduce_read env
302+ [ o_1_space_reduce_read env
393 , o_1_space_reduce_toBytes env
303 , o_1_space_reduce_toBytes env
394 , o_1_space_reduce_read_grouped env
304 , o_1_space_reduce_read_grouped env
395 ]
305 ]
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+52−100
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Streamly.Benchmark.FileSystem.Handle
4-- Module : Streamly.Benchmark.FileSystem.Handle
3-- Copyright : (c) 2019 Composewell Technologies
5-- Copyright : (c) 2019 Composewell Technologies
@@ -24,27 +26,23 @@ where
24
26
25import System.IO (Handle)
27import System.IO (Handle)
26import Prelude hiding (last, length)
28import Prelude hiding (last, length)
27−import Streamly.Internal.Data.Array.Foreign.Type (defaultChunkSize)
29+import Streamly.Internal.System.IO (defaultChunkSize)
28
30
29import qualified Streamly.FileSystem.Handle as FH
31import qualified Streamly.FileSystem.Handle as FH
30import qualified Streamly.Internal.Data.Unfold as IUF
32import qualified Streamly.Internal.Data.Unfold as IUF
31import qualified Streamly.Internal.FileSystem.Handle as IFH
33import qualified Streamly.Internal.FileSystem.Handle as IFH
32−import qualified Streamly.Internal.Data.Array.Stream.Foreign as AS
34+import qualified Streamly.Data.Array as A
33−import qualified Streamly.Data.Array.Foreign as A
35+import qualified Streamly.Data.Stream.Prelude as S
34−import qualified Streamly.Prelude as S
35
36
36−import Gauge hiding (env)
37+import Test.Tasty.Bench hiding (env)
37import Streamly.Benchmark.Common.Handle
38import Streamly.Benchmark.Common.Handle
38
39
39#ifdef INSPECTION
40#ifdef INSPECTION
40−import Foreign.Storable (Storable)
41−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
41+import Streamly.Internal.Data.Stream (Step(..))
42
42
43−import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
43+import qualified Streamly.Internal.Data.Stream as D
44import qualified Streamly.Internal.Data.Tuple.Strict as Strict
44import qualified Streamly.Internal.Data.Tuple.Strict as Strict
45−import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS
45+import qualified Streamly.Internal.Data.MutArray as MutArray
46−import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
47−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
48
46
49import Test.Inspection
47import Test.Inspection
50#endif
48#endif
@@ -55,7 +53,7 @@ import Test.Inspection
55
53
56-- | Copy file
54-- | Copy file
57copyChunks :: Handle -> Handle -> IO ()
55copyChunks :: Handle -> Handle -> IO ()
58−copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
56+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh
59
57
60#ifdef INSPECTION
58#ifdef INSPECTION
61inspect $ hasNoTypeClasses 'copyChunks
59inspect $ hasNoTypeClasses 'copyChunks
@@ -64,7 +62,7 @@ inspect $ 'copyChunks `hasNoType` ''Step
64
62
65o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
63o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
66o_1_space_copy_chunked env =
64o_1_space_copy_chunked env =
67− [ bgroup "copy/toChunks"
65+ [ bgroup "copy/getChunks"
68 [ mkBench "toNull" env $ \inH _ ->
66 [ mkBench "toNull" env $ \inH _ ->
69 copyChunks inH (nullH env)
67 copyChunks inH (nullH env)
70 , mkBench "raw" env $ \inH outH ->
68 , mkBench "raw" env $ \inH outH ->
@@ -78,14 +76,14 @@ o_1_space_copy_chunked env =
78
76
79-- | Copy file
77-- | Copy file
80copyStream :: Handle -> Handle -> IO ()
78copyStream :: Handle -> Handle -> IO ()
81−copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read inh)
79+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.reader inh)
82
80
83#ifdef INSPECTION
81#ifdef INSPECTION
84inspect $ hasNoTypeClasses 'copyStream
82inspect $ hasNoTypeClasses 'copyStream
85inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
83inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
86−inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
84+inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
87−inspect $ 'copyStream `hasNoType` ''MA.ReadUState -- FH.read/A.read
88−inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
85+inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
86+ -- FH.read/A.read
89inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
87inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
90#endif
88#endif
91
89
@@ -105,95 +103,92 @@ o_1_space_copy_read env =
105
103
106-- | Send the file contents to /dev/null
104-- | Send the file contents to /dev/null
107readFromBytesNull :: Handle -> Handle -> IO ()
105readFromBytesNull :: Handle -> Handle -> IO ()
108−readFromBytesNull inh devNull = IFH.fromBytes devNull $ S.unfold FH.read inh
106+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh
109
107
110#ifdef INSPECTION
108#ifdef INSPECTION
111inspect $ hasNoTypeClasses 'readFromBytesNull
109inspect $ hasNoTypeClasses 'readFromBytesNull
112inspect $ 'readFromBytesNull `hasNoType` ''Step
110inspect $ 'readFromBytesNull `hasNoType` ''Step
113−inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState
111+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.SpliceState
114−inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
112+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
115inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
113inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
116#endif
114#endif
117
115
118-- | Send the file contents ('defaultChunkSize') to /dev/null
116-- | Send the file contents ('defaultChunkSize') to /dev/null
119−readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
117+readWithFromBytesNull :: Handle -> Handle -> IO ()
120−readWithBufferOfFromBytesNull inh devNull =
118+readWithFromBytesNull inh devNull =
121− IFH.fromBytes devNull
119+ IFH.putBytes devNull
122− $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
120+ $ S.unfold FH.readerWith (defaultChunkSize, inh)
123
121
124#ifdef INSPECTION
122#ifdef INSPECTION
125−inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
123+inspect $ hasNoTypeClasses 'readWithFromBytesNull
126−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
124+inspect $ 'readWithFromBytesNull `hasNoType` ''Step
127−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState
125+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.SpliceState
128−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
126+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
129−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.FoldMany
127+inspect $ 'readWithFromBytesNull `hasNoType` ''D.FoldMany
130#endif
128#endif
131
129
132-- | Send the chunk content ('defaultChunkSize') to /dev/null
130-- | Send the chunk content ('defaultChunkSize') to /dev/null
133-- Implicitly benchmarked via 'readFromBytesNull'
131-- Implicitly benchmarked via 'readFromBytesNull'
134_readChunks :: Handle -> Handle -> IO ()
132_readChunks :: Handle -> Handle -> IO ()
135−_readChunks inh devNull = IUF.fold unf fld inh
133+_readChunks inh devNull = IUF.fold fld unf inh
136
134
137 where
135 where
138
136
139 fld = FH.write devNull
137 fld = FH.write devNull
140− unf = IUF.concat FH.readChunks A.read
138+ unf = IUF.many A.reader FH.chunkReader
141
139
142-- | Send the chunk content to /dev/null
140-- | Send the chunk content to /dev/null
143−-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
141+-- Implicitly benchmarked via 'readWithFromBytesNull'
144−_readChunksWithBufferOf :: Handle -> Handle -> IO ()
142+_readChunksWith :: Handle -> Handle -> IO ()
145−_readChunksWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
143+_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
146
144
147 where
145 where
148
146
149 fld = FH.write devNull
147 fld = FH.write devNull
150− unf = IUF.concat FH.readChunksWithBufferOf A.read
148+ unf = IUF.many A.reader FH.chunkReaderWith
151−
152
149
153o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
150o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
154o_1_space_copy_fromBytes env =
151o_1_space_copy_fromBytes env =
155− [ bgroup "copy/fromBytes"
152+ [ bgroup "copy/putBytes"
156 [ mkBench "rawToNull" env $ \inh _ ->
153 [ mkBench "rawToNull" env $ \inh _ ->
157 readFromBytesNull inh (nullH env)
154 readFromBytesNull inh (nullH env)
158− , mkBench "FH.readWithBufferOf" env $ \inh _ ->
155+ , mkBench "FH.readWith" env $ \inh _ ->
159− readWithBufferOfFromBytesNull inh (nullH env)
156+ readWithFromBytesNull inh (nullH env)
160 ]
157 ]
161 ]
158 ]
162
159
163-- | Send the file contents ('defaultChunkSize') to /dev/null
160-- | Send the file contents ('defaultChunkSize') to /dev/null
164−{-# NOINLINE writeReadWithBufferOf #-}
165−writeReadWithBufferOf :: Handle -> Handle -> IO ()
161+writeReadWith :: Handle -> Handle -> IO ()
166−writeReadWithBufferOf inh devNull = IUF.fold unf fld (defaultChunkSize, inh)
162+writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
167
163
168 where
164 where
169
165
170− fld = FH.writeWithBufferOf defaultChunkSize devNull
166+ fld = FH.writeWith defaultChunkSize devNull
171− unf = FH.readWithBufferOf
167+ unf = FH.readerWith
172
168
173#ifdef INSPECTION
169#ifdef INSPECTION
174−inspect $ hasNoTypeClasses 'writeReadWithBufferOf
170+inspect $ hasNoTypeClasses 'writeReadWith
175−inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
171+inspect $ 'writeReadWith `hasNoType` ''Step
176−inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
172+inspect $ 'writeReadWith `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
177−inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
178−inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
173+inspect $ 'writeReadWith `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
174+ -- FH.read/A.read
179#endif
175#endif
180
176
181-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
177-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
182−{-# NOINLINE writeRead #-}
183writeRead :: Handle -> Handle -> IO ()
178writeRead :: Handle -> Handle -> IO ()
184−writeRead inh devNull = IUF.fold unf fld inh
179+writeRead inh devNull = IUF.fold fld unf inh
185
180
186 where
181 where
187
182
188 fld = FH.write devNull
183 fld = FH.write devNull
189− unf = FH.read
184+ unf = FH.reader
190
185
191#ifdef INSPECTION
186#ifdef INSPECTION
192inspect $ hasNoTypeClasses 'writeRead
187inspect $ hasNoTypeClasses 'writeRead
193inspect $ 'writeRead `hasNoType` ''Step
188inspect $ 'writeRead `hasNoType` ''Step
194−inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.concat
189+inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
195−inspect $ 'writeRead `hasNoType` ''MA.ReadUState -- FH.read/A.read
196−inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
190+inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
191+ -- FH.read/A.read
197#endif
192#endif
198
193
199o_1_space_copy :: BenchEnv -> [Benchmark]
194o_1_space_copy :: BenchEnv -> [Benchmark]
@@ -201,53 +196,11 @@ o_1_space_copy env =
201 [ bgroup "copy"
196 [ bgroup "copy"
202 [ mkBench "FH.write . FH.read" env $ \inh _ ->
197 [ mkBench "FH.write . FH.read" env $ \inh _ ->
203 writeRead inh (nullH env)
198 writeRead inh (nullH env)
204− , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
199+ , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->
205− writeReadWithBufferOf inh (nullH env)
200+ writeReadWith inh (nullH env)
206 ]
201 ]
207 ]
202 ]
208
203
209−-------------------------------------------------------------------------------
210−-- copy with group/ungroup transformations
211−-------------------------------------------------------------------------------
212−
213−-- | Lines and unlines
214−copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
215−copyChunksSplitInterposeSuffix inh outh =
216− S.fold (IFH.write outh)
217− $ AS.interposeSuffix 10
218− $ AS.splitOnSuffix 10
219− $ IFH.toChunks inh
220−
221−#ifdef INSPECTION
222−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
223−inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
224−#endif
225−
226−-- | Words and unwords
227−copyChunksSplitInterpose :: Handle -> Handle -> IO ()
228−copyChunksSplitInterpose inh outh =
229− S.fold (IFH.write outh)
230− $ AS.interpose 32
231− -- XXX this is not correct word splitting combinator
232− $ AS.splitOn 32
233− $ IFH.toChunks inh
234−
235−#ifdef INSPECTION
236−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
237−inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
238−#endif
239−
240−o_1_space_copy_toChunks_group_ungroup :: BenchEnv -> [Benchmark]
241−o_1_space_copy_toChunks_group_ungroup env =
242− [ bgroup "copy/toChunks/group-ungroup"
243− [ mkBench "AS.interposeSuffix . AS.splitOnSuffix" env $ \inh outh ->
244− copyChunksSplitInterposeSuffix inh outh
245− , mkBenchSmall "AS.interpose . AS.splitOn" env $ \inh outh ->
246− copyChunksSplitInterpose inh outh
247− ]
248− ]
249−
250−
251-------------------------------------------------------------------------------
204-------------------------------------------------------------------------------
252--
205--
253-------------------------------------------------------------------------------
206-------------------------------------------------------------------------------
@@ -258,5 +211,4 @@ allBenchmarks env = Prelude.concat
258 , o_1_space_copy_read env
211 , o_1_space_copy_read env
259 , o_1_space_copy_fromBytes env
212 , o_1_space_copy_fromBytes env
260 , o_1_space_copy env
213 , o_1_space_copy env
261− , o_1_space_copy_toChunks_group_ungroup env
262 ]
214 ]
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+51−39
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -8,7 +10,7 @@
8import Control.Concurrent (threadDelay)
10import Control.Concurrent (threadDelay)
9import Control.Monad (when)
11import Control.Monad (when)
10import Control.Monad.IO.Class (liftIO)
12import Control.Monad.IO.Class (liftIO)
11−import Gauge
13+import Test.Tasty.Bench
12import Streamly.Prelude as S
14import Streamly.Prelude as S
13import System.Random (randomRIO)
15import System.Random (randomRIO)
14
16
@@ -19,6 +21,9 @@ import System.Random (randomRIO)
19-- Also, the worker dispatch depends on the worker dispatch latency which is
21-- Also, the worker dispatch depends on the worker dispatch latency which is
20-- set to fixed 200 us. We need to keep that in mind when designing tests.
22-- set to fixed 200 us. We need to keep that in mind when designing tests.
21
23
24+moduleName :: String
25+moduleName = "Prelude.Adaptive"
26+
22value :: Int
27value :: Int
23value = 1000
28value = 1000
24
29
@@ -31,11 +36,14 @@ source range = S.replicateM value $ do
31
36
32{-# INLINE run #-}
37{-# INLINE run #-}
33run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()
38run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()
34−run srange crange t = S.drain $ do
39+run srange crange t = S.drain $ S.mapM action (t $ source srange)
35− n <- t $ source srange
40+
41+ where
42+
43+ action x = liftIO $ do
36− d <- liftIO (randomRIO crange)
44+ d <- randomRIO crange
37− when (d /= 0) $ liftIO $ threadDelay d
45+ when (d /= 0) $ threadDelay d
38− return n
46+ return x
39
47
40low, medium, high :: Int
48low, medium, high :: Int
41low = 10
49low = 10
@@ -78,54 +86,58 @@ randomVar = run (low,high) (low,high)
78
86
79main :: IO ()
87main :: IO ()
80main =
88main =
81− defaultMain
89+ defaultMain [bgroup moduleName allBenchmarks]
90+
91+ where
92+
93+ allBenchmarks =
82 [
94 [
83 bgroup "serialConstantSlowConsumer"
95 bgroup "serialConstantSlowConsumer"
84− [ bench "serially" $ nfIO $ alwaysConstSlowSerial serially
96+ [ bench "serially" $ nfIO $ alwaysConstSlowSerial fromSerial
85− , bench "wSerially" $ nfIO $ alwaysConstSlowSerial wSerially
97+ , bench "wSerially" $ nfIO $ alwaysConstSlowSerial fromWSerial
86 ]
98 ]
87 , bgroup "default"
99 , bgroup "default"
88− [ bench "serially" $ nfIO $ noDelay serially
100+ [ bench "serially" $ nfIO $ noDelay fromSerial
89− , bench "wSerially" $ nfIO $ noDelay wSerially
101+ , bench "wSerially" $ nfIO $ noDelay fromWSerial
90− , bench "aheadly" $ nfIO $ noDelay aheadly
102+ , bench "aheadly" $ nfIO $ noDelay fromAhead
91− , bench "asyncly" $ nfIO $ noDelay asyncly
103+ , bench "asyncly" $ nfIO $ noDelay fromAsync
92− , bench "wAsyncly" $ nfIO $ noDelay wAsyncly
104+ , bench "wAsyncly" $ nfIO $ noDelay fromWAsync
93− , bench "parallely" $ nfIO $ noDelay parallely
105+ , bench "parallely" $ nfIO $ noDelay fromParallel
94 ]
106 ]
95 , bgroup "constantSlowConsumer"
107 , bgroup "constantSlowConsumer"
96− [ bench "aheadly" $ nfIO $ alwaysConstSlow aheadly
108+ [ bench "aheadly" $ nfIO $ alwaysConstSlow fromAhead
97− , bench "asyncly" $ nfIO $ alwaysConstSlow asyncly
109+ , bench "asyncly" $ nfIO $ alwaysConstSlow fromAsync
98− , bench "wAsyncly" $ nfIO $ alwaysConstSlow wAsyncly
110+ , bench "wAsyncly" $ nfIO $ alwaysConstSlow fromWAsync
99− , bench "parallely" $ nfIO $ alwaysConstSlow parallely
111+ , bench "parallely" $ nfIO $ alwaysConstSlow fromParallel
100 ]
112 ]
101 , bgroup "constantFastConsumer"
113 , bgroup "constantFastConsumer"
102− [ bench "aheadly" $ nfIO $ alwaysConstFast aheadly
114+ [ bench "aheadly" $ nfIO $ alwaysConstFast fromAhead
103− , bench "asyncly" $ nfIO $ alwaysConstFast asyncly
115+ , bench "asyncly" $ nfIO $ alwaysConstFast fromAsync
104− , bench "wAsyncly" $ nfIO $ alwaysConstFast wAsyncly
116+ , bench "wAsyncly" $ nfIO $ alwaysConstFast fromWAsync
105− , bench "parallely" $ nfIO $ alwaysConstFast parallely
117+ , bench "parallely" $ nfIO $ alwaysConstFast fromParallel
106 ]
118 ]
107 , bgroup "variableSlowConsumer"
119 , bgroup "variableSlowConsumer"
108− [ bench "aheadly" $ nfIO $ alwaysVarSlow aheadly
120+ [ bench "aheadly" $ nfIO $ alwaysVarSlow fromAhead
109− , bench "asyncly" $ nfIO $ alwaysVarSlow asyncly
121+ , bench "asyncly" $ nfIO $ alwaysVarSlow fromAsync
110− , bench "wAsyncly" $ nfIO $ alwaysVarSlow wAsyncly
122+ , bench "wAsyncly" $ nfIO $ alwaysVarSlow fromWAsync
111− , bench "parallely" $ nfIO $ alwaysVarSlow parallely
123+ , bench "parallely" $ nfIO $ alwaysVarSlow fromParallel
112 ]
124 ]
113 , bgroup "variableFastConsumer"
125 , bgroup "variableFastConsumer"
114− [ bench "aheadly" $ nfIO $ alwaysVarFast aheadly
126+ [ bench "aheadly" $ nfIO $ alwaysVarFast fromAhead
115− , bench "asyncly" $ nfIO $ alwaysVarFast asyncly
127+ , bench "asyncly" $ nfIO $ alwaysVarFast fromAsync
116− , bench "wAsyncly" $ nfIO $ alwaysVarFast wAsyncly
128+ , bench "wAsyncly" $ nfIO $ alwaysVarFast fromWAsync
117− , bench "parallely" $ nfIO $ alwaysVarFast parallely
129+ , bench "parallely" $ nfIO $ alwaysVarFast fromParallel
118 ]
130 ]
119 , bgroup "variableSometimesFastConsumer"
131 , bgroup "variableSometimesFastConsumer"
120− [ bench "aheadly" $ nfIO $ runVarSometimesFast aheadly
132+ [ bench "aheadly" $ nfIO $ runVarSometimesFast fromAhead
121− , bench "asyncly" $ nfIO $ runVarSometimesFast asyncly
133+ , bench "asyncly" $ nfIO $ runVarSometimesFast fromAsync
122− , bench "wAsyncly" $ nfIO $ runVarSometimesFast wAsyncly
134+ , bench "wAsyncly" $ nfIO $ runVarSometimesFast fromWAsync
123− , bench "parallely" $ nfIO $ runVarSometimesFast parallely
135+ , bench "parallely" $ nfIO $ runVarSometimesFast fromParallel
124 ]
136 ]
125 , bgroup "variableFullOverlap"
137 , bgroup "variableFullOverlap"
126− [ bench "aheadly" $ nfIO $ randomVar aheadly
138+ [ bench "aheadly" $ nfIO $ randomVar fromAhead
127− , bench "asyncly" $ nfIO $ randomVar asyncly
139+ , bench "asyncly" $ nfIO $ randomVar fromAsync
128− , bench "wAsyncly" $ nfIO $ randomVar wAsyncly
140+ , bench "wAsyncly" $ nfIO $ randomVar fromWAsync
129− , bench "parallely" $ nfIO $ randomVar parallely
141+ , bench "parallely" $ nfIO $ randomVar fromParallel
130 ]
142 ]
131 ]
143 ]
benchmark/Streamly/Benchmark/Prelude/Ahead.hs+30−30
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -7,13 +9,13 @@
7
9
8import Prelude hiding (mapM)
10import Prelude hiding (mapM)
9
11
10−import Streamly.Prelude (aheadly, serially, ahead, maxBuffer, maxThreads)
12+import Streamly.Prelude (fromAhead, fromSerial, ahead, maxBuffer, maxThreads)
11import qualified Streamly.Prelude as S
13import qualified Streamly.Prelude as S
12
14
13import Streamly.Benchmark.Common
15import Streamly.Benchmark.Common
14import Streamly.Benchmark.Prelude
16import Streamly.Benchmark.Prelude
15
17
16−import Gauge
18+import Test.Tasty.Bench
17
19
18moduleName :: String
20moduleName :: String
19moduleName = "Prelude.Ahead"
21moduleName = "Prelude.Ahead"
@@ -27,13 +29,13 @@ moduleName = "Prelude.Ahead"
27o_1_space_generation :: Int -> [Benchmark]
29o_1_space_generation :: Int -> [Benchmark]
28o_1_space_generation value =
30o_1_space_generation value =
29 [ bgroup "generation"
31 [ bgroup "generation"
30− [ benchIOSrc aheadly "unfoldr" (sourceUnfoldr value)
32+ [ benchIOSrc fromAhead "unfoldr" (sourceUnfoldr value)
31− , benchIOSrc aheadly "unfoldrM" (sourceUnfoldrM value)
33+ , benchIOSrc fromAhead "unfoldrM" (sourceUnfoldrM value)
32− , benchIOSrc aheadly "fromFoldable" (sourceFromFoldable value)
34+ , benchIOSrc fromAhead "fromFoldable" (sourceFromFoldable value)
33− , benchIOSrc aheadly "fromFoldableM" (sourceFromFoldableM value)
35+ , benchIOSrc fromAhead "fromFoldableM" (sourceFromFoldableM value)
34− , benchIOSrc aheadly "unfoldrM maxThreads 1"
36+ , benchIOSrc fromAhead "unfoldrM maxThreads 1"
35 (maxThreads 1 . sourceUnfoldrM value)
37 (maxThreads 1 . sourceUnfoldrM value)
36− , benchIOSrc aheadly "unfoldrM maxBuffer 1 (x/10 ops)"
38+ , benchIOSrc fromAhead "unfoldrM maxBuffer 1 (x/10 ops)"
37 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
39 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
38 ]
40 ]
39 ]
41 ]
@@ -41,9 +43,9 @@ o_1_space_generation value =
41o_1_space_mapping :: Int -> [Benchmark]
43o_1_space_mapping :: Int -> [Benchmark]
42o_1_space_mapping value =
44o_1_space_mapping value =
43 [ bgroup "mapping"
45 [ bgroup "mapping"
44− [ benchIOSink value "map" $ mapN aheadly 1
46+ [ benchIOSink value "map" $ mapN fromAhead 1
45− , benchIOSink value "fmap" $ fmapN aheadly 1
47+ , benchIOSink value "fmap" $ fmapN fromAhead 1
46− , benchIOSink value "mapM" $ mapM aheadly 1 . serially
48+ , benchIOSink value "mapM" $ mapM fromAhead 1 . fromSerial
47 ]
49 ]
48 ]
50 ]
49
51
@@ -51,17 +53,17 @@ o_1_space_concatFoldable :: Int -> [Benchmark]
51o_1_space_concatFoldable value =
53o_1_space_concatFoldable value =
52 [ bgroup
54 [ bgroup
53 "concat-foldable"
55 "concat-foldable"
54− [ benchIOSrc aheadly "foldMapWith (<>) (List)"
56+ [ benchIOSrc fromAhead "foldMapWith (<>) (List)"
55 (sourceFoldMapWith value)
57 (sourceFoldMapWith value)
56− , benchIOSrc aheadly "foldMapWith (<>) (Stream)"
58+ , benchIOSrc fromAhead "foldMapWith (<>) (Stream)"
57 (sourceFoldMapWithStream value)
59 (sourceFoldMapWithStream value)
58− , benchIOSrc aheadly "foldMapWithM (<>) (List)"
60+ , benchIOSrc fromAhead "foldMapWithM (<>) (List)"
59 (sourceFoldMapWithM value)
61 (sourceFoldMapWithM value)
60− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
62+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
61 (concatFoldableWith value)
63 (concatFoldableWith value)
62− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
64+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
63 (concatForFoldableWith value)
65 (concatForFoldableWith value)
64− , benchIOSrc aheadly "foldMapM (List)" (sourceFoldMapM value)
66+ , benchIOSrc fromAhead "foldMapM (List)" (sourceFoldMapM value)
65 ]
67 ]
66 ]
68 ]
67
69
@@ -70,7 +72,7 @@ o_1_space_concatMap value =
70 value2 `seq`
72 value2 `seq`
71 [ bgroup "concat"
73 [ bgroup "concat"
72 -- This is for comparison with foldMapWith
74 -- This is for comparison with foldMapWith
73− [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
75+ [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
74 (S.concatMapWith ahead id . sourceConcatMapId value)
76 (S.concatMapWith ahead id . sourceConcatMapId value)
75
77
76 , benchIO "concatMapWith (n of 1)"
78 , benchIO "concatMapWith (n of 1)"
@@ -93,13 +95,13 @@ o_1_space_concatMap value =
93o_1_space_outerProduct :: Int -> [Benchmark]
95o_1_space_outerProduct :: Int -> [Benchmark]
94o_1_space_outerProduct value =
96o_1_space_outerProduct value =
95 [ bgroup "monad-outer-product"
97 [ bgroup "monad-outer-product"
96− [ benchIO "toNullAp" $ toNullAp value aheadly
98+ [ benchIO "toNullAp" $ toNullAp value fromAhead
97− , benchIO "toNull" $ toNullM value aheadly
99+ , benchIO "toNull" $ toNullM value fromAhead
98− , benchIO "toNull3" $ toNullM3 value aheadly
100+ , benchIO "toNull3" $ toNullM3 value fromAhead
99− , benchIO "filterAllOut" $ filterAllOutM value aheadly
101+ , benchIO "filterAllOut" $ filterAllOutM value fromAhead
100− , benchIO "filterAllIn" $ filterAllInM value aheadly
102+ , benchIO "filterAllIn" $ filterAllInM value fromAhead
101− , benchIO "filterSome" $ filterSome value aheadly
103+ , benchIO "filterSome" $ filterSome value fromAhead
102− , benchIO "breakAfterSome" $ breakAfterSome value aheadly
104+ , benchIO "breakAfterSome" $ breakAfterSome value fromAhead
103
105
104 ]
106 ]
105 ]
107 ]
@@ -107,8 +109,8 @@ o_1_space_outerProduct value =
107o_n_space_outerProduct :: Int -> [Benchmark]
109o_n_space_outerProduct :: Int -> [Benchmark]
108o_n_space_outerProduct value =
110o_n_space_outerProduct value =
109 [ bgroup "monad-outer-product"
111 [ bgroup "monad-outer-product"
110− [ benchIO "toList" $ toListM value aheadly
112+ [ benchIO "toList" $ toListM value fromAhead
111− , benchIO "toListSome" $ toListSome value aheadly
113+ , benchIO "toListSome" $ toListSome value fromAhead
112 ]
114 ]
113 ]
115 ]
114
116
@@ -117,9 +119,7 @@ o_n_space_outerProduct value =
117-------------------------------------------------------------------------------
119-------------------------------------------------------------------------------
118
120
119main :: IO ()
121main :: IO ()
120−main = do
122+main = runWithCLIOpts defaultStreamSize allBenchmarks
121− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
122− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
123
123
124 where
124 where
125
125
benchmark/Streamly/Benchmark/Prelude/Async.hs+37−36
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -7,14 +9,14 @@
7
9
8import Prelude hiding (mapM)
10import Prelude hiding (mapM)
9
11
10−import Streamly.Prelude (asyncly, async, maxBuffer, maxThreads, serially)
12+import Streamly.Prelude (fromAsync, async, maxBuffer, maxThreads, fromSerial)
11import qualified Streamly.Prelude as S
13import qualified Streamly.Prelude as S
12−import qualified Streamly.Internal.Data.Stream.StreamK.Type as Internal
14+import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform
13
15
14import Streamly.Benchmark.Common
16import Streamly.Benchmark.Common
15import Streamly.Benchmark.Prelude
17import Streamly.Benchmark.Prelude
16
18
17−import Gauge
19+import Test.Tasty.Bench
18
20
19moduleName :: String
21moduleName :: String
20moduleName = "Prelude.Async"
22moduleName = "Prelude.Async"
@@ -27,14 +29,14 @@ o_1_space_generation :: Int -> [Benchmark]
27o_1_space_generation value =
29o_1_space_generation value =
28 -- These basically test the performance of consMAsync
30 -- These basically test the performance of consMAsync
29 [ bgroup "generation"
31 [ bgroup "generation"
30− [ benchIOSrc asyncly "unfoldr" (sourceUnfoldr value)
32+ [ benchIOSrc fromAsync "unfoldr" (sourceUnfoldr value)
31− , benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
33+ , benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)
32− , benchIOSrc asyncly "fromListM" (sourceFromListM value)
34+ , benchIOSrc fromAsync "fromListM" (sourceFromListM value)
33− , benchIOSrc asyncly "fromFoldable (List)" (sourceFromFoldable value)
35+ , benchIOSrc fromAsync "fromFoldable (List)" (sourceFromFoldable value)
34− , benchIOSrc asyncly "fromFoldableM (List)" (sourceFromFoldableM value)
36+ , benchIOSrc fromAsync "fromFoldableM (List)" (sourceFromFoldableM value)
35− , benchIOSrc asyncly "unfoldrM maxThreads 1"
37+ , benchIOSrc fromAsync "unfoldrM maxThreads 1"
36 (maxThreads 1 . sourceUnfoldrM value)
38 (maxThreads 1 . sourceUnfoldrM value)
37− , benchIOSrc asyncly "unfoldrM maxBuffer 1 (x/10 ops)"
39+ , benchIOSrc fromAsync "unfoldrM maxBuffer 1 (x/10 ops)"
38 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
40 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
39 ]
41 ]
40 ]
42 ]
@@ -47,19 +49,19 @@ o_1_space_generation value =
47foldrSShared :: Int -> Int -> IO ()
49foldrSShared :: Int -> Int -> IO ()
48foldrSShared count n =
50foldrSShared count n =
49 S.drain
51 S.drain
50− $ asyncly
52+ $ fromAsync
51− $ Internal.foldrSShared (\x xs -> S.consM (return x) xs) S.nil
53+ $ Transform.foldrSShared (\x xs -> S.consM (return x) xs) S.nil
52− $ serially
54+ $ fromSerial
53 $ sourceUnfoldrM count n
55 $ sourceUnfoldrM count n
54
56
55o_1_space_mapping :: Int -> [Benchmark]
57o_1_space_mapping :: Int -> [Benchmark]
56o_1_space_mapping value =
58o_1_space_mapping value =
57 [ bgroup "mapping"
59 [ bgroup "mapping"
58− [ benchIOSink value "map" $ mapN asyncly 1
60+ [ benchIOSink value "map" $ mapN fromAsync 1
59− , benchIOSink value "fmap" $ fmapN asyncly 1
61+ , benchIOSink value "fmap" $ fmapN fromAsync 1
60 , benchIOSrc1 "foldrSShared" (foldrSShared value)
62 , benchIOSrc1 "foldrSShared" (foldrSShared value)
61 -- This basically tests the performance of consMAsync
63 -- This basically tests the performance of consMAsync
62− , benchIOSink value "mapM" $ mapM asyncly 1 . serially
64+ , benchIOSink value "mapM" $ mapM fromAsync 1 . fromSerial
63 ]
65 ]
64 ]
66 ]
65
67
@@ -69,7 +71,7 @@ o_1_space_mapping value =
69
71
70o_n_heap_buffering :: Int -> [Benchmark]
72o_n_heap_buffering :: Int -> [Benchmark]
71o_n_heap_buffering value =
73o_n_heap_buffering value =
72− [bgroup "buffered" [benchIOSink value "mkAsync" (mkAsync asyncly)]]
74+ [bgroup "buffered" [benchIOSink value "mkAsync" (mkAsync fromAsync)]]
73
75
74-------------------------------------------------------------------------------
76-------------------------------------------------------------------------------
75-- Joining
77-- Joining
@@ -116,17 +118,17 @@ o_1_space_joining value =
116o_1_space_concatFoldable :: Int -> [Benchmark]
118o_1_space_concatFoldable :: Int -> [Benchmark]
117o_1_space_concatFoldable value =
119o_1_space_concatFoldable value =
118 [ bgroup "concat-foldable"
120 [ bgroup "concat-foldable"
119− [ benchIOSrc asyncly "foldMapWith (<>) (List)"
121+ [ benchIOSrc fromAsync "foldMapWith (<>) (List)"
120 (sourceFoldMapWith value)
122 (sourceFoldMapWith value)
121− , benchIOSrc asyncly "foldMapWith (<>) (Stream)"
123+ , benchIOSrc fromAsync "foldMapWith (<>) (Stream)"
122 (sourceFoldMapWithStream value)
124 (sourceFoldMapWithStream value)
123− , benchIOSrc asyncly "foldMapWithM (<>) (List)"
125+ , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
124 (sourceFoldMapWithM value)
126 (sourceFoldMapWithM value)
125− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
127+ , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"
126 (concatFoldableWith value)
128 (concatFoldableWith value)
127− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
129+ , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"
128 (concatForFoldableWith value)
130 (concatForFoldableWith value)
129− , benchIOSrc asyncly "foldMapM (List)" (sourceFoldMapM value)
131+ , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
130 ]
132 ]
131 ]
133 ]
132
134
@@ -136,7 +138,7 @@ o_1_space_concatMap value =
136 value2 `seq`
138 value2 `seq`
137 [ bgroup "concat"
139 [ bgroup "concat"
138 -- This is for comparison with foldMapWith
140 -- This is for comparison with foldMapWith
139− [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
141+ [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
140 (S.concatMapWith async id . sourceConcatMapId value)
142 (S.concatMapWith async id . sourceConcatMapId value)
141
143
142 , benchIO "concatMapWith (n of 1)"
144 , benchIO "concatMapWith (n of 1)"
@@ -159,13 +161,13 @@ o_1_space_concatMap value =
159o_1_space_outerProduct :: Int -> [Benchmark]
161o_1_space_outerProduct :: Int -> [Benchmark]
160o_1_space_outerProduct value =
162o_1_space_outerProduct value =
161 [ bgroup "monad-outer-product"
163 [ bgroup "monad-outer-product"
162− [ benchIO "toNullAp" $ toNullAp value asyncly
164+ [ benchIO "toNullAp" $ toNullAp value fromAsync
163− , benchIO "toNull" $ toNullM value asyncly
165+ , benchIO "toNull" $ toNullM value fromAsync
164− , benchIO "toNull3" $ toNullM3 value asyncly
166+ , benchIO "toNull3" $ toNullM3 value fromAsync
165− , benchIO "filterAllOut" $ filterAllOutM value asyncly
167+ , benchIO "filterAllOut" $ filterAllOutM value fromAsync
166− , benchIO "filterAllIn" $ filterAllInM value asyncly
168+ , benchIO "filterAllIn" $ filterAllInM value fromAsync
167− , benchIO "filterSome" $ filterSome value asyncly
169+ , benchIO "filterSome" $ filterSome value fromAsync
168− , benchIO "breakAfterSome" $ breakAfterSome value asyncly
170+ , benchIO "breakAfterSome" $ breakAfterSome value fromAsync
169
171
170 ]
172 ]
171 ]
173 ]
@@ -173,8 +175,8 @@ o_1_space_outerProduct value =
173o_n_space_outerProduct :: Int -> [Benchmark]
175o_n_space_outerProduct :: Int -> [Benchmark]
174o_n_space_outerProduct value =
176o_n_space_outerProduct value =
175 [ bgroup "monad-outer-product"
177 [ bgroup "monad-outer-product"
176− [ benchIO "toList" $ toListM value asyncly
178+ [ benchIO "toList" $ toListM value fromAsync
177− , benchIO "toListSome" $ toListSome value asyncly
179+ , benchIO "toListSome" $ toListSome value fromAsync
178 ]
180 ]
179 ]
181 ]
180
182
@@ -183,9 +185,8 @@ o_n_space_outerProduct value =
183-------------------------------------------------------------------------------
185-------------------------------------------------------------------------------
184
186
185main :: IO ()
187main :: IO ()
186−main = do
188+main = runWithCLIOpts defaultStreamSize allBenchmarks
187− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
189+
188− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
189
190
190 where
191 where
191
192
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+28−19
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+{-# LANGUAGE CPP #-}
1{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE RankNTypes #-}
2-- |
4-- |
3-- Module : Main
5-- Module : Main
@@ -8,9 +10,12 @@
8
10
9import Control.Concurrent
11import Control.Concurrent
10import Control.Monad (when, replicateM)
12import Control.Monad (when, replicateM)
13+import Streamly.Prelude
14+ ( IsStream, SerialT, serial, async, fromAsync, ahead, fromAhead, wAsync
15+ , fromWAsync, parallel, fromParallel
16+ )
11
17
12−import Gauge
18+import Test.Tasty.Bench
13−import Streamly.Prelude hiding (mapM_, replicateM)
14import qualified Streamly.Prelude as S
19import qualified Streamly.Prelude as S
15
20
16-------------------------------------------------------------------------------
21-------------------------------------------------------------------------------
@@ -28,8 +33,8 @@ append buflen tcount d t =
28 let work = (\i -> when (d /= 0) (threadDelay d) >> return i)
33 let work = (\i -> when (d /= 0) (threadDelay d) >> return i)
29 in S.drain
34 in S.drain
30 $ t
35 $ t
31− $ maxBuffer buflen
36+ $ S.maxBuffer buflen
32− $ maxThreads (-1)
37+ $ S.maxThreads (-1)
33 $ S.fromFoldableM $ fmap work [1..tcount]
38 $ S.fromFoldableM $ fmap work [1..tcount]
34
39
35-- | Run @threads@ concurrently, each producing streams of @elems@ elements
40-- | Run @threads@ concurrently, each producing streams of @elems@ elements
@@ -48,32 +53,33 @@ concated
48concated buflen threads d elems t =
53concated buflen threads d elems t =
49 let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)
54 let work = \i -> S.replicateM i (when (d /= 0) (threadDelay d) >> return i)
50 in S.drain
55 in S.drain
51− $ adapt
56+ $ S.adapt
52− $ maxThreads (-1)
57+ $ S.maxThreads (-1)
53− $ maxBuffer buflen
58+ $ S.maxBuffer buflen
54 $ S.concatMapWith t work
59 $ S.concatMapWith t work
55 $ S.replicate threads elems
60 $ S.replicate threads elems
56
61
57appendGroup :: Int -> Int -> Int -> [Benchmark]
62appendGroup :: Int -> Int -> Int -> [Benchmark]
58−appendGroup buflen threads delay =
63+appendGroup buflen threads usec =
59− [ -- bench "serial" $ nfIO $ append buflen threads delay serially
64+ [ -- bench "serial" $ nfIO $ append buflen threads delay fromSerial
60− bench "ahead" $ nfIO $ append buflen threads delay aheadly
65+ bench "ahead" $ nfIO $ append buflen threads usec fromAhead
61− , bench "async" $ nfIO $ append buflen threads delay asyncly
66+ , bench "async" $ nfIO $ append buflen threads usec fromAsync
62− , bench "wAsync" $ nfIO $ append buflen threads delay wAsyncly
67+ , bench "wAsync" $ nfIO $ append buflen threads usec fromWAsync
63− , bench "parallel" $ nfIO $ append buflen threads delay parallely
68+ , bench "parallel" $ nfIO $ append buflen threads usec fromParallel
64 ]
69 ]
65
70
66concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]
71concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]
67−concatGroup buflen threads delay n =
72+concatGroup buflen threads usec n =
68− [ bench "serial" $ nfIO $ concated buflen threads delay n serial
73+ [ bench "serial" $ nfIO $ concated buflen threads usec n serial
69− , bench "ahead" $ nfIO $ concated buflen threads delay n ahead
74+ , bench "ahead" $ nfIO $ concated buflen threads usec n ahead
70− , bench "async" $ nfIO $ concated buflen threads delay n async
75+ , bench "async" $ nfIO $ concated buflen threads usec n async
71− , bench "wAsync" $ nfIO $ concated buflen threads delay n wAsync
76+ , bench "wAsync" $ nfIO $ concated buflen threads usec n wAsync
72− , bench "parallel" $ nfIO $ concated buflen threads delay n parallel
77+ , bench "parallel" $ nfIO $ concated buflen threads usec n parallel
73 ]
78 ]
74
79
75main :: IO ()
80main :: IO ()
76main =
81main =
82+#ifdef MIN_VERSION_gauge
77 defaultMainWith (defaultConfig
83 defaultMainWith (defaultConfig
78 { timeLimit = Just 0
84 { timeLimit = Just 0
79 , minSamples = Just 1
85 , minSamples = Just 1
@@ -81,6 +87,9 @@ main =
81 , includeFirstIter = True
87 , includeFirstIter = True
82 , quickMode = True
88 , quickMode = True
83 })
89 })
90+#else
91+ defaultMain
92+#endif
84
93
85 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
94 [ -- bgroup "append/buf-1-threads-10k-0sec" (appendGroup 1 10000 0)
86 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
95 -- , bgroup "append/buf-100-threads-100k-0sec" (appendGroup 100 100000 0)
benchmark/Streamly/Benchmark/Prelude/Merge.hsnew file+298
@@ -0,0 +1,298 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
3+-- |
4+-- Module : Main
5+-- Copyright : (c) 2018 Composewell Technologies
6+--
7+-- License : BSD3
8+-- Maintainer : streamly@composewell.com
9+
10+{-# LANGUAGE BangPatterns #-}
11+{-# LANGUAGE CPP #-}
12+{-# LANGUAGE FlexibleContexts #-}
13+{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE RankNTypes #-}
15+
16+#ifdef __HADDOCK_VERSION__
17+#undef INSPECTION
18+#endif
19+
20+#ifdef INSPECTION
21+{-# LANGUAGE TemplateHaskell #-}
22+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23+#endif
24+
25+import Streamly.Internal.Data.Stream.IsStream (SerialT)
26+import qualified Data.List as List
27+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
28+-- import qualified Streamly.Internal.Data.Unfold as Unfold
29+
30+import Streamly.Benchmark.Common
31+import Streamly.Benchmark.Prelude
32+
33+import Test.Tasty.Bench
34+
35+#ifdef INSPECTION
36+import GHC.Types (SPEC(..))
37+import Test.Inspection
38+
39+import qualified Streamly.Internal.Data.Stream as D
40+#endif
41+
42+moduleName :: String
43+moduleName = "Prelude.Merge"
44+
45+-------------------------------------------------------------------------------
46+-- Merging
47+-------------------------------------------------------------------------------
48+
49+{-# INLINE mergeWith #-}
50+mergeWith ::
51+ ( (Int -> Int -> Ordering)
52+ -> SerialT IO Int
53+ -> SerialT IO Int
54+ -> SerialT IO Int
55+ )
56+ -> (Int -> Int -> Ordering)
57+ -> Int -> Int -> IO ()
58+mergeWith g cmp count n =
59+ Stream.drain
60+ $ g
61+ cmp
62+ (sourceUnfoldrM count n)
63+ (sourceUnfoldrM count (n + 1))
64+
65+{-# INLINE mergeWithM #-}
66+mergeWithM ::
67+ ( (Int -> Int -> IO Ordering)
68+ -> SerialT IO Int
69+ -> SerialT IO Int
70+ -> SerialT IO Int
71+ )
72+ -> (Int -> Int -> Ordering)
73+ -> Int -> Int -> IO ()
74+mergeWithM g cmp count n =
75+ Stream.drain
76+ $ g
77+ (\a b -> return $ cmp a b)
78+ (sourceUnfoldrM count n)
79+ (sourceUnfoldrM count (n + 1))
80+
81+{-# INLINE mergeBy #-}
82+mergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
83+mergeBy = mergeWith Stream.mergeBy
84+
85+{-# INLINE mergeByM #-}
86+mergeByM :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
87+mergeByM = mergeWithM Stream.mergeByM
88+
89+{-# INLINE mergeByMFused #-}
90+mergeByMFused :: (Int -> Int -> Ordering) -> Int -> Int -> IO ()
91+mergeByMFused = mergeWithM Stream.mergeByMFused
92+
93+#ifdef INSPECTION
94+inspect $ hasNoTypeClasses 'mergeBy
95+inspect $ 'mergeBy `hasNoType` ''SPEC
96+inspect $ 'mergeBy `hasNoType` ''D.Step
97+
98+inspect $ hasNoTypeClasses 'mergeByM
99+inspect $ 'mergeByM `hasNoType` ''SPEC
100+inspect $ 'mergeByM `hasNoType` ''D.Step
101+
102+{-# INLINE _mergeByMFusedCheck #-}
103+_mergeByMFusedCheck :: IO ()
104+_mergeByMFusedCheck = mergeWithM Stream.mergeByMFused compare 0 0
105+
106+inspect $ hasNoTypeClasses '_mergeByMFusedCheck
107+inspect $ '_mergeByMFusedCheck `hasNoType` ''SPEC
108+inspect $ '_mergeByMFusedCheck `hasNoType` ''D.Step
109+#endif
110+
111+{-# INLINE concatPairsWithMergeBy #-}
112+concatPairsWithMergeBy :: (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
113+concatPairsWithMergeBy cmp = concatPairsWith (Stream.mergeBy cmp)
114+
115+{-# INLINE concatPairsWithMergeByFused #-}
116+concatPairsWithMergeByFused ::
117+ (Int -> Int -> Ordering) -> Int -> Int -> Int -> IO ()
118+concatPairsWithMergeByFused cmp =
119+ concatPairsWith (Stream.mergeByMFused (\x y -> return $ cmp x y))
120+
121+-------------------------------------------------------------------------------
122+-- Interleaving
123+-------------------------------------------------------------------------------
124+
125+o_1_space_joining :: Int -> [Benchmark]
126+o_1_space_joining value =
127+ [ bgroup "joining (2 of n/2)"
128+ [ benchIOSrc1
129+ "mergeBy compare"
130+ (mergeBy compare (value `div` 2))
131+ , benchIOSrc1
132+ "mergeByM compare"
133+ (mergeByM compare (value `div` 2))
134+ , benchIOSrc1
135+ "mergeByMFused compare"
136+ (mergeByMFused compare (value `div` 2))
137+
138+ , benchIOSrc1
139+ "mergeBy (flip compare)"
140+ (mergeBy (flip compare) (value `div` 2))
141+ , benchIOSrc1
142+ "mergeByM (flip compare)"
143+ (mergeByM (flip compare) (value `div` 2))
144+ , benchIOSrc1
145+ "mergeByMFused (flip compare)"
146+ (mergeByMFused (flip compare) (value `div` 2))
147+
148+ , benchIOSrc1
149+ "concatPairsWithMergeBy compare"
150+ (concatPairsWithMergeBy compare 2 (value `div` 2))
151+ , benchIOSrc1
152+ "concatPairsWithMergeBy (flip compare)"
153+ (concatPairsWithMergeBy (flip compare) 2 (value `div` 2))
154+
155+ , benchIOSrc1
156+ "concatPairsWithMergeByFused compare"
157+ (concatPairsWithMergeByFused compare 2 (value `div` 2))
158+ , benchIOSrc1
159+ "concatPairsWithMergeByFused (flip compare)"
160+ (concatPairsWithMergeByFused (flip compare) 2 (value `div` 2))
161+ ]
162+ ]
163+
164+-------------------------------------------------------------------------------
165+-- Concat
166+-------------------------------------------------------------------------------
167+
168+{-
169+{-# INLINE sourceUnfoldrMUF #-}
170+-- (count, value)
171+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int
172+sourceUnfoldrMUF count = UF.unfoldrM step
173+ where
174+ step (cnt, start) =
175+ return $
176+ if cnt > start + count
177+ then Nothing
178+ else Just (cnt, (cnt + 1, start))
179+
180+{-# INLINE unfoldManyMergeBy #-}
181+unfoldManyMergeBy :: Int -> Int -> Int -> IO ()
182+unfoldManyMergeBy outer inner n =
183+ S.drain $ (Internal.unfoldManyMergeBy compare)
184+ -- (UF.lmap return (UF.replicateM inner))
185+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
186+ (sourceUnfoldrM outer n)
187+
188+#ifdef INSPECTION
189+inspect $ hasNoTypeClasses 'unfoldManyMergeBy
190+-- inspect $ 'unfoldManyMergeBy `hasNoType` ''SPEC
191+-- inspect $ 'unfoldManyMergeBy `hasNoType`
192+-- ''D.ConcatUnfoldMergeState
193+#endif
194+-}
195+
196+{-# INLINE sortBy #-}
197+sortBy :: (Int -> Int -> Ordering) -> SerialT IO Int -> IO ()
198+sortBy cmp = Stream.drain . Stream.sortBy cmp
199+
200+{-
201+-- For fair comparison with concatPairs, removed sorted segmentation
202+{-# INLINE listSortBy #-}
203+listSortBy :: (a -> a -> Ordering) -> [a] -> [a]
204+listSortBy cmp = mergeAll . sequences
205+ where
206+ sequences = fmap (: [])
207+
208+ mergeAll [x] = x
209+ mergeAll xs = mergeAll (mergePairs xs)
210+
211+ mergePairs (a:b:xs) = let !x = merge a b
212+ in x : mergePairs xs
213+ mergePairs xs = xs
214+
215+ merge as@(a:as') bs@(b:bs')
216+ | a `cmp` b == GT = b:merge as bs'
217+ | otherwise = a:merge as' bs
218+ merge [] bs = bs
219+ merge as [] = as
220+-}
221+
222+o_n_heap_concat :: Int -> [Benchmark]
223+o_n_heap_concat value =
224+ [ bgroup "concatPairsWith"
225+ [ benchIOSrc1
226+ "concatPairsWithMergeBy compare (n of 1)"
227+ (concatPairsWithMergeBy compare value 1)
228+ , benchIOSrc1
229+ "concatPairsWithMergeBy compare (sqrtVal of sqrtVal)"
230+ (concatPairsWithMergeBy compare sqrtVal sqrtVal)
231+
232+ , benchIOSrc1
233+ "concatPairsWithMergeBy (flip compare) (n of 1)"
234+ (concatPairsWithMergeBy (flip compare) value 1)
235+ , benchIOSrc1
236+ "concatPairsWithMergeBy (flip compare) (sqrtVal of sqrtVal)"
237+ (concatPairsWithMergeBy (flip compare) sqrtVal sqrtVal)
238+
239+ , benchIOSrc1
240+ "concatPairsWithMergeByFused compare (n of 1)"
241+ (concatPairsWithMergeByFused compare value 1)
242+ , benchIOSrc1
243+ "concatPairsWithMergeByFused compare (sqrtVal of sqrtVal)"
244+ (concatPairsWithMergeByFused compare sqrtVal sqrtVal)
245+ ]
246+ -- TODO: change sourceUnfoldrM to generate alternating bigger and lower
247+ -- numbers to simulate a random input for a worst case sort benchmark. We
248+ -- can use 0 and value as two ints in the state and alternate each in the
249+ -- output streams, incrementing the lower number of decrementing the higher
250+ -- number.
251+ , bgroup "sorting"
252+ [ benchIOSink value "sortBy compare" (sortBy compare)
253+ , benchIOSink value "sortBy (flip compare)" (sortBy (flip compare))
254+ , benchIOSink value "sortBy compare randomized"
255+ (sortBy compare . Stream.map (\x -> if even x then x + 2 else x))
256+ {-
257+ , bench "sortByLists compare"
258+ $ nf (\x -> listSortBy compare [1..x]) value
259+ , bench "sortByLists (flip compare)"
260+ $ nf (\x -> listSortBy (flip compare) [1..x]) value
261+ , bench "sortByLists compare randomized"
262+ $ nf (\x -> listSortBy compare
263+ (map (\n -> if even n then n + 2 else n) [1..x])
264+ )
265+ value
266+ -}
267+ , bench "sortByLists compare"
268+ $ nf (\x -> List.sortBy compare [1..x]) value
269+ , bench "sortByLists (flip compare)"
270+ $ nf (\x -> List.sortBy (flip compare) [1..x]) value
271+ , bench "sortByLists compare randomized"
272+ $ nf (\x -> List.sortBy compare
273+ (map (\n -> if even n then n + 2 else n) [1..x])
274+ )
275+ value
276+ ]
277+ ]
278+
279+ where
280+
281+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
282+
283+-------------------------------------------------------------------------------
284+-- Main
285+-------------------------------------------------------------------------------
286+
287+-- In addition to gauge options, the number of elements in the stream can be
288+-- passed using the --stream-size option.
289+--
290+main :: IO ()
291+main = runWithCLIOpts defaultStreamSize allBenchmarks
292+
293+ where
294+
295+ allBenchmarks size =
296+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_joining size)
297+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
298+ ]
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+33−34
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -11,17 +13,16 @@ import Prelude hiding (mapM)
11
13
12import Data.Function ((&))
14import Data.Function ((&))
13import Streamly.Prelude
15import Streamly.Prelude
14− ( SerialT, parallely, parallel, serially, maxBuffer, maxThreads)
16+ ( SerialT, fromParallel, parallel, fromSerial, maxBuffer, maxThreads)
15
17
16import qualified Streamly.Prelude as S
18import qualified Streamly.Prelude as S
17import qualified Streamly.Internal.Data.Fold as FL
19import qualified Streamly.Internal.Data.Fold as FL
18−import qualified Streamly.Internal.Data.Stream.Parallel as Par
19import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20
21
21import Streamly.Benchmark.Common
22import Streamly.Benchmark.Common
22import Streamly.Benchmark.Prelude
23import Streamly.Benchmark.Prelude
23
24
24−import Gauge
25+import Test.Tasty.Bench
25
26
26moduleName :: String
27moduleName :: String
27moduleName = "Prelude.Parallel"
28moduleName = "Prelude.Parallel"
@@ -72,7 +73,7 @@ parAppSum src = (S.sum S.|$. src) >>= \x -> seq x (return ())
72
73
73{-# INLINE tapAsyncS #-}
74{-# INLINE tapAsyncS #-}
74tapAsyncS :: S.MonadAsync m => Int -> SerialT m Int -> m ()
75tapAsyncS :: S.MonadAsync m => Int -> SerialT m Int -> m ()
75−tapAsyncS n = composeN n $ Par.tapAsync S.sum
76+tapAsyncS n = composeN n $ Internal.tapAsyncK S.sum
76
77
77{-# INLINE tapAsync #-}
78{-# INLINE tapAsync #-}
78tapAsync :: S.MonadAsync m => Int -> SerialT m Int -> m ()
79tapAsync :: S.MonadAsync m => Int -> SerialT m Int -> m ()
@@ -81,9 +82,9 @@ tapAsync n = composeN n $ Internal.tapAsync FL.sum
81o_1_space_merge_app_tap :: Int -> [Benchmark]
82o_1_space_merge_app_tap :: Int -> [Benchmark]
82o_1_space_merge_app_tap value =
83o_1_space_merge_app_tap value =
83 [ bgroup "merge-app-tap"
84 [ bgroup "merge-app-tap"
84− [ benchIOSrc serially "mergeAsyncBy (2,x/2)"
85+ [ benchIOSrc fromSerial "mergeAsyncBy (2,x/2)"
85 (mergeAsyncBy (value `div` 2))
86 (mergeAsyncBy (value `div` 2))
86− , benchIOSrc serially "mergeAsyncByM (2,x/2)"
87+ , benchIOSrc fromSerial "mergeAsyncByM (2,x/2)"
87 (mergeAsyncByM (value `div` 2))
88 (mergeAsyncByM (value `div` 2))
88 -- Parallel stages in a pipeline
89 -- Parallel stages in a pipeline
89 , benchIOSink value "parAppMap" parAppMap
90 , benchIOSink value "parAppMap" parAppMap
@@ -103,13 +104,13 @@ o_n_heap_generation :: Int -> [Benchmark]
103o_n_heap_generation value =
104o_n_heap_generation value =
104 [ bgroup
105 [ bgroup
105 "generation"
106 "generation"
106− [ benchIOSrc parallely "unfoldr" (sourceUnfoldr value)
107+ [ benchIOSrc fromParallel "unfoldr" (sourceUnfoldr value)
107− , benchIOSrc parallely "unfoldrM" (sourceUnfoldrM value)
108+ , benchIOSrc fromParallel "unfoldrM" (sourceUnfoldrM value)
108− , benchIOSrc parallely "fromFoldable" (sourceFromFoldable value)
109+ , benchIOSrc fromParallel "fromFoldable" (sourceFromFoldable value)
109− , benchIOSrc parallely "fromFoldableM" (sourceFromFoldableM value)
110+ , benchIOSrc fromParallel "fromFoldableM" (sourceFromFoldableM value)
110− , benchIOSrc parallely "unfoldrM maxThreads 1"
111+ , benchIOSrc fromParallel "unfoldrM maxThreads 1"
111 (maxThreads 1 . sourceUnfoldrM value)
112 (maxThreads 1 . sourceUnfoldrM value)
112− , benchIOSrc parallely "unfoldrM maxBuffer 1 (x/10 ops)"
113+ , benchIOSrc fromParallel "unfoldrM maxBuffer 1 (x/10 ops)"
113 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
114 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
114 ]
115 ]
115 ]
116 ]
@@ -121,9 +122,9 @@ o_n_heap_generation value =
121o_n_heap_mapping :: Int -> [Benchmark]
122o_n_heap_mapping :: Int -> [Benchmark]
122o_n_heap_mapping value =
123o_n_heap_mapping value =
123 [ bgroup "mapping"
124 [ bgroup "mapping"
124− [ benchIOSink value "map" $ mapN parallely 1
125+ [ benchIOSink value "map" $ mapN fromParallel 1
125− , benchIOSink value "fmap" $ fmapN parallely 1
126+ , benchIOSink value "fmap" $ fmapN fromParallel 1
126− , benchIOSink value "mapM" $ mapM parallely 1 . serially
127+ , benchIOSink value "mapM" $ mapM fromParallel 1 . fromSerial
127 ]
128 ]
128 ]
129 ]
129
130
@@ -153,17 +154,17 @@ o_n_heap_concatFoldable :: Int -> [Benchmark]
153o_n_heap_concatFoldable value =
154o_n_heap_concatFoldable value =
154 [ bgroup
155 [ bgroup
155 "concat-foldable"
156 "concat-foldable"
156− [ benchIOSrc parallely "foldMapWith (<>) (List)"
157+ [ benchIOSrc fromParallel "foldMapWith (<>) (List)"
157 (sourceFoldMapWith value)
158 (sourceFoldMapWith value)
158− , benchIOSrc parallely "foldMapWith (<>) (Stream)"
159+ , benchIOSrc fromParallel "foldMapWith (<>) (Stream)"
159 (sourceFoldMapWithStream value)
160 (sourceFoldMapWithStream value)
160− , benchIOSrc parallely "foldMapWithM (<>) (List)"
161+ , benchIOSrc fromParallel "foldMapWithM (<>) (List)"
161 (sourceFoldMapWithM value)
162 (sourceFoldMapWithM value)
162− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
163+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
163 (concatFoldableWith value)
164 (concatFoldableWith value)
164− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
165+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
165 (concatForFoldableWith value)
166 (concatForFoldableWith value)
166− , benchIOSrc parallely "foldMapM (List)" (sourceFoldMapM value)
167+ , benchIOSrc fromParallel "foldMapM (List)" (sourceFoldMapM value)
167 ]
168 ]
168 ]
169 ]
169
170
@@ -172,7 +173,7 @@ o_n_heap_concat value =
172 value2 `seq`
173 value2 `seq`
173 [ bgroup "concat"
174 [ bgroup "concat"
174 -- This is for comparison with foldMapWith
175 -- This is for comparison with foldMapWith
175− [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
176+ [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
176 (S.concatMapWith parallel id . sourceConcatMapId value)
177 (S.concatMapWith parallel id . sourceConcatMapId value)
177
178
178 , benchIO "concatMapWith (n of 1)"
179 , benchIO "concatMapWith (n of 1)"
@@ -195,22 +196,22 @@ o_n_heap_concat value =
195o_n_heap_outerProduct :: Int -> [Benchmark]
196o_n_heap_outerProduct :: Int -> [Benchmark]
196o_n_heap_outerProduct value =
197o_n_heap_outerProduct value =
197 [ bgroup "monad-outer-product"
198 [ bgroup "monad-outer-product"
198− [ benchIO "toNullAp" $ toNullAp value parallely
199+ [ benchIO "toNullAp" $ toNullAp value fromParallel
199− , benchIO "toNull" $ toNullM value parallely
200+ , benchIO "toNull" $ toNullM value fromParallel
200− , benchIO "toNull3" $ toNullM3 value parallely
201+ , benchIO "toNull3" $ toNullM3 value fromParallel
201− , benchIO "filterAllOut" $ filterAllOutM value parallely
202+ , benchIO "filterAllOut" $ filterAllOutM value fromParallel
202− , benchIO "filterAllIn" $ filterAllInM value parallely
203+ , benchIO "filterAllIn" $ filterAllInM value fromParallel
203− , benchIO "filterSome" $ filterSome value parallely
204+ , benchIO "filterSome" $ filterSome value fromParallel
204− , benchIO "breakAfterSome" $ breakAfterSome value parallely
205+ , benchIO "breakAfterSome" $ breakAfterSome value fromParallel
205 ]
206 ]
206 ]
207 ]
207
208
208o_n_space_outerProduct :: Int -> [Benchmark]
209o_n_space_outerProduct :: Int -> [Benchmark]
209o_n_space_outerProduct value =
210o_n_space_outerProduct value =
210 [ bgroup "monad-outer-product"
211 [ bgroup "monad-outer-product"
211− [ benchIO "toList" $ toListM value parallely
212+ [ benchIO "toList" $ toListM value fromParallel
212 -- XXX disabled due to a bug for now
213 -- XXX disabled due to a bug for now
213− -- , benchIO "toListSome" $ toListSome value parallely
214+ -- , benchIO "toListSome" $ toListSome value fromParallel
214 ]
215 ]
215 ]
216 ]
216
217
@@ -219,9 +220,7 @@ o_n_space_outerProduct value =
219-------------------------------------------------------------------------------
220-------------------------------------------------------------------------------
220
221
221main :: IO ()
222main :: IO ()
222−main = do
223+main = runWithCLIOpts defaultStreamSize allBenchmarks
223− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
224− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
225
224
226 where
225 where
227
226
benchmark/Streamly/Benchmark/Prelude/Rate.hs+27−29
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2
3
3-- |
4-- |
@@ -7,13 +8,13 @@
7-- License : BSD3
8-- License : BSD3
8-- Maintainer : streamly@composewell.com
9-- Maintainer : streamly@composewell.com
9
10
10−import Streamly.Prelude (asyncly, aheadly, maxThreads, IsStream, MonadAsync)
11+import Streamly.Prelude (fromAsync, fromAhead, maxThreads, IsStream, MonadAsync)
11import qualified Streamly.Prelude as S
12import qualified Streamly.Prelude as S
12
13
13import Streamly.Benchmark.Common
14import Streamly.Benchmark.Common
14import Streamly.Benchmark.Prelude
15import Streamly.Benchmark.Prelude
15
16
16−import Gauge
17+import Test.Tasty.Bench
17
18
18moduleName :: String
19moduleName :: String
19moduleName = "Prelude.Rate"
20moduleName = "Prelude.Rate"
@@ -54,32 +55,32 @@ o_1_space_async value =
54 "asyncly"
55 "asyncly"
55 [ bgroup
56 [ bgroup
56 "avgRate"
57 "avgRate"
57− -- benchIO "unfoldr" $ toNull asyncly
58+ -- benchIO "unfoldr" $ toNull fromAsync
58− -- benchIOSrc asyncly "unfoldrM" (sourceUnfoldrM value)
59+ -- benchIOSrc fromAsync "unfoldrM" (sourceUnfoldrM value)
59− [ benchIOSrc asyncly "Nothing" $ rateNothing value
60+ [ benchIOSrc fromAsync "Nothing" $ rateNothing value
60− , benchIOSrc asyncly "1M" $ avgRate value 1000000
61+ , benchIOSrc fromAsync "1M" $ avgRate value 1000000
61− , benchIOSrc asyncly "3M" $ avgRate value 3000000
62+ , benchIOSrc fromAsync "3M" $ avgRate value 3000000
62− , benchIOSrc asyncly "10M/maxThreads1"
63+ , benchIOSrc fromAsync "10M/maxThreads1"
63 $ avgRateThreads1 value 10000000
64 $ avgRateThreads1 value 10000000
64− , benchIOSrc asyncly "10M" $ avgRate value 10000000
65+ , benchIOSrc fromAsync "10M" $ avgRate value 10000000
65− , benchIOSrc asyncly "20M" $ avgRate value 20000000
66+ , benchIOSrc fromAsync "20M" $ avgRate value 20000000
66 ]
67 ]
67 , bgroup
68 , bgroup
68 "minRate"
69 "minRate"
69− [ benchIOSrc asyncly "1M" $ minRate value 1000000
70+ [ benchIOSrc fromAsync "1M" $ minRate value 1000000
70− , benchIOSrc asyncly "10M" $ minRate value 10000000
71+ , benchIOSrc fromAsync "10M" $ minRate value 10000000
71− , benchIOSrc asyncly "20M" $ minRate value 20000000
72+ , benchIOSrc fromAsync "20M" $ minRate value 20000000
72 ]
73 ]
73 , bgroup
74 , bgroup
74 "maxRate"
75 "maxRate"
75− [ -- benchIOSrc asyncly "10K" $ maxRate value 10000
76+ [ -- benchIOSrc fromAsync "10K" $ maxRate value 10000
76− benchIOSrc asyncly "10M" $ maxRate value 10000000
77+ benchIOSrc fromAsync "10M" $ maxRate value 10000000
77 ]
78 ]
78 , bgroup
79 , bgroup
79 "constRate"
80 "constRate"
80− [ -- benchIOSrc asyncly "10K" $ constRate value 10000
81+ [ -- benchIOSrc fromAsync "10K" $ constRate value 10000
81− benchIOSrc asyncly "1M" $ constRate value 1000000
82+ benchIOSrc fromAsync "1M" $ constRate value 1000000
82− , benchIOSrc asyncly "10M" $ constRate value 10000000
83+ , benchIOSrc fromAsync "10M" $ constRate value 10000000
83 ]
84 ]
84 ]
85 ]
85 ]
86 ]
@@ -87,12 +88,12 @@ o_1_space_async value =
87o_1_space_ahead :: Int -> [Benchmark]
88o_1_space_ahead :: Int -> [Benchmark]
88o_1_space_ahead value =
89o_1_space_ahead value =
89 [ bgroup
90 [ bgroup
90− "aheadly"
91+ "aheadly"
91− [ benchIOSrc aheadly "avgRate/1M" $ avgRate value 1000000
92+ [ benchIOSrc fromAhead "avgRate/1M" $ avgRate value 1000000
92− , benchIOSrc aheadly "minRate/1M" $ minRate value 1000000
93+ , benchIOSrc fromAhead "minRate/1M" $ minRate value 1000000
93− , benchIOSrc aheadly "maxRate/1M" $ maxRate value 1000000
94+ , benchIOSrc fromAhead "maxRate/1M" $ maxRate value 1000000
94− , benchIOSrc asyncly "constRate/1M" $ constRate value 1000000
95+ , benchIOSrc fromAsync "constRate/1M" $ constRate value 1000000
95− ]
96+ ]
96 ]
97 ]
97
98
98-------------------------------------------------------------------------------
99-------------------------------------------------------------------------------
@@ -100,13 +101,10 @@ o_1_space_ahead value =
100-------------------------------------------------------------------------------
101-------------------------------------------------------------------------------
101
102
102main :: IO ()
103main :: IO ()
103−main = do
104+main = runWithCLIOpts defaultStreamSize allBenchmarks
104− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
105− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
106
105
107 where
106 where
108
107
109 allBenchmarks value =
108 allBenchmarks value =
110 [ bgroup (o_1_space_prefix moduleName)
109 [ bgroup (o_1_space_prefix moduleName)
111− $ concat [o_1_space_async value, o_1_space_ahead value]
110+ $ concat [o_1_space_async value, o_1_space_ahead value]]
112− ]
benchmark/Streamly/Benchmark/Prelude/Serial.hsdeleted−54
@@ -1,54 +0,0 @@
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.Nested as Nested
20−import qualified Serial.Split as Split
21−import qualified Serial.Transformation1 as Transformation1
22−import qualified Serial.Transformation2 as Transformation2
23−import qualified Serial.Transformation3 as Transformation3
24−
25−import Gauge hiding (env)
26−import Streamly.Benchmark.Common
27−
28−moduleName :: String
29−moduleName = "Prelude.Serial"
30−
31−-------------------------------------------------------------------------------
32−-- Main
33−-------------------------------------------------------------------------------
34−
35−-- In addition to gauge options, the number of elements in the stream can be
36−-- passed using the --stream-size option.
37−--
38−main :: IO ()
39−main = do
40− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
41− env <- mkHandleBenchEnv
42− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value env)
43− where
44−
45− allBenchmarks size env = Prelude.concat
46− [ Generation.benchmarks moduleName size
47− , Elimination.benchmarks moduleName size
48− , Exceptions.benchmarks moduleName env
49− , Split.benchmarks moduleName env
50− , Transformation1.benchmarks moduleName size
51− , Transformation2.benchmarks moduleName size
52− , Transformation3.benchmarks moduleName size
53− , Nested.benchmarks moduleName size
54− ]
benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hsdeleted−217
@@ -1,217 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions
3−-- Copyright : (c) 2019 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−-- Stability : experimental
7−-- Portability : GHC
8−
9−{-# LANGUAGE CPP #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−
12−#ifdef __HADDOCK_VERSION__
13−#undef INSPECTION
14−#endif
15−
16−#ifdef INSPECTION
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19−#endif
20−
21−module Serial.Exceptions (benchmarks) where
22−
23−import Control.Exception (SomeException)
24−import System.IO (Handle, hClose, hPutChar)
25−
26−import qualified Streamly.FileSystem.Handle as FH
27−import qualified Streamly.Internal.Data.Unfold as IUF
28−import qualified Streamly.Internal.FileSystem.Handle as IFH
29−import qualified Streamly.Internal.Data.Stream.IsStream as IP
30−import qualified Streamly.Prelude as S
31−
32−import Gauge hiding (env)
33−import Prelude hiding (last, length)
34−import Streamly.Benchmark.Common
35−import Streamly.Benchmark.Common.Handle
36−
37−#ifdef INSPECTION
38−import Test.Inspection
39−#endif
40−
41−-------------------------------------------------------------------------------
42−-- stream exceptions
43−-------------------------------------------------------------------------------
44−
45−-- | Send the file contents to /dev/null with exception handling
46−readWriteOnExceptionStream :: Handle -> Handle -> IO ()
47−readWriteOnExceptionStream inh devNull =
48− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
49− in S.fold (FH.write devNull) $ readEx
50−
51−-- | Send the file contents to /dev/null with exception handling
52−readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
53−readWriteHandleExceptionStream inh devNull =
54− let handler (_e :: SomeException) = S.yieldM (hClose inh >> return 10)
55− readEx = S.handle handler (S.unfold FH.read inh)
56− in S.fold (FH.write devNull) $ readEx
57−
58−-- | Send the file contents to /dev/null with exception handling
59−readWriteFinally_Stream :: Handle -> Handle -> IO ()
60−readWriteFinally_Stream inh devNull =
61− let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
62− in S.fold (FH.write devNull) readEx
63−
64−readWriteFinallyStream :: Handle -> Handle -> IO ()
65−readWriteFinallyStream inh devNull =
66− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
67− in S.fold (FH.write devNull) readEx
68−
69−-- | Send the file contents to /dev/null with exception handling
70−fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
71−fromToBytesBracket_Stream inh devNull =
72− let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
73− (\_ -> IFH.toBytes inh)
74− in IFH.fromBytes devNull $ readEx
75−
76−#ifdef INSPECTION
77−inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
78−-- inspect $ 'fromToBytesBracketStream `hasNoType` ''Step
79−#endif
80−
81−fromToBytesBracketStream :: Handle -> Handle -> IO ()
82−fromToBytesBracketStream inh devNull =
83− let readEx = S.bracket (return ()) (\_ -> hClose inh)
84− (\_ -> IFH.toBytes inh)
85− in IFH.fromBytes devNull $ readEx
86−
87−readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
88−readWriteBeforeAfterStream inh devNull =
89− let readEx =
90− IP.after (hClose inh)
91− $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
92− in S.fold (FH.write devNull) readEx
93−
94−readWriteAfterStream :: Handle -> Handle -> IO ()
95−readWriteAfterStream inh devNull =
96− let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
97− in S.fold (FH.write devNull) readEx
98−
99−readWriteAfter_Stream :: Handle -> Handle -> IO ()
100−readWriteAfter_Stream inh devNull =
101− let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
102− in S.fold (FH.write devNull) readEx
103−
104−o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
105−o_1_space_copy_stream_exceptions env =
106− [ bgroup "exceptions"
107− [ mkBenchSmall "S.onException" env $ \inh _ ->
108− readWriteOnExceptionStream inh (nullH env)
109− , mkBenchSmall "S.handle" env $ \inh _ ->
110− readWriteHandleExceptionStream inh (nullH env)
111− , mkBenchSmall "S.finally_" env $ \inh _ ->
112− readWriteFinally_Stream inh (nullH env)
113− , mkBenchSmall "S.finally" env $ \inh _ ->
114− readWriteFinallyStream inh (nullH env)
115− , mkBenchSmall "S.after . S.before" env $ \inh _ ->
116− readWriteBeforeAfterStream inh (nullH env)
117− , mkBenchSmall "S.after" env $ \inh _ ->
118− readWriteAfterStream inh (nullH env)
119− , mkBenchSmall "S.after_" env $ \inh _ ->
120− readWriteAfter_Stream inh (nullH env)
121− ]
122− , bgroup "exceptions/fromToBytes"
123− [ mkBenchSmall "S.bracket_" env $ \inh _ ->
124− fromToBytesBracket_Stream inh (nullH env)
125− , mkBenchSmall "S.bracket" env $ \inh _ ->
126− fromToBytesBracketStream inh (nullH env)
127− ]
128− ]
129−
130− -------------------------------------------------------------------------------
131−-- Exceptions readChunks
132−-------------------------------------------------------------------------------
133−
134−-- | Send the file contents to /dev/null with exception handling
135−readChunksOnException :: Handle -> Handle -> IO ()
136−readChunksOnException inh devNull =
137− let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
138− in IUF.fold readEx (IFH.writeChunks devNull) inh
139−
140−#ifdef INSPECTION
141−inspect $ hasNoTypeClasses 'readChunksOnException
142−-- inspect $ 'readChunksOnException `hasNoType` ''Step
143−#endif
144−
145−-- | Send the file contents to /dev/null with exception handling
146−readChunksBracket_ :: Handle -> Handle -> IO ()
147−readChunksBracket_ inh devNull =
148− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks
149− in IUF.fold readEx (IFH.writeChunks devNull) inh
150−
151−#ifdef INSPECTION
152−inspect $ hasNoTypeClasses 'readChunksBracket_
153−-- inspect $ 'readChunksBracket `hasNoType` ''Step
154−#endif
155−
156−readChunksBracket :: Handle -> Handle -> IO ()
157−readChunksBracket inh devNull =
158− let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
159− in IUF.fold readEx (IFH.writeChunks devNull) inh
160−
161−o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
162−o_1_space_copy_exceptions_readChunks env =
163− [ bgroup "exceptions/readChunks"
164− [ mkBench "UF.onException" env $ \inH _ ->
165− readChunksOnException inH (nullH env)
166− , mkBench "UF.bracket_" env $ \inH _ ->
167− readChunksBracket_ inH (nullH env)
168− , mkBench "UF.bracket" env $ \inH _ ->
169− readChunksBracket inH (nullH env)
170− ]
171− ]
172−
173−-------------------------------------------------------------------------------
174−-- Exceptions toChunks
175−-------------------------------------------------------------------------------
176−
177−-- | Send the file contents to /dev/null with exception handling
178−toChunksBracket_ :: Handle -> Handle -> IO ()
179−toChunksBracket_ inh devNull =
180− let readEx = IP.bracket_
181− (return ())
182− (\_ -> hClose inh)
183− (\_ -> IFH.toChunks inh)
184− in S.fold (IFH.writeChunks devNull) $ readEx
185−
186−#ifdef INSPECTION
187−inspect $ hasNoTypeClasses 'toChunksBracket_
188−-- inspect $ 'toChunksBracket `hasNoType` ''Step
189−#endif
190−
191−toChunksBracket :: Handle -> Handle -> IO ()
192−toChunksBracket inh devNull =
193− let readEx = S.bracket
194− (return ())
195− (\_ -> hClose inh)
196− (\_ -> IFH.toChunks inh)
197− in S.fold (IFH.writeChunks devNull) $ readEx
198−
199−o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
200−o_1_space_copy_exceptions_toChunks env =
201− [ bgroup "exceptions/toChunks"
202− [ mkBench "S.bracket_" env $ \inH _ ->
203− toChunksBracket_ inH (nullH env)
204− , mkBench "S.bracket" env $ \inH _ ->
205− toChunksBracket inH (nullH env)
206− ]
207− ]
208−
209−
210−benchmarks :: String -> BenchEnv -> [Benchmark]
211−benchmarks moduleName env =
212− [ bgroup (o_1_space_prefix moduleName) $ concat
213− [ o_1_space_copy_exceptions_readChunks env
214− , o_1_space_copy_exceptions_toChunks env
215− , o_1_space_copy_stream_exceptions env
216− ]
217− ]
benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hsdeleted−179
@@ -1,179 +0,0 @@
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, serially, 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 serially "unfoldr" (sourceUnfoldr value)
122− , benchIOSrc serially "unfoldrM" (sourceUnfoldrM value)
123− , benchIOSrc serially "repeat" (repeat value)
124− , benchIOSrc serially "repeatM" (repeatM value)
125− , benchIOSrc serially "replicate" (replicate value)
126− , benchIOSrc serially "replicateM" (replicateM value)
127− , benchIOSrc serially "iterate" (iterate value)
128− , benchIOSrc serially "iterateM" (iterateM value)
129− , benchIOSrc serially "fromIndices" (fromIndices value)
130− , benchIOSrc serially "fromIndicesM" (fromIndicesM value)
131− , benchIOSrc serially "intFromTo" (sourceIntFromTo value)
132− , benchIOSrc serially "intFromThenTo" (sourceIntFromThenTo value)
133− , benchIOSrc serially "integerFromStep" (sourceIntegerFromStep value)
134− , benchIOSrc serially "fracFromThenTo" (sourceFracFromThenTo value)
135− , benchIOSrc serially "fracFromTo" (sourceFracFromTo value)
136− , benchIOSrc serially "fromList" (sourceFromList value)
137− , benchPureSrc "IsList.fromList" (sourceIsList value)
138− , benchPureSrc "IsString.fromString" (sourceIsString value)
139− , benchIOSrc serially "fromListM" (sourceFromListM value)
140− , benchIOSrc serially "enumerateFrom" (enumerateFrom value)
141− , benchIOSrc serially "enumerateFromTo" (enumerateFromTo value)
142− , benchIOSrc serially "enumerateFromThen" (enumerateFromThen value)
143− , benchIOSrc serially "enumerateFromThenTo" (enumerateFromThenTo value)
144− , benchIOSrc serially "enumerate" (enumerate value)
145− , benchIOSrc serially "enumerateTo" (enumerateTo value)
146−
147− -- These essentially test cons and consM
148− , benchIOSrc serially "fromFoldable" (sourceFromFoldable value)
149− , benchIOSrc serially "fromFoldableM" (sourceFromFoldableM value)
150−
151− , benchIOSrc serially "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/Transformation1.hsdeleted−554
@@ -1,554 +0,0 @@
1−-- |
2−-- Module : Serial.Transformation1
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 __HADDOCK_VERSION__
13−#undef INSPECTION
14−#endif
15−
16−#ifdef INSPECTION
17−{-# LANGUAGE TemplateHaskell #-}
18−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19−#endif
20−
21−module Serial.Transformation1 (benchmarks) where
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad.IO.Class (MonadIO(..))
25−import Data.Functor.Identity (Identity)
26−import Data.IORef (newIORef, modifyIORef')
27−import System.Random (randomRIO)
28−
29−#ifdef INSPECTION
30−import Test.Inspection
31−#endif
32−
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
36−import qualified Prelude
37−
38−import Gauge
39−import Streamly.Prelude (SerialT, serially, MonadAsync)
40−import Streamly.Benchmark.Common
41−import Streamly.Benchmark.Prelude
42−import Streamly.Internal.Data.Time.Units
43−import Prelude hiding (sequence, mapM, fmap)
44−
45−-------------------------------------------------------------------------------
46−-- Pipelines (stream-to-stream transformations)
47−-------------------------------------------------------------------------------
48−
49−-------------------------------------------------------------------------------
50−-- one-to-one transformations
51−-------------------------------------------------------------------------------
52−
53−-------------------------------------------------------------------------------
54−-- Traversable Instance
55−-------------------------------------------------------------------------------
56−
57−{-# INLINE traversableTraverse #-}
58−traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
59−traversableTraverse = traverse return
60−
61−{-# INLINE traversableSequenceA #-}
62−traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
63−traversableSequenceA = sequenceA . Prelude.fmap return
64−
65−{-# INLINE traversableMapM #-}
66−traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
67−traversableMapM = Prelude.mapM return
68−
69−{-# INLINE traversableSequence #-}
70−traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
71−traversableSequence = Prelude.sequence . Prelude.fmap return
72−
73−{-# INLINE benchPureSinkIO #-}
74−benchPureSinkIO
75− :: NFData b
76− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
77−benchPureSinkIO value name f =
78− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
79−
80−o_n_space_traversable :: Int -> [Benchmark]
81−o_n_space_traversable value =
82− -- Buffering operations using heap proportional to number of elements.
83− [ bgroup "traversable"
84− -- Traversable instance
85− [ benchPureSinkIO value "traverse" traversableTraverse
86− , benchPureSinkIO value "sequenceA" traversableSequenceA
87− , benchPureSinkIO value "mapM" traversableMapM
88− , benchPureSinkIO value "sequence" traversableSequence
89− ]
90− ]
91−
92−-------------------------------------------------------------------------------
93−-- maps and scans
94−-------------------------------------------------------------------------------
95−
96−{-# INLINE scanl' #-}
97−scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
98−scanl' n = composeN n $ S.scanl' (+) 0
99−
100−{-# INLINE scanlM' #-}
101−scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
102−scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
103−
104−{-# INLINE scanl1' #-}
105−scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
106−scanl1' n = composeN n $ S.scanl1' (+)
107−
108−{-# INLINE scanl1M' #-}
109−scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
110−scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
111−
112−{-# INLINE scan #-}
113−scan :: MonadIO m => Int -> SerialT m Int -> m ()
114−scan n = composeN n $ S.scan FL.sum
115−
116−{-# INLINE postscanl' #-}
117−postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
118−postscanl' n = composeN n $ S.postscanl' (+) 0
119−
120−{-# INLINE postscanlM' #-}
121−postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
122−postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
123−
124−{-# INLINE postscan #-}
125−postscan :: MonadIO m => Int -> SerialT m Int -> m ()
126−postscan n = composeN n $ S.postscan FL.sum
127−
128−{-# INLINE sequence #-}
129−sequence ::
130− (S.IsStream t, S.MonadAsync m)
131− => (t m Int -> S.SerialT m Int)
132− -> t m (m Int)
133− -> m ()
134−sequence t = S.drain . t . S.sequence
135−
136−{-# INLINE tap #-}
137−tap :: MonadIO m => Int -> SerialT m Int -> m ()
138−tap n = composeN n $ S.tap FL.sum
139−
140−{-# INLINE tapRate #-}
141−tapRate :: Int -> SerialT IO Int -> IO ()
142−tapRate n str = do
143− cref <- newIORef 0
144− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
145−
146−{-# INLINE pollCounts #-}
147−pollCounts :: Int -> SerialT IO Int -> IO ()
148−pollCounts n =
149− composeN n (Internal.pollCounts (const True) f FL.drain)
150−
151− where
152−
153− f = Internal.rollingMap (-) . Internal.delayPost 1
154−
155−{-# INLINE timestamped #-}
156−timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
157−timestamped = S.drain . Internal.timestamped
158−
159−{-# INLINE foldrS #-}
160−foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
161−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
162−
163−{-# INLINE foldrSMap #-}
164−foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
165−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
166−
167−{-# INLINE foldrT #-}
168−foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
169−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
170−
171−{-# INLINE foldrTMap #-}
172−foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
173−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
174−
175−
176−{-# INLINE trace #-}
177−trace :: MonadAsync m => Int -> SerialT m Int -> m ()
178−trace n = composeN n $ Internal.trace return
179−
180−o_1_space_mapping :: Int -> [Benchmark]
181−o_1_space_mapping value =
182− [ bgroup
183− "mapping"
184− [
185− -- Right folds
186− benchIOSink value "foldrS" (foldrS 1)
187− , benchIOSink value "foldrSMap" (foldrSMap 1)
188− , benchIOSink value "foldrT" (foldrT 1)
189− , benchIOSink value "foldrTMap" (foldrTMap 1)
190−
191− -- Mapping
192− , benchIOSink value "map" (mapN serially 1)
193− , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
194− sequence serially (sourceUnfoldrAction value n)
195− , benchIOSink value "mapM" (mapM serially 1)
196− , benchIOSink value "tap" (tap 1)
197− , benchIOSink value "tapRate 1 second" (tapRate 1)
198− , benchIOSink value "pollCounts 1 second" (pollCounts 1)
199− , benchIOSink value "timestamped" timestamped
200−
201− -- Scanning
202− , benchIOSink value "scanl'" (scanl' 1)
203− , benchIOSink value "scanl1'" (scanl1' 1)
204− , benchIOSink value "scanlM'" (scanlM' 1)
205− , benchIOSink value "scanl1M'" (scanl1M' 1)
206− , benchIOSink value "postscanl'" (postscanl' 1)
207− , benchIOSink value "postscanlM'" (postscanlM' 1)
208−
209− , benchIOSink value "scan" (scan 1)
210− , benchIOSink value "postscan" (postscan 1)
211− ]
212− ]
213−
214−o_1_space_mappingX4 :: Int -> [Benchmark]
215−o_1_space_mappingX4 value =
216− [ bgroup "mappingX4"
217− [ benchIOSink value "map" (mapN serially 4)
218− , benchIOSink value "mapM" (mapM serially 4)
219− , benchIOSink value "trace" (trace 4)
220−
221− , benchIOSink value "scanl'" (scanl' 4)
222− , benchIOSink value "scanl1'" (scanl1' 4)
223− , benchIOSink value "scanlM'" (scanlM' 4)
224− , benchIOSink value "scanl1M'" (scanl1M' 4)
225− , benchIOSink value "postscanl'" (postscanl' 4)
226− , benchIOSink value "postscanlM'" (postscanlM' 4)
227−
228− ]
229− ]
230−
231−{-# INLINE sieveScan #-}
232−sieveScan :: Monad m => SerialT m Int -> SerialT m Int
233−sieveScan =
234− S.mapMaybe snd
235− . S.scanlM' (\(primes, _) n -> do
236− return $
237− let ps = takeWhile (\p -> p * p <= n) primes
238− in if all (\p -> n `mod` p /= 0) ps
239− then (primes ++ [n], Just n)
240− else (primes, Nothing)) (return ([2], Just 2))
241−
242−o_n_space_mapping :: Int -> [Benchmark]
243−o_n_space_mapping value =
244− [ bgroup "mapping"
245− [ benchIO "naive prime sieve"
246− (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
247− ]
248− ]
249−
250−-------------------------------------------------------------------------------
251−-- Functor
252−-------------------------------------------------------------------------------
253−
254−o_1_space_functor :: Int -> [Benchmark]
255−o_1_space_functor value =
256− [ bgroup "Functor"
257− [ benchIOSink value "fmap" (fmapN serially 1)
258− , benchIOSink value "fmap x 4" (fmapN serially 4)
259− ]
260− ]
261−
262−-------------------------------------------------------------------------------
263−-- Size reducing transformations (filtering)
264−-------------------------------------------------------------------------------
265−
266−{-# INLINE filterEven #-}
267−filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
268−filterEven n = composeN n $ S.filter even
269−
270−{-# INLINE filterAllOut #-}
271−filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
272−filterAllOut value n = composeN n $ S.filter (> (value + 1))
273−
274−{-# INLINE filterAllIn #-}
275−filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
276−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
277−
278−{-# INLINE filterMEven #-}
279−filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
280−filterMEven n = composeN n $ S.filterM (return . even)
281−
282−{-# INLINE filterMAllOut #-}
283−filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
284−filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
285−
286−{-# INLINE filterMAllIn #-}
287−filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
288−filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
289−
290−{-# INLINE _takeOne #-}
291−_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
292−_takeOne n = composeN n $ S.take 1
293−
294−{-# INLINE takeAll #-}
295−takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
296−takeAll value n = composeN n $ S.take (value + 1)
297−
298−{-# INLINE takeWhileTrue #-}
299−takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
300−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
301−
302−{-# INLINE takeWhileMTrue #-}
303−takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
304−takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
305−
306−{-# INLINE takeByTime #-}
307−takeByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
308−takeByTime i n = composeN n (Internal.takeByTime i)
309−
310−#ifdef INSPECTION
311−-- inspect $ hasNoType 'takeByTime ''SPEC
312−inspect $ hasNoTypeClasses 'takeByTime
313−-- inspect $ 'takeByTime `hasNoType` ''D.Step
314−#endif
315−
316−{-# INLINE dropOne #-}
317−dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
318−dropOne n = composeN n $ S.drop 1
319−
320−{-# INLINE dropAll #-}
321−dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
322−dropAll value n = composeN n $ S.drop (value + 1)
323−
324−{-# INLINE dropWhileTrue #-}
325−dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
326−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
327−
328−{-# INLINE dropWhileMTrue #-}
329−dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
330−dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
331−
332−{-# INLINE dropWhileFalse #-}
333−dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
334−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
335−
336−-- XXX Decide on the time interval
337−{-# INLINE _intervalsOfSum #-}
338−_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
339−_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
340−
341−{-# INLINE dropByTime #-}
342−dropByTime :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
343−dropByTime i n = composeN n (Internal.dropByTime i)
344−
345−#ifdef INSPECTION
346−inspect $ hasNoTypeClasses 'dropByTime
347−-- inspect $ 'dropByTime `hasNoType` ''D.Step
348−#endif
349−
350−{-# INLINE findIndices #-}
351−findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
352−findIndices value n = composeN n $ S.findIndices (== (value + 1))
353−
354−{-# INLINE elemIndices #-}
355−elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
356−elemIndices value n = composeN n $ S.elemIndices (value + 1)
357−
358−{-# INLINE deleteBy #-}
359−deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
360−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
361−
362−-- uniq . uniq == uniq, composeN 2 ~ composeN 1
363−{-# INLINE uniq #-}
364−uniq :: MonadIO m => Int -> SerialT m Int -> m ()
365−uniq n = composeN n S.uniq
366−
367−{-# INLINE mapMaybe #-}
368−mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
369−mapMaybe n =
370− composeN n $
371− S.mapMaybe
372− (\x ->
373− if odd x
374− then Nothing
375− else Just x)
376−
377−{-# INLINE mapMaybeM #-}
378−mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
379−mapMaybeM n =
380− composeN n $
381− S.mapMaybeM
382− (\x ->
383− if odd x
384− then return Nothing
385− else return $ Just x)
386−
387−o_1_space_filtering :: Int -> [Benchmark]
388−o_1_space_filtering value =
389− [ bgroup "filtering"
390− [ benchIOSink value "filter-even" (filterEven 1)
391− , benchIOSink value "filter-all-out" (filterAllOut value 1)
392− , benchIOSink value "filter-all-in" (filterAllIn value 1)
393−
394− , benchIOSink value "filterM-even" (filterMEven 1)
395− , benchIOSink value "filterM-all-out" (filterMAllOut value 1)
396− , benchIOSink value "filterM-all-in" (filterMAllIn value 1)
397−
398− -- Trimming
399− , benchIOSink value "take-all" (takeAll value 1)
400− , benchIOSink
401− value
402− "takeByTime-all"
403− (takeByTime (NanoSecond64 maxBound) 1)
404− , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
405− -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
406− , benchIOSink value "drop-one" (dropOne 1)
407− , benchIOSink value "drop-all" (dropAll value 1)
408− , benchIOSink
409− value
410− "dropByTime-all"
411− (dropByTime (NanoSecond64 maxBound) 1)
412− , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
413− -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
414− , benchIOSink
415− value
416− "dropWhile-false"
417− (dropWhileFalse value 1)
418− , benchIOSink value "deleteBy" (deleteBy value 1)
419−
420− , benchIOSink value "uniq" (uniq 1)
421−
422− -- Map and filter
423− , benchIOSink value "mapMaybe" (mapMaybe 1)
424− , benchIOSink value "mapMaybeM" (mapMaybeM 1)
425−
426− -- Searching (stateful map and filter)
427− , benchIOSink value "findIndices" (findIndices value 1)
428− , benchIOSink value "elemIndices" (elemIndices value 1)
429− ]
430− ]
431−
432−o_1_space_filteringX4 :: Int -> [Benchmark]
433−o_1_space_filteringX4 value =
434− [ bgroup "filteringX4"
435− [ benchIOSink value "filter-even" (filterEven 4)
436− , benchIOSink value "filter-all-out" (filterAllOut value 4)
437− , benchIOSink value "filter-all-in" (filterAllIn value 4)
438−
439− , benchIOSink value "filterM-even" (filterMEven 4)
440− , benchIOSink value "filterM-all-out" (filterMAllOut value 4)
441− , benchIOSink value "filterM-all-in" (filterMAllIn value 4)
442−
443− -- trimming
444− , benchIOSink value "take-all" (takeAll value 4)
445− , benchIOSink value "takeWhile-true" (takeWhileTrue value 4)
446− , benchIOSink value "takeWhileM-true" (takeWhileMTrue value 4)
447− , benchIOSink value "drop-one" (dropOne 4)
448− , benchIOSink value "drop-all" (dropAll value 4)
449− , benchIOSink value "dropWhile-true" (dropWhileTrue value 4)
450− , benchIOSink value "dropWhileM-true" (dropWhileMTrue value 4)
451− , benchIOSink
452− value
453− "dropWhile-false"
454− (dropWhileFalse value 4)
455− , benchIOSink value "deleteBy" (deleteBy value 4)
456−
457− , benchIOSink value "uniq" (uniq 4)
458−
459− -- map and filter
460− , benchIOSink value "mapMaybe" (mapMaybe 4)
461− , benchIOSink value "mapMaybeM" (mapMaybeM 4)
462−
463− -- searching
464− , benchIOSink value "findIndices" (findIndices value 4)
465− , benchIOSink value "elemIndices" (elemIndices value 4)
466− ]
467− ]
468−
469−-------------------------------------------------------------------------------
470−-- Size increasing transformations (insertions)
471−-------------------------------------------------------------------------------
472−
473−{-# INLINE intersperse #-}
474−intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
475−intersperse value n = composeN n $ S.intersperse (value + 1)
476−
477−{-# INLINE intersperseM #-}
478−intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
479−intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
480−
481−{-# INLINE insertBy #-}
482−insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
483−insertBy value n = composeN n $ S.insertBy compare (value + 1)
484−
485−o_1_space_inserting :: Int -> [Benchmark]
486−o_1_space_inserting value =
487− [ bgroup "filtering"
488− [ benchIOSink value "intersperse" (intersperse value 1)
489− , benchIOSink value "intersperseM" (intersperseM value 1)
490− , benchIOSink value "insertBy" (insertBy value 1)
491− ]
492− ]
493−
494−o_1_space_insertingX4 :: Int -> [Benchmark]
495−o_1_space_insertingX4 value =
496− [ bgroup "insertingX4"
497− [ benchIOSink value "intersperse" (intersperse value 4)
498− , benchIOSink value "insertBy" (insertBy value 4)
499− ]
500− ]
501−
502−-------------------------------------------------------------------------------
503−-- Indexing
504−-------------------------------------------------------------------------------
505−
506−{-# INLINE indexed #-}
507−indexed :: MonadIO m => Int -> SerialT m Int -> m ()
508−indexed n = composeN n (S.map snd . S.indexed)
509−
510−{-# INLINE indexedR #-}
511−indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
512−indexedR value n = composeN n (S.map snd . S.indexedR value)
513−
514−o_1_space_indexing :: Int -> [Benchmark]
515−o_1_space_indexing value =
516− [ bgroup "indexing"
517− [ benchIOSink value "indexed" (indexed 1)
518− , benchIOSink value "indexedR" (indexedR value 1)
519− ]
520− ]
521−
522−o_1_space_indexingX4 :: Int -> [Benchmark]
523−o_1_space_indexingX4 value =
524− [ bgroup "indexingx4"
525− [ benchIOSink value "indexed" (indexed 4)
526− , benchIOSink value "indexedR" (indexedR value 4)
527− ]
528− ]
529−
530−-------------------------------------------------------------------------------
531−-- Main
532−-------------------------------------------------------------------------------
533−
534−-- In addition to gauge options, the number of elements in the stream can be
535−-- passed using the --stream-size option.
536−--
537−benchmarks :: String -> Int -> [Benchmark]
538−benchmarks moduleName size =
539− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
540− [ o_1_space_functor size
541− , o_1_space_mapping size
542− , o_1_space_mappingX4 size
543− , o_1_space_filtering size
544− , o_1_space_filteringX4 size
545− , o_1_space_inserting size
546− , o_1_space_insertingX4 size
547− , o_1_space_indexing size
548− , o_1_space_indexingX4 size
549− ]
550− , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
551− [ o_n_space_traversable size
552− , o_n_space_mapping size
553− ]
554− ]
benchmark/Streamly/Benchmark/Prelude/Serial/Transformation2.hsdeleted−449
@@ -1,449 +0,0 @@
1−-- |
2−-- Module : Serial.Transformation2
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.Transformation2 (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 Data.List as List
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, serially)
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 serially "(<$) (n times)" $
96− iterateSingleton (<$) value
97− , benchIOSrc serially "fmap (n times)" $
98− iterateSingleton (fmap . (+)) value
99− {-
100− , benchIOSrc serially "_(<$) (n times)" $
101− _iterateSingleton (<$) value
102− , benchIOSrc serially "_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 foldIterateM #-}
145−foldIterateM :: Monad m => SerialT m Int -> m ()
146−foldIterateM =
147− S.drain
148− . S.map getSum
149− . Internal.foldIterateM (return . FL.take 2 . FL.sconcat) (Sum 0)
150− . S.map Sum
151−
152−o_1_space_grouping :: Int -> [Benchmark]
153−o_1_space_grouping value =
154− -- Buffering operations using heap proportional to group/window sizes.
155− [ bgroup "grouping"
156− [ benchIOSink value "groups" groups
157− , benchIOSink value "groupsByGT" groupsByGT
158− , benchIOSink value "groupsByEq" groupsByEq
159− , benchIOSink value "groupsByRollingLT" groupsByRollingLT
160− , benchIOSink value "groupsByRollingEq" groupsByRollingEq
161− , benchIOSink value "foldMany" foldMany
162− , benchIOSink value "foldIterateM" foldIterateM
163− ]
164− ]
165−
166−-------------------------------------------------------------------------------
167−-- Size conserving transformations (reordering, buffering, etc.)
168−-------------------------------------------------------------------------------
169−
170−{-# INLINE reverse #-}
171−reverse :: MonadIO m => Int -> SerialT m Int -> m ()
172−reverse n = composeN n S.reverse
173−
174−{-# INLINE reverse' #-}
175−reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
176−reverse' n = composeN n Internal.reverse'
177−
178−{-# INLINE sortBy #-}
179−sortBy :: MonadIO m => Int -> SerialT m Int -> m ()
180−sortBy n = composeN n (Internal.sortBy compare)
181−
182−o_n_heap_buffering :: Int -> [Benchmark]
183−o_n_heap_buffering value =
184− [ bgroup "buffered"
185− [
186− -- Reversing/sorting a stream
187− benchIOSink value "reverse" (reverse 1)
188− , benchIOSink value "reverse'" (reverse' 1)
189− , benchIOSink value "sortBy" (sortBy 1)
190− , bench "sort Lists" $ nf (\x -> List.sort [1..x]) value
191−
192− , benchIOSink value "mkAsync" (mkAsync serially)
193− ]
194− ]
195−
196−-------------------------------------------------------------------------------
197−-- Grouping/Splitting
198−-------------------------------------------------------------------------------
199−
200−{-# INLINE classifySessionsOf #-}
201−classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()
202−classifySessionsOf =
203− S.drain
204− . Internal.classifySessionsOf (const (return False)) 3 FL.drain
205− . Internal.timestamped
206− . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
207−
208−o_n_space_grouping :: Int -> [Benchmark]
209−o_n_space_grouping value =
210− -- Buffering operations using heap proportional to group/window sizes.
211− [ bgroup "grouping"
212− [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf
213− ]
214− ]
215−
216−-------------------------------------------------------------------------------
217−-- Mixed Transformation
218−-------------------------------------------------------------------------------
219−
220−{-# INLINE scanMap #-}
221−scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
222−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
223−
224−{-# INLINE dropMap #-}
225−dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
226−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
227−
228−{-# INLINE dropScan #-}
229−dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
230−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
231−
232−{-# INLINE takeDrop #-}
233−takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
234−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
235−
236−{-# INLINE takeScan #-}
237−takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
238−takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
239−
240−{-# INLINE takeMap #-}
241−takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
242−takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
243−
244−{-# INLINE filterDrop #-}
245−filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
246−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
247−
248−{-# INLINE filterTake #-}
249−filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
250−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
251−
252−{-# INLINE filterScan #-}
253−filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
254−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
255−
256−{-# INLINE filterScanl1 #-}
257−filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
258−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
259−
260−{-# INLINE filterMap #-}
261−filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
262−filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
263−
264−-------------------------------------------------------------------------------
265−-- Scan and fold
266−-------------------------------------------------------------------------------
267−
268−data Pair a b =
269− Pair !a !b
270− deriving (Generic, NFData)
271−
272−{-# INLINE sumProductFold #-}
273−sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
274−sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
275−
276−{-# INLINE sumProductScan #-}
277−sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
278−sumProductScan =
279− S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
280− S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
281−
282−{-# INLINE foldl'ReduceMap #-}
283−foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
284−foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0
285−
286−o_1_space_transformations_mixed :: Int -> [Benchmark]
287−o_1_space_transformations_mixed value =
288− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
289− -- library. If scan/fold followed by a map is efficient enough we may not
290− -- need monolithic implementations of these.
291− [ bgroup "mixed"
292− [ benchIOSink value "scanl-map" (scanMap 1)
293− , benchIOSink value "foldl-map" foldl'ReduceMap
294− , benchIOSink value "sum-product-fold" sumProductFold
295− , benchIOSink value "sum-product-scan" sumProductScan
296− ]
297− ]
298−
299−o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
300−o_1_space_transformations_mixedX4 value =
301− [ bgroup "mixedX4"
302− [ benchIOSink value "scan-map" (scanMap 4)
303− , benchIOSink value "drop-map" (dropMap 4)
304− , benchIOSink value "drop-scan" (dropScan 4)
305− , benchIOSink value "take-drop" (takeDrop value 4)
306− , benchIOSink value "take-scan" (takeScan value 4)
307− , benchIOSink value "take-map" (takeMap value 4)
308− , benchIOSink value "filter-drop" (filterDrop value 4)
309− , benchIOSink value "filter-take" (filterTake value 4)
310− , benchIOSink value "filter-scan" (filterScan 4)
311− , benchIOSink value "filter-scanl1" (filterScanl1 4)
312− , benchIOSink value "filter-map" (filterMap value 4)
313− ]
314− ]
315−
316−-------------------------------------------------------------------------------
317−-- Iterating a transformation over and over again
318−-------------------------------------------------------------------------------
319−
320−-- this is quadratic
321−{-# INLINE iterateScan #-}
322−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
323−iterateScan = iterateSource (S.scanl' (+) 0)
324−
325−-- this is quadratic
326−{-# INLINE iterateScanl1 #-}
327−iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
328−iterateScanl1 = iterateSource (S.scanl1' (+))
329−
330−{-# INLINE iterateMapM #-}
331−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
332−iterateMapM = iterateSource (S.mapM return)
333−
334−{-# INLINE iterateFilterEven #-}
335−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
336−iterateFilterEven = iterateSource (S.filter even)
337−
338−{-# INLINE iterateTakeAll #-}
339−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
340−iterateTakeAll value = iterateSource (S.take (value + 1))
341−
342−{-# INLINE iterateDropOne #-}
343−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
344−iterateDropOne = iterateSource (S.drop 1)
345−
346−{-# INLINE iterateDropWhileFalse #-}
347−iterateDropWhileFalse :: S.MonadAsync m
348− => Int -> Int -> Int -> Int -> SerialT m Int
349−iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
350−
351−{-# INLINE iterateDropWhileTrue #-}
352−iterateDropWhileTrue :: S.MonadAsync m
353− => Int -> Int -> Int -> Int -> SerialT m Int
354−iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
355−
356−{-# INLINE tail #-}
357−tail :: Monad m => SerialT m a -> m ()
358−tail s = S.tail s >>= mapM_ tail
359−
360−{-# INLINE nullHeadTail #-}
361−nullHeadTail :: Monad m => SerialT m Int -> m ()
362−nullHeadTail s = do
363− r <- S.null s
364− when (not r) $ do
365− _ <- S.head s
366− S.tail s >>= mapM_ nullHeadTail
367−
368−-- Head recursive operations.
369−o_n_stack_iterated :: Int -> [Benchmark]
370−o_n_stack_iterated value = by10 `seq` by100 `seq`
371− [ bgroup "iterated"
372− [ benchIOSrc serially "mapM (n/10 x 10)" $ iterateMapM by10 10
373− , benchIOSrc serially "scanl' (quadratic) (n/100 x 100)" $
374− iterateScan by100 100
375− , benchIOSrc serially "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
376− , benchIOSrc serially "filterEven (n/10 x 10)" $
377− iterateFilterEven by10 10
378− , benchIOSrc serially "takeAll (n/10 x 10)" $
379− iterateTakeAll value by10 10
380− , benchIOSrc serially "dropOne (n/10 x 10)" $ iterateDropOne by10 10
381− , benchIOSrc serially "dropWhileFalse (n/10 x 10)" $
382− iterateDropWhileFalse value by10 10
383− , benchIOSrc serially "dropWhileTrue (n/10 x 10)" $
384− iterateDropWhileTrue value by10 10
385− , benchIOSink value "tail" tail
386− , benchIOSink value "nullHeadTail" nullHeadTail
387− ]
388− ]
389−
390− where
391−
392− by10 = value `div` 10
393− by100 = value `div` 100
394−
395−-------------------------------------------------------------------------------
396−-- Pipes
397−-------------------------------------------------------------------------------
398−
399−o_1_space_pipes :: Int -> [Benchmark]
400−o_1_space_pipes value =
401− [ bgroup "pipes"
402− [ benchIOSink value "mapM" (transformMapM serially 1)
403− , benchIOSink value "compose" (transformComposeMapM serially 1)
404− , benchIOSink value "tee" (transformTeeMapM serially 1)
405−#ifdef DEVBUILD
406− -- XXX this take 1 GB memory to compile
407− , benchIOSink value "zip" (transformZipMapM serially 1)
408−#endif
409− ]
410− ]
411−
412−o_1_space_pipesX4 :: Int -> [Benchmark]
413−o_1_space_pipesX4 value =
414− [ bgroup "pipesX4"
415− [ benchIOSink value "mapM" (transformMapM serially 4)
416− , benchIOSink value "compose" (transformComposeMapM serially 4)
417− , benchIOSink value "tee" (transformTeeMapM serially 4)
418−#ifdef DEVBUILD
419− -- XXX this take 1 GB memory to compile
420− , benchIOSink value "zip" (transformZipMapM serially 4)
421−#endif
422− ]
423− ]
424−
425−-------------------------------------------------------------------------------
426−-- Main
427−-------------------------------------------------------------------------------
428−
429−-- In addition to gauge options, the number of elements in the stream can be
430−-- passed using the --stream-size option.
431−--
432−benchmarks :: String -> Int -> [Benchmark]
433−benchmarks moduleName size =
434− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
435− [ o_1_space_grouping size
436− , o_1_space_transformations_mixed size
437− , o_1_space_transformations_mixedX4 size
438−
439− -- pipes
440− , o_1_space_pipes size
441− , o_1_space_pipesX4 size
442− ]
443− , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
444− , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
445− [ o_n_space_grouping size
446− , o_n_space_functor size
447− , o_n_heap_buffering size
448− ]
449− ]
benchmark/Streamly/Benchmark/Prelude/Serial/Transformation3.hsdeleted−122
@@ -1,122 +0,0 @@
1−-- |
2−-- Module : Serial.Transformation3
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.Transformation3 (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, serially)
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 serially "evalState" (evalStateT value)
59− , benchIOSrc serially "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−iterateState ::
88− (S.MonadAsync m, MonadState Int m)
89− => Int
90− -> SerialT m Int
91−iterateState n = do
92− x <- get
93− if x > n
94− then do
95− put (x - 1)
96− iterateState n
97− else return x
98−
99−o_n_heap_transformer :: Int -> [Benchmark]
100−o_n_heap_transformer value =
101− [ bgroup "transformer"
102− [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
103− State.evalStateT (iterateStateIO n) value
104− , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
105− State.evalStateT (S.drain (iterateStateT n)) value
106− , benchIO "MonadState Int m => SerialT m Int" $ \n ->
107− State.evalStateT (S.drain (iterateState n)) value
108− ]
109− ]
110−
111−-------------------------------------------------------------------------------
112−-- Main
113−-------------------------------------------------------------------------------
114−
115−-- In addition to gauge options, the number of elements in the stream can be
116−-- passed using the --stream-size option.
117−--
118−benchmarks :: String -> Int -> [Benchmark]
119−benchmarks moduleName size =
120− [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
121− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
122− ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hs+30−30
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -7,13 +9,13 @@
7
9
8import Prelude hiding (mapM)
10import Prelude hiding (mapM)
9
11
10−import Streamly.Prelude (wAsyncly, serially, wAsync, maxBuffer, maxThreads)
12+import Streamly.Prelude (fromWAsync, fromSerial, wAsync, maxBuffer, maxThreads)
11import qualified Streamly.Prelude as S
13import qualified Streamly.Prelude as S
12
14
13import Streamly.Benchmark.Common
15import Streamly.Benchmark.Common
14import Streamly.Benchmark.Prelude
16import Streamly.Benchmark.Prelude
15
17
16−import Gauge
18+import Test.Tasty.Bench
17
19
18moduleName :: String
20moduleName :: String
19moduleName = "Prelude.WAsync"
21moduleName = "Prelude.WAsync"
@@ -25,13 +27,13 @@ moduleName = "Prelude.WAsync"
25o_1_space_generation :: Int -> [Benchmark]
27o_1_space_generation :: Int -> [Benchmark]
26o_1_space_generation value =
28o_1_space_generation value =
27 [ bgroup "generation"
29 [ bgroup "generation"
28− [ benchIOSrc wAsyncly "unfoldr" (sourceUnfoldr value)
30+ [ benchIOSrc fromWAsync "unfoldr" (sourceUnfoldr value)
29− , benchIOSrc wAsyncly "unfoldrM" (sourceUnfoldrM value)
31+ , benchIOSrc fromWAsync "unfoldrM" (sourceUnfoldrM value)
30− , benchIOSrc wAsyncly "fromFoldable" (sourceFromFoldable value)
32+ , benchIOSrc fromWAsync "fromFoldable" (sourceFromFoldable value)
31− , benchIOSrc wAsyncly "fromFoldableM" (sourceFromFoldableM value)
33+ , benchIOSrc fromWAsync "fromFoldableM" (sourceFromFoldableM value)
32− , benchIOSrc wAsyncly "unfoldrM maxThreads 1"
34+ , benchIOSrc fromWAsync "unfoldrM maxThreads 1"
33 (maxThreads 1 . sourceUnfoldrM value)
35 (maxThreads 1 . sourceUnfoldrM value)
34− , benchIOSrc wAsyncly "unfoldrM maxBuffer 1 (x/10 ops)"
36+ , benchIOSrc fromWAsync "unfoldrM maxBuffer 1 (x/10 ops)"
35 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
37 (maxBuffer 1 . sourceUnfoldrM (value `div` 10))
36 ]
38 ]
37 ]
39 ]
@@ -43,9 +45,9 @@ o_1_space_generation value =
43o_1_space_mapping :: Int -> [Benchmark]
45o_1_space_mapping :: Int -> [Benchmark]
44o_1_space_mapping value =
46o_1_space_mapping value =
45 [ bgroup "mapping"
47 [ bgroup "mapping"
46− [ benchIOSink value "map" $ mapN wAsyncly 1
48+ [ benchIOSink value "map" $ mapN fromWAsync 1
47− , benchIOSink value "fmap" $ fmapN wAsyncly 1
49+ , benchIOSink value "fmap" $ fmapN fromWAsync 1
48− , benchIOSink value "mapM" $ mapM wAsyncly 1 . serially
50+ , benchIOSink value "mapM" $ mapM fromWAsync 1 . fromSerial
49 ]
51 ]
50 ]
52 ]
51
53
@@ -93,17 +95,17 @@ o_1_space_joining value =
93o_1_space_concatFoldable :: Int -> [Benchmark]
95o_1_space_concatFoldable :: Int -> [Benchmark]
94o_1_space_concatFoldable value =
96o_1_space_concatFoldable value =
95 [ bgroup "concat-foldable"
97 [ bgroup "concat-foldable"
96− [ benchIOSrc wAsyncly "foldMapWith (<>) (List)"
98+ [ benchIOSrc fromWAsync "foldMapWith (<>) (List)"
97 (sourceFoldMapWith value)
99 (sourceFoldMapWith value)
98− , benchIOSrc wAsyncly "foldMapWith (<>) (Stream)"
100+ , benchIOSrc fromWAsync "foldMapWith (<>) (Stream)"
99 (sourceFoldMapWithStream value)
101 (sourceFoldMapWithStream value)
100− , benchIOSrc wAsyncly "foldMapWithM (<>) (List)"
102+ , benchIOSrc fromWAsync "foldMapWithM (<>) (List)"
101 (sourceFoldMapWithM value)
103 (sourceFoldMapWithM value)
102− , benchIOSrc serially "S.concatFoldableWith (<>) (List)"
104+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
103 (concatFoldableWith value)
105 (concatFoldableWith value)
104− , benchIOSrc serially "S.concatForFoldableWith (<>) (List)"
106+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
105 (concatForFoldableWith value)
107 (concatForFoldableWith value)
106− , benchIOSrc wAsyncly "foldMapM (List)" (sourceFoldMapM value)
108+ , benchIOSrc fromWAsync "foldMapM (List)" (sourceFoldMapM value)
107 ]
109 ]
108 ]
110 ]
109
111
@@ -120,7 +122,7 @@ o_1_space_concatMap value =
120 value2 `seq`
122 value2 `seq`
121 [ bgroup "concat"
123 [ bgroup "concat"
122 -- This is for comparison with foldMapWith
124 -- This is for comparison with foldMapWith
123− [ benchIOSrc serially "concatMapWithId (n of 1) (fromFoldable)"
125+ [ benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
124 (S.concatMapWith wAsync id . sourceConcatMapId value)
126 (S.concatMapWith wAsync id . sourceConcatMapId value)
125
127
126 , benchIO "concatMapWith (n of 1)"
128 , benchIO "concatMapWith (n of 1)"
@@ -143,13 +145,13 @@ o_1_space_concatMap value =
143o_n_heap_outerProduct :: Int -> [Benchmark]
145o_n_heap_outerProduct :: Int -> [Benchmark]
144o_n_heap_outerProduct value =
146o_n_heap_outerProduct value =
145 [ bgroup "monad-outer-product"
147 [ bgroup "monad-outer-product"
146− [ benchIO "toNullAp" $ toNullAp value wAsyncly
148+ [ benchIO "toNullAp" $ toNullAp value fromWAsync
147− , benchIO "toNull" $ toNullM value wAsyncly
149+ , benchIO "toNull" $ toNullM value fromWAsync
148− , benchIO "toNull3" $ toNullM3 value wAsyncly
150+ , benchIO "toNull3" $ toNullM3 value fromWAsync
149− , benchIO "filterAllOut" $ filterAllOutM value wAsyncly
151+ , benchIO "filterAllOut" $ filterAllOutM value fromWAsync
150− , benchIO "filterAllIn" $ filterAllInM value wAsyncly
152+ , benchIO "filterAllIn" $ filterAllInM value fromWAsync
151− , benchIO "filterSome" $ filterSome value wAsyncly
153+ , benchIO "filterSome" $ filterSome value fromWAsync
152− , benchIO "breakAfterSome" $ breakAfterSome value wAsyncly
154+ , benchIO "breakAfterSome" $ breakAfterSome value fromWAsync
153
155
154 ]
156 ]
155 ]
157 ]
@@ -157,8 +159,8 @@ o_n_heap_outerProduct value =
157o_n_space_outerProduct :: Int -> [Benchmark]
159o_n_space_outerProduct :: Int -> [Benchmark]
158o_n_space_outerProduct value =
160o_n_space_outerProduct value =
159 [ bgroup "monad-outer-product"
161 [ bgroup "monad-outer-product"
160− [ benchIO "toList" $ toListM value wAsyncly
162+ [ benchIO "toList" $ toListM value fromWAsync
161− , benchIO "toListSome" $ toListSome value wAsyncly
163+ , benchIO "toListSome" $ toListSome value fromWAsync
162 ]
164 ]
163 ]
165 ]
164
166
@@ -167,9 +169,7 @@ o_n_space_outerProduct value =
167-------------------------------------------------------------------------------
169-------------------------------------------------------------------------------
168
170
169main :: IO ()
171main :: IO ()
170−main = do
172+main = runWithCLIOpts defaultStreamSize allBenchmarks
171− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
172− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
173
173
174 where
174 where
175
175
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+218−68
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -19,7 +21,7 @@
19{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20#endif
22#endif
21
23
22−import Streamly.Prelude (wSerial, wSerially)
24+import Streamly.Prelude (wSerial, fromWSerial)
23import qualified Streamly.Prelude as S
25import qualified Streamly.Prelude as S
24import qualified Streamly.Internal.Data.Stream.IsStream as Internal
26import qualified Streamly.Internal.Data.Stream.IsStream as Internal
25import qualified Streamly.Internal.Data.Unfold as UF
27import qualified Streamly.Internal.Data.Unfold as UF
@@ -27,13 +29,13 @@ import qualified Streamly.Internal.Data.Unfold as UF
27import Streamly.Benchmark.Common
29import Streamly.Benchmark.Common
28import Streamly.Benchmark.Prelude
30import Streamly.Benchmark.Prelude
29
31
30−import Gauge
32+import Test.Tasty.Bench
31
33
32#ifdef INSPECTION
34#ifdef INSPECTION
33import GHC.Types (SPEC(..))
35import GHC.Types (SPEC(..))
34import Test.Inspection
36import Test.Inspection
35
37
36−import qualified Streamly.Internal.Data.Stream.StreamD as D
38+import qualified Streamly.Internal.Data.Stream as D
37#endif
39#endif
38
40
39moduleName :: String
41moduleName :: String
@@ -46,7 +48,7 @@ moduleName = "Prelude.WSerial"
46o_1_space_mapping :: Int -> [Benchmark]
48o_1_space_mapping :: Int -> [Benchmark]
47o_1_space_mapping value =
49o_1_space_mapping value =
48 [ bgroup "mapping"
50 [ bgroup "mapping"
49− [ benchIOSink value "fmap" $ fmapN wSerially 1 ]
51+ [ benchIOSink value "fmap" $ fmapN fromWSerial 1 ]
50 ]
52 ]
51
53
52-------------------------------------------------------------------------------
54-------------------------------------------------------------------------------
@@ -88,18 +90,54 @@ inspect $ 'roundRobin2 `hasNoType` ''SPEC
88inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
90inspect $ 'roundRobin2 `hasNoType` ''D.InterleaveState
89#endif
91#endif
90
92
91−o_1_space_joining :: Int -> [Benchmark]
93+{-# INLINE sourceUnfoldrMUF #-}
92−o_1_space_joining value =
94+-- (count, value)
93− [ bgroup "joining"
95+sourceUnfoldrMUF :: Monad m => Int -> UF.Unfold m (Int, Int) Int
94− [ benchIOSrc1 "wSerial (2,x/2)" (wSerial2 value)
96+sourceUnfoldrMUF count = UF.unfoldrM step
95− , benchIOSrc1 "interleave (2,x/2)" (interleave2 value)
97+ where
96− , benchIOSrc1 "roundRobin (2,x/2)" (roundRobin2 value)
98+ step (cnt, start) =
97− ]
99+ return $
98− ]
100+ if cnt > start + count
101+ then Nothing
102+ else Just (cnt, (cnt + 1, start))
103+
104+{-# INLINE unfoldManyInterleave #-}
105+unfoldManyInterleave :: Int -> Int -> Int -> IO ()
106+unfoldManyInterleave outer inner n =
107+ S.drain $ Internal.unfoldManyInterleave
108+ -- (UF.lmap return (UF.replicateM inner))
109+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
110+ (sourceUnfoldrM outer n)
99
111
100−-------------------------------------------------------------------------------
112+#ifdef INSPECTION
101−-- Concat
113+inspect $ hasNoTypeClasses 'unfoldManyInterleave
102−-------------------------------------------------------------------------------
114+-- inspect $ 'unfoldManyInterleave `hasNoType` ''SPEC
115+-- inspect $ 'unfoldManyInterleave `hasNoType`
116+-- ''D.ConcatUnfoldInterleaveState
117+#endif
118+
119+{-# INLINE unfoldManyRoundRobin #-}
120+unfoldManyRoundRobin :: Int -> Int -> Int -> IO ()
121+unfoldManyRoundRobin outer inner n =
122+ S.drain $ Internal.unfoldManyRoundRobin
123+ -- (UF.lmap return (UF.replicateM inner))
124+ (UF.lmap (\x -> (x,x)) (sourceUnfoldrMUF inner))
125+ (sourceUnfoldrM outer n)
126+
127+#ifdef INSPECTION
128+inspect $ hasNoTypeClasses 'unfoldManyRoundRobin
129+-- inspect $ 'unfoldManyRoundRobin `hasNoType` ''SPEC
130+-- inspect $ 'unfoldManyRoundRobin `hasNoType`
131+-- ''D.ConcatUnfoldInterleaveState
132+#endif
133+
134+{-# INLINE concatPairsWithWSerial #-}
135+concatPairsWithWSerial :: Int -> Int -> Int -> IO ()
136+concatPairsWithWSerial = concatPairsWith Internal.wSerial
137+
138+{-# INLINE concatPairsWithRoundrobin #-}
139+concatPairsWithRoundrobin :: Int -> Int -> Int -> IO ()
140+concatPairsWithRoundrobin = concatPairsWith Internal.roundrobin
103
141
104{-# INLINE concatMapWithWSerial #-}
142{-# INLINE concatMapWithWSerial #-}
105concatMapWithWSerial :: Int -> Int -> Int -> IO ()
143concatMapWithWSerial :: Int -> Int -> Int -> IO ()
@@ -110,86 +148,198 @@ inspect $ hasNoTypeClasses 'concatMapWithWSerial
110inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC
148inspect $ 'concatMapWithWSerial `hasNoType` ''SPEC
111#endif
149#endif
112
150
151+o_1_space_joining :: Int -> [Benchmark]
152+o_1_space_joining value =
153+ [ bgroup "joining (2 of n/2)"
154+ [ benchIOSrc1 "wSerial" (wSerial2 value)
155+ , benchIOSrc1 "interleave" (interleave2 value)
156+ , benchIOSrc1 "roundRobin" (roundRobin2 value)
157+ , benchIOSrc1
158+ "concatMapWithWSerial"
159+ (concatMapWithWSerial 2 (value `div` 2))
160+ , benchIOSrc1
161+ "concatMapWithInterleave"
162+ (concatStreamsWith Internal.interleave 2 (value `div` 2))
163+ , benchIOSrc1
164+ "concatMapWithRoundrobin"
165+ (concatStreamsWith Internal.roundrobin 2 (value `div` 2))
166+ , benchIOSrc1
167+ "unfoldManyInterleave"
168+ (unfoldManyInterleave 2 (value `div` 2))
169+ , benchIOSrc1
170+ "concatPairsWithWSerial"
171+ (concatPairsWithWSerial 2 (value `div` 2))
172+ , benchIOSrc1
173+ "concatPairsWithRoundrobin"
174+ (concatPairsWithRoundrobin 2 (value `div` 2))
175+ ]
176+ ]
177+
178+-------------------------------------------------------------------------------
179+-- Concat
180+-------------------------------------------------------------------------------
181+
113o_1_space_concat :: Int -> [Benchmark]
182o_1_space_concat :: Int -> [Benchmark]
114o_1_space_concat value =
183o_1_space_concat value =
115− [ bgroup "concat"
184+ [ bgroup "concatMapWith"
116 [ benchIOSrc1
185 [ benchIOSrc1
117− "concatMapWithWSerial (2,x/2)"
186+ "concatMapWithWSerial (n of 1)"
118− (concatMapWithWSerial 2 (value `div` 2))
187+ (concatStreamsWith wSerial value 1)
119 , benchIOSrc1
188 , benchIOSrc1
120− "concatMapWithWSerial (x/2,2)"
189+ "concatMapWithWSerial (sqrtVal of sqrtVal)"
121− (concatMapWithWSerial (value `div` 2) 2)
190+ (concatStreamsWith wSerial sqrtVal sqrtVal)
122 ]
191 ]
123 ]
192 ]
124
193
125−{-# INLINE concatUnfoldInterleaveRepl4xN #-}
194+ where
126−concatUnfoldInterleaveRepl4xN :: Int -> Int -> IO ()
127−concatUnfoldInterleaveRepl4xN value n =
128− S.drain $ Internal.concatUnfoldInterleave
129− (UF.lmap return (UF.replicateM 4))
130− (sourceUnfoldrM (value `div` 4) n)
131
195
132−#ifdef INSPECTION
196+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
133−inspect $ hasNoTypeClasses 'concatUnfoldInterleaveRepl4xN
134−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType` ''SPEC
135−-- inspect $ 'concatUnfoldInterleaveRepl4xN `hasNoType`
136−-- ''D.ConcatUnfoldInterleaveState
137−#endif
138
197
139−{-# INLINE concatUnfoldRoundrobinRepl4xN #-}
198+o_n_space_concat :: Int -> [Benchmark]
140−concatUnfoldRoundrobinRepl4xN :: Int -> Int -> IO ()
199+o_n_space_concat value =
141−concatUnfoldRoundrobinRepl4xN value n =
200+ [ bgroup "concatMapWith"
142− S.drain $ Internal.concatUnfoldRoundrobin
201+ [
143− (UF.lmap return (UF.replicateM 4))
202+ -- concatMapWith using StreamD versions of interleave operations are
144− (sourceUnfoldrM (value `div` 4) n)
203+ -- all quadratic, we just measure the sqrtVal benchmark for comparison.
204+ benchIOSrc1
205+ "concatMapWithInterleave (sqrtVal of 1)"
206+ (concatStreamsWith Internal.interleave sqrtVal 1)
207+ , benchIOSrc1
208+ "concatMapWithInterleave (sqrtVal of sqrtVal)"
209+ (concatStreamsWith Internal.interleave sqrtVal sqrtVal)
210+ , benchIOSrc1
211+ "concatMapWithRoundrobin (sqrtVal of sqrtVal)"
212+ (concatStreamsWith Internal.roundrobin sqrtVal sqrtVal)
213+ ]
214+ ]
145
215
146−#ifdef INSPECTION
216+ where
147−inspect $ hasNoTypeClasses 'concatUnfoldRoundrobinRepl4xN
217+
148−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType` ''SPEC
218+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
149−-- inspect $ 'concatUnfoldRoundrobinRepl4xN `hasNoType`
219+
150−-- ''D.ConcatUnfoldInterleaveState
220+{-# INLINE concatPairsWithInterleave #-}
151−#endif
221+concatPairsWithInterleave :: Int -> Int -> Int -> IO ()
222+concatPairsWithInterleave = concatPairsWith Internal.interleave
223+
224+{-# INLINE concatPairsWithInterleaveSuffix #-}
225+concatPairsWithInterleaveSuffix :: Int -> Int -> Int -> IO ()
226+concatPairsWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix
227+
228+{-# INLINE concatPairsWithInterleaveInfix #-}
229+concatPairsWithInterleaveInfix :: Int -> Int -> Int -> IO ()
230+concatPairsWithInterleaveInfix = concatPairsWith Internal.interleaveInfix
231+
232+{-# INLINE concatPairsWithInterleaveMin #-}
233+concatPairsWithInterleaveMin :: Int -> Int -> Int -> IO ()
234+concatPairsWithInterleaveMin = concatPairsWith Internal.interleaveMin
152
235
153o_n_heap_concat :: Int -> [Benchmark]
236o_n_heap_concat :: Int -> [Benchmark]
154o_n_heap_concat value =
237o_n_heap_concat value =
155− [ bgroup "concat"
238+ [ bgroup "concatPairsWith"
156 [
239 [
157− -- interleave x/4 streams of 4 elements each. Needs to buffer
158− -- proportional to x/4. This is different from WSerial because
159− -- WSerial expands slowly because of binary interleave behavior and
160− -- this expands immediately because of Nary interleave behavior.
161 benchIOSrc1
240 benchIOSrc1
162− "concatUnfoldInterleaveRepl (x/4,4)"
241+ "unfoldManyInterleave (n of 1)"
163− (concatUnfoldInterleaveRepl4xN value)
242+ (unfoldManyInterleave value 1)
243+ , benchIOSrc1
244+ "unfoldManyInterleave (sqrtVal of sqrtVal)"
245+ (unfoldManyInterleave sqrtVal sqrtVal)
246+
247+ , benchIOSrc1
248+ "unfoldManyRoundRobin (n of 1)"
249+ (unfoldManyRoundRobin value 1)
250+ , benchIOSrc1
251+ "unfoldManyRoundRobin (sqrtVal of sqrtVal)"
252+ (unfoldManyRoundRobin sqrtVal sqrtVal)
253+
164 , benchIOSrc1
254 , benchIOSrc1
165− "concatUnfoldRoundrobinRepl (x/4,4)"
255+ "concatPairsWithWSerial (n of 1)"
166− (concatUnfoldRoundrobinRepl4xN value)
256+ (concatPairsWithWSerial value 1)
257+ , benchIOSrc1
258+ "concatPairsWithWSerial (sqrtVal of sqrtVal)"
259+ (concatPairsWithWSerial sqrtVal sqrtVal)
260+
261+ , benchIOSrc1
262+ "concatPairsWithInterleave (n of 1)"
263+ (concatPairsWithInterleave value 1)
264+ , benchIOSrc1
265+ "concatPairsWithInterleave (sqrtVal of sqrtVal)"
266+ (concatPairsWithInterleave sqrtVal sqrtVal)
267+
268+ , benchIOSrc1
269+ "concatPairsWithInterleaveSuffix (n of 1)"
270+ (concatPairsWithInterleaveSuffix value 1)
271+ , benchIOSrc1
272+ "concatPairsWithInterleaveSuffix (sqrtVal of sqrtVal)"
273+ (concatPairsWithInterleaveSuffix sqrtVal sqrtVal)
274+
275+ , benchIOSrc1
276+ "concatPairsWithInterleaveInfix (n of 1)"
277+ (concatPairsWithInterleaveInfix value 1)
278+ , benchIOSrc1
279+ "concatPairsWithInterleaveInfix (sqrtVal of sqrtVal)"
280+ (concatPairsWithInterleaveInfix sqrtVal sqrtVal)
281+
282+ , benchIOSrc1
283+ "concatPairsWithInterleaveMin (n of 1)"
284+ (concatPairsWithInterleaveMin value 1)
285+ , benchIOSrc1
286+ "concatPairsWithInterleaveMin (sqrtVal of sqrtVal)"
287+ (concatPairsWithInterleaveMin sqrtVal sqrtVal)
288+
289+ , benchIOSrc1
290+ "concatPairsWithRoundrobin (n of 1)"
291+ (concatPairsWithRoundrobin value 1)
292+ , benchIOSrc1
293+ "concatPairsWithRoundrobin (sqrtVal of sqrtVal)"
294+ (concatPairsWithRoundrobin sqrtVal sqrtVal)
167 ]
295 ]
168 ]
296 ]
169
297
298+ where
299+
300+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
301+
170-------------------------------------------------------------------------------
302-------------------------------------------------------------------------------
171-- Monad
303-- Monad
172-------------------------------------------------------------------------------
304-------------------------------------------------------------------------------
173
305
174o_1_space_outerProduct :: Int -> [Benchmark]
306o_1_space_outerProduct :: Int -> [Benchmark]
175o_1_space_outerProduct value =
307o_1_space_outerProduct value =
176− [ bgroup "monad-outer-product"
308+ [ bgroup "outer-product"
309+ [ benchIO
310+ "drain applicative (+) (sqrtVal of sqrtVal)"
177− [ benchIO "toNullAp" $ toNullAp value wSerially
311+ (toNullAp value fromWSerial)
312+ , benchIO
313+ "drain monad (+) (sqrtVal of sqrtVal)"
178− , benchIO "toNullM" $ toNullM value wSerially
314+ (toNullM value fromWSerial)
315+ , benchIO
316+ "drain monad (+) (cbrtVal of cbrtVal of cbrtVal)"
179− , benchIO "toNullM3" $ toNullM3 value wSerially
317+ (toNullM3 value fromWSerial)
318+ , benchIO
319+ "filterAllOut monad (+) (sqrtVal of sqrtVal)"
180− , benchIO "filterAllOutM" $ filterAllOutM value wSerially
320+ (filterAllOutM value fromWSerial)
321+ , benchIO
322+ "filterAllIn monad (+) (sqrtVal of sqrtVal)"
181− , benchIO "filterAllInM" $ filterAllInM value wSerially
323+ (filterAllInM value fromWSerial)
324+ , benchIO
325+ "filterSome monad (+) (sqrtVal of sqrtVal)"
182− , benchIO "filterSome" $ filterSome value wSerially
326+ (filterSome value fromWSerial)
327+ , benchIO
328+ "breakAfterSome monad (+) (sqrtVal of sqrtVal)"
183− , benchIO "breakAfterSome" $ breakAfterSome value wSerially
329+ (breakAfterSome value fromWSerial)
184 ]
330 ]
185 ]
331 ]
186
332
187o_n_space_outerProduct :: Int -> [Benchmark]
333o_n_space_outerProduct :: Int -> [Benchmark]
188o_n_space_outerProduct value =
334o_n_space_outerProduct value =
189 [ bgroup
335 [ bgroup
190− "monad-outer-product"
336+ "outer-product"
337+ [ benchIO
338+ "toList monad (+) (sqrtVal of sqrtVal)"
191− [ benchIO "toList" $ toListM value wSerially
339+ (toListM value fromWSerial)
340+ , benchIO
341+ "toListSome monad (+) (sqrtVal of sqrtVal)"
192− , benchIO "toListSome" $ toListSome value wSerially
342+ (toListSome value fromWSerial)
193 ]
343 ]
194 ]
344 ]
195
345
@@ -201,9 +351,8 @@ o_n_space_outerProduct value =
201-- passed using the --stream-size option.
351-- passed using the --stream-size option.
202--
352--
203main :: IO ()
353main :: IO ()
204−main = do
354+main = runWithCLIOpts defaultStreamSize allBenchmarks
205− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
355+
206− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
207
356
208 where
357 where
209
358
@@ -215,5 +364,6 @@ main = do
215 , o_1_space_outerProduct size
364 , o_1_space_outerProduct size
216 ]
365 ]
217 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
366 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
218− , bgroup (o_n_space_prefix moduleName) (o_n_space_outerProduct size)
367+ , bgroup (o_n_space_prefix moduleName) $
368+ o_n_space_outerProduct size ++ o_n_space_concat size
219 ]
369 ]
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+25−11
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Main
4-- Module : Main
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -7,13 +9,13 @@
7
9
8{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE FlexibleContexts #-}
9
11
10−import Streamly.Prelude (serially)
12+import Streamly.Prelude (fromSerial)
11import qualified Streamly.Prelude as S
13import qualified Streamly.Prelude as S
12
14
13import Streamly.Benchmark.Common
15import Streamly.Benchmark.Common
14import Streamly.Benchmark.Prelude
16import Streamly.Benchmark.Prelude
15
17
16−import Gauge
18+import Test.Tasty.Bench
17
19
18moduleName :: String
20moduleName :: String
19moduleName = "Prelude.ZipAsync"
21moduleName = "Prelude.ZipAsync"
@@ -38,18 +40,31 @@ zipAsyncWithM count n =
38{-# INLINE zipAsyncAp #-}
40{-# INLINE zipAsyncAp #-}
39zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
41zipAsyncAp :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m (Int, Int)
40zipAsyncAp count n =
42zipAsyncAp count n =
41− S.zipAsyncly $
43+ S.fromZipAsync $
42 (,) <$> sourceUnfoldrM count n <*> sourceUnfoldrM count (n + 1)
44 (,) <$> sourceUnfoldrM count n <*> sourceUnfoldrM count (n + 1)
43
45
46+fromZipAsyncTraverse :: String -> Int -> Benchmark
47+fromZipAsyncTraverse name count =
48+ bench name
49+ $ nfIO
50+ $ S.drain $ S.fromZipAsync $ traverse S.fromPure [0 :: Int .. count]
51+
44o_1_space_joining :: Int -> [Benchmark]
52o_1_space_joining :: Int -> [Benchmark]
45o_1_space_joining value =
53o_1_space_joining value =
46 [ bgroup "joining"
54 [ bgroup "joining"
47− [ benchIOSrc serially "zipAsyncWith (2,x/2)" (zipAsyncWith
55+ [ benchIOSrc fromSerial "zipAsyncWith (2,x/2)" (zipAsyncWith
48 (value `div` 2))
56 (value `div` 2))
49− , benchIOSrc serially "zipAsyncWithM (2,x/2)" (zipAsyncWithM
57+ , benchIOSrc fromSerial "zipAsyncWithM (2,x/2)" (zipAsyncWithM
50 (value `div` 2))
58 (value `div` 2))
51− , benchIOSrc serially "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
59+ , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
52− , benchIOSink value "fmap zipAsyncly" $ fmapN S.zipAsyncly 1
60+ , 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)
53 ]
68 ]
54 ]
69 ]
55
70
@@ -60,7 +75,7 @@ o_1_space_joining value =
60o_1_space_outerProduct :: Int -> [Benchmark]
75o_1_space_outerProduct :: Int -> [Benchmark]
61o_1_space_outerProduct value =
76o_1_space_outerProduct value =
62 [ bgroup "monad-outer-product"
77 [ bgroup "monad-outer-product"
63− [ benchIO "toNullAp" $ toNullAp value S.zipAsyncly
78+ [ benchIO "toNullAp" $ toNullAp value S.fromZipAsync
64 ]
79 ]
65 ]
80 ]
66
81
@@ -69,9 +84,7 @@ o_1_space_outerProduct value =
69-------------------------------------------------------------------------------
84-------------------------------------------------------------------------------
70
85
71main :: IO ()
86main :: IO ()
72−main = do
87+main = runWithCLIOpts defaultStreamSize allBenchmarks
73− (value, cfg, benches) <- parseCLIOpts defaultStreamSize
74− value `seq` runMode (mode cfg) cfg benches (allBenchmarks value)
75
88
76 where
89 where
77
90
@@ -80,4 +93,5 @@ main = do
80 [ o_1_space_joining size
93 [ o_1_space_joining size
81 , o_1_space_outerProduct size
94 , o_1_space_outerProduct size
82 ]
95 ]
96+ , bgroup (o_n_heap_prefix moduleName) $ o_n_heap_joining size
83 ]
97 ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+56−10

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Char.hsnew file+90

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Parser.hsnew file+107

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Stream.hs+165−104

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/Utf8.hsnew file+55

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/AllChars.txtnew file+216

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Deutsch.txtnew file+153

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Devanagari.txtnew file+699

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/English.txtnew file+58

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Japanese.txtnew file+855

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Korean.txtnew file+493

This diff is too big to show here.

benchmark/Streamly/Benchmark/Unicode/data/Vietnamese.txtnew file+402

This diff is too big to show here.

benchmark/bench-runner/Main.hsnew file+183

This diff is too big to show here.

benchmark/bench-runner/bench-runner.cabalnew file+42

This diff is too big to show here.

benchmark/bench-runner/cabal.projectnew file+4

This diff is too big to show here.

benchmark/bench-runner/default.nixnew file+164

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Common.hs+65−17

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Common/Handle.hs+47−32

This diff is too big to show here.

benchmark/lib/Streamly/Benchmark/Prelude.hs+110−44

This diff is too big to show here.

benchmark/streamly-benchmarks.cabal+465−168

This diff is too big to show here.

bin/bench-exec-one.shdeleted−184

This diff is too big to show here.

bin/bench.shdeleted−428

This diff is too big to show here.

bin/build-lib.shdeleted−246

This diff is too big to show here.

bin/mk-hscope.sh+2−2

This diff is too big to show here.

bin/replnew file+3

This diff is too big to show here.

bin/run-ci.sh+235−75

This diff is too big to show here.

bin/run-repl-quick.shnew file+113

This diff is too big to show here.

bin/targets.shdeleted−112

This diff is too big to show here.

bin/test.shdeleted−175

This diff is too big to show here.

cabal.project+2

This diff is too big to show here.

cabal.project.O0new file+24

This diff is too big to show here.

cabal.project.ci → cabal.project.Werrorrenamed+4

This diff is too big to show here.

cabal.project.Werror-nocodenew file+21

This diff is too big to show here.

cabal.project.coverage+5−4

This diff is too big to show here.

cabal.project.doctestnew file+24

This diff is too big to show here.

cabal.project.ghc-headnew file+35

This diff is too big to show here.

cabal.project.hpc-coveralls+1−1

This diff is too big to show here.

cabal.project.packdiffnew file+9

This diff is too big to show here.

cabal.project.reportnew file+30

This diff is too big to show here.

cabal.project.streamlynew file+10

This diff is too big to show here.

configure+1368−1516

This diff is too big to show here.

configure.ac+1−5

This diff is too big to show here.

core/Changelog.mdnew file+1

This diff is too big to show here.

core/LICENSEnew file+322

This diff is too big to show here.

core/Setup.hsnew file+6

This diff is too big to show here.

core/configurenew file+4349

This diff is too big to show here.

core/configure.acnew file+17

This diff is too big to show here.

core/docs/ApiChangelogs/0.1.0-0.2.0.txtnew file+1471

This diff is too big to show here.

core/docs/ApiChangelogs/0.1.0.txtnew file+405

This diff is too big to show here.

core/docs/ApiChangelogs/0.2.0-0.2.2.txtnew file+306

This diff is too big to show here.

core/docs/Changelog.mdnew file+97

This diff is too big to show here.

core/docs/Readme.mdnew file+1

This diff is too big to show here.

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

The content is the same.

core/src/DocTestDataArray.hsnew file+22

This diff is too big to show here.

core/src/DocTestDataFold.hsnew file+27

This diff is too big to show here.

core/src/DocTestDataMutArray.hsnew file+10

This diff is too big to show here.

core/src/DocTestDataMutArrayGeneric.hsnew file+10

This diff is too big to show here.

core/src/DocTestDataParser.hsnew file+20

This diff is too big to show here.

core/src/DocTestDataParserK.hsnew file+15

This diff is too big to show here.

core/src/DocTestDataStream.hsnew file+39

This diff is too big to show here.

core/src/DocTestDataStreamK.hsnew file+21

This diff is too big to show here.

core/src/DocTestDataUnfold.hsnew file+12

This diff is too big to show here.

core/src/DocTestFileSystemHandle.hsnew file+15

This diff is too big to show here.

core/src/DocTestUnicodeParser.hsnew file+9

This diff is too big to show here.

core/src/DocTestUnicodeStream.hsnew file+12

This diff is too big to show here.

core/src/DocTestUnicodeString.hsnew file+5

This diff is too big to show here.

core/src/Streamly/Console/Stdio.hsnew file+30

This diff is too big to show here.

core/src/Streamly/Data/Array.hsnew file+167

This diff is too big to show here.

core/src/Streamly/Data/Array/Generic.hsnew file+51

This diff is too big to show here.

core/src/Streamly/Data/Fold.hsnew file+415

This diff is too big to show here.

core/src/Streamly/Data/MutArray.hsnew file+110

This diff is too big to show here.

core/src/Streamly/Data/MutArray/Generic.hsnew file+70

This diff is too big to show here.

core/src/Streamly/Data/MutByteArray.hsnew file+106

This diff is too big to show here.

core/src/Streamly/Data/Parser.hsnew file+247

This diff is too big to show here.

core/src/Streamly/Data/ParserK.hsnew file+139

This diff is too big to show here.

core/src/Streamly/Data/Stream.hsnew file+746

This diff is too big to show here.

core/src/Streamly/Data/StreamK.hsnew file+194

This diff is too big to show here.

core/src/Streamly/Data/Unfold.hsnew file+233

This diff is too big to show here.

core/src/Streamly/FileSystem/Dir.hsnew file+23

This diff is too big to show here.

core/src/Streamly/FileSystem/File.hsnew file+60

This diff is too big to show here.

core/src/Streamly/FileSystem/Handle.hsnew file+117

This diff is too big to show here.

core/src/Streamly/Internal/BaseCompat.hsnew file+37

This diff is too big to show here.

core/src/Streamly/Internal/Console/Stdio.hsnew file+228

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Control/ForkIO.hsnew file+50

This diff is too big to show here.

src/Streamly/Internal/Control/Monad.hs → core/src/Streamly/Internal/Control/Monad.hsrenamed

The content is the same.

core/src/Streamly/Internal/Data/Array.hsnew file+1018

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/ArrayMacros.hnew file+43

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Generic.hsnew file+342

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Stream.hsnew file+725

This diff is too big to show here.

core/src/Streamly/Internal/Data/Array/Type.hsnew file+1148

This diff is too big to show here.

src/Streamly/Internal/Data/Binary/Decode.hs → core/src/Streamly/Internal/Data/Binary/Parser.hsrenamed+165−44

This diff is too big to show here.

core/src/Streamly/Internal/Data/Binary/Stream.hsnew file+383

This diff is too big to show here.

core/src/Streamly/Internal/Data/Builder.hsnew file+82

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold.hsnew file+33

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Chunked.hsnew file+379

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Combinators.hsnew file+2452

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Container.hsnew file+783

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Step.hsnew file+83

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Tee.hsnew file+184

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Type.hsnew file+2099

This diff is too big to show here.

core/src/Streamly/Internal/Data/Fold/Window.hsnew file+357

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/IORef/Unboxed.hsnew file+101

This diff is too big to show here.

core/src/Streamly/Internal/Data/IsMap.hsnew file+60

This diff is too big to show here.

core/src/Streamly/Internal/Data/List.hsnew file+234

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray.hsnew file+207

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Generic.hsnew file+947

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Stream.hsnew file+145

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutArray/Type.hsnew file+3318

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutByteArray.hsnew file+251

This diff is too big to show here.

core/src/Streamly/Internal/Data/MutByteArray/Type.hsnew file+321

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser.hsnew file+3621

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Type.hsnew file+1452

This diff is too big to show here.

core/src/Streamly/Internal/Data/ParserK.hsnew file+16

This diff is too big to show here.

core/src/Streamly/Internal/Data/ParserK/Type.hsnew file+752

This diff is too big to show here.

core/src/Streamly/Internal/Data/Pipe.hsnew file+273

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Producer.hs → core/src/Streamly/Internal/Data/Producer.hsrenamed+7−14

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Refold/Type.hsnew file+251

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring.hsnew file+619

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring/Generic.hsnew file+185

This diff is too big to show here.

core/src/Streamly/Internal/Data/SVar/Type.hsnew file+540

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH.hsnew file+530

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/Bottom.hsnew file+475

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/Common.hsnew file+70

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/TH/RecHeader.hsnew file+411

This diff is too big to show here.

core/src/Streamly/Internal/Data/Serialize/Type.hsnew file+317

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream.hsnew file+42

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Container.hsnew file+310

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Eliminate.hsnew file+849

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Exception.hsnew file+501

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Generate.hsnew file+1191

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Lift.hsnew file+129

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs → core/src/Streamly/Internal/Data/Stream/Nesting.hsrenamed+957−259

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/StreamD.hsnew file+16

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Top.hsnew file+480

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Transform.hsnew file+1971

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Transformer.hsnew file+183

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Type.hsnew file+2220

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK.hsnew file+1730

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK/Transformer.hsnew file+79

This diff is too big to show here.

core/src/Streamly/Internal/Data/StreamK/Type.hsnew file+2153

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock.hsnew file+180

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unbox.hsnew file+908

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unbox/TH.hsnew file+498

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold.hsnew file+1077

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Enumeration.hsnew file+543

This diff is too big to show here.

core/src/Streamly/Internal/Data/Unfold/Type.hsnew file+999

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Dir.hs → core/src/Streamly/Internal/FileSystem/Dir.hsrenamed+192−85

This diff is too big to show here.

src/Streamly/Internal/FileSystem/File.hs → core/src/Streamly/Internal/FileSystem/File.hsrenamed+240−145

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Handle.hs → core/src/Streamly/Internal/FileSystem/Handle.hsrenamed+328−287

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Path.hsnew file+515

This diff is too big to show here.

core/src/Streamly/Internal/System/IO.hsnew file+58

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Array.hsnew file+104

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Parser.hsnew file+627

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Stream.hsnew file+1123

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/String.hsnew file+158

This diff is too big to show here.

core/src/Streamly/Unicode/Parser.hsnew file+69

This diff is too big to show here.

src/Streamly/Unicode/Stream.hs → core/src/Streamly/Unicode/Stream.hsrenamed+32−18

This diff is too big to show here.

core/src/Streamly/Unicode/String.hsnew file+30

This diff is too big to show here.

core/src/assert.hsnew file+6

This diff is too big to show here.

core/src/config.h.innew file+57

This diff is too big to show here.

core/src/inline.hsnew file+27

This diff is too big to show here.

core/streamly-core.cabalnew file+534

This diff is too big to show here.

credits/COPYRIGHTS.mddeleted−77

This diff is too big to show here.

credits/Yampa-0.10.6.2.txtdeleted−29

This diff is too big to show here.

credits/base-4.12.0.0.txtdeleted−83

This diff is too big to show here.

credits/bjoern-2008-2009.txtdeleted−19

This diff is too big to show here.

credits/clock-0.7.2.txtdeleted−32

This diff is too big to show here.

credits/foldl-1.4.5.txtdeleted−24

This diff is too big to show here.

credits/fsnotify-0.3.0.1.txtdeleted−30

This diff is too big to show here.

credits/hfsevents-0.1.6.txtdeleted−30

This diff is too big to show here.

credits/pipes-concurrency-2.0.8.txtdeleted−24

This diff is too big to show here.

credits/primitive-0.7.0.0.txtdeleted−30

This diff is too big to show here.

credits/transient-0.5.5.txtdeleted−18

This diff is too big to show here.

credits/vector-0.12.0.2.txtdeleted−30

This diff is too big to show here.

default.nix+48−11

This diff is too big to show here.

docs/Developer/Benchmarks.mdnew file+342

This diff is too big to show here.

docs/Developer/Contributing.mdnew file+271

This diff is too big to show here.

docs/Developer/Github.linknew file+1

This diff is too big to show here.

docs/Developer/MAINTAINING.mdnew file+422

This diff is too big to show here.

docs/Developer/Tests.mdnew file+139

This diff is too big to show here.

docs/Developer/ci-tests.mdnew file+64

This diff is too big to show here.

docs/Developer/container-api.mdnew file+124

This diff is too big to show here.

design/cps-vs-direct.rst → docs/Developer/cps-vs-direct.rstrenamed+4−4

This diff is too big to show here.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

The content is the same.

design/module-organization.md → docs/Developer/module-organization.mdrenamed+5−5

This diff is too big to show here.

design/optimization-guidelines.md → docs/Developer/optimization-guidelines.mdrenamed+14−2

This diff is too big to show here.

docs/Developer/overview.mdnew file+24

This diff is too big to show here.

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

This diff is too big to show here.

docs/Developer/related-packages.mdnew file+71

This diff is too big to show here.

docs/Developer/resources.mdnew file+45

This diff is too big to show here.

docs/Developer/roadmap.mdnew file+36

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

docs/Documentation.mdnew file+5

This diff is too big to show here.

docs/Setup.hsnew file+6

This diff is too big to show here.

docs/User/Explanatory/Overview.mdnew file+468

This diff is too big to show here.

docs/User/Explanatory/design.mdnew file+42

This diff is too big to show here.

docs/User/Explanatory/monad-transformers.mdnew file+65

This diff is too big to show here.

docs/User/Explanatory/performance.mdnew file+7

This diff is too big to show here.

docs/User/Explanatory/streaming-pradigms.rstnew file+117

This diff is too big to show here.

docs/User/Explanatory/unified-abstractions.mdnew file+275

This diff is too big to show here.

docs/User/HowTo/Compiling.mdnew file+145

This diff is too big to show here.

docs/User/HowTo/Examples.linknew file+1

This diff is too big to show here.

docs/User/HowTo/faq.mdnew file+94

This diff is too big to show here.

docs/User/HowTo/interoperation.mdnew file+11

This diff is too big to show here.

docs/Build.md → docs/User/HowTo/optimizing.mdrenamed+9−120

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txtnew file+175

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.8.3.txtnew file+261

This diff is too big to show here.

docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txtnew file+424

This diff is too big to show here.

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

This diff is too big to show here.

Changelog.md → docs/User/Project/Changelog.mdrenamed+235−74

This diff is too big to show here.

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

This diff is too big to show here.

docs/User/Project/Github.linknew file+1

This diff is too big to show here.

docs/User/Project/README.mdnew file+141

This diff is too big to show here.

docs/User/Project/Roadmap.linknew file+1

This diff is too big to show here.

docs/User/Project/Upgrading-0.8-to-0.9.mdnew file+384

This diff is too big to show here.

docs/User/Tutorials/ConcurrentStreams.hsnew file+771

This diff is too big to show here.

docs/User/Tutorials/Examples.linknew file+1

This diff is too big to show here.

docs/User/Tutorials/ReactiveProgramming.hsnew file+126

This diff is too big to show here.

docs/User/Tutorials/Tutorial.hsnew file+521

This diff is too big to show here.

docs/User/Tutorials/before-you-begin.mdnew file+77

This diff is too big to show here.

docs/User/Tutorials/getting-started.mdnew file+225

This diff is too big to show here.

docs/User/Tutorials/haskell-lazy-evaluation.mdnew file+215

This diff is too big to show here.

docs/User/Tutorials/quick-overview.mdnew file+517

This diff is too big to show here.

docs/User/Tutorials/why-haskell-streamly.mdnew file+91

This diff is too big to show here.

docs/User/resources.mdnew file+18

This diff is too big to show here.

docs/streamly-docs.cabalnew file+49

This diff is too big to show here.

docs/transformers.mddeleted−32

This diff is too big to show here.

doctests.hsdeleted−14

This diff is too big to show here.

examples/README.md+1−1

This diff is too big to show here.

hie.yaml+103−30

This diff is too big to show here.

src/Streamly.hsdeleted−658

This diff is too big to show here.

src/Streamly/Data/Array.hsdeleted−43

This diff is too big to show here.

src/Streamly/Data/Array/Foreign.hs+52−6

This diff is too big to show here.

src/Streamly/Data/Fold.hsdeleted−274

This diff is too big to show here.

src/Streamly/Data/Fold/Prelude.hsnew file+65

This diff is too big to show here.

src/Streamly/Data/Fold/Tee.hsnew file+16

This diff is too big to show here.

src/Streamly/Data/Prim/Array.hsdeleted−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.hsnew file+115

This diff is too big to show here.

src/Streamly/Data/Stream/Prelude.hsnew file+232

This diff is too big to show here.

src/Streamly/Data/Unfold.hsdeleted−62

This diff is too big to show here.

src/Streamly/Data/Unicode/Stream.hsdeleted−99

This diff is too big to show here.

src/Streamly/FileSystem/Handle.hsdeleted−86

This diff is too big to show here.

src/Streamly/Internal/BaseCompat.hsdeleted−42

This diff is too big to show here.

src/Streamly/Internal/Control/Concurrent.hs+51−63

This diff is too big to show here.

src/Streamly/Internal/Control/ForkLifted.hsnew file+66

This diff is too big to show here.

src/Streamly/Internal/Data/Array.hsdeleted−206

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign.hsdeleted−576

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Mut/Type.hsdeleted−1256

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Type.hsdeleted−667

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim.hsdeleted−110

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Mut/Type.hsdeleted−94

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hsdeleted−407

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Pinned.hsdeleted−108

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hsdeleted−176

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hsdeleted−127

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/Type.hsdeleted−98

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Prim/TypesInclude.hsdeleted−703

This diff is too big to show here.

src/Streamly/Internal/Data/Array/PrimInclude.hsdeleted−185

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Stream/Foreign.hsdeleted−387

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Stream/Mut/Foreign.hsdeleted−311

This diff is too big to show here.

src/Streamly/Internal/Data/Channel.hsnew file+19

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Dispatcher.hsnew file+294

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Types.hsnew file+817

This diff is too big to show here.

src/Streamly/Internal/Data/Channel/Worker.hsnew file+375

This diff is too big to show here.

src/Streamly/Internal/Data/Fold.hsdeleted−1795

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Async.hsnew file+133

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent.hsnew file+57

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent/Channel.hsnew file+112

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hsnew file+331

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Prelude.hsnew file+19

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/SVar.hsnew file+79

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Tee.hsdeleted−158

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Type.hsdeleted−1132

This diff is too big to show here.

src/Streamly/Internal/Data/IOFinalizer/Lifted.hsnew file+74

This diff is too big to show here.

src/Streamly/Internal/Data/IORef/Prim.hsdeleted−110

This diff is too big to show here.

src/Streamly/Internal/Data/IsMap/HashMap.hsnew file+42

This diff is too big to show here.

src/Streamly/Internal/Data/List.hsdeleted−188

This diff is too big to show here.

src/Streamly/Internal/Data/Parser.hsdeleted−1118

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserD.hsdeleted−1033

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserD/Type.hsdeleted−883

This diff is too big to show here.

src/Streamly/Internal/Data/Parser/ParserK/Type.hsdeleted−467

This diff is too big to show here.

src/Streamly/Internal/Data/Pipe.hsdeleted−1968

This diff is too big to show here.

src/Streamly/Internal/Data/SVar.hs+116−1989

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Dispatch.hsnew file+739

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Pull.hsnew file+164

This diff is too big to show here.

src/Streamly/Internal/Data/SVar/Worker.hsnew file+544

This diff is too big to show here.

src/Streamly/Internal/Data/Sink.hsdeleted−245

This diff is too big to show here.

src/Streamly/Internal/Data/Sink/Type.hsdeleted−24

This diff is too big to show here.

src/Streamly/Internal/Data/SmallArray.hs+41−34

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Ahead.hs+148−120

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Async.hs+266−214

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Common.hsnew file+105

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent.hsnew file+903

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel.hsnew file+109

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hsnew file+1046

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Consumer.hsnew file+127

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hsnew file+417

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hsnew file+252

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hsnew file+294

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hsnew file+172

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream.hs+30−6

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Combinators.hs+8−3

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Common.hs+300−75

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+176−139

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Enumeration.hs+89−41

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Exception.hs+109−27

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Expand.hsnew file+1158

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+202−131

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Lift.hs+18−16

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Nesting.hs → src/Streamly/Internal/Data/Stream/IsStream/Reduce.hsrenamed+525−1158

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+265−123

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Transform.hs+331−258

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Type.hsnew file+783

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Types.hsdeleted−74

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Lifted.hsnew file+335

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/MkType.hsnew file+641

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Parallel.hs+144−264

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar.hs+7−678

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Eliminate.hsnew file+405

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Generate.hsnew file+294

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Serial.hs+196−251

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD.hsdeleted−36

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hsdeleted−491

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Exception.hsdeleted−350

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Generate.hsdeleted−398

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Lift.hsdeleted−112

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Transform.hsdeleted−1226

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamD/Type.hsdeleted−962

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamDK.hsdeleted−156

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamK.hsdeleted−1121

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/StreamK/Type.hsdeleted−1188

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Time.hsnew file+950

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Zip.hs+82−182

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/ZipAsync.hsnew file+134

This diff is too big to show here.

src/Streamly/Internal/Data/Time.hsdeleted−74

This diff is too big to show here.

src/Streamly/Internal/Data/Time/Clock.hsdeleted−80

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold.hsdeleted−1303

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Exception.hsnew file+214

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Prelude.hsnew file+17

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/SVar.hsnew file+161

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Type.hsdeleted−373

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event.hsnew file+245

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.hs+219−163

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Linux.hs+282−222

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Windows.hs+224−167

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FD.hs+76−65

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FDIO.hs+2−11

This diff is too big to show here.

src/Streamly/Internal/Foreign/Malloc.hsdeleted−49

This diff is too big to show here.

src/Streamly/Internal/Network/Inet/TCP.hs+180−143

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+226−286

This diff is too big to show here.

src/Streamly/Internal/Ring/Foreign.hsdeleted−250

This diff is too big to show here.

src/Streamly/Internal/System/IOVec.hsnew file+132

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Unicode/Array/Char.hsdeleted−92

This diff is too big to show here.

src/Streamly/Internal/Unicode/Array/Prim/Pinned.hsdeleted−91

This diff is too big to show here.

src/Streamly/Internal/Unicode/Char.hs+266−3

This diff is too big to show here.

src/Streamly/Internal/Unicode/Stream.hsdeleted−927

This diff is too big to show here.

src/Streamly/Internal/Unicode/Utf8.hsnew file+73

This diff is too big to show here.

src/Streamly/Memory/Array.hsdeleted−74

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Network/Socket.hs+93−55

This diff is too big to show here.

src/Streamly/Prelude.hs+560−384

This diff is too big to show here.

src/Streamly/Tutorial.hsdeleted−1730

This diff is too big to show here.

src/assert.hsnew file+6

This diff is too big to show here.

src/config.h.in−36

This diff is too big to show here.

src/inline.hs+2−2

This diff is too big to show here.

stack.yaml+10−10

This diff is too big to show here.

streamly.cabal+343−383

This diff is too big to show here.

targets/Targets.hsnew file+213

This diff is too big to show here.

targets/cabal.projectnew file+1

This diff is too big to show here.

targets/default.nixnew file+163

This diff is too big to show here.

targets/streamly-targets.cabalnew file+12

This diff is too big to show here.

test/README.mdmode 100644 → 120000+1−97

This diff is too big to show here.

test/Streamly/Test/Common/Array.hsdeleted−248

This diff is too big to show here.

test/Streamly/Test/Data/Array.hs+268−3

This diff is too big to show here.

test/Streamly/Test/Data/Array/Common.hsnew file+101

This diff is too big to show here.

test/Streamly/Test/Data/Array/CommonImports.hsnew file+13

This diff is too big to show here.

test/Streamly/Test/Data/Array/Foreign.hsdeleted−12

This diff is too big to show here.

test/Streamly/Test/Data/Array/Generic.hsnew file+65

This diff is too big to show here.

test/Streamly/Test/Data/Array/Prim.hsdeleted−12

This diff is too big to show here.

test/Streamly/Test/Data/Array/Prim/Pinned.hsdeleted−12

This diff is too big to show here.

test/Streamly/Test/Data/Array/Stream.hsnew file+113

This diff is too big to show here.

test/Streamly/Test/Data/Fold.hs+391−74

This diff is too big to show here.

test/Streamly/Test/Data/Fold/Window.hsnew file+67

This diff is too big to show here.

test/Streamly/Test/Data/List.hs+29−28

This diff is too big to show here.

test/Streamly/Test/Data/MutArray.hsnew file+152

This diff is too big to show here.

test/Streamly/Test/Data/Parser.hs+840−205

This diff is too big to show here.

test/Streamly/Test/Data/Parser/ParserD.hs → test/Streamly/Test/Data/ParserK.hsrenamed+177−108

This diff is too big to show here.

test/Streamly/Test/Data/Ring/Unboxed.hsnew file+53

This diff is too big to show here.

test/Streamly/Test/Data/Serialize.hsnew file+306

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/CompatV0.hsnew file+46

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/CompatV1.hsnew file+48

This diff is too big to show here.

test/Streamly/Test/Data/Serialize/TH.hsnew file+82

This diff is too big to show here.

test/Streamly/Test/Data/SmallArray.hs+20−3

This diff is too big to show here.

test/Streamly/Test/Data/Stream.hsnew file+33

This diff is too big to show here.

test/Streamly/Test/Data/Stream/Concurrent.hsnew file+363

This diff is too big to show here.

test/Streamly/Test/Data/Unbox.hsnew file+347

This diff is too big to show here.

test/Streamly/Test/Data/Unbox/TH.hsnew file+146

This diff is too big to show here.

test/Streamly/Test/Data/Unfold.hs+341−86

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event.hs+15−386

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Common.hsnew file+422

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Darwin.hsnew file+86

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Linux.hsnew file+163

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event/Windows.hsnew file+51

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Network/Inet/TCP.hs+33−22

This diff is too big to show here.

test/Streamly/Test/Network/Socket.hs+43−30

This diff is too big to show here.

test/Streamly/Test/Prelude.hs+40−38

This diff is too big to show here.

test/Streamly/Test/Prelude/Ahead.hs+17−15

This diff is too big to show here.

test/Streamly/Test/Prelude/Async.hs+51−14

This diff is too big to show here.

test/Streamly/Test/Prelude/Concurrent.hs+58−52

This diff is too big to show here.

test/Streamly/Test/Prelude/Fold.hs+28−13

This diff is too big to show here.

test/Streamly/Test/Prelude/Parallel.hs+21−19

This diff is too big to show here.

test/Streamly/Test/Prelude/Rate.hs+47−39

This diff is too big to show here.

test/Streamly/Test/Prelude/Serial.hs+211−143

This diff is too big to show here.

test/Streamly/Test/Prelude/Top.hsnew file+224

This diff is too big to show here.

test/Streamly/Test/Prelude/WAsync.hs+75−22

This diff is too big to show here.

test/Streamly/Test/Prelude/WSerial.hs+21−18

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipAsync.hs+10−5

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipSerial.hs+12−10

This diff is too big to show here.

test/Streamly/Test/Serialize/Serializable.hsnew file+237

This diff is too big to show here.

test/Streamly/Test/Unicode/Char.hsnew file+133

This diff is too big to show here.

test/Streamly/Test/Unicode/Parser.hsnew file+231

This diff is too big to show here.

test/Streamly/Test/Unicode/Stream.hs+40−33

This diff is too big to show here.

test/Streamly/Test/Unicode/extra/NormalizationTest.txtnew file+9

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/lib/Streamly/Test/Prelude/Common.hs+119−103

This diff is too big to show here.

test/streamly-tests.cabal+280−41

This diff is too big to show here.

test/test-runner/Main.hs+33

This diff is too big to show here.

test/test-runner/cabal.project+4

This diff is too big to show here.

test/test-runner/default.nix+164

This diff is too big to show here.

test/test-runner/test-runner.cabal+41

This diff is too big to show here.