on master help sign in
.circleci/config.yml+78−279
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,15 +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_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
43− CABAL_BUILD_OPTIONS: "--flag limit-build-mem"
42+ CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
44
43
45 # ------------------------------------------------------------------------
44 # ------------------------------------------------------------------------
46 # Where to find the required tools
45 # Where to find the required tools
47 # ------------------------------------------------------------------------
46 # ------------------------------------------------------------------------
48− PATH: /opt/ghc/bin:/opt/ghcjs/bin:/sbin:/usr/sbin:/bin:/usr/bin
47+ PATH: /sbin:/usr/sbin:/bin:/usr/bin
49− TOOLS_DIR: /opt
50
48
51 # ------------------------------------------------------------------------
49 # ------------------------------------------------------------------------
52 # 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 ).
@@ -59,15 +57,15 @@ env: &env
59 # 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
60 # then it is automatically pulled from this URL.
58 # then it is automatically pulled from this URL.
61 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
59 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
62− PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
60+ PACKCHECK_GITHUB_COMMIT: "f6cfd7b7a33b4bf6fd63cce6a3fb3d26f5031403"
63
61
64executors:
62executors:
65 amd64-executor:
63 amd64-executor:
66 docker:
64 docker:
67− - image: ubuntu:xenial
65+ - image: ubuntu:latest
68 x86-executor:
66 x86-executor:
69 docker:
67 docker:
70− - image: i386/ubuntu:eoan
68+ - image: i386/ubuntu:focal
71
69
72#-----------------------------------------------------------------------------
70#-----------------------------------------------------------------------------
73# Common utility stuff, not to be modified usually
71# Common utility stuff, not to be modified usually
@@ -79,38 +77,50 @@ preinstall: &preinstall
79 # required for https/cache save and restore
77 # required for https/cache save and restore
80 apt-get install -y ca-certificates
78 apt-get install -y ca-certificates
81
79
82− # required to (re)generate the configure script
80+ # Alternative way of installing ghc and cabal, directly from
83− apt-get install -y autoconf
81+ # haskell.org instead of using ghcup. NOTE: this is for Debian
84−
82+ # only and is debian release specific.
85− # For ghc and cabal-install packages from hvr's ppa
86 # gnupg is required for apt-key to work
83 # gnupg is required for apt-key to work
87− apt-get install -y gnupg
84+ #apt-get install -y gnupg
88− apt-get install -y apt-transport-https
89− apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
85+ #apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
90− apt-get install -y software-properties-common
91− add-apt-repository -y ppa:hvr/ghc
92− # echo "deb http://downloads.haskell.org/debian stretch main" >> /etc/apt/sources.list
86+ #echo "deb http://downloads.haskell.org/debian buster main" >> /etc/apt/sources.list
93− echo "deb-src http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main" >> /etc/apt/sources.list
94− apt-get update
87+ #apt-get update
95
88
96− # required for packcheck
89+ # required for outbound https for stack and for stack setup
90+ apt-get install -y netbase xz-utils make
97− apt-get install -y curl
91+ apt-get install -y zlib1g-dev
98
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+
99− # required for circleci.
100+ # libgmp required by ghc for linking
100− apt-get install -y libcurl4-gnutls-dev
101+ apt-get install -y libgmp-dev
101− apt-get install -y git
102 apt-get install -y libtinfo-dev
102 apt-get install -y libtinfo-dev
103
103
104− # required for outbound https for stack and for stack setup
104+ # Required by cabal when git URL is specified in project file
105+ apt-get install -y git
106+
107+ # Required for and by packcheck
105− apt-get install -y netbase xz-utils make
108+ apt-get install -y curl
106
109
107−project-preinstall: &project-preinstall
108− run: |
109 # Get packcheck if needed
110 # Get packcheck if needed
110− 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
111− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
117+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
112− 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
113− chmod +x $PACKCHECK
122+ chmod +x $PACKCHECK
123+ fi
114
124
115restore: &restore
125restore: &restore
116 # Needs to happen after installing ca-certificates
126 # Needs to happen after installing ca-certificates
@@ -126,269 +136,72 @@ save: &save
126 save_cache:
136 save_cache:
127 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
137 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
128 paths:
138 paths:
129− - ~/.cabal
130− - ~/.ghc
131 - ~/.local
139 - ~/.local
140+ - ~/.cabal
132 - ~/.stack
141 - ~/.stack
142+ - ~/.ghcup
133
143
134#-----------------------------------------------------------------------------
144#-----------------------------------------------------------------------------
135# Build matrix
145# Build matrix
136#-----------------------------------------------------------------------------
146#-----------------------------------------------------------------------------
137
147
138jobs:
148jobs:
139− cabal-ghc-8_10_4:
140− <<: *env
141− executor: amd64-executor
142− steps:
143− - *preinstall
144− - checkout
145− - *project-preinstall
146− - *restore
147− - run:
148− environment:
149− DISABLE_TEST: "yes"
150− DISABLE_BENCH: "yes"
151− DISABLE_DIST_CHECKS: "yes"
152− command: |
153− apt-get install -y ghc-8.10.4
154− apt-get install -y cabal-install-3.4
155− bash -c "$PACKCHECK cabal"
156− - *save
157− stack-ghc-8_8:
158− <<: *env
159− executor: amd64-executor
160− steps:
161− - *preinstall
162− - checkout
163− - *project-preinstall
164− - *restore
165− - run:
166− name: GHC 8.8 + stack lts-16.12
167− environment:
168− BUILD: "stack"
169− RESOLVER: "lts-16.12"
170− SDIST_OPTIONS: "--ignore-check"
171− STACK_BUILD_OPTIONS: "--flag streamly-benchmarks:-opt"
172− command: |
173− apt-get build-dep -y ghc-8.8.4
174− apt-get install -y cabal-install-3.2
175− bash -c "$PACKCHECK $BUILD"
176− - *save
177 cabal-ghc-8_6_5:
149 cabal-ghc-8_6_5:
178 <<: *env
150 <<: *env
179 executor: amd64-executor
151 executor: amd64-executor
180 steps:
152 steps:
181− - *preinstall
182 - checkout
153 - checkout
183− - *project-preinstall
184 - *restore
154 - *restore
185− - run: |
186− apt-get install -y ghc-8.6.3
187− apt-get install -y cabal-install-2.4
188− bash -c "$PACKCHECK cabal-v2"
189− - *save
190− cabal-ghc-8_4_4:
191− <<: *env
192− executor: x86-executor
193− steps:
194 - *preinstall
155 - *preinstall
195− - checkout
196− - *project-preinstall
197− - *restore
198− - run:
199− name: GHC 8.4.4 + x86 + debug
200− environment:
201− BUILD: "cabal-v2"
202− GHCVER: "8.4.4"
203− CABAL_BUILD_OPTIONS: "--flag debug --flag limit-build-mem"
204− command: |
205− apt-get install -y ghc-8.4.4
206− apt-get install -y cabal-install-3.2
207− bash -c "$PACKCHECK $BUILD"
208− - *save
209− cabal-ghc-8_2_2:
210− <<: *env
211− executor: amd64-executor
212− steps:
213− - *preinstall
214− - checkout
215− - *project-preinstall
216− - *restore
217 - run:
156 - run:
218 environment:
157 environment:
219− BUILD: "cabal-v2"
158+ GHCVER: "8.6.5"
220− DISABLE_TEST: "yes"
159+ CABAL_VERSION: "3.6.2.0"
221− DISABLE_BENCH: "yes"
160+ CABAL_PROJECT: "cabal.project"
222− DISABLE_DOCS: "yes"
223 DISABLE_SDIST_BUILD: "yes"
161 DISABLE_SDIST_BUILD: "yes"
224− DISABLE_DIST_CHECKS: "yes"
162+ CABAL_BUILD_OPTIONS: "--flag debug --flag -opt"
225 command: |
163 command: |
226− apt-get install -y ghc-8.2.2
227− apt-get install -y cabal-install-3.2
228− bash -c "$PACKCHECK $BUILD"
164+ bash -c "$PACKCHECK cabal"
229− - *save
230− cabal-ghc-8_0_2:
231− <<: *env
232− executor: amd64-executor
233− steps:
234− - *preinstall
235− - checkout
236− - *project-preinstall
237− - *restore
238− - run:
239− environment:
240− BUILD: "cabal-v2"
241− DISABLE_TEST: "yes"
242− DISABLE_BENCH: "yes"
243− DISABLE_DOCS: "yes"
244− DISABLE_SDIST_BUILD: "yes"
245− DISABLE_DIST_CHECKS: "yes"
246− command: |
247− apt-get install -y ghc-8.0.2
248− apt-get install -y cabal-install-3.2
249− bash -c "$PACKCHECK $BUILD"
250− - *save
251− cabal-ghc-7_10_3:
252− <<: *env
253− executor: amd64-executor
254− steps:
255− - *preinstall
256− - checkout
257− - *project-preinstall
258− - *restore
259− - run: |
260− apt-get install -y ghc-7.10.3
261− apt-get install -y cabal-install-2.4
262− bash -c "$PACKCHECK cabal-v2"
263− - *save
264− stack-ghc-8_4:
265− <<: *env
266− executor: amd64-executor
267− steps:
268− - *preinstall
269− - checkout
270− - *project-preinstall
271− - *restore
272− - run: |
273− bash -c "$PACKCHECK stack RESOLVER=lts-12"
274− - *save
275− stack-ghc-8_2:
276− <<: *env
277− executor: amd64-executor
278− steps:
279− - *preinstall
280− - checkout
281− - *project-preinstall
282− - *restore
283− - run: |
284− bash -c "$PACKCHECK stack RESOLVER=lts-11"
285− - *save
286− cabal-ghcjs-8_4:
287− <<: *env
288− executor: amd64-executor
289− steps:
290− - *preinstall
291− - checkout
292− - *project-preinstall
293− - *restore
294− - run:
295− name: GHCJS 8.4+no-test+no-docs
296− environment:
297− BUILD: cabal-v2
298− ENABLE_GHCJS: "yes"
299− DISABLE_TEST: "yes"
300− ENABLE_INSTALL: ""
301− DISABLE_DOCS: "yes"
302− DISABLE_SDIST_BUILD: "yes"
303− command: |
304− add-apt-repository -y ppa:hvr/ghcjs
305− add-apt-repository -y 'deb https://deb.nodesource.com/node_11.x xenial main'
306− curl -sSL https://deb.nodesource.com/gpgkey/nodesource.gpg.key | apt-key add -
307− apt-get update
308− apt-get install -y cabal-install-3.2
309− apt-get install -y nodejs
310− apt-get install -y ghcjs-8.4
311− cabal user-config update -a "jobs: 1"
312− bash -c "$PACKCHECK $BUILD"
313 - *save
165 - *save
314− coveralls-ghc-8_2_2:
166+ cabal-ghc-9_8_1-docspec:
315 <<: *env
167 <<: *env
316 executor: amd64-executor
168 executor: amd64-executor
317 steps:
169 steps:
318− - *preinstall
319 - checkout
170 - checkout
320− - *project-preinstall
321 - *restore
171 - *restore
322− - run:
323− environment:
324− BUILD: cabal
325− COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test test"
326− GHC_OPTIONS: "-DCOVERAGE_BUILD"
327− command: |
328− apt-get install -y ghc-8.2.2
329− apt-get install -y cabal-install-2.4
330− bash -c "$PACKCHECK cabal-v1"
331− - *save
332− coveralls-ghc-8_8_3:
333− <<: *env
334− executor: amd64-executor
335− steps:
336 - *preinstall
172 - *preinstall
337− - checkout
338− - *project-preinstall
339− - *restore
340 - run:
173 - run:
341 environment:
174 environment:
342− BUILD: cabal-v2
175+ GHCVER: "9.8.1"
343− COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test"
176+ CABAL_VERSION: "3.10.1.0"
344− CABAL_PROJECT: "cabal.project.coverage"
177+ CABAL_PROJECT: "cabal.project.doctest"
345− CABAL_BUILD_TARGETS: ""
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"
346 command: |
185 command: |
347− apt-get install -y ghc-8.8.3
348− apt-get install -y cabal-install-3.0
349− bash -c "$PACKCHECK cabal-v2"
186+ bash -c "$PACKCHECK cabal"
350− no_output_timeout: 25m
351 - *save
187 - *save
352− coveralls-ghc-8_10_2:
188+ hlint-trailing-spaces:
353 <<: *env
189 <<: *env
354 executor: amd64-executor
190 executor: amd64-executor
355 steps:
191 steps:
356− - *preinstall
357 - checkout
192 - checkout
358− - *project-preinstall
359 - *restore
193 - *restore
360− - run:
361− name: Build and test with inspection, coverage, Werror
362− command: |
363− apt-get install -y ghc-8.10.2
364− apt-get install -y cabal-install-3.2
365− # Run tests with coverage
366− cabal update
367− cabal user-config update -a "jobs: 1"
368− bin/test.sh --coverage --raw
369− # Upload results to coveralls.io
370− PATH=$HOME/.cabal/bin:$PATH
371− export PATH
372− which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
373− hpc-coveralls --repo-token="$REPO_TOKEN" --coverage-mode=StrictlyFullLines
374− no_output_timeout: 25m
375− - *save
376− hlint-src:
377− <<: *env
378− executor: amd64-executor
379− steps:
380 - *preinstall
194 - *preinstall
381− - checkout
382− - *project-preinstall
383− - *restore
384 - run:
195 - run:
385− name: Hlint src
196+ name: hlint and trailing spaces
386 environment:
197 environment:
387− BUILD: cabal-v2
198+ DISABLE_SDIST_BUILD: "yes"
199+ HLINT_VERSION: 3.6.1
388− HLINT_OPTIONS: lint --cpp-include=src --cpp-include=test
200+ HLINT_OPTIONS: lint
389− HLINT_TARGETS: src test benchmark
201+ HLINT_TARGETS: core/src src test benchmark
390 command: |
202 command: |
391− bash -c "$PACKCHECK $BUILD" || exit 1
203+ bash -c "$PACKCHECK hlint" || exit 1
204+ echo "Checking trailing spaces..."
392 count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
205 count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
393 exit $count
206 exit $count
394 - *save
207 - *save
@@ -397,23 +210,9 @@ workflows:
397 version: 2
210 version: 2
398 build:
211 build:
399 jobs:
212 jobs:
400− - cabal-ghc-8_10_4:
213+ #- cabal-ghc-8_6_5:
401− name: GHC 8.10.4 + sdist
214+ # name: 8.6.5-debug-unoptimized
402− #- cabal-ghc-8.6.5
403− #- cabal-ghc-8_4_4:
404− # name: GHC 8.4.4 + x86 + debug
405− - cabal-ghc-8_2_2:
406− name: GHC 8.2.2 + no-test + no-bench + no-docs
407− - cabal-ghc-8_0_2:
408− name: GHC 8.0.2 + no-test + no-bench + no-docs
409− #- cabal-ghc-7.10.3
215+ - cabal-ghc-9_8_1-docspec:
410− - cabal-ghcjs-8_4:
216+ name: ghc-9.8.1-docspec
411− name: GHCJS 8.4 + no-test + no-docs
217+ - hlint-trailing-spaces:
412− #- stack-ghc-8.4
218+ name: hlint and trailing spaces
413− #- stack-ghc-8.2
414− #- coveralls-ghc-8.2.2
415− #- coveralls-ghc-8.8.3
416− #- coveralls-ghc-8_10_2:
417− # name: GHC 8.10.2 + inspection + coverage + Werror
418− - hlint-src:
419− name: Hlint src + Trailing Spaces
.github/workflows/haskell.yml+166−90
@@ -8,14 +8,22 @@ on:
8
8
9jobs:
9jobs:
10 build:
10 build:
11− name: GHC ${{ matrix.name }}
11+ name: GHC ${{matrix.name}}
12 env:
12 env:
13 # packcheck environment variables
13 # packcheck environment variables
14 LC_ALL: C.UTF-8
14 LC_ALL: C.UTF-8
15 BUILD: ${{ matrix.build }}
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 }}
16 GHCVER: ${{ matrix.ghc_version }}
21 GHCVER: ${{ matrix.ghc_version }}
22+ CABALVER: ${{ matrix.cabal_version }}
17 DISABLE_DOCS: ${{ matrix.disable_docs }}
23 DISABLE_DOCS: ${{ matrix.disable_docs }}
24+ ENABLE_DOCSPEC: ${{ matrix.enable_docspec }}
18 DISABLE_TEST: ${{ matrix.disable_test }}
25 DISABLE_TEST: ${{ matrix.disable_test }}
26+ DISABLE_BENCH: ${{ matrix.disable_bench }}
19 DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
27 DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
20 SDIST_OPTIONS: ${{ matrix.sdist_options }}
28 SDIST_OPTIONS: ${{ matrix.sdist_options }}
21 DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
29 DISABLE_SDIST_BUILD: ${{ matrix.disable_sdist_build }}
@@ -37,136 +45,192 @@ jobs:
37 STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
45 STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
38
46
39 # packcheck location and revision
47 # packcheck location and revision
40− PACKCHECK_LOCAL_PATH: "./packcheck.sh"
48+ PACKCHECK: "./packcheck.sh"
41 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
49 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
42− PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
50+ PACKCHECK_GITHUB_COMMIT: "v0.7.0"
43
51
44 # Pull token from "secrets" setting of the github repo
52 # Pull token from "secrets" setting of the github repo
45 COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
53 COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
46 COVERAGE: ${{ matrix.coverage }}
54 COVERAGE: ${{ matrix.coverage }}
47− DOCTEST: ${{ matrix.doctest }}
55+
56+ # hlint
57+ HLINT_VERSION: 3.6.1
58+ HLINT_OPTIONS: "lint"
59+ HLINT_TARGETS: "core/src src test benchmark"
60+
61+ # Subdir
62+ SUBDIR: ${{ matrix.subdir }}
48
63
49 runs-on: ${{ matrix.runner }}
64 runs-on: ${{ matrix.runner }}
65+ continue-on-error: ${{ matrix.ignore_error }}
50 strategy:
66 strategy:
51− fail-fast: false
67+ fail-fast: true
52 matrix:
68 matrix:
69+ # The order is important to optimize fail-fast.
53 name:
70 name:
54− - 9.0.1
71+ - 9.8.1-Werror
55− - 8.10.4+stack
72+ # - 9.8.1-docspec
56− - 8.10.4+macOS
57− - 8.10.4+linux+coverage+cabal
73+ # - 8.10.7-coverage
58− - 8.10.4+docspec
74+
59− - 8.8.4
75+ # Note: if cabal.project is not specified benchmarks and tests won't
60− - 8.8.4+inspection+fusion-plugin+Werror
76+ # run. But we need at least one test where we test without
61− - 8.6.5+fusion-plugin
77+ # cabal.project because that is how hackage would build it.
62− - 8.6.5+streamk
63− - 8.4.4+debug
64− cabal_version: ["3.4"]
65 include:
78 include:
66− - name: 9.0.1
79+ - name: head
67− ghc_version: 9.0.1
80+ ghc_version: head
68− build: cabal-v2
81+ # The URL may change, to find a working URL go to https://gitlab.haskell.org/ghc/ghc/-/jobs/
69− cabal_build_options: "--allow-newer=hsc2hs"
82+ # Find a debian10/11/12 job, click on a passed/failed status, at the
70− disable_sdist_build: "y"
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"
71 runner: ubuntu-latest
91 runner: ubuntu-latest
72− - name: 8.10.4+stack
73− build: stack
92+ build: cabal
74− resolver: lts-18.0
93+ cabal_version: 3.10.2.0
75− stack_yaml: stack.yaml
94+ cabal_project: cabal.project.ghc-head
76− sdist_options: "--ignore-check"
77− stack_build_options: "--flag streamly-benchmarks:-opt"
78− runner: ubuntu-latest
79− - name: 8.10.4+macOS
80− ghc_version: 8.10.4
81− build: cabal-v2
82 disable_sdist_build: "y"
95 disable_sdist_build: "y"
83− runner: macos-latest
96+ ignore_error: true
84− - name: 8.10.4+linux+coverage+cabal
97+ # Note: use linux for warning build for convenient dev testing
98+ - name: 9.8.1-Werror
85− ghc_version: 8.10.4
99+ ghc_version: 9.8.1
86− coverage: "y"
87 runner: ubuntu-latest
100 runner: ubuntu-latest
88− - name: 8.8.4+inspection+fusion-plugin+Werror
89− ghc_version: 8.8.4
90− build: cabal-v2
101+ build: cabal
102+ cabal_version: 3.10.1.0
103+ disable_sdist_build: "y"
91 cabal_project: cabal.project.Werror
104 cabal_project: cabal.project.Werror
105+ ignore_error: false
106+ #- name: 9.8.1-docspec
107+ # ghc_version: 9.8.1
108+ # runner: ubuntu-latest
109+ # build: cabal
110+ # cabal_version: 3.10.1.0
111+ # cabal_project: cabal.project.doctest
112+ # disable_test: "y"
113+ # disable_bench: "y"
114+ # disable_docs: "y"
115+ # enable_docspec: "y"
116+ # disable_sdist_build: "y"
117+ # ignore_error: false
118+ - name: 9.8.1-fusion-inspection
119+ ghc_version: 9.8.1
120+ runner: ubuntu-latest
121+ build: cabal
122+ cabal_version: 3.10.1.0
123+ disable_sdist_build: "y"
124+ cabal_project: cabal.project
92 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
93 runner: ubuntu-latest
137 runner: ubuntu-latest
94− - name: 8.8.4
95− ghc_version: 8.8.4
96 build: cabal
138 build: cabal
139+ cabal_version: 3.8.1.0
140+ disable_sdist_build: "y"
97 cabal_project: cabal.project
141 cabal_project: cabal.project
98− cabal_build_options: "--flag -opt"
142+ ignore_error: false
143+ - name: 9.2.8
144+ ghc_version: 9.2.8
99 runner: ubuntu-latest
145 runner: ubuntu-latest
100− - name: 8.6.5+streamk
101− ghc_version: 8.6.5
102− build: cabal-v2
146+ build: cabal
103 cabal_project: cabal.project
147 cabal_project: cabal.project
104− cabal_build_options: "--flag streamk --flag -opt"
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
105 runner: ubuntu-latest
153 runner: ubuntu-latest
106− - name: 8.6.5+fusion-plugin
154+ build: cabal
155+ cabal_version: 3.6.2.0
156+ cabal_project: cabal.project.streamly
157+ ignore_error: true
158+ - name: 9.0.2-streamly-core-sdist
159+ ghc_version: 9.0.2
160+ runner: ubuntu-latest
161+ build: cabal
162+ cabal_version: 3.6.2.0
163+ subdir: core
164+ ignore_error: false
165+ - name: 8.10.7-streamly-sdist-stack
166+ runner: ubuntu-latest
167+ build: stack
168+ resolver: lts-20.13
169+ stack_yaml: stack.yaml
170+ sdist_options: "--ignore-check"
171+ stack_build_options: "--flag streamly-benchmarks:-opt"
172+ cabal_version: 3.6.2.0
173+ ignore_error: false
174+ # - name: 8.10.7-coverage
175+ # ghc_version: 8.10.7
176+ # runner: ubuntu-latest
177+ # coverage: "y"
178+ # cabal_version: 3.6.2.0
179+ # ignore_error: false
180+ - name: 8.8.4
107− ghc_version: 8.6.5
181+ ghc_version: 8.8.4
182+ runner: ubuntu-latest
108− build: cabal-v2
183+ build: cabal
184+ cabal_version: 3.6.2.0
109 cabal_project: cabal.project
185 cabal_project: cabal.project
110− cabal_build_options: "--flag fusion-plugin"
186+ disable_sdist_build: "y"
111− # haddock generation does not work with 8.6.5+fusion-plugin
187+ ignore_error: false
112− disable_docs: "y"
188+ - name: 8.6.5-debug-unoptimized
189+ ghc_version: 8.6.5
113 runner: ubuntu-latest
190 runner: ubuntu-latest
114− - name: 8.4.4+debug
115− ghc_version: 8.4.4
116− build: cabal-v2
191+ build: cabal
192+ cabal_version: 3.6.2.0
117 cabal_project: cabal.project
193 cabal_project: cabal.project
118 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
119 runner: ubuntu-latest
199 runner: ubuntu-latest
120− - name: 8.10.4+docspec
200+ ignore_error: true
121− ghc_version: 8.10.4
122− doctest: "y"
123− runner: ubuntu-latest
124
201
125 steps:
202 steps:
126 - uses: actions/checkout@v2
203 - uses: actions/checkout@v2
127
204
128− - uses: haskell/actions/setup@v1
129− with:
130− ghc-version: ${{ matrix.ghc_version }}
131− cabal-version: ${{ matrix.cabal_version }}
132−
133 - uses: actions/cache@v1
205 - uses: actions/cache@v1
134− name: Cache ~/.cabal
206+ name: Cache common directories
135 with:
207 with:
208+ path: |
209+ ~/.local
136− path: ~/.cabal
210+ ~/.cabal
211+ ~/.stack
212+ ~/.ghcup
137 # Bump the key version to clear the cache
213 # Bump the key version to clear the cache
138− key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v1
214+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v2
139
215
140 - name: Download packcheck
216 - name: Download packcheck
141 run: |
217 run: |
142− # Get packcheck if needed
218+ if test ! -e "$PACKCHECK"
143− CURL=$(which curl)
144− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
145− if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
146− chmod +x $PACKCHECK_LOCAL_PATH
147−
148− - name: Run tests
149− run: |
150− if test -n "$DOCTEST"
151 then
219 then
152− mkdir -p $HOME/.cabal/bin
220+ if test -z "$PACKCHECK_GITHUB_COMMIT"
153− curl -sL https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz > cabal-docspec.xz
221+ then
154− echo '0829bd034fba901cbcfe491d98ed8b28fd54f9cb5c91fa8e1ac62dc4413c9562 cabal-docspec.xz' | sha256sum -c -
222+ die "PACKCHECK_GITHUB_COMMIT is not specified."
155− xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec
223+ fi
156− rm -f cabal-docspec.xz
224+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
157− chmod a+x $HOME/.cabal/bin/cabal-docspec
225+ curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
158− cabal update
226+ chmod +x $PACKCHECK
159− cabal build all
160− $HOME/.cabal/bin/cabal-docspec --version
161− $HOME/.cabal/bin/cabal-docspec --timeout 60 --check-properties --property-variables xs
162− elif test -z "$COVERAGE"
227+ elif test ! -x "$PACKCHECK"
163 then
228 then
164− export TOOLS_DIR=/opt
229+ chmod +x $PACKCHECK
165− # /usr/local/opt/curl/bin for macOS
166− export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
167− bash -c "$PACKCHECK_LOCAL_PATH $BUILD"
168 fi
230 fi
169
231
232+ - name: Run tests
233+ run: |
170 if test -n "$COVERAGE"
234 if test -n "$COVERAGE"
171 then
235 then
172 # Run tests with coverage
236 # Run tests with coverage
@@ -179,4 +243,16 @@ jobs:
179 bin/test.sh --coverage --raw
243 bin/test.sh --coverage --raw
180 # XXX Uncomment this and fix it properly later
244 # XXX Uncomment this and fix it properly later
181 # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
245 # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
246+ else
247+ # /usr/local/opt/curl/bin for macOS
248+ export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
249+ if test -n "$SUBDIR"
250+ then
251+ mv "$PACKCHECK" "$SUBDIR/packcheck.sh"
252+ # This is required as dist-newstyle will be created on the top level
253+ # directory as it is considered the working dir.
254+ rm cabal.project
255+ cd "$SUBDIR"
256+ fi
257+ bash -c "$PACKCHECK $BUILD"
182 fi
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−25
@@ -1,53 +1,40 @@
1−src/Streamly/Internal/Data/Stream/Prelude.hs
1+core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs
2+core/src/Streamly/Internal/Data/Pipe/Type.hs
3+core/src/Streamly/Internal/Unicode/Stream.hs
4+src/Streamly/Internal/Data/SmallArray/Type.hs
2−src/Streamly/Internal/Data/Stream/PreludeCommon.hs
5+src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs
3src/Streamly/Internal/Data/Stream/Serial.hs
6src/Streamly/Internal/Data/Stream/Serial.hs
4src/Streamly/Internal/Data/Stream/Zip.hs
7src/Streamly/Internal/Data/Stream/Zip.hs
5−src/Streamly/Internal/Data/Stream/StreamK/Type.hs
6−src/Streamly/Internal/Data/Stream/StreamD/Type.hs
7−src/Streamly/Internal/Data/Pipe/Type.hs
8−src/Streamly/Internal/Data/SmallArray/Type.hs
9−src/Streamly/Internal/Unicode/Stream.hs
10−src/Streamly/Internal/Data/Array/Prim/Type.hs
11−src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs
12−src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs
13−src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs
14−src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs
15−src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs
16−test/Streamly/Test/Common/Array.hs
17test/Streamly/Test/Data/Array.hs
8test/Streamly/Test/Data/Array.hs
18−test/Streamly/Test/Data/Array/Prim.hs
19−test/Streamly/Test/Data/Array/Prim/Pinned.hs
20−test/Streamly/Test/Data/Array/Foreign.hs
21test/Streamly/Test/Data/Parser.hs
9test/Streamly/Test/Data/Parser.hs
22−test/Streamly/Test/Data/Parser/ParserD.hs
10+test/Streamly/Test/Data/ParserK.hs
23test/Streamly/Test/Data/SmallArray.hs
11test/Streamly/Test/Data/SmallArray.hs
24test/Streamly/Test/Data/Unfold.hs
12test/Streamly/Test/Data/Unfold.hs
25test/Streamly/Test/FileSystem/Event.hs
13test/Streamly/Test/FileSystem/Event.hs
26test/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
27test/Streamly/Test/Prelude/Fold.hs
17test/Streamly/Test/Prelude/Fold.hs
28test/Streamly/Test/Prelude/Rate.hs
18test/Streamly/Test/Prelude/Rate.hs
29test/Streamly/Test/Prelude/Serial.hs
19test/Streamly/Test/Prelude/Serial.hs
30test/Streamly/Test/Unicode/Stream.hs
20test/Streamly/Test/Unicode/Stream.hs
21+test/Streamly/Test/Data/Unbox.hs
31benchmark/lib/Streamly/Benchmark/Common.hs
22benchmark/lib/Streamly/Benchmark/Common.hs
32benchmark/lib/Streamly/Benchmark/Common/Handle.hs
23benchmark/lib/Streamly/Benchmark/Common/Handle.hs
33benchmark/lib/Streamly/Benchmark/Prelude.hs
24benchmark/lib/Streamly/Benchmark/Prelude.hs
34benchmark/NanoBenchmarks.hs
25benchmark/NanoBenchmarks.hs
35benchmark/Streamly/Benchmark/Data/Array.hs
26benchmark/Streamly/Benchmark/Data/Array.hs
36−benchmark/Streamly/Benchmark/Data/ArrayOps.hs
37−benchmark/Streamly/Benchmark/Data/NestedUnfoldOps.hs
38benchmark/Streamly/Benchmark/Data/Parser.hs
27benchmark/Streamly/Benchmark/Data/Parser.hs
39−benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs
28+benchmark/Streamly/Benchmark/Data/ParserK.hs
40benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
29benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
41benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
30benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
42benchmark/Streamly/Benchmark/Data/Unfold.hs
31benchmark/Streamly/Benchmark/Data/Unfold.hs
43benchmark/Streamly/Benchmark/FileSystem/Handle.hs
32benchmark/Streamly/Benchmark/FileSystem/Handle.hs
44benchmark/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
45benchmark/Streamly/Benchmark/Prelude/Parallel.hs
36benchmark/Streamly/Benchmark/Prelude/Parallel.hs
46benchmark/Streamly/Benchmark/Prelude/Rate.hs
37benchmark/Streamly/Benchmark/Prelude/Rate.hs
47−benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
48−benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs
49−benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs
50−benchmark/Streamly/Benchmark/Prelude/Serial/Transformation1.hs
51benchmark/Streamly/Benchmark/Prelude/WAsync.hs
38benchmark/Streamly/Benchmark/Prelude/WAsync.hs
52benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
39benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
53benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
40benchmark/Streamly/Benchmark/Prelude/ZipSerial.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+14−1
@@ -1,23 +1,36 @@
1.circleci/config.yml
1.circleci/config.yml
2.ghci
2.ghci
3.github/workflows/haskell.yml
3.github/workflows/haskell.yml
4+.github/workflows/regression-check.yml
5+.github/workflows/packdiff.yml
4.gitignore
6.gitignore
5.hlint.ignore
7.hlint.ignore
6.hlint.yaml
8.hlint.yaml
7.packcheck.ignore
9.packcheck.ignore
8appveyor.yml
10appveyor.yml
9−benchmark/bench-report/default.nix
11+benchmark/bench-runner/default.nix
12+benchmark/bench-runner/cabal.project
10bin/ghc.sh
13bin/ghc.sh
14+bin/repl
11bin/run-ci.sh
15bin/run-ci.sh
16+bin/run-repl-quick.sh
12cabal.project
17cabal.project
13cabal.project.coverage
18cabal.project.coverage
14cabal.project.doctest
19cabal.project.doctest
15cabal.project.ghc-head
20cabal.project.ghc-head
16cabal.project.hpc-coveralls
21cabal.project.hpc-coveralls
17cabal.project.O0
22cabal.project.O0
23+cabal.project.report
24+cabal.project.packdiff
25+cabal.project.streamly
18cabal.project.Werror
26cabal.project.Werror
19cabal.project.Werror-nocode
27cabal.project.Werror-nocode
28+core/
20default.nix
29default.nix
21examples/README.md
30examples/README.md
22hie.yaml
31hie.yaml
23stack.yaml
32stack.yaml
33+targets/default.nix
34+targets/cabal.project
35+test/test-runner/default.nix
36+test/test-runner/cabal.project
CHANGELOG.mdnew file+1
@@ -0,0 +1 @@
1+docs/User/Project/Changelog.md
CONTRIBUTING.mdmode 100644 → 120000+1−265
@@ -1,265 +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:
186−
187−```
188−$ cabal haddock
189−```
190−
191−Open the link printed at the end of the output of this command, in
192−your browser.
193−
194−For general library developer documentation see the `dev` directory.
195−
196−## Coding Guidelines
197−
198−### Coding Style
199−
200−Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).
201−
202−### Type variable ordering
203−
204−Ordering of variables in `forall` may be important in type applications. In
205−streams, we usually declare them in this order `t m a`.
206−
207−Use the same order in constraints as well
208−
209−Example,
210−
211−```
212−func :: forall m a. (MonadIO m, Storable a) => ...
213−```
214−
215−### StreamD coding style
216−
217−Some conventions that we follow in the StreamD code are illustrated by the
218−following example:
219−
220−```
221−mapM f (Stream step1 state1) = Stream step state
222− where
223−
224− step gst st = do
225− r <- step1 (adaptState gst) st
226− case r of
227− Yield x s -> f x >>= \a -> return $ Yield a s
228− Skip s -> return $ Skip s
229− Stop -> return Stop
230−```
231−
232−* For the input streams use numbering for `step` and `state` e.g.
233− step1/state1. For the output stream use `step` and `state`.
234−* For state argument of `step`, use `st`.
235−* For result of executing a `step` use `r` or `res`
236−* For the yielded element use `x`
237−* For the yielded state use `s`
238−
239−In general, the rule is - the shorter the scope of a variable the shorter its
240−name can be. For example, `s` has the shortest scope in the above code, `st`
241−has a bigger scope and `state` has the biggest scope.
242−
243−## Design guides
244−
245−See [the design directory](design) for design guidelines and documents.
246−
247−### Tricky Parts
248−
249−The state-passing through each API is currently fragile. Every time we run a
250−stream we need to be careful about the state we are passing to it. In case of
251−folds where there is no incoming state, we start with the initial state
252−`defState`. When we have an incoming state passed to us there are two cases:
253−
254−1. When we are building a concurrent stream that needs to share the same `SVar`
255− we pass the incoming state as is.
256−2. In all other cases we must not share the SVar and every time we pass on the
257− state to run a stream we must use `adaptState` to reset the `SVar` in the
258− state.
259−
260−When in doubt just use `adaptState` on the state before passing it on, we will at
261−most lose concurrency but the behavior will be correct.
262−
263−There is no type level enforcement about this as of now, and therefore we need
264−to be careful when coding. There are specific tests to detect and report any
265−problems due to this, all transform operations must be added to those tests.
@@ -0,0 +1 @@
1+docs/Developer/Contributing.md
LICENSE−254
@@ -26,172 +26,6 @@ CAUSED 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
28
29−-------------------------------------------------------------------------------
30−base-4.12.0.0 (http://hackage.haskell.org/package/base-4.12.0.0)
31−-------------------------------------------------------------------------------
32−This library (libraries/base) is derived from code from several
33−sources:
34−
35− * Code from the GHC project which is largely (c) The University of
36− Glasgow, and distributable under a BSD-style license (see below),
37−
38− * Code from the Haskell 98 Report which is (c) Simon Peyton Jones
39− and freely redistributable (but see the full license for
40− restrictions).
41−
42− * Code from the Haskell Foreign Function Interface specification,
43− which is (c) Manuel M. T. Chakravarty and freely redistributable
44− (but see the full license for restrictions).
45−
46−The full text of these licenses is reproduced below. All of the
47−licenses are BSD-style or compatible.
48−
49−The Glasgow Haskell Compiler License
50−
51−Copyright 2004, The University Court of the University of Glasgow.
52−All rights reserved.
53−
54−Redistribution and use in source and binary forms, with or without
55−modification, are permitted provided that the following conditions are met:
56−
57−- Redistributions of source code must retain the above copyright notice,
58−this list of conditions and the following disclaimer.
59−
60−- Redistributions in binary form must reproduce the above copyright notice,
61−this list of conditions and the following disclaimer in the documentation
62−and/or other materials provided with the distribution.
63−
64−- Neither name of the University nor the names of its contributors may be
65−used to endorse or promote products derived from this software without
66−specific prior written permission.
67−
68−THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
69−GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
70−INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
71−FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
72−UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
73−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
74−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
75−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
76−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
77−LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
78−OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
79−DAMAGE.
80−
81−Code derived from the document "Report on the Programming Language
82−Haskell 98", is distributed under the following license:
83−
84− Copyright (c) 2002 Simon Peyton Jones
85−
86− The authors intend this Report to belong to the entire Haskell
87− community, and so we grant permission to copy and distribute it for
88− any purpose, provided that it is reproduced in its entirety,
89− including this Notice. Modified versions of this Report may also be
90− copied and distributed for any purpose, provided that the modified
91− version is clearly presented as such, and that it does not claim to
92− be a definition of the Haskell 98 Language.
93−
94−Code derived from the document "The Haskell 98 Foreign Function
95−Interface, An Addendum to the Haskell 98 Report" is distributed under
96−the following license:
97−
98− Copyright (c) 2002 Manuel M. T. Chakravarty
99−
100− The authors intend this Report to belong to the entire Haskell
101− community, and so we grant permission to copy and distribute it for
102− any purpose, provided that it is reproduced in its entirety,
103− including this Notice. Modified versions of this Report may also be
104− copied and distributed for any purpose, provided that the modified
105− version is clearly presented as such, and that it does not claim to
106− be a definition of the Haskell 98 Foreign Function Interface.
107−
108−-------------------------------------------------------------------------------
109−bjoern-2008-2009 (http://bjoern.hoehrmann.de/utf-8/decoder/dfa/)
110−-------------------------------------------------------------------------------
111−Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>
112−
113−Permission is hereby granted, free of charge, to any person obtaining a copy of
114−this software and associated documentation files (the "Software"), to deal in
115−the Software without restriction, including without limitation the rights to
116−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
117−of the Software, and to permit persons to whom the Software is furnished to do
118−so, subject to the following conditions:
119−
120−The above copyright notice and this permission notice shall be included in all
121−copies or substantial portions of the Software.
122−
123−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
124−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
125−FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
126−AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
127−LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
128−OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
129−SOFTWARE.
130−
131−-------------------------------------------------------------------------------
132−clock-0.7.2 (http://hackage.haskell.org/package/clock-0.7.2)
133−-------------------------------------------------------------------------------
134−Copyright (c) 2009-2012, Cetin Sert
135−Copyright (c) 2010, Eugene Kirpichov
136−
137−All rights reserved.
138−
139−Redistribution and use in source and binary forms, with or without
140−modification, are permitted provided that the following conditions are
141−met:
142−
143− * Redistributions of source code must retain the above copyright
144− notice, this list of conditions and the following disclaimer.
145−
146− * Redistributions in binary form must reproduce the above
147− copyright notice, this list of conditions and the following
148− disclaimer in the documentation and/or other materials provided
149− with the distribution.
150−
151− * The names of contributors may not be used to endorse or promote
152− products derived from this software without specific prior
153− written permission.
154−
155−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
156−"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
157−LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
158−A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
159−OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
160−SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
161−LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
162−DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
163−THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
164−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
165−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
166−
167−-------------------------------------------------------------------------------
168−foldl-1.4.5 (http://hackage.haskell.org/package/foldl-1.4.5)
169−-------------------------------------------------------------------------------
170−Copyright (c) 2013 Gabriel Gonzalez
171−All rights reserved.
172−
173−Redistribution and use in source and binary forms, with or without modification,
174−are permitted provided that the following conditions are met:
175− * Redistributions of source code must retain the above copyright notice,
176− this list of conditions and the following disclaimer.
177− * Redistributions in binary form must reproduce the above copyright notice,
178− this list of conditions and the following disclaimer in the documentation
179− and/or other materials provided with the distribution.
180− * Neither the name of Gabriel Gonzalez nor the names of other contributors
181− may be used to endorse or promote products derived from this software
182− without specific prior written permission.
183−
184−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
185−ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
186−WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
187−DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
188−ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
189−(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
190−LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
191−ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
192−(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
193−SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
194−
195-------------------------------------------------------------------------------
29-------------------------------------------------------------------------------
196fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
30fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
197-------------------------------------------------------------------------------
31-------------------------------------------------------------------------------
@@ -259,91 +93,3 @@ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
259THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
93THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
260(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
94(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
261OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
95OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
262−
263−-------------------------------------------------------------------------------
264−primitive-0.7.0.0 (https://hackage.haskell.org/package/primitive-0.7.0.0)
265−-------------------------------------------------------------------------------
266−Copyright (c) 2008-2009, Roman Leshchinskiy
267−All rights reserved.
268−
269−Redistribution and use in source and binary forms, with or without
270−modification, are permitted provided that the following conditions are met:
271−
272−- Redistributions of source code must retain the above copyright notice,
273−this list of conditions and the following disclaimer.
274−
275−- Redistributions in binary form must reproduce the above copyright notice,
276−this list of conditions and the following disclaimer in the documentation
277−and/or other materials provided with the distribution.
278−
279−- Neither name of the University nor the names of its contributors may be
280−used to endorse or promote products derived from this software without
281−specific prior written permission.
282−
283−THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
284−GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
285−INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
286−FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
287−UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
288−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
289−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
290−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
291−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
292−LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
293−OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
294−DAMAGE.
295−
296−-------------------------------------------------------------------------------
297−transient-0.5.5 (http://hackage.haskell.org/package/transient-0.5.5)
298−-------------------------------------------------------------------------------
299−Copyright © 2014-2016 Alberto G. Corona <https://github.com/agocorona>
300−
301−Permission is hereby granted, free of charge, to any person obtaining a copy of
302−this software and associated documentation files (the "Software"), to deal in
303−the Software without restriction, including without limitation the rights to
304−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
305−the Software, and to permit persons to whom the Software is furnished to do so,
306−subject to the following conditions:
307−
308−The above copyright notice and this permission notice shall be included in all
309−copies or substantial portions of the Software.
310−
311−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
312−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
313−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
314−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
315−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
316−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
317−
318−-------------------------------------------------------------------------------
319−vector-0.12.0.2 (http://hackage.haskell.org/package/vector-0.12.0.2)
320−-------------------------------------------------------------------------------
321−Copyright (c) 2008-2012, Roman Leshchinskiy
322−All rights reserved.
323−
324−Redistribution and use in source and binary forms, with or without
325−modification, are permitted provided that the following conditions are met:
326−
327−- Redistributions of source code must retain the above copyright notice,
328−this list of conditions and the following disclaimer.
329−
330−- Redistributions in binary form must reproduce the above copyright notice,
331−this list of conditions and the following disclaimer in the documentation
332−and/or other materials provided with the distribution.
333−
334−- Neither name of the University nor the names of its contributors may be
335−used to endorse or promote products derived from this software without
336−specific prior written permission.
337−
338−THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
339−GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
340−INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
341−FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
342−UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
343−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
344−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
345−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
346−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
347−LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
348−OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
349−DAMAGE.
README.mdmode 100644 → 120000+1−651
@@ -1,651 +0,0 @@
1−# [Streamly][]: Idiomatic Haskell with the Performance of C
2−
3−[![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)
4−[![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)
5−
6−Streamly is a Haskell library that provides the building blocks to build
7−safe, scalable, modular and high performance software. Streamly offers:
8−
9−* The type safety of Haskell.
10−* The performance of C programs.
11−* Powerful abstractions for structuring your code.
12−* Idiomatic functional programming.
13−* Declarative concurrency for the seamless use of multiprocessing hardware.
14−
15−## About This Document
16−
17−This guide introduces programming with [Streamly][] using a few practical
18−examples:
19−
20−* We will start with a simple program that [counts the number of words
21− in a text](#modular-word-counting). We will then transform this program
22− into a [concurrent](#concurrent-word-counting) program that can efficiently
23− use multiprocessing hardware.
24−* Next, we will create a [concurrent network
25− server](#a-concurrent-network-server). We then show
26− how to write a network server that [merges multiple
27− streams](#merging-incoming-streams) concurrently.
28−* Our third example shows how to list a directory tree concurrently,
29− by reading [multiple directories in
30− parallel](#listing-directories-recursivelyconcurrently).
31−* Finally, we will look at how to [rate limit](#rate-limiting) stream
32− processing.
33−
34−The guide then looks at how Streamly achieves its
35−[performance](#performance). It [concludes](#notes) with a brief
36−discussion about Streamly's design philosophy, and with suggestions for
37−further reading.
38−
39−## Getting Started
40−
41−### Installing Streamly
42−
43−If you wish to follow along with this guide, you will need to have
44−[Streamly][] installed.
45−
46−Please see the [Getting Started With The Streamly Package](docs/getting-started.md)
47−guide for instructions on how to install [Streamly][].
48−
49−If you wish to run benchmarks, please be sure to build your
50−application using the instructions in the [Build Guide](docs/building.md).
51−
52−### An overview of the types used in these examples
53−
54−As an expository device, we have indicated the types at the intermediate
55−stages of stream computations as comments in the examples below.
56−The meaning of these types are:
57−
58−* A `SerialT IO a` is a serial stream of values of type `a` in the IO Monad.
59−* An `AsyncT IO a` is a concurrent (asynchronous) stream of values of type
60− `a` in the IO Monad.
61−* An `Unfold IO a b` is a representation of a function that converts a seed
62− value of type `a` into a stream of values of type `b` in the IO Monad.
63−* A `Fold IO a b` is a representation of a function that converts a stream of
64− type `a` to a final accumulator of type `b` in the IO Monad.
65−
66−### A Note on Module Naming
67−
68−Some of the examples below use modules from the `Internal` Streamly package
69−hierarchy. These are not really internal to the library. We classify
70−`Streamly` modules into two categories:
71−
72−* _Released modules and APIs_: These modules and APIs are
73− stable. Significant changes to these modules and APIs will cause
74− Streamly's version number to change according to the package versioning
75− policy.
76−* _Pre-release modules and APIs_: These modules and APIs have not been
77− formally released yet. They may change in the near future, and such
78− changes will not necessarily be reflected in Streamly's package
79− version number. As yet unreleased modules and APIs reside in the
80− `Internal` namespace.
81−
82−Please use a minor release upper bound to adhere to the Haskell PVP when
83−using the pre-release (internal) modules.
84−
85−## The Examples
86−
87−### Modular Word Counting
88−
89−A `Fold` in Streamly is a composable stream consumer. For our first
90−example, we will use `Fold`s to count the number of bytes, words and lines
91−present in a file. We will then compose individual `Fold`s together to
92−count words, bytes and lines at the same time.
93−
94−Please see the file [WordCountModular.hs][] for the complete example
95−program, including the imports that we have omitted here.
96−
97−#### Count Bytes (wc -c)
98−
99−We start with a code fragment that counts the number of bytes in a file:
100−
101−```haskell
102−import qualified Streamly.Data.Fold as Fold
103−import qualified Streamly.Internal.FileSystem.File as File
104−import qualified Streamly.Prelude as Stream
105−
106−wcb :: String -> IO Int
107−wcb file =
108− File.toBytes file -- SerialT IO Word8
109− & Stream.fold Fold.length -- IO Int
110−```
111−
112−### Count Lines (wc -l)
113−
114−The next code fragment shows how to count the number of lines in a file:
115−
116−```haskell
117−-- ASCII character 10 is a newline.
118−countl :: Int -> Word8 -> Int
119−countl n ch = if ch == 10 then n + 1 else n
120−
121−-- The fold accepts a stream of `Word8` and returns a line count (`Int`).
122−nlines :: Monad m => Fold m Word8 Int
123−nlines = Fold.foldl' countl 0
124−
125−wcl :: String -> IO Int
126−wcl file =
127− File.toBytes file -- SerialT IO Word8
128− & Stream.fold nlines -- IO Int
129−```
130−
131−### Count Words (wc -w)
132−
133−Our final code fragment counts the number of whitespace-separated words
134−in a stream:
135−
136−```haskell
137−countw :: (Int, Bool) -> Word8 -> (Int, Bool)
138−countw (n, wasSpace) ch =
139− if isSpace $ chr $ fromIntegral ch
140− then (n, True)
141− else (if wasSpace then n + 1 else n, False)
142−
143−-- The fold accepts a stream of `Word8` and returns a word count (`Int`).
144−nwords :: Monad m => Fold m Word8 Int
145−nwords = fst <$> Fold.foldl' countw (0, True)
146−
147−wcw :: String -> IO Int
148−wcw file =
149− File.toBytes file -- SerialT IO Word8
150− & Stream.fold nwords -- IO Int
151−```
152−
153−### Counting Bytes, Words and Lines Together
154−
155−By using the `Tee` combinator we can compose the three folds that count
156−bytes, lines and words individually into a single fold that counts all
157−three at once. The applicative instance of `Tee` distributes its input
158−to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and
159−then combines the outputs from the folds using the supplied combiner
160−function (`(,,)`).
161−
162−```haskell
163−import qualified Streamly.Internal.Data.Fold.Tee as Tee
164−
165−-- The fold accepts a stream of `Word8` and returns the three counts.
166−countAll :: Fold IO Word8 (Int, Int, Int)
167−countAll = Tee.toFold $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords
168−
169−wc :: String -> IO (Int, Int, Int)
170−wc file =
171− File.toBytes file -- SerialT IO Word8
172− & Stream.fold countAll -- IO (Int, Int, Int)
173−```
174−
175−This example demonstrates the excellent modularity offered by
176−[Streamly][]'s simple and concise API. Experienced Haskellers will
177−notice that we have not used bytestrings&mdash;we instead used a stream of
178−`Word8` values, simplifying our program.
179−
180−### The Performance of Word Counting
181−
182−We compare two equivalent implementations: one using [Streamly][],
183−and the other using C.
184−
185−The performance of the [Streamly word counting
186−implementation][WordCount.hs] is:
187−
188−```
189−$ time WordCount-hs gutenberg-500MB.txt
190−11242220 97050938 574714449 gutenberg-500MB.txt
191−
192−real 0m1.825s
193−user 0m1.697s
194−sys 0m0.128s
195−```
196−
197−The performance of an equivalent [wc implementation in C][WordCount.c] is:
198−
199−```
200−$ time WordCount-c gutenberg-500MB.txt
201−11242220 97050938 574714449 gutenberg-500MB.txt
202−
203−real 0m2.100s
204−user 0m1.935s
205−sys 0m0.165s
206−```
207−
208−### Concurrent Word Counting
209−
210−In our next example we show how the task of counting words, lines,
211−and bytes could be done in parallel on multiprocessor hardware.
212−
213−To count words in parallel we first divide the stream into chunks
214−(arrays), do the counting within each chunk, and then add all the
215−counts across chunks. We use the same code as above except that we use
216−arrays for our input data.
217−
218−Please see the file [WordCountParallel.hs][] for the complete working
219−code for this example, including the imports that we have omitted below.
220−
221−The `countArray` function counts the line, word, char counts in one chunk:
222−
223−```haskell
224−import qualified Streamly.Data.Array.Foreign as Array
225−
226−countArray :: Array Word8 -> IO Counts
227−countArray arr =
228− Stream.unfold Array.read arr -- SerialT IO Word8
229− & Stream.decodeLatin1 -- SerialT IO Char
230− & Stream.foldl' count (Counts 0 0 0 True) -- IO Counts
231−```
232−
233−Here the function `count` and the `Counts` data type are defined in the
234−`WordCount` helper module defined in [WordCount.hs][].
235−
236−When combining the counts in two contiguous chunks, we need to check
237−whether the first element of the next chunk is a whitespace character
238−in order to determine if the same word continues in the next chunk or
239−whether the chunk starts with a new word. The `partialCounts` function
240−adds a `Bool` flag to `Counts` returned by `countArray` to indicate
241−whether the first character in the chunk is a space.
242−
243−```haskell
244−partialCounts :: Array Word8 -> IO (Bool, Counts)
245−partialCounts arr = do
246− let r = Array.getIndex arr 0
247− case r of
248− Just x -> do
249− counts <- countArray arr
250− return (isSpace (chr (fromIntegral x)), counts)
251− Nothing -> return (False, Counts 0 0 0 True)
252−```
253−
254−`addCounts` then adds the counts from two consecutive chunks:
255−
256−```haskell
257−addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)
258−addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =
259− let wcount =
260− if not ws1 && not sp2 -- No space between two chunks.
261− then w1 + w2 - 1
262− else w1 + w2
263− in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)
264−```
265−
266−To count in parallel we now only need to divide the stream into arrays,
267−apply our counting function to each array, and then combine the counts
268−from each chunk.
269−
270−```haskell
271−wc :: String -> IO (Bool, Counts)
272−wc file = do
273− Stream.unfold File.readChunks file -- AheadT IO (Array Word8)
274− & Stream.mapM partialCounts -- AheadT IO (Bool, Counts)
275− & Stream.maxThreads numCapabilities -- AheadT IO (Bool, Counts)
276− & Stream.fromAhead -- SerialT IO (Bool, Counts)
277− & Stream.foldl' addCounts (False, Counts 0 0 0 True) -- IO (Bool, Counts)
278−```
279−
280−Please note that the only difference between a concurrent and a
281−non-concurrent program lies in the use of the `Stream.fromAhead`
282−combinator. If we remove the call to `Stream.fromAhead`, we would
283−still have a perfectly valid and performant serial program. Notice
284−how succinctly and idiomatically we have expressed the concurrent word
285−counting problem.
286−
287−A benchmark with 2 CPUs:
288−
289−```
290−$ time WordCount-hs-parallel gutenberg-500MB.txt
291−11242220 97050938 574714449 gutenberg-500MB.txt
292−
293−real 0m1.284s
294−user 0m1.952s
295−sys 0m0.140s
296−```
297−
298−These example programs have assumed ASCII encoded input data. For UTF-8
299−streams, we have a [concurrent wc implementation][WordCountUTF8.hs]
300−with UTF-8 decoding. This concurrent implementation performs as well
301−as the standard `wc` program in serial benchmarks. In concurrent mode
302−[Streamly][]'s implementation can utilise multiple processing cores if
303−these are present, and can thereby run much faster than the standard
304−binary.
305−
306−Streamly provides concurrency facilities similar
307−to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and
308−[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative
309−style of expression. With Streamly you can write concurrent programs
310−with ease, with support for different types of concurrent scheduling.
311−
312−### A Concurrent Network Server
313−
314−We now move to a slightly more complicated example: we simulate a
315−dictionary lookup server which can serve word meanings to multiple
316−clients concurrently. This example demonstrates the use of the concurrent
317−`mapM` combinator.
318−
319−Please see the file [WordServer.hs][] for the complete code for this
320−example, including the imports that we have omitted below.
321−
322−```haskell
323−import qualified Streamly.Data.Fold as Fold
324−import qualified Streamly.Network.Inet.TCP as TCP
325−import qualified Streamly.Network.Socket as Socket
326−import qualified Streamly.Unicode.Stream as Unicode
327−
328−-- Simulate network/db query by adding a delay.
329−fetch :: String -> IO (String, String)
330−fetch w = threadDelay 1000000 >> return (w,w)
331−
332−-- Read lines of whitespace separated list of words from a socket, fetch the
333−-- meanings of each word concurrently and return the meanings separated by
334−-- newlines, in same order as the words were received. Repeat until the
335−-- connection is closed.
336−lookupWords :: Socket -> IO ()
337−lookupWords sk =
338− Stream.unfold Socket.read sk -- SerialT IO Word8
339− & Unicode.decodeLatin1 -- SerialT IO Char
340− & Stream.wordsBy isSpace Fold.toList -- SerialT IO String
341− & Stream.fromSerial -- AheadT IO String
342− & Stream.mapM fetch -- AheadT IO (String, String)
343− & Stream.fromAhead -- SerialT IO (String, String)
344− & Stream.map show -- SerialT IO String
345− & Stream.intersperse "\n" -- SerialT IO String
346− & Unicode.encodeStrings Unicode.encodeLatin1 -- SerialT IO (Array Word8)
347− & Stream.fold (Socket.writeChunks sk) -- IO ()
348−
349−serve :: Socket -> IO ()
350−serve sk = finally (lookupWords sk) (close sk)
351−
352−-- | Run a server on port 8091. Accept and handle connections concurrently. The
353−-- connection handler is "serve" (i.e. lookupWords). You can use "telnet" or
354−-- "nc" as a client to try it out.
355−main :: IO ()
356−main =
357− Stream.unfold TCP.acceptOnPort 8091 -- SerialT IO Socket
358− & Stream.fromSerial -- AsyncT IO ()
359− & Stream.mapM serve -- AsyncT IO ()
360− & Stream.fromAsync -- SerialT IO ()
361− & Stream.drain -- IO ()
362−```
363−
364−### Merging Incoming Streams
365−
366−In the next example, we show how to merge logs coming from multiple
367−nodes in your network. These logs are merged at line boundaries and
368−the merged logs are written to a file or to a network destination.
369−This example uses the `concatMapWith` combinator to merge multiple
370−streams concurrently.
371−
372−Please see the file [MergeServer.hs][] for the complete working code,
373−including the imports that we have omitted below.
374−
375−```haskell
376−import qualified Streamly.Data.Unfold as Unfold
377−import qualified Streamly.Network.Socket as Socket
378−
379−-- | Read a line stream from a socket.
380−-- Note: lines are buffered, and we could add a limit to the
381−-- buffering for safety.
382−readLines :: Socket -> SerialT IO (Array Char)
383−readLines sk =
384− Stream.unfold Socket.read sk -- SerialT IO Word8
385− & Unicode.decodeLatin1 -- SerialT IO Char
386− & Stream.splitWithSuffix (== '\n') Array.write -- SerialT IO String
387−
388−recv :: Socket -> SerialT IO (Array Char)
389−recv sk = Stream.finally (liftIO $ close sk) (readLines sk)
390−
391−-- | Starts a server at port 8091 listening for lines with space separated
392−-- words. Multiple clients can connect to the server and send streams of lines.
393−-- The server handles all the connections concurrently, merges the incoming
394−-- streams at line boundaries and writes the merged stream to a file.
395−server :: Handle -> IO ()
396−server file =
397− Stream.unfold TCP.acceptOnPort 8090 -- SerialT IO Socket
398− & Stream.concatMapWith Stream.parallel recv -- SerialT IO (Array Char)
399− & Stream.unfoldMany Array.read -- SerialT IO Char
400− & Unicode.encodeLatin1 -- SerialT IO Word8
401− & Stream.fold (Handle.write file) -- IO ()
402−
403−main :: IO ()
404−main = withFile "output.txt" AppendMode server
405−```
406−
407−### Listing Directories Recursively/Concurrently
408−
409−Our next example lists a directory tree recursively, reading
410−multiple directories concurrently.
411−
412−This example uses the tree traversing combinator `iterateMapLeftsWith`.
413−This combinator maps a stream generator on the `Left` values in its
414−input stream (directory names in this case), feeding the resulting `Left`
415−values back to the input, while it lets the `Right` values (file names
416−in this case) pass through to the output. The `Stream.ahead` stream
417−joining combinator then makes it iterate on the directories concurrently.
418−
419−Please see the file [ListDir.hs][] for the complete working code,
420−including the imports that we have omitted below.
421−
422−```haskell
423−import Streamly.Internal.Data.Stream.IsStream (iterateMapLeftsWith)
424−
425−import qualified Streamly.Prelude as Stream
426−import qualified Streamly.Internal.FileSystem.Dir as Dir (toEither)
427−
428−-- Lists a directory as a stream of (Either Dir File).
429−listDir :: String -> SerialT IO (Either String String)
430−listDir dir =
431− Dir.toEither dir -- SerialT IO (Either String String)
432− & Stream.map (bimap mkAbs mkAbs) -- SerialT IO (Either String String)
433−
434− where mkAbs x = dir ++ "/" ++ x
435−
436−-- | List the current directory recursively using concurrent processing.
437−main :: IO ()
438−main = do
439− hSetBuffering stdout LineBuffering
440− let start = Stream.fromPure (Left ".")
441− Stream.iterateMapLeftsWith Stream.ahead listDir start
442− & Stream.mapM_ print
443−```
444−
445−### Rate Limiting
446−
447−For bounded concurrent streams, a stream yield rate can be specified
448−easily. For example, to print "tick" once every second you can simply
449−write:
450−
451−```haskell
452−main :: IO ()
453−main =
454− Stream.repeatM (pure "tick") -- AsyncT IO String
455− & Stream.timestamped -- AsyncT IO (AbsTime, String)
456− & Stream.avgRate 1 -- AsyncT IO (AbsTime, String)
457− & Stream.fromAsync -- SerialT IO (AbsTime, String)
458− & Stream.mapM_ print -- IO ()
459−```
460−
461−Please see the file [Rate.hs][] for the complete working code.
462−
463−The concurrency of the stream is automatically controlled to match the
464−specified rate. [Streamly][]'s rate control works precisely even at
465−throughputs as high as millions of yields per second.
466−
467−For more sophisticated rate control needs please see the Streamly [reference
468−documentation][Streamly].
469−
470−### Reactive Programming
471−
472−Streamly supports reactive (time domain) programming because of its
473−support for declarative concurrency. Please see the `Streamly.Prelude`
474−module for time-specific combinators like `intervalsOf`, and
475−folds like `takeInterval` in `Streamly.Internal.Data.Fold`.
476−Please also see the pre-release sampling combinators in the
477−`Streamly.Internal.Data.Stream.IsStream.Top` module for `throttle` and
478−`debounce` like operations.
479−
480−The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate
481−reactive programming using [Streamly][].
482−
483−### More Examples
484−
485−If you would like to view more examples, please visit the [Streamly
486−Examples][streamly-examples] web page.
487−
488−### Further Reading
489−
490−* [Streaming Benchmarks][streaming-benchmarks]
491−* [Concurrency Benchmarks][concurrency-benchmarks]
492−* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)
493−* [Other Guides](docs/)
494−* [Streamly Homepage][Streamly]
495−
496−## Performance
497−
498−As you have seen in the word count example above, [Streamly][] offers
499−highly modular abstractions for building programs while also offering
500−the performance close to an equivalent (imperative) C program.
501−
502−Streamly offers excellent performance even for byte-at-a-time stream
503−operations using efficient abstractions like `Unfold`s and terminating
504−`Fold`s. Byte-at-a-time stream operations can simplify programming
505−because the developer does not have to deal explicitly with chunking
506−and re-combining data.
507−
508−Streamly exploits GHC's stream fusion optimizations (`case-of-case` and
509−`spec-constr`) aggressively to achieve C-like speed, while also offering
510−highly modular abstractions to developers.
511−
512−[Streamly][] will usually perform very well without any
513−compiler plugins. However, we have fixed some deficiencies
514−that we had noticed in GHC's optimizer using a [compiler
515−plugin](https://github.com/composewell/fusion-plugin). We hope to fold
516−these optimizations into GHC in the future; until then we recommend that
517−you use this plugin for applications that are performance sensitive.
518−
519−### Benchmarks
520−
521−We measured several Haskell streaming implementations
522−using various micro-benchmarks. Please see the [streaming
523−benchmarks][streaming-benchmarks] page for a detailed comparison of
524−Streamly against other streaming libraries.
525−
526−Our results show that [Streamly][] is the fastest effectful streaming
527−implementation on almost all the measured microbenchmarks. In many cases
528−it runs up to 100x faster, and in some cases even 1000x faster than
529−some of the tested alternatives. In some composite operation benchmarks
530−[Streamly][] turns out to be significantly faster than Haskell's list
531−implementation.
532−
533−*Note*: If you can write a program in some other way or with some other
534−language that runs significantly faster than what [Streamly][] offers,
535−please let us know and we will improve.
536−
537−## Notes
538−
539−Streamly comes equipped with a very powerful set of abstractions to
540−accomplish many kinds of programming tasks: it provides support for
541−programming with streams and arrays, for reading and writing from the
542−file system and from the network, for time domain programming (reactive
543−programming), and for reacting to file system events using `fsnotify`.
544−
545−Please view [Streamly's documentation][Streamly] for more information
546−about Streamly's features.
547−
548−### Concurrency
549−
550−Streamly uses lock-free synchronization for achieving concurrent
551−operation with low overheads. The number of tasks performed concurrently
552−are determined automatically based on the rate at which a consumer
553−is consuming the results. In other words, you do not need to manage
554−thread pools or decide how many threads to use for a particular task.
555−For CPU-bound tasks Streamly will try to keep the number of threads
556−close to the number of CPUs available; for IO-bound tasks it will utilize
557−more threads.
558−
559−The parallelism available during program execution can be utilized with
560−very little overhead even where the task size is very
561−small, because Streamly will automatically switch between
562−serial or batched execution of tasks on the same CPU depending
563−on whichever is more efficient. Please see our [concurrency
564−benchmarks][concurrency-benchmarks] for more detailed performance
565−measurements, and for a comparison with the `async` package.
566−
567−### Design Goals
568−
569−Our goals for [Streamly][] from the very beginning have been:
570−
571−1. To achieve simplicity by unifying abstractions.
572−2. To offer high performance.
573−
574−These goals are hard to achieve simultaneously because they are usually
575−inversely related. We have spent many years trying to get the abstractions
576−right without compromising performance.
577−
578−`Unfold` is an example of an abstraction that we have created to achieve
579−high performance when mapping streams on streams. `Unfold` allows stream
580−generation to be optimized well by the compiler through stream fusion.
581−A `Fold` with termination capability is another example which modularizes
582−stream elimination operations through stream fusion. Terminating folds
583−can perform many simple parsing tasks that do not require backtracking.
584−In Streamly, `Parser`s are a natural extension to terminating `Fold`s;
585−`Parser`s add the ability to backtrack to `Fold`s. Unification leads
586−to simpler abstractions and lower cognitive overheads while also not
587−compromising performance.
588−
589−## Credits
590−
591−The following authors/libraries have influenced or inspired this library in a
592−significant way:
593−
594− * Roman Leshchinskiy ([vector](http://hackage.haskell.org/package/vector))
595− * Gabriel Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))
596− * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient))
597−
598−Please see the [`credits`](./credits/README.md) directory for a full
599−list of contributors, credits and licenses.
600−
601−## Licensing
602−
603−Streamly is an [open source](https://github.com/composewell/streamly)
604−project available under a liberal [BSD-3-Clause license][LICENSE]
605−
606−## Contributing to Streamly
607−
608−As an open project we welcome contributions:
609−
610−* [Streamly Contributor's Guide][CONTRIBUTING.md]
611−* [Contact the streamly development team](mailto:streamly@composewell.com)
612−
613−## Getting Support
614−
615−Professional support is available for [Streamly][]: please contact
616−[support@composewell.com](mailto:support@composewell.com).
617−
618−You can also join our [community chat
619−channel](https://gitter.im/composewell/streamly) on Gitter.
620−
621−<!--
622−Link References.
623−-->
624−
625−[Streamly]: https://streamly.composewell.com/
626−[streamly-examples]: https://github.com/composewell/streamly-examples
627−[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks
628−[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks
629−
630−<!--
631−Keep all the unstable links here so that they can be updated to stable
632−links (for online docs) before we release.
633−-->
634−
635−<!-- examples -->
636−[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs
637−[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs
638−[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c
639−[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs
640−[WordCountUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountUTF8.hs
641−[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs
642−[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs
643−[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs
644−[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs
645−[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs
646−[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs
647−
648−<!-- local files -->
649−[LICENSE]: LICENSE
650−[CONTRIBUTING.md]: CONTRIBUTING.md
651−[docs]: docs/
@@ -0,0 +1 @@
1+docs/User/Project/README.md
appveyor.yml+4−2
@@ -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,9 +36,9 @@ 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-18.0"
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"
42 STACK_YAML: "stack.yaml"
44 STACK_YAML: "stack.yaml"
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−313
@@ -1,313 +0,0 @@
1−# Benchmarking
2−
3−## Benchmark Drivers
4−
5−Two benchmark drivers are supported:
6−
7−* `tasty-bench` (default)
8−* `gauge` (enabled by `--use-gauge` build flag)
9−
10−## Build and run benchmarks directly
11−
12−The benchmark executables are `tasty-bench` executables unless you have
13−passed `--use-gauge` cabal flag when building in which case it is a
14−`gauge` executable.
15−
16−```
17−$ cabal run bench:Prelude.Serial # run selected
18−$ cabal run bench:Prelude.Serial -- --help # help on arguments
19−$ cabal run bench:Prelude.Serial -- --stdev 100000 # specify arguments
20−$ cabal run bench:Prelude.Serial --flag fusion-plugin # with fusion-plugin
21−
22−$ cabal build bench:Prelude.Serial # build selected
23−$ cabal build --enable-benchmarks streamly-benchmarks # build all
24−$ cabal build --enable-benchmarks all # build all, alternate method
25−
26−$ cabal build --flag "-opt" ... # disable optimization, faster build
27−```
28−
29−## Building and Running Benchmarks with bench.sh
30−
31−`<streamly repo>/bin/bench.sh` script is the top level driver for
32−running benchmarks. It runs the requested benchmarks and then creates a
33−report from the results using the `bench-show` package.
34−
35−IMPORTANT NOTE: The first time you run this script it may take a long
36−time because it has to build the `bench-report` executable which has a
37−lot of dependencies. If you are using nix then use `--use-nix` flag
38−for the first time so that the `bench-report` executable is built using
39−nix. That can save a lot of time compiling it. However, once it is built
40−it will be cached in the `bin` directory of the repo and used from
41−there every time. You can also build it manually from the cabal file in
42−`benchmark/bench-report` and install it in the `bin` directory.
43−
44−## bench.sh: Quick start
45−
46−Useful commands:
47−
48−```
49−$ bin/bench.sh --help
50−$ bin/bench.sh --quick # run all the benchmark suites
51−$ bin/bench.sh --benchmarks help # Show available benchmark suites
52−$ bin/bench.sh --benchmarks serial_grp # Run all serial benchmark suites
53−$ bin/bench.sh --benchmarks "Prelude.Serial Data.Parser" # run selected suites
54−$ bin/bench.sh --no-measure # don't run benchmarks just show previous results
55−
56−# Run all O(1) space complexity benchmarks in `Prelude.Serial` suite
57−$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space
58−
59−# Run a specific benchmark in `Prelude.Serial` suite
60−$ bin/bench.sh --benchmarks Prelude.Serial --prefix Prelude.Serial/o-1-space.generation.unfoldr
61−```
62−
63−Note: `bench.sh` enables fusion-plugin by default.
64−
65−## Comparing results with baseline
66−
67−```
68−# Checkout baseline commit
69−$ bin/bench.sh --quick
70−
71−# Checkout commit with new changes
72−$ bin/bench.sh --quick --append
73−
74−# To add another result to comparisons just repeat the above command on
75−# desired commit
76−```
77−
78−## Comparing benchmark suites
79−
80−First see the available benchmark suites:
81−
82−```
83−$ bin/bench.sh --benchmarks help
84−```
85−
86−You will see some benchmark suites end with `_cmp`, these are comparison
87−groups. If you run a comparison group benchmark, comparison of all the
88−benchmark suites in that group will be shown in the end. For example to compare
89−all array benchmark suites:
90−
91−```
92−$ bin/bench.sh --benchmarks array_cmp
93−```
94−
95−## Reporting without measuring
96−
97−You can use the `--no-measure` option to report the already measured results in
98−the benchmarks results file. A results file may collect an arbitrary number of
99−results by running with `--append` multiple times. Each benchmark has its own
100−results file, for example the `Prelude.Serial` benchmark has the results file at
101−`charts/Prelude.Serial/results.csv`.
102−
103−You can also manually edit the file to remove a set of results if you like or
104−to append results from previously saved results or from some other results
105−file. After editing you can run `bench.sh` with the `--no-measure` option to
106−see the reports corresponding to the results.
107−
108−## Additional benchmark configuration
109−
110−### Stream size
111−
112−You can specify the stream size (default is 100000) to be used for
113−benchmarking:
114−
115−```
116−$ cabal run bench:Prelude.Serial -- --stream-size 1000000
117−```
118−
119−### External input file
120−
121−In the `FileSystem.Handle` benchmark you can specify the input file as an
122−environment variable:
123−
124−```
125−$ export Benchmark_FileSystem_Handle_InputFile=./gutenberg-500.txt
126−$ cabal run FileSystem.Handle -- FileSystem.Handle/o-1-space/reduce/read/S.splitOnSeq
127−```
128−
129−The automatic tests do not test unicode input, this option is useful to specify
130−a unicode text file manually.
131−
132−## Benchmarking notes
133−
134−We run each benchmark in an isolated process to minimize interference
135−of benchmarks and to be able to control the RTS memory restrictions per
136−benchmark.
137−
138−### Gotchas
139−
140−Gauge forces a GC before and after the measurement. However, we have observed
141−that sometimes the GC stats may not be accurate when the number of iterations
142−in the measurement is small (e.g. 1 iteration). In such cases usually the
143−number of GCs and GC times would also be 0.
144−
145−## Diagnosing Performance Issues
146−
147−### Reproducible comparison
148−
149−When comparing different compilers we need to make sure that we are
150−using exactly the same versions of the libraries for apples to apples
151−comparison. We have seen cases where a change in the "random" library
152−caused allocations regressions in the new version of compiler because of
153−the way in which the benchmark code was generated due to the change.
154−
155−When it is required to reproduce benchmark results precisely across
156−different systems, it is recommended that you create and use a cabal
157−freeze file so that the versions of all libraries are pinned.
158−
159−### Identifying issues
160−
161−There are two ways to find problematic code:
162−
163−1. Run performance benchmarks using `bench.sh`, select the benchmarks
164− that are taking more than expected time.
165−2. When making a new change, compare with the baseline and select benchmarks
166− with the most regression reported by `bench.sh`.
167−
168−Number of allocations are the most stable measure that do not vary from
169−run to run. `cpuTime` and `bytesCopied` may vary. When comparing two
170−runs for regression the first thing to look at is the difference in
171−allocations. Also note that allocations may vary from run to run for
172−concurrent benchmarks.
173−
174−The next thing to look at is cpuTime. Please note that cpuTime may
175−fluctuate quite a bit, you may want to run the relevant benchmarks
176−without the --quick mode for confirming and make sure no other load is
177−running on the system when measuring.
178−
179−Usually the increase is cpuTime is proportional to the increase in
180−allocations but sometimes it may increase independently because more cpu
181−instructions are being executed. TBD - we should count the instructions
182−instead.
183−
184−### Inspection Testing
185−
186−Before you proceed make sure have to run the benchmarks with
187−`inspection` flag on. It may catch any obvious issues or regressions.
188−
189−```
190−$ cabal build --flag inspection --flag fusion-plugin --enable-benchmarks streamly-benchmarks
191−```
192−
193−### Compiling with diagnostics
194−
195−1. Comment out all other benchmarks in the given benchmark suite, and
196− keep only the one you are examining.
197−2. Edit the file and add the following line on top:
198−
199−```
200−{-# OPTIONS_GHC
201− -ddump-simpl
202− -ddump-to-file
203− -dsuppress-all
204− -Wmissed-specialisations
205− -Wall-missed-specialisations
206− -fplugin-opt=Fusion.Plugin:verbose=2
207− -fplugin-opt=Fusion.Plugin:dump-core
208−#-}
209−```
210−3. Build the benchmark suite with fusion-plugin enabled:
211−
212−```
213−$ cabal build bench:Prelude.Serial --flag fusion-plugin
214−```
215−
216−See the `.dump-simpl` file in the cabal build directory. You can find it
217−like this:
218−
219−```
220−$ find dist-newstyle/ -name "*.dump-simpl"
221−```
222−
223−Make sure you are looking into the right build dir (`--build-dir` may change
224−`dist-newstyle` to something else), and check in the appropriate GHC
225−version dir.
226−
227−### Compiling standalone example
228−
229−Sometimes you may want to create a separate program from the benchmark code
230−removing the benchmarking harness to simplify and isolate the code for better
231−reasoning and simpler core.
232−
233−Add the following GHC options at the top of your file, say, example.hs:
234−
235−```
236−{-# OPTIONS_GHC
237− -ddump-simpl
238− -ddump-to-file
239− -dsuppress-all
240− -Wmissed-specialisations
241− -Wall-missed-specialisations
242− -fplugin Fusion.Plugin
243− -fplugin-opt=Fusion.Plugin:verbose=2
244− -fplugin-opt=Fusion.Plugin:dump-core
245−#-}
246−```
247−
248−Do not include the optimization options in OPTIONS_GHC pragma, instead, specify
249−them on the command line. This is to avoid optimization failing if you import
250−another module which is not compiled with the same optimization options.
251−
252−```
253−$ cabal build # build and write ghc environment file
254−$ ghc -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 example.hs
255−```
256−
257−To pinpoint where the optimization is going wrong you can examine the
258−plugin generated core files for each optimization pass. The files are
259−numbered for each optimization pass. You can compare successive files
260−using side-by-side diff and see what the compiler is doing between each
261−pass.
262−
263−### Diagnosing the Problem
264−
265−#### Specialization Issues
266−
267−Look for missed specialization messages. When you are comparing against a
268−baseline, check if something that was specialized before is no longer
269−specialized.
270−
271−In the core you have to look for type class dictionaries e.g.
272−
273−```
274−exc_r6DD = \ @s_a6ai -> try $fMonadCatchIO $fExceptionSomeException
275−```
276−
277−Search for `$f` in the core.
278−
279−#### Fusion Issues
280−
281−Look for unfused function warnings emitted by fusion-plugin. You may
282−want to take a look at the unfused constructors or functions that
283−fusion-plugin is warning about. Beware that:
284−
285−* fusion-plugin emits warnings for unfused stuff in intermediate functions as
286− well, those should be ignored.
287−* the constructors may remain genuinely unfused unless the loop is
288− closed. So you should look at the warnings in the file where the loop is
289− closed and everything is supposed to be fused.
290−
291−Also, look at the core for unfused constructors. At times you may need
292−to look for the boxed primitive type constructors e.g. W8# or I#, these
293−may not be eliminated, usually, due to strictness issues.
294−
295−Often it is useful to diff and compare the core without the problem and
296−the core with the problem especially in cases when the problem is due to
297−GHC version changes, or smaller changes in the code.
298−
299−Note, some operations are inherently fusion breaking, those cannot fuse,
300−they are usually annotated so in their documentation.
301−
302−### Resolving the problem
303−
304−Review the problematic code, see [the optimization
305−guide](dev/optimization-guidelines.md) for common problems and how to
306−solve those. If no obvious issues are found on review, then generate and
307−examine the core.
308−
309−You may want to add the `Fuse` annotation on some of those constructors
310−to make the code fuse. Please note that unnecessary `Fuse` annotations
311−may cause unnecessary inlining. Also, make sure that the constructor you
312−are adding fuse annotation is not shared by any other code where you may
313−not want inlining/fusion.
@@ -0,0 +1 @@
1+../docs/Developer/Benchmarks.md
benchmark/Streamly/Benchmark/Data/Array.hs+77−136
@@ -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 "writeLastN.1" (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
102+ (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
103+ , benchFold "writeLastN.10"
124− , benchFold "writeLastN.10" (S.fold (IA.writeLastN 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 ]
@@ -138,49 +118,14 @@ o_n_heap_serial value =
138 -- Converting the stream to an array
118 -- Converting the stream to an array
139 benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
119 benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))
140 (P.sourceUnfoldrM value)
120 (P.sourceUnfoldrM value)
141− , benchFold "writeN" (S.fold (A.writeN value))
142− (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 = "Data.Array.Foreign"
169−#elif defined(DATA_ARRAY_PRIM)
170−moduleName = "Data.Array.Prim"
171−#elif defined(DATA_ARRAY_PRIM_PINNED)
172−moduleName = "Data.Array.Prim.Pinned"
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 ()
186main = runWithCLIOpts defStreamSize allBenchmarks
131main = runWithCLIOpts defStreamSize allBenchmarks
@@ -188,12 +133,8 @@ main = runWithCLIOpts defStreamSize allBenchmarks
188 where
133 where
189
134
190 allBenchmarks size =
135 allBenchmarks size =
191− [ bgroup (o_1_space_prefix moduleName) $ concat
136+ [ bgroup (o_1_space_prefix moduleName) $
192− [ o_1_space_generation size
193− , o_1_space_elimination size
137+ o_1_space_generation size ++ o_1_space_elimination size
194− , o_1_space_transformation size
195− , o_1_space_transformationX4 size
196− ]
197 , bgroup (o_n_space_prefix moduleName) $
138 , bgroup (o_n_space_prefix moduleName) $
198 o_n_heap_serial size
139 o_n_heap_serial size
199− ]
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/Foreign.hs → benchmark/Streamly/Benchmark/Data/Array/Stream.hsrenamed+81−45
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Streamly.Benchmark.Data.ParserD
4-- Module : Streamly.Benchmark.Data.ParserD
3-- Copyright : (c) 2020 Composewell Technologies
5-- Copyright : (c) 2020 Composewell Technologies
@@ -24,31 +26,35 @@ module Main
24 ) where
26 ) where
25
27
26import Control.DeepSeq (NFData(..))
28import Control.DeepSeq (NFData(..))
27−import Control.Monad (void)
29+import Control.Monad (void, when)
28−import Control.Monad.Catch (MonadThrow)
30+import Control.Monad.Catch (MonadCatch)
29import Data.Functor.Identity (runIdentity)
31import Data.Functor.Identity (runIdentity)
32+import Data.Maybe (isJust)
30import Data.Word (Word8)
33import Data.Word (Word8)
34+import Streamly.Internal.Data.Stream (Stream)
35+import Streamly.Internal.Data.StreamK (StreamK)
31import System.IO (Handle)
36import System.IO (Handle)
32import System.Random (randomRIO)
37import System.Random (randomRIO)
33import Prelude hiding ()
38import Prelude hiding ()
34
39
35−import qualified Streamly.Prelude as Stream
40+import qualified Streamly.Data.Stream as Stream
36−import qualified Streamly.Internal.Data.Array.Foreign as Array
41+import qualified Streamly.Internal.Data.Array as Array
37−import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
42+import qualified Streamly.Internal.Data.Array.Stream as ArrayStream
38import qualified Streamly.Internal.Data.Fold as Fold
43import qualified Streamly.Internal.Data.Fold as Fold
39−import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
44+import qualified Streamly.Internal.Data.Parser as Parser
40−import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)
45+import qualified Streamly.Internal.Data.Stream as Stream
46+import qualified Streamly.Internal.Data.StreamK as StreamK
41import qualified Streamly.Internal.FileSystem.Handle as Handle
47import qualified Streamly.Internal.FileSystem.Handle as Handle
42import qualified Streamly.Internal.Unicode.Stream as Unicode
48import qualified Streamly.Internal.Unicode.Stream as Unicode
43
49
44−import Gauge hiding (env)
50+import Test.Tasty.Bench hiding (env)
45−import Streamly.Prelude (SerialT, MonadAsync, IsStream)
46import Streamly.Benchmark.Common
51import Streamly.Benchmark.Common
47import Streamly.Benchmark.Common.Handle
52import Streamly.Benchmark.Common.Handle
53+import Control.Monad.IO.Class (MonadIO)
48
54
49#ifdef INSPECTION
55#ifdef INSPECTION
50−import Foreign.Storable (Storable)
56+import Streamly.Internal.Data.MutByteArray (Unbox)
51−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
57+import Streamly.Internal.Data.Stream (Step(..))
52import Test.Inspection
58import Test.Inspection
53#endif
59#endif
54
60
@@ -59,7 +65,7 @@ import Test.Inspection
59-- XXX these can be moved to the common module
65-- XXX these can be moved to the common module
60
66
61{-# INLINE sourceUnfoldrM #-}
67{-# INLINE sourceUnfoldrM #-}
62−sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
68+sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
63sourceUnfoldrM value n = Stream.unfoldrM step n
69sourceUnfoldrM value n = Stream.unfoldrM step n
64 where
70 where
65 step cnt =
71 step cnt =
@@ -70,7 +76,7 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
70{-# INLINE benchIO #-}
76{-# INLINE benchIO #-}
71benchIO
77benchIO
72 :: NFData b
78 :: NFData b
73− => String -> (Int -> t IO a) -> (t IO a -> IO b) -> Benchmark
79+ => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
74benchIO name src sink =
80benchIO name src sink =
75 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
81 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
76
82
@@ -81,11 +87,11 @@ benchIO name src sink =
81-- | Get the last byte from a file bytestream.
87-- | Get the last byte from a file bytestream.
82toChunksLast :: Handle -> IO (Maybe Word8)
88toChunksLast :: Handle -> IO (Maybe Word8)
83toChunksLast inh = do
89toChunksLast inh = do
84− let s = Handle.toChunks inh
90+ let s = Handle.readChunks inh
85 larr <- Stream.last s
91 larr <- Stream.last s
86 return $ case larr of
92 return $ case larr of
87 Nothing -> Nothing
93 Nothing -> Nothing
88− Just arr -> Array.getIndex arr (Array.length arr - 1)
94+ Just arr -> Array.getIndex (Array.length arr - 1) arr
89
95
90#ifdef INSPECTION
96#ifdef INSPECTION
91inspect $ hasNoTypeClasses 'toChunksLast
97inspect $ hasNoTypeClasses 'toChunksLast
@@ -95,8 +101,8 @@ inspect $ 'toChunksLast `hasNoType` ''Step
95-- | Count the number of bytes in a file.
101-- | Count the number of bytes in a file.
96toChunksSumLengths :: Handle -> IO Int
102toChunksSumLengths :: Handle -> IO Int
97toChunksSumLengths inh =
103toChunksSumLengths inh =
98− let s = Handle.toChunks inh
104+ let s = Handle.readChunks inh
99− in Stream.sum (Stream.map Array.length s)
105+ in Stream.fold Fold.sum (Stream.map Array.length s)
100
106
101#ifdef INSPECTION
107#ifdef INSPECTION
102inspect $ hasNoTypeClasses 'toChunksSumLengths
108inspect $ hasNoTypeClasses 'toChunksSumLengths
@@ -106,8 +112,8 @@ inspect $ 'toChunksSumLengths `hasNoType` ''Step
106-- | Sum the bytes in a file.
112-- | Sum the bytes in a file.
107toChunksCountBytes :: Handle -> IO Word8
113toChunksCountBytes :: Handle -> IO Word8
108toChunksCountBytes inh = do
114toChunksCountBytes inh = do
109− let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream
115+ let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
110− let s = Handle.toChunks inh
116+ let s = Handle.readChunks inh
111 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
117 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
112
118
113#ifdef INSPECTION
119#ifdef INSPECTION
@@ -117,7 +123,7 @@ inspect $ 'toChunksCountBytes `hasNoType` ''Step
117
123
118toChunksDecodeUtf8Arrays :: Handle -> IO ()
124toChunksDecodeUtf8Arrays :: Handle -> IO ()
119toChunksDecodeUtf8Arrays =
125toChunksDecodeUtf8Arrays =
120− Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
126+ Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
121
127
122#ifdef INSPECTION
128#ifdef INSPECTION
123inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
129inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
@@ -131,7 +137,9 @@ inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
131-- | Count the number of lines in a file.
137-- | Count the number of lines in a file.
132toChunksSplitOnSuffix :: Handle -> IO Int
138toChunksSplitOnSuffix :: Handle -> IO Int
133toChunksSplitOnSuffix =
139toChunksSplitOnSuffix =
140+ Stream.fold Fold.length
134− Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
141+ . ArrayStream.splitOnSuffix 10
142+ . Handle.readChunks
135
143
136#ifdef INSPECTION
144#ifdef INSPECTION
137inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
145inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
@@ -141,7 +149,10 @@ inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
141-- XXX use a word splitting combinator instead of splitOn and test it.
149-- XXX use a word splitting combinator instead of splitOn and test it.
142-- | Count the number of words in a file.
150-- | Count the number of words in a file.
143toChunksSplitOn :: Handle -> IO Int
151toChunksSplitOn :: Handle -> IO Int
152+toChunksSplitOn =
153+ Stream.fold Fold.length
144−toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks
154+ . ArrayStream.splitOn 32
155+ . Handle.readChunks
145
156
146#ifdef INSPECTION
157#ifdef INSPECTION
147inspect $ hasNoTypeClasses 'toChunksSplitOn
158inspect $ hasNoTypeClasses 'toChunksSplitOn
@@ -179,12 +190,11 @@ o_1_space_read_chunked env =
179copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
190copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
180copyChunksSplitInterposeSuffix inh outh =
191copyChunksSplitInterposeSuffix inh outh =
181 Stream.fold (Handle.write outh)
192 Stream.fold (Handle.write outh)
182− $ ArrayStream.interposeSuffix 10
193+ $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
183− $ ArrayStream.splitOnSuffix 10
184− $ Handle.toChunks inh
194+ $ Handle.readChunks inh
185
195
186#ifdef INSPECTION
196#ifdef INSPECTION
187−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
197+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
188inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
198inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
189#endif
199#endif
190
200
@@ -193,13 +203,12 @@ inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
193copyChunksSplitInterpose :: Handle -> Handle -> IO ()
203copyChunksSplitInterpose :: Handle -> Handle -> IO ()
194copyChunksSplitInterpose inh outh =
204copyChunksSplitInterpose inh outh =
195 Stream.fold (Handle.write outh)
205 Stream.fold (Handle.write outh)
196− $ ArrayStream.interpose 32
197 -- XXX this is not correct word splitting combinator
206 -- XXX this is not correct word splitting combinator
198− $ ArrayStream.splitOn 32
207+ $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
199− $ Handle.toChunks inh
208+ $ Handle.readChunks inh
200
209
201#ifdef INSPECTION
210#ifdef INSPECTION
202−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
211+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
203inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
212inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
204#endif
213#endif
205
214
@@ -218,30 +227,53 @@ o_1_space_copy_toChunks_group_ungroup env =
218-------------------------------------------------------------------------------
227-------------------------------------------------------------------------------
219
228
220{-# INLINE drainWhile #-}
229{-# INLINE drainWhile #-}
221−drainWhile :: MonadThrow m => (a -> Bool) -> ParserD.Parser m a ()
230+drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
222−drainWhile p = ParserD.takeWhile p Fold.drain
231+drainWhile p = Parser.takeWhile p Fold.drain
223
232
224-------------------------------------------------------------------------------
233-------------------------------------------------------------------------------
225-- Folds and parsers
234-- Folds and parsers
226-------------------------------------------------------------------------------
235-------------------------------------------------------------------------------
227
236
228{-# INLINE fold #-}
237{-# INLINE fold #-}
229−fold :: SerialT IO (Array.Array Int) -> IO ()
238+fold :: Stream IO (Array.Array Int) -> IO ()
230−fold s = void $ ArrayStream.fold Fold.drain s
239+fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s
231−
240+
232−{-# INLINE parseArray #-}
241+{-# INLINE parse #-}
233−parseArray :: Int -> SerialT IO (Array.Array Int) -> IO ()
242+parse :: Int -> Stream IO (Array.Array Int) -> IO ()
243+parse value s =
234−parseArray value s = void $ ArrayStream.parse (drainWhile (< 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
235
259
236o_1_space_serial_array ::
260o_1_space_serial_array ::
237 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
261 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
238o_1_space_serial_array bound arraysSmall arraysBig =
262o_1_space_serial_array bound arraysSmall arraysBig =
239 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
263 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
240 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
264 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265+ , benchIO
266+ "foldBreak (recursive, small arrays)"
267+ (\_ -> Stream.fromList arraysSmall)
268+ (foldBreak . StreamK.fromStream)
241 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
269 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
242− $ parseArray bound
270+ $ parse bound
243 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
271 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
244− $ parseArray bound
272+ $ parse bound
273+ , benchIO
274+ "parseBreak (recursive, small arrays)"
275+ (\_ -> Stream.fromList arraysSmall)
276+ (parseBreak . StreamK.fromStream)
245 ]
277 ]
246
278
247-------------------------------------------------------------------------------
279-------------------------------------------------------------------------------
@@ -249,7 +281,7 @@ o_1_space_serial_array bound arraysSmall arraysBig =
249-------------------------------------------------------------------------------
281-------------------------------------------------------------------------------
250
282
251moduleName :: String
283moduleName :: String
252−moduleName = "Data.Array.Stream.Foreign"
284+moduleName = "Data.Array.Stream"
253
285
254main :: IO ()
286main :: IO ()
255main = do
287main = do
@@ -258,10 +290,14 @@ main = do
258
290
259 where
291 where
260
292
261− alloc value = do
293+ alloc value =
294+ if value <= 0
295+ then return (undefined, undefined)
296+ else
297+ do
262− small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0
298+ small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
263− big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0
299+ big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0
264− return (small, big)
300+ return (small, big)
265
301
266 allBenchmarks env arrays value =
302 allBenchmarks env arrays value =
267 let (arraysSmall, arraysBig) = arrays
303 let (arraysSmall, arraysBig) = arrays
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+299−135
@@ -6,34 +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
39+import qualified Streamly.Data.Fold.Prelude as Fold
40+import qualified Streamly.Internal.Data.Unfold as Unfold
22import qualified Streamly.Internal.Data.Pipe as Pipe
41import qualified Streamly.Internal.Data.Pipe as Pipe
23−import qualified Streamly.Internal.Data.Sink as Sink
42+import qualified Streamly.Internal.Data.Stream as Stream
24−import qualified Streamly.Internal.Data.Stream.IsStream as IP
25−import qualified Streamly.Prelude as S
26
43
27−import Gauge
44+import Test.Tasty.Bench
28import Streamly.Benchmark.Common
45import Streamly.Benchmark.Common
29−import Prelude hiding (all, any, take, unzip, sequence_)
46+import Prelude hiding (all, any, take, unzip, sequence_, filter)
30
47
31-- 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
32-- completely optimized out by the compiler in some cases.
49-- completely optimized out by the compiler in some cases.
33
50
34{-# INLINE sourceUnfoldrM #-}
51{-# INLINE sourceUnfoldrM #-}
35−sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
52+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
36−sourceUnfoldrM value n = S.unfoldrM step n
53+sourceUnfoldrM value n = Stream.unfoldrM step n
37 where
54 where
38 step cnt =
55 step cnt =
39 if cnt > n + value
56 if cnt > n + value
@@ -41,14 +58,14 @@ sourceUnfoldrM value n = S.unfoldrM step n
41 else return (Just (cnt, cnt + 1))
58 else return (Just (cnt, cnt + 1))
42
59
43{-# INLINE source #-}
60{-# INLINE source #-}
44−source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
61+source :: Monad m => Int -> Int -> Stream m Int
45source = sourceUnfoldrM
62source = sourceUnfoldrM
46
63
47-- | Takes a fold method, and uses it with a default source.
64-- | Takes a fold method, and uses it with a default source.
48{-# INLINE benchIOSink #-}
65{-# INLINE benchIOSink #-}
49benchIOSink
66benchIOSink
50− :: (S.IsStream t, NFData b)
67+ :: NFData b
51− => Int -> String -> (t IO Int -> IO b) -> Benchmark
68+ => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
52benchIOSink 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
53
70
54-------------------------------------------------------------------------------
71-------------------------------------------------------------------------------
@@ -56,16 +73,16 @@ benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source va
56-------------------------------------------------------------------------------
73-------------------------------------------------------------------------------
57
74
58{-# INLINE any #-}
75{-# INLINE any #-}
59−any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
76+any :: (Monad m, Ord a) => a -> Stream m a -> m Bool
60−any value = IP.fold (FL.any (> value))
77+any value = Stream.fold (FL.any (> value))
61
78
62{-# INLINE all #-}
79{-# INLINE all #-}
63−all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
80+all :: (Monad m, Ord a) => a -> Stream m a -> m Bool
64−all value = IP.fold (FL.all (<= value))
81+all value = Stream.fold (FL.all (<= value))
65
82
66{-# INLINE take #-}
83{-# INLINE take #-}
67−take :: Monad m => Int -> SerialT m a -> m ()
84+take :: Monad m => Int -> Stream m a -> m ()
68−take value = IP.fold (FL.take value FL.drain)
85+take value = Stream.fold (FL.take value FL.drain)
69
86
70{-# INLINE sequence_ #-}
87{-# INLINE sequence_ #-}
71sequence_ :: Monad m => Int -> Fold m a ()
88sequence_ :: Monad m => Int -> Fold m a ()
@@ -77,55 +94,80 @@ sequence_ value =
77 {-# INLINE f #-}
94 {-# INLINE f #-}
78 f m k = FL.concatMap (const k) m
95 f m k = FL.concatMap (const k) m
79
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+
80-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
81-- Splitting by serial application
117-- Splitting by serial application
82-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
83
119
84{-# INLINE takeEndBy_ #-}
120{-# INLINE takeEndBy_ #-}
85−takeEndBy_ :: Monad m => Int -> SerialT m Int -> m ()
121+takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()
86−takeEndBy_ value = IP.fold (FL.takeEndBy_ (>= value) FL.drain)
122+takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)
87
123
88{-# INLINE many #-}
124{-# INLINE many #-}
89−many :: Monad m => SerialT m Int -> m ()
125+many :: Monad m => Stream m Int -> m ()
90−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)
91
127
92{-# INLINE splitAllAny #-}
128{-# INLINE splitAllAny #-}
93−splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)
129+splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool)
94splitAllAny value =
130splitAllAny value =
95− IP.fold
131+ Stream.fold
96− (FL.serialWith (,)
132+ (FL.splitWith (,)
97 (FL.all (<= (value `div` 2)))
133 (FL.all (<= (value `div` 2)))
98 (FL.any (> value))
134 (FL.any (> value))
99 )
135 )
100
136
101−{-# INLINE serial_ #-}
137+{-# INLINE split_ #-}
102−serial_ :: Monad m => Int -> SerialT m Int -> m Bool
138+split_ :: Monad m => Int -> Stream m Int -> m Bool
103−serial_ value =
139+split_ value =
104− IP.fold
140+ Stream.fold
105− (FL.serial_
141+ (FL.split_
106 (FL.all (<= (value `div` 2)))
142 (FL.all (<= (value `div` 2)))
107 (FL.any (> value))
143 (FL.any (> value))
108 )
144 )
109
145
110{-# INLINE shortest #-}
146{-# INLINE shortest #-}
111−shortest :: Monad m => SerialT m Int -> m (Either Int Int)
147+shortest :: Monad m => Stream m Int -> m (Either Int Int)
112−shortest = IP.fold (FL.shortest FL.sum FL.length)
148+shortest = Stream.fold (FL.shortest FL.sum FL.length)
113
149
114{-# INLINE longest #-}
150{-# INLINE longest #-}
115−longest :: Monad m => SerialT m Int -> m (Either Int Int)
151+longest :: Monad m => Stream m Int -> m (Either Int Int)
116−longest = IP.fold (FL.longest FL.sum FL.length)
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
117
159
118-------------------------------------------------------------------------------
160-------------------------------------------------------------------------------
119-- Distributing by parallel application
161-- Distributing by parallel application
120-------------------------------------------------------------------------------
162-------------------------------------------------------------------------------
121
163
122{-# INLINE teeSumLength #-}
164{-# INLINE teeSumLength #-}
123−teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
165+teeSumLength :: Monad m => Stream m Int -> m (Int, Int)
124−teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)
166+teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)
125
167
126{-# INLINE teeAllAny #-}
168{-# INLINE teeAllAny #-}
127−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)
128−teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
170+teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
129
171
130 where
172 where
131
173
@@ -133,16 +175,16 @@ teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
133 any_ = FL.any (> value)
175 any_ = FL.any (> value)
134
176
135{-# INLINE teeWithFst #-}
177{-# INLINE teeWithFst #-}
136−teeWithFst :: Monad m => SerialT m Int -> m (Int, Int)
178+teeWithFst :: Monad m => Stream m Int -> m (Int, Int)
137−teeWithFst = IP.fold (FL.teeWithFst (,) FL.sum FL.length)
179+teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)
138
180
139{-# INLINE teeWithMin #-}
181{-# INLINE teeWithMin #-}
140−teeWithMin :: Monad m => SerialT m Int -> m (Int, Int)
182+teeWithMin :: Monad m => Stream m Int -> m (Int, Int)
141−teeWithMin = IP.fold (FL.teeWithMin (,) FL.sum FL.length)
183+teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)
142
184
143{-# INLINE distribute #-}
185{-# INLINE distribute #-}
144−distribute :: Monad m => SerialT m Int -> m [Int]
186+distribute :: Monad m => Stream m Int -> m [Int]
145−distribute = IP.fold (FL.distribute [FL.sum, FL.length])
187+distribute = Stream.fold (FL.distribute [FL.sum, FL.length])
146
188
147-------------------------------------------------------------------------------
189-------------------------------------------------------------------------------
148-- Partitioning
190-- Partitioning
@@ -153,61 +195,99 @@ oddEven :: Int -> Either Int Int
153oddEven x = if odd x then Left x else Right x
195oddEven x = if odd x then Left x else Right x
154
196
155{-# INLINE partition #-}
197{-# INLINE partition #-}
156−partition :: Monad m => SerialT m Int -> m (Int, Int)
198+partition :: Monad m => Stream m Int -> m (Int, Int)
157−partition = IP.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
199+partition = Stream.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
158
200
159{-# INLINE partitionByFstM #-}
201{-# INLINE partitionByFstM #-}
160−partitionByFstM :: Monad m => SerialT m Int -> m (Int, Int)
202+partitionByFstM :: Monad m => Stream m Int -> m (Int, Int)
161partitionByFstM =
203partitionByFstM =
162− IP.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
204+ Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
163
205
164{-# INLINE partitionByMinM #-}
206{-# INLINE partitionByMinM #-}
165−partitionByMinM :: Monad m => SerialT m Int -> m (Int, Int)
207+partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)
166partitionByMinM =
208partitionByMinM =
167− IP.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
209+ Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
168−
210+
169−{-# INLINE demuxWith #-}
211+{-# INLINE demuxToMap #-}
170−demuxWith ::
171− (Monad m, Ord k)
212+demuxToMap :: (Monad m, Ord k) =>
172− => (a -> (k, a'))
213+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
173− -> Map k (Fold m a' b)
214+demuxToMap f g = Stream.fold (FL.demuxToContainer f g)
174− -> SerialT m a
215+
175− -> m (Map k b)
216+{-# INLINE demuxToIntMap #-}
176−demuxWith f mp = S.fold (FL.demuxWith f mp)
217+demuxToIntMap :: Monad m =>
177−
218+ (a -> Int) -> (a -> m (Fold m a b)) -> Stream m a -> m (IntMap b)
178−{-# INLINE demuxDefaultWith #-}
219+demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g)
179−demuxDefaultWith ::
220+
180− (Monad m, Ord k, Num b)
221+{-# INLINE demuxToHashMap #-}
181− => (a -> (k, b))
222+demuxToHashMap :: (Monad m, Hashable k) =>
182− -> Map k (Fold m b b)
223+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
183− -> SerialT m a
224+demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g)
184− -> m (Map k b, b)
225+
185−demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.lmap snd FL.sum))
226+{-# INLINE demuxToMapIO #-}
186−
227+demuxToMapIO :: (MonadIO m, Ord k) =>
187−{-# INLINE classifyWith #-}
228+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
188−classifyWith ::
229+demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
189− (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)
230+
190−classifyWith f = S.fold (FL.classifyWith f FL.sum)
231+{-# INLINE demuxToHashMapIO #-}
232+demuxToHashMapIO :: (MonadIO m, Hashable k) =>
233+ (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
234+demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
235+
236+{-# INLINE toMap #-}
237+toMap ::
238+ (Monad m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
239+toMap f = Stream.fold (FL.toContainer f FL.sum)
240+
241+{-# INLINE toIntMap #-}
242+toIntMap ::
243+ (Monad m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
244+toIntMap f = Stream.fold (FL.toContainer f FL.sum)
245+
246+{-# INLINE toMapIO #-}
247+toMapIO ::
248+ (MonadIO m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
249+toMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
250+
251+{-# INLINE toIntMapIO #-}
252+toIntMapIO ::
253+ (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
254+toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
255+
256+{-# INLINE toHashMapIO #-}
257+toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) =>
258+ (a -> k) -> Stream m a -> m (HashMap k a)
259+toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum)
191
260
192-------------------------------------------------------------------------------
261-------------------------------------------------------------------------------
193-- unzip
262-- unzip
194-------------------------------------------------------------------------------
263-------------------------------------------------------------------------------
195
264
196{-# INLINE unzip #-}
265{-# INLINE unzip #-}
197−unzip :: Monad m => SerialT m Int -> m (Int, Int)
266+unzip :: Monad m => Stream m Int -> m (Int, Int)
198−unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
267+unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
199
268
200{-# INLINE unzipWithFstM #-}
269{-# INLINE unzipWithFstM #-}
201−unzipWithFstM :: Monad m => SerialT m Int -> m (Int, Int)
270+unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
202unzipWithFstM = do
271unzipWithFstM = do
203− let f = \a -> return (a + 1, a)
272+ let f a = return (a + 1, a)
204− IP.fold (FL.unzipWithFstM f FL.sum FL.length)
273+ Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
205
274
206{-# INLINE unzipWithMinM #-}
275{-# INLINE unzipWithMinM #-}
207−unzipWithMinM :: Monad m => SerialT m Int -> m (Int, Int)
276+unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
208unzipWithMinM = do
277unzipWithMinM = do
209− let f = \a -> return (a + 1, a)
278+ let f a = return (a + 1, a)
210− IP.fold (FL.unzipWithMinM f FL.sum FL.length)
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))
211
291
212-------------------------------------------------------------------------------
292-------------------------------------------------------------------------------
213-- Benchmarks
293-- Benchmarks
@@ -216,92 +296,113 @@ unzipWithMinM = do
216moduleName :: String
296moduleName :: String
217moduleName = "Data.Fold"
297moduleName = "Data.Fold"
218
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+
219o_1_space_serial_elimination :: Int -> [Benchmark]
307o_1_space_serial_elimination :: Int -> [Benchmark]
220o_1_space_serial_elimination value =
308o_1_space_serial_elimination value =
221 [ bgroup "elimination"
309 [ bgroup "elimination"
222− [ benchIOSink value "drain" (S.fold FL.drain)
310+ [ benchIOSink value "drain" (Stream.fold FL.drain)
223− , benchIOSink value "drainBy" (S.fold (FL.drainBy return))
311+ , benchIOSink value "drainBy" (Stream.fold (FL.drainBy return))
224− , benchIOSink value "drainN" (S.fold (FL.drainN value))
312+ , benchIOSink value "drainN" (Stream.fold (FL.drainN value))
225− , 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)
226− , benchIOSink value "last" (S.fold FL.last)
315+ , benchIOSink value "top" (Stream.fold $ FL.top 10)
227− , benchIOSink value "length" (S.fold FL.length)
316+ , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)
228− , benchIOSink value "sum" (S.fold FL.sum)
317+ , benchIOSink value "sum" (Stream.fold FL.sum)
229− , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))
318+ , benchIOSink value "sum (foldMap)" (Stream.fold (FL.foldMap Sum))
230− , benchIOSink value "product" (S.fold FL.product)
319+ , benchIOSink value "product" (Stream.fold FL.product)
231− , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
320+ , benchIOSink value "maximumBy" (Stream.fold (FL.maximumBy compare))
232− , benchIOSink value "maximum" (S.fold FL.maximum)
321+ , benchIOSink value "maximum" (Stream.fold FL.maximum)
233− , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
322+ , benchIOSink value "minimumBy" (Stream.fold (FL.minimumBy compare))
234− , benchIOSink value "minimum" (S.fold FL.minimum)
323+ , benchIOSink value "minimum" (Stream.fold FL.minimum)
235 , benchIOSink
324 , benchIOSink
236 value
325 value
237 "mean"
326 "mean"
238− (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))
327+ (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))
239 , benchIOSink
328 , benchIOSink
240 value
329 value
241 "variance"
330 "variance"
242− (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))
331+ (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))
243 , benchIOSink
332 , benchIOSink
244 value
333 value
245 "stdDev"
334 "stdDev"
246− (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))
335+ (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))
247 , benchIOSink
336 , benchIOSink
248 value
337 value
249 "mconcat"
338 "mconcat"
250− (S.fold FL.mconcat . S.map (Last . Just))
339+ (Stream.fold FL.mconcat . fmap (Last . Just))
251 , benchIOSink
340 , benchIOSink
252 value
341 value
253 "foldMap"
342 "foldMap"
254− (S.fold (FL.foldMap (Last . Just)))
343+ (Stream.fold (FL.foldMap (Last . Just)))
255 , benchIOSink
344 , benchIOSink
256 value
345 value
257 "foldMapM"
346 "foldMapM"
258− (S.fold (FL.foldMapM (return . Last . Just)))
347+ (Stream.fold (FL.foldMapM (return . Last . Just)))
259− , benchIOSink value "index" (S.fold (FL.index (value + 1)))
348+ , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))
260− , benchIOSink value "head" (S.fold FL.head)
349+ , benchIOSink value "head" (Stream.fold FL.head)
261− , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
350+ , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))
262 , benchIOSink
351 , benchIOSink
263 value
352 value
264 "lookup"
353 "lookup"
265− (S.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
354+ (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
266 , benchIOSink
355 , benchIOSink
267 value
356 value
268 "findIndex"
357 "findIndex"
269− (S.fold (FL.findIndex (== (value + 1))))
358+ (Stream.fold (FL.findIndex (== (value + 1))))
270 , benchIOSink
359 , benchIOSink
271 value
360 value
272 "elemIndex"
361 "elemIndex"
273− (S.fold (FL.elemIndex (value + 1)))
362+ (Stream.fold (FL.elemIndex (value + 1)))
274− , benchIOSink value "null" (S.fold FL.null)
363+ , benchIOSink value "null" (Stream.fold FL.null)
275− , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
364+ , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))
276− , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
365+ , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))
277 , benchIOSink value "all" $ all value
366 , benchIOSink value "all" $ all value
278 , benchIOSink value "any" $ any value
367 , benchIOSink value "any" $ any value
279 , benchIOSink value "take" $ take value
368 , benchIOSink value "take" $ take value
280 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
369 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
281− , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))
370+ , benchIOSink value "and" (Stream.fold FL.and . fmap (<= (value + 1)))
282− , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))
371+ , benchIOSink value "or" (Stream.fold FL.or . fmap (> (value + 1)))
283 ]
372 ]
284 ]
373 ]
285
374
286o_1_space_serial_transformation :: Int -> [Benchmark]
375o_1_space_serial_transformation :: Int -> [Benchmark]
287o_1_space_serial_transformation value =
376o_1_space_serial_transformation value =
288 [ bgroup "transformation"
377 [ bgroup "transformation"
289− [ benchIOSink value "map" (S.fold (FL.lmap (+ 1) FL.drain))
378+ [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))
290 , let f x = if even x then Just x else Nothing
379 , let f x = if even x then Just x else Nothing
291 fld = FL.mapMaybe f FL.drain
380 fld = FL.mapMaybe f FL.drain
292− in benchIOSink value "mapMaybe" (S.fold fld)
381+ in benchIOSink value "mapMaybe" (Stream.fold fld)
293 , benchIOSink
382 , benchIOSink
294 value
383 value
295 "rsequence"
384 "rsequence"
296− (S.fold (FL.rmapM id (return <$> FL.drain)))
385+ (Stream.fold (FL.rmapM id (return <$> FL.drain)))
297− , benchIOSink value "rmapM" (S.fold (FL.rmapM return FL.drain))
386+ , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))
298 , benchIOSink
387 , benchIOSink
299 value
388 value
300 "pipe-mapM"
389 "pipe-mapM"
301− (S.fold
390+ (Stream.fold
302 (FL.transform
391 (FL.transform
303 (Pipe.mapM (\x -> return $ x + 1))
392 (Pipe.mapM (\x -> return $ x + 1))
304 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)
305 ]
406 ]
306 ]
407 ]
307
408
@@ -309,10 +410,15 @@ o_1_space_serial_composition :: Int -> [Benchmark]
309o_1_space_serial_composition value =
410o_1_space_serial_composition value =
310 [ bgroup
411 [ bgroup
311 "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
312− [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
417+ , benchIOSink value "splitWith (all, any)" $ splitAllAny value
313− , benchIOSink value "serial_ (all, any)" $ serial_ value
418+ , benchIOSink value "split_ (all, any)" $ split_ value
314 , benchIOSink value "tee (all, any)" $ teeAllAny value
419 , benchIOSink value "tee (all, any)" $ teeAllAny value
315 , benchIOSink value "many drain (take 1)" many
420 , benchIOSink value "many drain (take 1)" many
421+ , bench "unfoldMany" $ unfoldMany value
316 , benchIOSink value "shortest (sum, length)" shortest
422 , benchIOSink value "shortest (sum, length)" shortest
317 , benchIOSink value "longest (sum, length)" longest
423 , benchIOSink value "longest (sum, length)" longest
318 , benchIOSink value "tee (sum, length)" teeSumLength
424 , benchIOSink value "tee (sum, length)" teeSumLength
@@ -325,23 +431,12 @@ o_1_space_serial_composition value =
325 , benchIOSink value "unzip (sum, length)" unzip
431 , benchIOSink value "unzip (sum, length)" unzip
326 , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
432 , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
327 , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
433 , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
328− , benchIOSink value "demuxDefaultWith [sum, length] sum"
329− $ demuxDefaultWith fn mp
330− , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
331− , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)
332 ]
434 ]
333 ]
435 ]
334
436
335− where
336−
337− -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.
338− fn x = (x `mod` 3, x)
339−
340− mp = Map.fromList [(0, FL.sum), (1, FL.length)]
341−
342o_n_space_serial :: Int -> [Benchmark]
437o_n_space_serial :: Int -> [Benchmark]
343o_n_space_serial value =
438o_n_space_serial value =
344− [ benchIOSink value "sequence_/100" $ S.fold (sequence_ (value `div` 100))
439+ [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))
345 ]
440 ]
346
441
347o_n_heap_serial :: Int -> [Benchmark]
442o_n_heap_serial :: Int -> [Benchmark]
@@ -350,19 +445,71 @@ o_n_heap_serial value =
350 -- Left folds for building a structure are inherently non-streaming
445 -- Left folds for building a structure are inherently non-streaming
351 -- as the structure cannot be lazily consumed until fully built.
446 -- as the structure cannot be lazily consumed until fully built.
352 [
447 [
353− benchIOSink value "toList" (S.fold FL.toList)
448+ benchIOSink value "toList" (Stream.fold FL.toList)
354− , benchIOSink value "toListRev" (S.fold FL.toListRev)
449+ , benchIOSink value "toListRev" (Stream.fold FL.toListRev)
355− , benchIOSink value "toStream" (S.fold FL.toStream)
450+ , benchIOSink value "toStream"
451+ (Stream.fold FL.toStream
452+ :: Stream IO a -> IO (Stream Identity a))
356− , 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)
357 ]
492 ]
358 ]
493 ]
359
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+
360-------------------------------------------------------------------------------
505-------------------------------------------------------------------------------
361-- Driver
506-- Driver
362-------------------------------------------------------------------------------
507-------------------------------------------------------------------------------
363
508
364main :: IO ()
509main :: IO ()
510+main = do
511+#ifndef FUSION_CHECK
365−main = runWithCLIOpts defaultStreamSize allBenchmarks
512+ runWithCLIOpts defaultStreamSize allBenchmarks
366
513
367 where
514 where
368
515
@@ -375,3 +522,20 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
375 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
522 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
376 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
523 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
377 ]
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+641−181
@@ -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,188 +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)
130+
131+{-# INLINE takeGE #-}
132+takeGE :: Monad m => Int -> Stream m a -> m (Either ParseError ())
133+takeGE value = Stream.parse (PR.takeGE value Fold.drain)
134+
135+{-# INLINE dropWhile #-}
136+dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
137+dropWhile value = Stream.parse (PR.dropWhile (<= value))
84
138
85−{-# INLINE drainWhile #-}
139+{-# INLINE takeStartBy #-}
86−drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
140+takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
87−drainWhile value = IP.parse (PR.drainWhile (<= value))
141+takeStartBy value stream = do
142+ let stream2 = value `Stream.cons` stream
143+ Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2
88
144
89−{-# INLINE sliceBeginWith #-}
145+takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ())
90−sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
146+takeFramedByEsc_ _ = Stream.parse parser
91−sliceBeginWith value stream = do
147+
92− stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream
148+ where
93− let stream2 = value `S.cons` stream1
149+
94− IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2
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))
99
171
100{-# INLINE takeP #-}
172{-# INLINE takeP #-}
101−takeP :: MonadCatch m => Int -> SerialT m a -> m ()
173+takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())
102−takeP value = IP.parse (PR.takeP value (PR.fromFold FL.drain))
174+takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))
103
175
104{-# INLINE groupBy #-}
176{-# INLINE groupBy #-}
105−groupBy :: MonadCatch m => SerialT m Int -> m ()
177+groupBy :: Monad m => Stream m Int -> m (Either ParseError ())
106−groupBy = IP.parse (PR.groupBy (<=) FL.drain)
178+groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)
107
179
108{-# INLINE groupByRolling #-}
180{-# INLINE groupByRolling #-}
109−groupByRolling :: MonadCatch m => SerialT m Int -> m ()
181+groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())
110−groupByRolling = IP.parse (PR.groupByRolling (<=) FL.drain)
182+groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)
111
183
112{-# INLINE wordBy #-}
184{-# INLINE wordBy #-}
113−wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()
185+wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
114−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
115
241
116{-# INLINE manyWordByEven #-}
242{-# INLINE manyWordByEven #-}
117−manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
243+manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())
118−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)
119
245
120{-# INLINE many #-}
246{-# INLINE many #-}
121−many :: MonadCatch m => SerialT m Int -> m Int
247+many :: Monad m => Stream m Int -> m (Either ParseError Int)
122−many = IP.parse (PR.many (PR.satisfy (> 0)) FL.length)
248+many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
123
249
124{-# INLINE manyAlt #-}
250{-# INLINE manyAlt #-}
125−manyAlt :: MonadCatch m => SerialT m Int -> m Int
251+manyAlt :: Monad m => Stream m Int -> m Int
126manyAlt xs = do
252manyAlt xs = do
127− x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
253+ x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
128 return $ Prelude.length x
254 return $ Prelude.length x
129
255
130{-# INLINE some #-}
256{-# INLINE some #-}
131−some :: MonadCatch m => SerialT m Int -> m Int
257+some :: Monad m => Stream m Int -> m (Either ParseError Int)
132−some = IP.parse (PR.some (PR.satisfy (> 0)) FL.length)
258+some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
133
259
134{-# INLINE someAlt #-}
260{-# INLINE someAlt #-}
135−someAlt :: MonadCatch m => SerialT m Int -> m Int
261+someAlt :: Monad m => Stream m Int -> m Int
136someAlt xs = do
262someAlt xs = do
137− x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
263+ x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
138 return $ Prelude.length x
264 return $ Prelude.length x
139
265
140{-# INLINE manyTill #-}
266{-# INLINE manyTill #-}
141−manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
267+manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
142manyTill value =
268manyTill value =
143− 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)
144
270
145−{-# INLINE splitAp #-}
271+{-# INLINE splitAp2 #-}
146−splitAp :: MonadCatch m
272+splitAp2 :: Monad m
147− => Int -> SerialT m Int -> m ((), ())
273+ => Int -> Stream m Int -> m (Either ParseError ((), ()))
148−splitAp value =
274+splitAp2 value =
149− IP.parse
275+ Stream.parse
150 ((,)
276 ((,)
151− <$> PR.drainWhile (<= (value `div` 2))
277+ <$> PR.dropWhile (<= (value `div` 2))
152− <*> 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)
153 )
307 )
154
308
155{-# INLINE splitApBefore #-}
309{-# INLINE splitApBefore #-}
156−splitApBefore :: MonadCatch m
310+splitApBefore :: Monad m
157− => Int -> SerialT m Int -> m ()
311+ => Int -> Stream m Int -> m (Either ParseError ())
158splitApBefore value =
312splitApBefore value =
159− IP.parse
313+ Stream.parse
160− ( PR.drainWhile (<= (value `div` 2))
314+ ( PR.dropWhile (<= (value `div` 2))
161− *> PR.drainWhile (<= value)
315+ *> PR.dropWhile (<= value)
162 )
316 )
163
317
164{-# INLINE splitApAfter #-}
318{-# INLINE splitApAfter #-}
165−splitApAfter :: MonadCatch m
319+splitApAfter :: Monad m
166− => Int -> SerialT m Int -> m ()
320+ => Int -> Stream m Int -> m (Either ParseError ())
167splitApAfter value =
321splitApAfter value =
168− IP.parse
322+ Stream.parse
169− ( PR.drainWhile (<= (value `div` 2))
323+ ( PR.dropWhile (<= (value `div` 2))
170− <* PR.drainWhile (<= value)
324+ <* PR.dropWhile (<= value)
171 )
325 )
172
326
173−{-# INLINE serialWith #-}
327+{-# INLINE splitWith2 #-}
174−serialWith :: MonadCatch m
328+splitWith2 :: Monad m
175− => Int -> SerialT m Int -> m ((), ())
329+ => Int -> Stream m Int -> m (Either ParseError ((), ()))
176−serialWith value =
330+splitWith2 value =
177− IP.parse
331+ Stream.parse
178− (PR.serialWith (,)
332+ (PR.splitWith (,)
179− (PR.drainWhile (<= (value `div` 2)))
333+ (PR.dropWhile (<= (value `div` 2)))
180− (PR.drainWhile (<= value))
334+ (PR.dropWhile (<= value))
181 )
335 )
182
336
183{-# INLINE split_ #-}
337{-# INLINE split_ #-}
184−split_ :: MonadCatch m
338+split_ :: Monad m
185− => Int -> SerialT m Int -> m ()
339+ => Int -> Stream m Int -> m (Either ParseError ())
186split_ value =
340split_ value =
187− IP.parse
341+ Stream.parse
188 (PR.split_
342 (PR.split_
189− (PR.drainWhile (<= (value `div` 2)))
343+ (PR.dropWhile (<= (value `div` 2)))
190− (PR.drainWhile (<= value))
344+ (PR.dropWhile (<= value))
191 )
345 )
192
346
193−{-# INLINE sliceSepByP #-}
347+-- XXX dropWhile with applicative does not fuse
194−sliceSepByP :: MonadCatch m
348+-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
195− => Int -> SerialT m Int -> m()
349+{-# INLINE takeWhileFail #-}
196−sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
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
197
355
356+ initial = do
357+ res <- finitial
358+ return $ case res of
359+ Fold.Partial s -> IPartial s
360+ Fold.Done b -> IDone b
361+
362+ step s a =
363+ if predicate a
364+ then do
365+ fres <- fstep s a
366+ return
367+ $ case fres of
368+ Fold.Partial s1 -> Partial 0 s1
369+ Fold.Done b -> Done 0 b
370+ else return $ Error "fail"
371+
372+ extract s = fmap (Done 0) (ffinal s)
373+
374+{-# INLINE alt2 #-}
375+alt2 :: Monad m
376+ => Int -> Stream m Int -> m (Either ParseError ())
377+alt2 value =
378+ Stream.parse
379+ (PR.alt
380+ (takeWhileFail (<= (value `div` 2)) Fold.drain)
381+ (PR.dropWhile (<= value))
382+ )
383+
384+{-# INLINE alt4 #-}
385+alt4 :: Monad m
386+ => Int -> Stream m Int -> m (Either ParseError ())
387+alt4 value =
388+ Stream.parse
389+ ( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain
390+ <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain
391+ <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain
392+ <|> PR.dropWhile (<= value)
393+ )
394+
395+{-# INLINE alt8 #-}
396+alt8 :: Monad m
397+ => Int -> Stream m Int -> m (Either ParseError ())
398+alt8 value =
399+ Stream.parse
400+ ( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain
401+ <|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain
402+ <|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain
403+ <|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain
404+ <|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain
405+ <|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain
406+ <|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain
407+ <|> PR.dropWhile (<= value)
408+ )
409+
410+{-# INLINE alt16 #-}
411+alt16 :: Monad m
412+ => Int -> Stream m Int -> m (Either ParseError ())
413+alt16 value =
414+ Stream.parse
415+ ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
416+ <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
417+ <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
418+ <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
419+ <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
420+ <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
421+ <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
422+ <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
423+ <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
424+ <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
425+ <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
426+ <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
427+ <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
428+ <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
429+ <|> PR.dropWhile (<= value)
430+ )
431+
432+{-# INLINE altSmall #-}
433+altSmall :: Monad m
434+ => Int -> Stream m Int -> m ()
435+altSmall value =
436+ Stream.fold Fold.drain .
437+ Stream.parseMany
438+ (PR.alt
439+ (PR.satisfy (>= value) *> PR.die "alt")
440+ (PR.satisfy (<= value))
441+ )
442+
443+{-# INLINE monad #-}
444+monad :: Monad m
445+ => Int -> Stream m Int -> m (Either ParseError ())
446+monad value =
447+ Stream.parse
448+ $ do
449+ PR.dropWhile (<= (value `div` 2))
450+ PR.dropWhile (<= value)
451+
452+{-# INLINE monad4 #-}
453+monad4 :: Monad m
454+ => Int -> Stream m Int -> m (Either ParseError ())
455+monad4 value =
456+ Stream.parse $ do
457+ PR.dropWhile (<= (value `div` 4))
458+ PR.dropWhile (<= (value `div` 2))
459+ PR.dropWhile (<= (value * 3 `div` 4))
460+ PR.dropWhile (<= value)
461+
462+{-# INLINE monad8 #-}
463+monad8 :: Monad m
464+ => Int -> Stream m Int -> m (Either ParseError ())
465+monad8 value =
466+ Stream.parse $ do
467+ PR.dropWhile (<= (value * 1 `div` 8))
468+ PR.dropWhile (<= (value * 2 `div` 8))
469+ PR.dropWhile (<= (value * 3 `div` 8))
470+ PR.dropWhile (<= (value * 4 `div` 8))
471+ PR.dropWhile (<= (value * 5 `div` 8))
472+ PR.dropWhile (<= (value * 6 `div` 8))
473+ PR.dropWhile (<= (value * 7 `div` 8))
474+ PR.dropWhile (<= value)
475+
476+{-# INLINE monad16 #-}
477+monad16 :: Monad m
478+ => Int -> Stream m Int -> m (Either ParseError ())
479+monad16 value =
480+ Stream.parse $ do
481+ PR.dropWhile (<= (value * 1 `div` 16))
482+ PR.dropWhile (<= (value * 2 `div` 16))
483+ PR.dropWhile (<= (value * 3 `div` 16))
484+ PR.dropWhile (<= (value * 4 `div` 16))
485+ PR.dropWhile (<= (value * 5 `div` 16))
486+ PR.dropWhile (<= (value * 6 `div` 16))
487+ PR.dropWhile (<= (value * 7 `div` 16))
488+ PR.dropWhile (<= (value * 8 `div` 16))
489+ PR.dropWhile (<= (value * 9 `div` 16))
490+ PR.dropWhile (<= (value * 10 `div` 16))
491+ PR.dropWhile (<= (value * 11 `div` 16))
492+ PR.dropWhile (<= (value * 12 `div` 16))
493+ PR.dropWhile (<= (value * 13 `div` 16))
494+ PR.dropWhile (<= (value * 14 `div` 16))
495+ PR.dropWhile (<= (value * 15 `div` 16))
496+ PR.dropWhile (<= value)
497+
498+{-# INLINE takeEndBy_ #-}
499+takeEndBy_ :: Monad m
500+ => Int -> Stream m Int -> m (Either ParseError ())
501+takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))
502+
503+{-
198{-# INLINE teeAllAny #-}
504{-# INLINE teeAllAny #-}
199−teeAllAny :: MonadCatch m
505+teeAllAny :: Monad m
200− => Int -> SerialT m Int -> m ((), ())
506+ => Int -> Stream m Int -> m ((), ())
201teeAllAny value =
507teeAllAny value =
202− IP.parse
508+ Stream.parse
203 (PR.teeWith (,)
509 (PR.teeWith (,)
204− (PR.drainWhile (<= value))
510+ (PR.dropWhile (<= value))
205− (PR.drainWhile (<= value))
511+ (PR.dropWhile (<= value))
206 )
512 )
207
513
208{-# INLINE teeFstAllAny #-}
514{-# INLINE teeFstAllAny #-}
209−teeFstAllAny :: MonadCatch m
515+teeFstAllAny :: Monad m
210− => Int -> SerialT m Int -> m ((), ())
516+ => Int -> Stream m Int -> m ((), ())
211teeFstAllAny value =
517teeFstAllAny value =
212− IP.parse
518+ Stream.parse
213 (PR.teeWithFst (,)
519 (PR.teeWithFst (,)
214− (PR.drainWhile (<= value))
520+ (PR.dropWhile (<= value))
215− (PR.drainWhile (<= value))
521+ (PR.dropWhile (<= value))
216 )
522 )
217
523
218{-# INLINE shortestAllAny #-}
524{-# INLINE shortestAllAny #-}
219−shortestAllAny :: MonadCatch m
525+shortestAllAny :: Monad m
220− => Int -> SerialT m Int -> m ()
526+ => Int -> Stream m Int -> m (Either ParseError ())
221shortestAllAny value =
527shortestAllAny value =
222− IP.parse
528+ Stream.parse
223 (PR.shortest
529 (PR.shortest
224− (PR.drainWhile (<= value))
530+ (PR.dropWhile (<= value))
225− (PR.drainWhile (<= value))
531+ (PR.dropWhile (<= value))
226 )
532 )
227
533
228{-# INLINE longestAllAny #-}
534{-# INLINE longestAllAny #-}
229−longestAllAny :: MonadCatch m
535+longestAllAny :: Monad m
230− => Int -> SerialT m Int -> m ()
536+ => Int -> Stream m Int -> m (Either ParseError ())
231longestAllAny value =
537longestAllAny value =
232− IP.parse
538+ Stream.parse
233 (PR.longest
539 (PR.longest
234− (PR.drainWhile (<= value))
540+ (PR.dropWhile (<= value))
235− (PR.drainWhile (<= value))
541+ (PR.dropWhile (<= value))
236 )
542 )
237−
543+-}
238−parseManyChunksOfSum :: Int -> Handle -> IO Int
239−parseManyChunksOfSum n inh =
240− S.length
241− $ IP.parseMany
242− (PR.fromFold $ FL.take n FL.sum)
243− (S.unfold Handle.read inh)
244
544
245-------------------------------------------------------------------------------
545-------------------------------------------------------------------------------
246−-- Parsing with unfolds
546+-- Spanning
247-------------------------------------------------------------------------------
547-------------------------------------------------------------------------------
248
548
249−{-# INLINE parseManyUnfoldArrays #-}
549+{-# INLINE span #-}
250−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
550+span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
251−parseManyUnfoldArrays count arrays = do
551+span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)
252− 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
253− let parser = PR.fromFold (FL.take count FL.drain)
567+ (PR.fromFold $ Fold.take n Fold.sum)
254− let readSrc =
568+ (Stream.unfold Handle.reader inh)
255− Source.producer
256− $ Producer.concat Producer.fromList Array.producer
257− let streamParser =
258− Producer.simplify (Source.parseMany parser readSrc)
259− S.drain $ S.unfold streamParser src
260
569
261-------------------------------------------------------------------------------
570-------------------------------------------------------------------------------
262-- Parsers in which -fspec-constr-recursive=16 is problematic
571-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -267,63 +576,129 @@ parseManyUnfoldArrays count arrays = do
267-- not have to rely on it.
576-- not have to rely on it.
268--
577--
269{-# INLINE lookAhead #-}
578{-# INLINE lookAhead #-}
270−lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
579+lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
271lookAhead value =
580lookAhead value =
272− IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
581+ Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
273
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
274{-# INLINE sequenceA #-}
590{-# INLINE sequenceA #-}
275−sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
591+sequenceA :: Monad m => Int -> Stream m Int -> m Int
276sequenceA value xs = do
592sequenceA value xs = do
277− x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
593+ x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
278 return $ length x
594 return $ length x
279
595
280−{-# INLINE sequenceA_ #-}
596+-- quadratic complexity
281−sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
282−sequenceA_ value =
283− IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
284−
285{-# INLINE sequence #-}
597{-# INLINE sequence #-}
286−sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
598+sequence :: Monad m => Int -> Stream m Int -> m Int
287sequence value xs = do
599sequence value xs = do
288− x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
600+ x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
289 return $ length x
601 return $ length x
290
602
291{-# INLINE sequence_ #-}
603{-# INLINE sequence_ #-}
292−sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
604+sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
293−sequence_ value =
605+sequence_ value xs =
294− IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))
606+ Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs
295
607
608+ where
609+
610+ {-# INLINE f #-}
611+ f m k = m >>= (\_ -> k)
612+
613+-- choice using the "Alternative" instance with direct style parser type has
614+-- quadratic performance complexity.
615+--
296{-# INLINE choiceAsum #-}
616{-# INLINE choiceAsum #-}
297−choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
617+choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
298choiceAsum value =
618choiceAsum value =
299− IP.parse (asum (replicate value (PR.satisfy (< 0)))
619+ Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
300 AP.<|> PR.satisfy (> 0))
620 AP.<|> PR.satisfy (> 0))
301
621
622+{-
302{-# INLINE choice #-}
623{-# INLINE choice #-}
303−choice :: MonadCatch m => Int -> SerialT m Int -> m Int
624+choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
304choice value =
625choice value =
305− IP.parse
626+ Stream.parse
306 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
627 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
628+-}
629+
630+-------------------------------------------------------------------------------
631+-- Parsing with unfolds
632+-------------------------------------------------------------------------------
633+
634+{-# INLINE parseManyUnfoldArrays #-}
635+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
636+parseManyUnfoldArrays count arrays = do
637+ let src = Producer.source (Just (Producer.OuterLoop arrays))
638+ let parser = PR.fromFold (Fold.take count Fold.drain)
639+ let readSrc =
640+ Producer.producer
641+ $ Producer.concat Producer.fromList Array.producer
642+ let streamParser =
643+ Producer.simplify (Producer.parseMany parser readSrc)
644+ Stream.fold Fold.drain $ Stream.unfold streamParser src
307
645
308-------------------------------------------------------------------------------
646-------------------------------------------------------------------------------
309-- Stream transformation
647-- Stream transformation
310-------------------------------------------------------------------------------
648-------------------------------------------------------------------------------
311
649
312{-# INLINE parseMany #-}
650{-# INLINE parseMany #-}
313−parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()
651+parseMany :: Monad m => Int -> Stream m Int -> m ()
314parseMany n =
652parseMany n =
315− S.drain
653+ Stream.fold Fold.drain
316− . S.map getSum
654+ . fmap getSum
317− . IP.parseMany (PR.fromFold $ FL.take n FL.mconcat)
655+ . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)
318− . 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
319
686
320{-# INLINE parseIterate #-}
687{-# INLINE parseIterate #-}
321−parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()
688+parseIterate :: Monad m => Int -> Stream m Int -> m ()
322parseIterate n =
689parseIterate n =
323− S.drain
690+ Stream.fold Fold.drain
324− . S.map getSum
691+ . fmap getSum
692+ . Stream.catRights
693+ . Stream.parseIterate
325− . IP.parseIterate (PR.fromFold . FL.take n . FL.sconcat) (Sum 0)
694+ (PR.fromFold . Fold.take n . Fold.sconcat)
695+ (Sum 0)
326− . 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
327
702
328-------------------------------------------------------------------------------
703-------------------------------------------------------------------------------
329-- Benchmarks
704-- Benchmarks
@@ -332,41 +707,95 @@ parseIterate n =
332moduleName :: String
707moduleName :: String
333moduleName = "Data.Parser"
708moduleName = "Data.Parser"
334
709
710+instance NFData ParseError where
711+ {-# INLINE rnf #-}
712+ rnf (ParseError x) = rnf x
713+
335o_1_space_serial :: Int -> [Benchmark]
714o_1_space_serial :: Int -> [Benchmark]
336o_1_space_serial value =
715o_1_space_serial value =
337 [ benchIOSink value "takeBetween" $ takeBetween value
716 [ benchIOSink value "takeBetween" $ takeBetween value
338− , benchIOSink value "takeEQ" $ takeEQ value
339 , benchIOSink value "takeWhile" $ takeWhile value
717 , benchIOSink value "takeWhile" $ takeWhile value
718+ , benchIOSink value "takeWhileP" $ takeWhileP value
340 , benchIOSink value "takeP" $ takeP value
719 , benchIOSink value "takeP" $ takeP value
341− , benchIOSink value "drainWhile" $ drainWhile value
720+ , benchIOSink value "dropWhile" $ dropWhile value
342− , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
721+ , benchIOSink value "takeStartBy" $ takeStartBy value
722+ , benchIOSink value "takeEndBy_" $ takeEndBy_ value
343 , benchIOSink value "groupBy" $ groupBy
723 , benchIOSink value "groupBy" $ groupBy
344 , benchIOSink value "groupByRolling" $ groupByRolling
724 , benchIOSink value "groupByRolling" $ groupByRolling
345 , benchIOSink value "wordBy" $ wordBy value
725 , benchIOSink value "wordBy" $ wordBy value
346− , 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
347 , benchIOSink value "splitApBefore" $ splitApBefore value
736 , benchIOSink value "splitApBefore" $ splitApBefore value
348 , benchIOSink value "splitApAfter" $ splitApAfter value
737 , benchIOSink value "splitApAfter" $ splitApAfter value
349− , 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
350− , 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
351 , benchIOSink value "many" many
751 , benchIOSink value "many" many
352 , benchIOSink value "many (wordBy even)" $ manyWordByEven
752 , benchIOSink value "many (wordBy even)" $ manyWordByEven
353 , benchIOSink value "some" some
753 , benchIOSink value "some" some
354 , benchIOSink value "manyTill" $ manyTill value
754 , benchIOSink value "manyTill" $ manyTill value
355− , benchIOSink value "tee" $ teeAllAny value
755+ , benchIOSink value "parseMany" $ parseMany value
356− , benchIOSink value "teeFst" $ teeFstAllAny value
357− , benchIOSink value "shortest" $ shortestAllAny value
358− , benchIOSink value "longest" $ longestAllAny value
359 , benchIOSink value "parseMany (take 1)" (parseMany 1)
756 , benchIOSink value "parseMany (take 1)" (parseMany 1)
360 , 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
361 , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
770 , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
362 , 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)
363 ]
780 ]
364
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+
365o_1_space_filesystem :: BenchEnv -> [Benchmark]
794o_1_space_filesystem :: BenchEnv -> [Benchmark]
366o_1_space_filesystem env =
795o_1_space_filesystem env =
367− [ mkBench ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") env
796+ [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env
368 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
797 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
369− , mkBench "S.parseMany (FL.take 1 FL.sum)" env
798+ , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env
370 $ \inh _ -> inline parseManyChunksOfSum 1 inh
799 $ \inh _ -> inline parseManyChunksOfSum 1 inh
371 ]
800 ]
372
801
@@ -381,26 +810,38 @@ o_1_space_serial_unfold bound arrays =
381o_n_heap_serial :: Int -> [Benchmark]
810o_n_heap_serial :: Int -> [Benchmark]
382o_n_heap_serial value =
811o_n_heap_serial value =
383 [
812 [
813+ benchIOSink value "takeEQ" $ takeEQ value
814+ , benchIOSink value "takeGE" $ takeGE value
815+
384 -- lookahead benchmark holds the entire input till end
816 -- lookahead benchmark holds the entire input till end
385− benchIOSink value "lookAhead" $ lookAhead value
817+ , benchIOSink value "lookAhead" $ lookAhead value
386
818
387− -- accumulates the results in a list
819+ -- o-n-heap because of backtracking
388− , benchIOSink value "sequence" $ sequence value
820+ , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
389− , benchIOSink value "sequenceA" $ sequenceA value
821+ $ takeFramedByEsc_ value
390
822
391− -- XXX why should this take O(n) heap, it discards the results?
392− , benchIOSink value "sequence_" $ sequence_ value
393− , benchIOSink value "sequenceA_" $ sequenceA_ value
394 -- non-linear time complexity (parserD)
823 -- non-linear time complexity (parserD)
395 , benchIOSink value "split_" $ split_ value
824 , benchIOSink value "split_" $ split_ value
396− -- XXX why O(n) heap?
825+ -- XXX Takes lot of space when run on a long stream, why?
397− , benchIOSink value "choice (asum)" $ choiceAsum value
826+ , benchIOSink value "monad16" $ monad16 value
398− , benchIOSink value "choice" $ choice value
399
827
400 -- These show non-linear time complexity.
828 -- These show non-linear time complexity.
401 -- They accumulate the results in a list.
829 -- They accumulate the results in a list.
830+ , benchIOSink value "sepBy1" sepBy1
402 , benchIOSink value "manyAlt" manyAlt
831 , benchIOSink value "manyAlt" manyAlt
403 , 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)
404 ]
845 ]
405
846
406-------------------------------------------------------------------------------
847-------------------------------------------------------------------------------
@@ -409,12 +850,13 @@ o_n_heap_serial value =
409
850
410main :: IO ()
851main :: IO ()
411main = do
852main = do
853+#ifndef FUSION_CHECK
412 env <- mkHandleBenchEnv
854 env <- mkHandleBenchEnv
413 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
855 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
414
856
415 where
857 where
416
858
417− alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
859+ alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
418
860
419 allBenchmarks env arrays value =
861 allBenchmarks env arrays value =
420 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
862 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
@@ -424,4 +866,22 @@ main = do
424 , bgroup (o_1_space_prefix moduleName)
866 , bgroup (o_1_space_prefix moduleName)
425 (o_1_space_serial_unfold value arrays)
867 (o_1_space_serial_unfold value arrays)
426 , 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)
427 ]
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−388
@@ -1,388 +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.fromPure (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 takeP #-}
83−takeP :: MonadThrow m => Int -> SerialT m a -> m ()
84−takeP value = IP.parseD (PR.takeP value (PR.fromFold FL.drain))
85−
86−{-# INLINE groupBy #-}
87−groupBy :: MonadThrow m => SerialT m Int -> m ()
88−groupBy = IP.parseD (PR.groupBy (<=) FL.drain)
89−
90−{-# INLINE groupByRolling #-}
91−groupByRolling :: MonadThrow m => SerialT m Int -> m ()
92−groupByRolling = IP.parseD (PR.groupByRolling (<=) FL.drain)
93−
94−{-# INLINE wordBy #-}
95−wordBy :: MonadThrow m => Int -> SerialT m Int -> m ()
96−wordBy value = IP.parseD (PR.wordBy (>= value) FL.drain)
97−
98−{-# INLINE manyWordByEven #-}
99−manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
100−manyWordByEven =
101− IP.parseD (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
102−
103−{-# INLINE many #-}
104−many :: MonadCatch m => SerialT m Int -> m Int
105−many = IP.parseD (PR.many (PR.satisfy (> 0)) FL.length)
106−
107−{-# INLINE manyAlt #-}
108−manyAlt :: MonadCatch m => SerialT m Int -> m Int
109−manyAlt xs = do
110− x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
111− return $ Prelude.length x
112−
113−{-# INLINE some #-}
114−some :: MonadCatch m => SerialT m Int -> m Int
115−some = IP.parseD (PR.some (PR.satisfy (> 0)) FL.length)
116−
117−{-# INLINE someAlt #-}
118−someAlt :: MonadCatch m => SerialT m Int -> m Int
119−someAlt xs = do
120− x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
121− return $ Prelude.length x
122−
123−{-#INLINE sliceSepByP #-}
124−sliceSepByP :: MonadCatch m => Int -> SerialT m Int -> m ()
125−sliceSepByP value = IP.parseD (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
126−
127−{-# INLINE manyTill #-}
128−manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
129−manyTill value =
130− let p = PR.satisfy (> 0)
131− pcond = PR.satisfy (== value)
132− in IP.parseD (PR.manyTill FL.length p pcond)
133−
134−{-# INLINE serialWith #-}
135−serialWith :: MonadThrow m
136− => Int -> SerialT m Int -> m ((), ())
137−serialWith value =
138− IP.parseD
139− ((,)
140− <$> drainWhile (<= (value `div` 2))
141− <*> drainWhile (<= value)
142− )
143−
144−{-# INLINE teeAllAny #-}
145−teeAllAny :: MonadThrow m
146− => Int -> SerialT m Int -> m ((), ())
147−teeAllAny value =
148− IP.parseD
149− (PR.teeWith (,)
150− (drainWhile (<= value))
151− (drainWhile (<= value))
152− )
153−
154−{-# INLINE teeFstAllAny #-}
155−teeFstAllAny :: MonadThrow m
156− => Int -> SerialT m Int -> m ((), ())
157−teeFstAllAny value =
158− IP.parseD
159− (PR.teeWithFst (,)
160− (drainWhile (<= value))
161− (drainWhile (<= value))
162− )
163−
164−{-# INLINE shortestAllAny #-}
165−shortestAllAny :: MonadThrow m
166− => Int -> SerialT m Int -> m ()
167−shortestAllAny value =
168− IP.parseD
169− (PR.shortest
170− (drainWhile (<= value))
171− (drainWhile (<= value))
172− )
173−
174−{-# INLINE longestAllAny #-}
175−longestAllAny :: MonadCatch m
176− => Int -> SerialT m Int -> m ()
177−longestAllAny value =
178− IP.parseD
179− (PR.longest
180− (drainWhile (<= value))
181− (drainWhile (<= value))
182− )
183−
184−-------------------------------------------------------------------------------
185−-- Spanning
186−-------------------------------------------------------------------------------
187−
188−{-# INLINE span #-}
189−span :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
190−span value = IP.parseD (PR.span (<= (value `div` 2)) FL.drain FL.drain)
191−
192−{-# INLINE spanBy #-}
193−spanBy :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
194−spanBy value =
195− IP.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) FL.drain FL.drain)
196−
197−{-# INLINE spanByRolling #-}
198−spanByRolling :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
199−spanByRolling value =
200− IP.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) FL.drain FL.drain)
201−
202−-------------------------------------------------------------------------------
203−-- Nested
204−-------------------------------------------------------------------------------
205−
206−{-# INLINE parseMany #-}
207−parseMany :: MonadThrow m => Int -> SerialT m Int -> m ()
208−parseMany value = IP.drain . IP.parseManyD (drainWhile (<= value + 1))
209−
210−{-# INLINE parseManyGroups #-}
211−parseManyGroups :: MonadThrow m => Bool -> SerialT m Int -> m ()
212−parseManyGroups b = IP.drain . IP.parseManyD (PR.groupBy (\_ _ -> b) FL.drain)
213−
214−{-# INLINE parseManyGroupsRolling #-}
215−parseManyGroupsRolling :: MonadThrow m => Bool -> SerialT m Int -> m ()
216−parseManyGroupsRolling b =
217− IP.drain . IP.parseManyD (PR.groupByRolling (\_ _ -> b) FL.drain)
218−
219−-------------------------------------------------------------------------------
220−-- Parsing with unfolds
221−-------------------------------------------------------------------------------
222−
223−{-# INLINE parseManyUnfoldArrays #-}
224−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
225−parseManyUnfoldArrays count arrays = do
226− let src = Source.source (Just (Producer.OuterLoop arrays))
227− let parser = PR.fromFold (FL.take count FL.drain)
228− let readSrc =
229− Source.producer
230− $ Producer.concat Producer.fromList Array.producer
231− let streamParser =
232− Producer.simplify (Source.parseManyD parser readSrc)
233− S.drain $ S.unfold streamParser src
234−
235−-------------------------------------------------------------------------------
236−-- Parsers in which -fspec-constr-recursive=16 is problematic
237−-------------------------------------------------------------------------------
238−
239−-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
240−-- We need to fix GHC so that we can have better control over that option or do
241−-- not have to rely on it.
242−--
243−{-# INLINE lookAhead #-}
244−lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
245−lookAhead value =
246− IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
247−
248−{-# INLINE sequenceA_ #-}
249−sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
250−sequenceA_ value =
251− IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
252−
253−-- quadratic complexity
254−{-# INLINE sequenceA #-}
255−sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
256−sequenceA value xs = do
257− x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
258− return $ length x
259−
260−-- quadratic complexity
261−{-# INLINE sequence #-}
262−sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
263−sequence value xs = do
264− x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
265− return $ length x
266−
267−{-# INLINE sequence_ #-}
268−sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
269−sequence_ value xs =
270− IP.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 FL.drain))) xs
271−
272− where
273−
274− {-# INLINE f #-}
275− f m k = m >>= (\_ -> k)
276−
277−-- choice using the "Alternative" instance with direct style parser type has
278−-- quadratic performance complexity.
279−--
280−{-# INLINE choiceAsum #-}
281−choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
282−choiceAsum value =
283− IP.parseD (asum (replicate value (PR.satisfy (< 0)))
284− AP.<|> PR.satisfy (> 0))
285−
286−{-# INLINE choice #-}
287−choice :: MonadCatch m => Int -> SerialT m Int -> m Int
288−choice value =
289− IP.parseD
290− (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
291−
292−-------------------------------------------------------------------------------
293−-- Benchmarks
294−-------------------------------------------------------------------------------
295−
296−moduleName :: String
297−moduleName = "Data.Parser.ParserD"
298−
299−o_1_space_serial :: Int -> [Benchmark]
300−o_1_space_serial value =
301− [ benchIOSink value "takeWhile" $ takeWhile value
302− , benchIOSink value "takeP" $ takeP value
303− , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
304− , benchIOSink value "groupBy" $ groupBy
305− , benchIOSink value "groupByRolling" $ groupByRolling
306− , benchIOSink value "wordBy" $ wordBy value
307− , benchIOSink value "serialWith" $ serialWith value
308− , benchIOSink value "many" many
309− , benchIOSink value "many (wordBy even)" $ manyWordByEven
310− , benchIOSink value "some" some
311− , benchIOSink value "sliceSepByP" $ sliceSepByP value
312− , benchIOSink value "manyTill" $ manyTill value
313− , benchIOSink value "tee (all,any)" $ teeAllAny value
314− , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
315− , benchIOSink value "shortest (all,any)" $ shortestAllAny value
316− , benchIOSink value "longest (all,any)" $ longestAllAny value
317− ]
318−
319−o_1_space_serial_spanning :: Int -> [Benchmark]
320−o_1_space_serial_spanning value =
321− [ benchIOSink value "span" $ span value
322− , benchIOSink value "spanBy" $ spanBy value
323− , benchIOSink value "spanByRolling" $ spanByRolling value
324− ]
325−
326−o_1_space_serial_nested :: Int -> [Benchmark]
327−o_1_space_serial_nested value =
328− [ benchIOSink value "parseMany" $ parseMany value
329− , benchIOSink value "parseMany groupBy (bound groups)"
330− $ (parseManyGroups False)
331− , benchIOSink value "parseMany groupRollingBy (bound groups)"
332− $ (parseManyGroupsRolling False)
333− , benchIOSink value "parseMany groupBy (1 group)" $ (parseManyGroups True)
334− , benchIOSink value "parseMany groupRollingBy (1 group)"
335− $ (parseManyGroupsRolling True)
336− ]
337−
338−o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]
339−o_1_space_serial_unfold bound arrays =
340− [ bench "parseMany/Unfold/1000 arrays/1 parse"
341− $ nfIO $ parseManyUnfoldArrays bound arrays
342− , bench "parseMany/Unfold/1000 arrays/100000 parses"
343− $ nfIO $ parseManyUnfoldArrays 1 arrays
344− ]
345−
346−o_n_heap_serial :: Int -> [Benchmark]
347−o_n_heap_serial value =
348− [
349− -- lookahead benchmark holds the entire input till end
350− benchIOSink value "lookAhead" $ lookAhead value
351−
352− -- These show non-linear time complexity
353− -- They accumulate the results in a list.
354− , benchIOSink value "manyAlt" manyAlt
355− , benchIOSink value "someAlt" someAlt
356− ]
357−
358−-- accumulate results in a list in IO
359−o_n_space_serial :: Int -> [Benchmark]
360−o_n_space_serial value =
361− [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
362− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
363− , benchIOSink value "sequence/100" $ sequence (value `div` 100)
364− , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
365− , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
366− , benchIOSink value "choice/100" $ choice (value `div` 100)
367− ]
368−
369−-------------------------------------------------------------------------------
370−-- Driver
371−-------------------------------------------------------------------------------
372−
373−main :: IO ()
374−main = runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
375−
376− where
377−
378− alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
379−
380− allBenchmarks arraysSmall value =
381− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
382− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)
383− , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)
384− , bgroup (o_1_space_prefix moduleName)
385− (o_1_space_serial_unfold value arraysSmall)
386− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
387− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
388− ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hsdeleted−163
@@ -1,163 +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 = runWithCLIOpts defaultStreamSize allBenchmarks
157−
158− where
159−
160− allBenchmarks value =
161− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
162− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
163− ]
benchmark/Streamly/Benchmark/Data/ParserK.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+183−121
@@ -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, fromSerial)
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,155 +308,187 @@ 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
@@ -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,6 +525,7 @@ 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 -- length is used to check for foldr/build fusion
530 -- length is used to check for foldr/build fusion
475 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
531 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
@@ -480,12 +536,13 @@ o_1_space_elimination_folds value =
480-- Buffered Transformations by fold
536-- Buffered Transformations by fold
481-------------------------------------------------------------------------------
537-------------------------------------------------------------------------------
482
538
539+#ifdef USE_PRELUDE
483{-# INLINE foldl'Build #-}
540{-# INLINE foldl'Build #-}
484−foldl'Build :: Monad m => SerialT m Int -> m [Int]
541+foldl'Build :: Monad m => Stream m Int -> m [Int]
485foldl'Build = S.foldl' (flip (:)) []
542foldl'Build = S.foldl' (flip (:)) []
486
543
487{-# INLINE foldlM'Build #-}
544{-# INLINE foldlM'Build #-}
488−foldlM'Build :: Monad m => SerialT m Int -> m [Int]
545+foldlM'Build :: Monad m => Stream m Int -> m [Int]
489foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
546foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
490
547
491o_n_heap_elimination_foldl :: Int -> [Benchmark]
548o_n_heap_elimination_foldl :: Int -> [Benchmark]
@@ -499,6 +556,7 @@ o_n_heap_elimination_foldl value =
499 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
556 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
500 ]
557 ]
501 ]
558 ]
559+#endif
502
560
503-- For comparisons
561-- For comparisons
504{-# INLINE showInstanceList #-}
562{-# INLINE showInstanceList #-}
@@ -518,7 +576,7 @@ o_n_heap_elimination_buffered value =
518 ]
576 ]
519
577
520{-# INLINE foldrMReduce #-}
578{-# INLINE foldrMReduce #-}
521−foldrMReduce :: Monad m => SerialT m Int -> m Int
579+foldrMReduce :: Monad m => Stream m Int -> m Int
522foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
580foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
523
581
524o_n_space_elimination_foldr :: Int -> [Benchmark]
582o_n_space_elimination_foldr :: Int -> [Benchmark]
@@ -534,13 +592,14 @@ o_n_space_elimination_foldr value =
534 ]
592 ]
535 ]
593 ]
536
594
595+#ifdef USE_PRELUDE
537o_n_heap_elimination_toList :: Int -> [Benchmark]
596o_n_heap_elimination_toList :: Int -> [Benchmark]
538o_n_heap_elimination_toList value =
597o_n_heap_elimination_toList value =
539 [ bgroup "toList"
598 [ bgroup "toList"
540 -- 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
541− [ benchIOSink value "toListRev" Internal.toListRev
600+ [ benchIOSink value "toListRev" S.toListRev
542 , benchIOSink value "toStreamRev"
601 , benchIOSink value "toStreamRev"
543− (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
602+ (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))
544 ]
603 ]
545 ]
604 ]
546
605
@@ -549,10 +608,13 @@ o_n_space_elimination_toList value =
549 [ bgroup "toList"
608 [ bgroup "toList"
550 -- 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
551 [ benchIOSink value "toList" S.toList
610 [ benchIOSink value "toList" S.toList
611+#ifndef USE_PRELUDE
552 , benchIOSink value "toStream"
612 , benchIOSink value "toStream"
553− (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
613+ (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))
614+#endif
554 ]
615 ]
555 ]
616 ]
617+#endif
556
618
557-------------------------------------------------------------------------------
619-------------------------------------------------------------------------------
558-- Multi-stream folds
620-- Multi-stream folds
@@ -563,7 +625,7 @@ o_n_space_elimination_toList value =
563-------------------------------------------------------------------------------
625-------------------------------------------------------------------------------
564
626
565{-# INLINE eqBy' #-}
627{-# INLINE eqBy' #-}
566−eqBy' :: (Monad m, Eq a) => SerialT m a -> m Bool
628+eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool
567eqBy' src = S.eqBy (==) src src
629eqBy' src = S.eqBy (==) src src
568
630
569{-# INLINE eqByPure #-}
631{-# INLINE eqByPure #-}
@@ -577,15 +639,15 @@ inspect $ 'eqByPure `hasNoType` ''D.Step
577#endif
639#endif
578
640
579{-# INLINE eqInstance #-}
641{-# INLINE eqInstance #-}
580−eqInstance :: SerialT Identity Int -> Bool
642+eqInstance :: Stream Identity Int -> Bool
581eqInstance src = src == src
643eqInstance src = src == src
582
644
583{-# INLINE eqInstanceNotEq #-}
645{-# INLINE eqInstanceNotEq #-}
584−eqInstanceNotEq :: SerialT Identity Int -> Bool
646+eqInstanceNotEq :: Stream Identity Int -> Bool
585eqInstanceNotEq src = src /= src
647eqInstanceNotEq src = src /= src
586
648
587{-# INLINE cmpBy' #-}
649{-# INLINE cmpBy' #-}
588−cmpBy' :: (Monad m, Ord a) => SerialT m a -> m Ordering
650+cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering
589cmpBy' src = S.cmpBy compare src src
651cmpBy' src = S.cmpBy compare src src
590
652
591{-# INLINE cmpByPure #-}
653{-# INLINE cmpByPure #-}
@@ -599,7 +661,7 @@ inspect $ 'cmpByPure `hasNoType` ''D.Step
599#endif
661#endif
600
662
601{-# INLINE ordInstance #-}
663{-# INLINE ordInstance #-}
602−ordInstance :: SerialT Identity Int -> Bool
664+ordInstance :: Stream Identity Int -> Bool
603ordInstance src = src < src
665ordInstance src = src < src
604
666
605o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
667o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
@@ -614,15 +676,15 @@ o_1_space_elimination_multi_stream_pure value =
614 ]
676 ]
615
677
616{-# INLINE isPrefixOf #-}
678{-# INLINE isPrefixOf #-}
617−isPrefixOf :: Monad m => SerialT m Int -> m Bool
679+isPrefixOf :: Monad m => Stream m Int -> m Bool
618isPrefixOf src = S.isPrefixOf src src
680isPrefixOf src = S.isPrefixOf src src
619
681
620{-# INLINE isSubsequenceOf #-}
682{-# INLINE isSubsequenceOf #-}
621−isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
683+isSubsequenceOf :: Monad m => Stream m Int -> m Bool
622isSubsequenceOf src = S.isSubsequenceOf src src
684isSubsequenceOf src = S.isSubsequenceOf src src
623
685
624{-# INLINE stripPrefix #-}
686{-# INLINE stripPrefix #-}
625−stripPrefix :: Monad m => SerialT m Int -> m ()
687+stripPrefix :: Monad m => Stream m Int -> m ()
626stripPrefix src = do
688stripPrefix src = do
627 _ <- S.stripPrefix src src
689 _ <- S.stripPrefix src src
628 return ()
690 return ()
@@ -673,14 +735,14 @@ benchmarks moduleName size =
673 , o_1_space_elimination_multi_stream_pure size
735 , o_1_space_elimination_multi_stream_pure size
674 , o_1_space_elimination_multi_stream size
736 , o_1_space_elimination_multi_stream size
675 ]
737 ]
738+
676− , 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
677− [ o_n_heap_elimination_foldl size
742+ ++ o_n_heap_elimination_foldl size
678− , o_n_heap_elimination_toList size
743+ ++ o_n_heap_elimination_toList size
679− , o_n_heap_elimination_buffered size
744+ ++ o_n_space_elimination_toList size
680− ]
745+#endif
681− , bgroup (o_n_space_prefix moduleName) $ concat
746+ , bgroup (o_n_space_prefix moduleName) $
682− [ o_n_space_elimination_foldable size
683− , o_n_space_elimination_toList size
684− , o_n_space_elimination_foldr size
747+ o_n_space_elimination_foldr size
685− ]
686 ]
748 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs → benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hsrenamed+124−70
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Streamly.Benchmark.Prelude.Serial.Exceptions
2+-- Module : Stream.Exceptions
3-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
4-- License : BSD-3-Clause
4-- License : BSD-3-Clause
5-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -7,8 +7,13 @@
7-- Portability : GHC
7-- Portability : GHC
8
8
9{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
10+{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11
12
13+#ifdef USE_PRELUDE
14+{-# OPTIONS_GHC -Wno-deprecations #-}
15+#endif
16+
12#ifdef __HADDOCK_VERSION__
17#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
18#undef INSPECTION
14#endif
19#endif
@@ -18,29 +23,63 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
24#endif
20
25
21−module Serial.Exceptions (benchmarks) where
26+module Stream.Exceptions (benchmarks) where
22
27
23−import Control.Exception (SomeException, Exception, throwIO)
28+import Control.Exception (Exception, throwIO)
24−import System.IO (Handle, hClose, hPutChar)
29+import Stream.Common (drain)
25
30
26import qualified Data.IORef as Ref
31import qualified Data.IORef as Ref
27import qualified Data.Map.Strict as Map
32import qualified Data.Map.Strict as Map
28
33
34+import Control.Exception (SomeException)
35+import System.IO (Handle, hClose, hPutChar)
29import qualified Streamly.FileSystem.Handle as FH
36import qualified Streamly.FileSystem.Handle as FH
30−import qualified Streamly.Internal.Data.Unfold as IUF
31import qualified Streamly.Internal.FileSystem.Handle as IFH
37import qualified Streamly.Internal.FileSystem.Handle as IFH
32−import qualified Streamly.Internal.Data.Stream.IsStream as IP
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
33−import qualified Streamly.Prelude as S
45+import qualified Streamly.Internal.Data.Stream.Prelude as Stream
46+#endif
34
47
35−import Gauge hiding (env)
48+import Test.Tasty.Bench hiding (env)
36import Prelude hiding (last, length)
49import Prelude hiding (last, length)
37import Streamly.Benchmark.Common
50import Streamly.Benchmark.Common
38import Streamly.Benchmark.Common.Handle
51import Streamly.Benchmark.Common.Handle
39
52
40#ifdef INSPECTION
53#ifdef INSPECTION
54+import Control.Monad.Catch (MonadCatch)
41import Test.Inspection
55import Test.Inspection
42
56
43−import qualified Streamly.Internal.Data.Stream.StreamD as D
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
44#endif
83#endif
45
84
46-------------------------------------------------------------------------------
85-------------------------------------------------------------------------------
@@ -56,37 +95,41 @@ instance Exception BenchException
56
95
57retryNoneSimple :: Int -> Int -> IO ()
96retryNoneSimple :: Int -> Int -> IO ()
58retryNoneSimple length from =
97retryNoneSimple length from =
59− IP.drain
98+ drain
99+ $ Stream.retry
60− $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
100+ (Map.singleton BenchException1 length)
101+ (const Stream.nil)
102+ source
61
103
62 where
104 where
63
105
64− source = S.enumerateFromTo from (from + length)
106+ source = Stream.enumerateFromTo from (from + length)
65
107
66retryNone :: Int -> Int -> IO ()
108retryNone :: Int -> Int -> IO ()
67retryNone length from = do
109retryNone length from = do
68 ref <- Ref.newIORef (0 :: Int)
110 ref <- Ref.newIORef (0 :: Int)
69− IP.drain
111+ drain
70− $ IP.retry (Map.singleton BenchException1 length) (const S.nil)
112+ $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
71 $ source ref
113 $ source ref
72
114
73 where
115 where
74
116
75 source ref =
117 source ref =
76− IP.replicateM (from + length)
118+ Stream.replicateM (from + length)
77 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
119 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
78
120
79retryAll :: Int -> Int -> IO ()
121retryAll :: Int -> Int -> IO ()
80retryAll length from = do
122retryAll length from = do
81 ref <- Ref.newIORef 0
123 ref <- Ref.newIORef 0
82− IP.drain
124+ drain
125+ $ Stream.retry
83− $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
126+ (Map.singleton BenchException1 (length + from)) (const Stream.nil)
84 $ source ref
127 $ source ref
85
128
86 where
129 where
87
130
88 source ref =
131 source ref =
89− IP.fromEffect
132+ Stream.fromEffect
90 $ do
133 $ do
91 Ref.modifyIORef' ref (+ 1)
134 Ref.modifyIORef' ref (+ 1)
92 val <- Ref.readIORef ref
135 val <- Ref.readIORef ref
@@ -96,13 +139,13 @@ retryAll length from = do
96
139
97retryUnknown :: Int -> Int -> IO ()
140retryUnknown :: Int -> Int -> IO ()
98retryUnknown length from = do
141retryUnknown length from = do
99− IP.drain
142+ drain
100− $ IP.retry (Map.singleton BenchException1 length) (const source)
143+ $ Stream.retry (Map.singleton BenchException1 length) (const source)
101− $ throwIO BenchException2 `S.before` S.nil
144+ $ throwIO BenchException2 `Stream.before` Stream.nil
102
145
103 where
146 where
104
147
105− source = S.enumerateFromTo from (from + length)
148+ source = Stream.enumerateFromTo from (from + length)
106
149
107
150
108o_1_space_serial_exceptions :: Int -> [Benchmark]
151o_1_space_serial_exceptions :: Int -> [Benchmark]
@@ -116,6 +159,8 @@ o_1_space_serial_exceptions length =
116 ]
159 ]
117 ]
160 ]
118
161
162+-- XXX Move these to FileSystem.Handle benchmarks
163+
119-------------------------------------------------------------------------------
164-------------------------------------------------------------------------------
120-- copy stream exceptions
165-- copy stream exceptions
121-------------------------------------------------------------------------------
166-------------------------------------------------------------------------------
@@ -123,8 +168,8 @@ o_1_space_serial_exceptions length =
123-- | Send the file contents to /dev/null with exception handling
168-- | Send the file contents to /dev/null with exception handling
124readWriteOnExceptionStream :: Handle -> Handle -> IO ()
169readWriteOnExceptionStream :: Handle -> Handle -> IO ()
125readWriteOnExceptionStream inh devNull =
170readWriteOnExceptionStream inh devNull =
126− let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
171+ let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
127− in S.fold (FH.write devNull) $ readEx
172+ in Stream.fold (FH.write devNull) readEx
128
173
129#ifdef INSPECTION
174#ifdef INSPECTION
130inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
175inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@@ -133,9 +178,10 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
133-- | Send the file contents to /dev/null with exception handling
178-- | Send the file contents to /dev/null with exception handling
134readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
179readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
135readWriteHandleExceptionStream inh devNull =
180readWriteHandleExceptionStream inh devNull =
136− let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
181+ let handler (_e :: SomeException) =
182+ return $ Stream.fromEffect (hClose inh >> return 10)
137− readEx = S.handle handler (S.unfold FH.read inh)
183+ readEx = Stream.handle handler (Stream.unfold FH.reader inh)
138− in S.fold (FH.write devNull) $ readEx
184+ in Stream.fold (FH.write devNull) readEx
139
185
140#ifdef INSPECTION
186#ifdef INSPECTION
141inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
187inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@@ -144,8 +190,9 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
144-- | Send the file contents to /dev/null with exception handling
190-- | Send the file contents to /dev/null with exception handling
145readWriteFinally_Stream :: Handle -> Handle -> IO ()
191readWriteFinally_Stream :: Handle -> Handle -> IO ()
146readWriteFinally_Stream inh devNull =
192readWriteFinally_Stream inh devNull =
193+ let readEx =
147− let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
194+ finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
148− in S.fold (FH.write devNull) readEx
195+ in Stream.fold (FH.write devNull) readEx
149
196
150#ifdef INSPECTION
197#ifdef INSPECTION
151inspect $ hasNoTypeClasses 'readWriteFinally_Stream
198inspect $ hasNoTypeClasses 'readWriteFinally_Stream
@@ -153,15 +200,15 @@ inspect $ hasNoTypeClasses 'readWriteFinally_Stream
153
200
154readWriteFinallyStream :: Handle -> Handle -> IO ()
201readWriteFinallyStream :: Handle -> Handle -> IO ()
155readWriteFinallyStream inh devNull =
202readWriteFinallyStream inh devNull =
156− let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
203+ let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
157− in S.fold (FH.write devNull) readEx
204+ in Stream.fold (FH.write devNull) readEx
158
205
159-- | Send the file contents to /dev/null with exception handling
206-- | Send the file contents to /dev/null with exception handling
160fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
207fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
161fromToBytesBracket_Stream inh devNull =
208fromToBytesBracket_Stream inh devNull =
162− let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
209+ let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
163− (\_ -> IFH.toBytes inh)
210+ (\_ -> fromStreamD $ IFH.read inh)
164− in IFH.putBytes devNull $ readEx
211+ in IFH.putBytes devNull (toStreamD readEx)
165
212
166#ifdef INSPECTION
213#ifdef INSPECTION
167inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
214inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
@@ -169,16 +216,16 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
169
216
170fromToBytesBracketStream :: Handle -> Handle -> IO ()
217fromToBytesBracketStream :: Handle -> Handle -> IO ()
171fromToBytesBracketStream inh devNull =
218fromToBytesBracketStream inh devNull =
172− let readEx = S.bracket (return ()) (\_ -> hClose inh)
219+ let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
173− (\_ -> IFH.toBytes inh)
220+ (\_ -> fromStreamD $ IFH.read inh)
174− in IFH.putBytes devNull $ readEx
221+ in IFH.putBytes devNull (toStreamD readEx)
175
222
176readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
223readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
177readWriteBeforeAfterStream inh devNull =
224readWriteBeforeAfterStream inh devNull =
178 let readEx =
225 let readEx =
179− IP.after (hClose inh)
226+ Stream.after (hClose inh)
180− $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
227+ $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
181− in S.fold (FH.write devNull) readEx
228+ in Stream.fold (FH.write devNull) readEx
182
229
183#ifdef INSPECTION
230#ifdef INSPECTION
184inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
231inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
@@ -186,8 +233,8 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
186
233
187readWriteAfterStream :: Handle -> Handle -> IO ()
234readWriteAfterStream :: Handle -> Handle -> IO ()
188readWriteAfterStream inh devNull =
235readWriteAfterStream inh devNull =
189− let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
236+ let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
190− in S.fold (FH.write devNull) readEx
237+ in Stream.fold (FH.write devNull) readEx
191
238
192#ifdef INSPECTION
239#ifdef INSPECTION
193inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
240inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
@@ -195,8 +242,8 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
195
242
196readWriteAfter_Stream :: Handle -> Handle -> IO ()
243readWriteAfter_Stream :: Handle -> Handle -> IO ()
197readWriteAfter_Stream inh devNull =
244readWriteAfter_Stream inh devNull =
198− let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
245+ let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
199− in S.fold (FH.write devNull) readEx
246+ in Stream.fold (FH.write devNull) readEx
200
247
201#ifdef INSPECTION
248#ifdef INSPECTION
202inspect $ hasNoTypeClasses 'readWriteAfter_Stream
249inspect $ hasNoTypeClasses 'readWriteAfter_Stream
@@ -206,25 +253,25 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
206o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
253o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
207o_1_space_copy_stream_exceptions env =
254o_1_space_copy_stream_exceptions env =
208 [ bgroup "exceptions"
255 [ bgroup "exceptions"
209− [ mkBenchSmall "S.onException" env $ \inh _ ->
256+ [ mkBenchSmall "Stream.onException" env $ \inh _ ->
210 readWriteOnExceptionStream inh (nullH env)
257 readWriteOnExceptionStream inh (nullH env)
211− , mkBenchSmall "S.handle" env $ \inh _ ->
258+ , mkBenchSmall "Stream.handle" env $ \inh _ ->
212 readWriteHandleExceptionStream inh (nullH env)
259 readWriteHandleExceptionStream inh (nullH env)
213− , mkBenchSmall "S.finally_" env $ \inh _ ->
260+ , mkBenchSmall "Stream.finally_" env $ \inh _ ->
214 readWriteFinally_Stream inh (nullH env)
261 readWriteFinally_Stream inh (nullH env)
215− , mkBenchSmall "S.finally" env $ \inh _ ->
262+ , mkBenchSmall "Stream.finally" env $ \inh _ ->
216 readWriteFinallyStream inh (nullH env)
263 readWriteFinallyStream inh (nullH env)
217− , mkBenchSmall "S.after . S.before" env $ \inh _ ->
264+ , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
218 readWriteBeforeAfterStream inh (nullH env)
265 readWriteBeforeAfterStream inh (nullH env)
219− , mkBenchSmall "S.after" env $ \inh _ ->
266+ , mkBenchSmall "Stream.after" env $ \inh _ ->
220 readWriteAfterStream inh (nullH env)
267 readWriteAfterStream inh (nullH env)
221− , mkBenchSmall "S.after_" env $ \inh _ ->
268+ , mkBenchSmall "Stream.after_" env $ \inh _ ->
222 readWriteAfter_Stream inh (nullH env)
269 readWriteAfter_Stream inh (nullH env)
223 ]
270 ]
224 , bgroup "exceptions/fromToBytes"
271 , bgroup "exceptions/fromToBytes"
225− [ mkBenchSmall "S.bracket_" env $ \inh _ ->
272+ [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
226 fromToBytesBracket_Stream inh (nullH env)
273 fromToBytesBracket_Stream inh (nullH env)
227− , mkBenchSmall "S.bracket" env $ \inh _ ->
274+ , mkBenchSmall "Stream.bracket" env $ \inh _ ->
228 fromToBytesBracketStream inh (nullH env)
275 fromToBytesBracketStream inh (nullH env)
229 ]
276 ]
230 ]
277 ]
@@ -236,26 +283,34 @@ o_1_space_copy_stream_exceptions env =
236-- | Send the file contents to /dev/null with exception handling
283-- | Send the file contents to /dev/null with exception handling
237readChunksOnException :: Handle -> Handle -> IO ()
284readChunksOnException :: Handle -> Handle -> IO ()
238readChunksOnException inh devNull =
285readChunksOnException inh devNull =
239− let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
286+ let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
240 in IUF.fold (IFH.writeChunks devNull) readEx inh
287 in IUF.fold (IFH.writeChunks devNull) readEx inh
241
288
242#ifdef INSPECTION
289#ifdef INSPECTION
290+#if __GLASGOW_HASKELL__ >= 906
291+inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
292+#else
243inspect $ hasNoTypeClasses 'readChunksOnException
293inspect $ hasNoTypeClasses 'readChunksOnException
244#endif
294#endif
295+#endif
245
296
246-- | Send the file contents to /dev/null with exception handling
297-- | Send the file contents to /dev/null with exception handling
247readChunksBracket_ :: Handle -> Handle -> IO ()
298readChunksBracket_ :: Handle -> Handle -> IO ()
248readChunksBracket_ inh devNull =
299readChunksBracket_ inh devNull =
249− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks
300+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
250 in IUF.fold (IFH.writeChunks devNull) readEx inh
301 in IUF.fold (IFH.writeChunks devNull) readEx inh
251
302
252#ifdef INSPECTION
303#ifdef INSPECTION
304+#if __GLASGOW_HASKELL__ >= 906
305+inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
306+#else
253inspect $ hasNoTypeClasses 'readChunksBracket_
307inspect $ hasNoTypeClasses 'readChunksBracket_
254#endif
308#endif
309+#endif
255
310
256readChunksBracket :: Handle -> Handle -> IO ()
311readChunksBracket :: Handle -> Handle -> IO ()
257readChunksBracket inh devNull =
312readChunksBracket inh devNull =
258− let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
313+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
259 in IUF.fold (IFH.writeChunks devNull) readEx inh
314 in IUF.fold (IFH.writeChunks devNull) readEx inh
260
315
261o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
316o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
@@ -277,11 +332,11 @@ o_1_space_copy_exceptions_readChunks env =
277-- | Send the file contents to /dev/null with exception handling
332-- | Send the file contents to /dev/null with exception handling
278toChunksBracket_ :: Handle -> Handle -> IO ()
333toChunksBracket_ :: Handle -> Handle -> IO ()
279toChunksBracket_ inh devNull =
334toChunksBracket_ inh devNull =
280− let readEx = IP.bracket_
335+ let readEx = bracketUnsafe
281 (return ())
336 (return ())
282 (\_ -> hClose inh)
337 (\_ -> hClose inh)
283− (\_ -> IFH.toChunks inh)
338+ (\_ -> fromStreamD $ IFH.readChunks inh)
284− in S.fold (IFH.writeChunks devNull) $ readEx
339+ in Stream.fold (IFH.writeChunks devNull) readEx
285
340
286#ifdef INSPECTION
341#ifdef INSPECTION
287inspect $ hasNoTypeClasses 'toChunksBracket_
342inspect $ hasNoTypeClasses 'toChunksBracket_
@@ -289,29 +344,28 @@ inspect $ hasNoTypeClasses 'toChunksBracket_
289
344
290toChunksBracket :: Handle -> Handle -> IO ()
345toChunksBracket :: Handle -> Handle -> IO ()
291toChunksBracket inh devNull =
346toChunksBracket inh devNull =
292− let readEx = S.bracket
347+ let readEx = Stream.bracket
293 (return ())
348 (return ())
294 (\_ -> hClose inh)
349 (\_ -> hClose inh)
295− (\_ -> IFH.toChunks inh)
350+ (\_ -> fromStreamD $ IFH.readChunks inh)
296− in S.fold (IFH.writeChunks devNull) $ readEx
351+ in Stream.fold (IFH.writeChunks devNull) readEx
297
352
298o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
353o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
299o_1_space_copy_exceptions_toChunks env =
354o_1_space_copy_exceptions_toChunks env =
300 [ bgroup "exceptions/toChunks"
355 [ bgroup "exceptions/toChunks"
301− [ mkBench "S.bracket_" env $ \inH _ ->
356+ [ mkBench "Stream.bracket_" env $ \inH _ ->
302 toChunksBracket_ inH (nullH env)
357 toChunksBracket_ inH (nullH env)
303− , mkBench "S.bracket" env $ \inH _ ->
358+ , mkBench "Stream.bracket" env $ \inH _ ->
304 toChunksBracket inH (nullH env)
359 toChunksBracket inH (nullH env)
305 ]
360 ]
306 ]
361 ]
307
362
308−
309benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
363benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
310−benchmarks moduleName env size =
364+benchmarks moduleName _env size =
311 [ bgroup (o_1_space_prefix moduleName) $ concat
365 [ bgroup (o_1_space_prefix moduleName) $ concat
366+ [ o_1_space_serial_exceptions size
312− [ o_1_space_copy_exceptions_readChunks env
367+ , o_1_space_copy_exceptions_readChunks _env
313− , o_1_space_copy_exceptions_toChunks env
368+ , o_1_space_copy_exceptions_toChunks _env
314− , o_1_space_copy_stream_exceptions env
369+ , o_1_space_copy_stream_exceptions _env
315− , o_1_space_serial_exceptions size
316 ]
370 ]
317 ]
371 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs → benchmark/Streamly/Benchmark/Data/Stream/Expand.hsrenamed+263−186
@@ -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, fromSerial, 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 fromSerial "foldMapWith (<>) (List)"
149+ [ benchIOSrc "foldMapWith (<>) (List)"
180 (sourceFoldMapWith value)
150 (sourceFoldMapWith value)
181− , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"
151+ , benchIOSrc "foldMapWith (<>) (Stream)"
182 (sourceFoldMapWithStream value)
152 (sourceFoldMapWithStream value)
183− , benchIOSrc fromSerial "foldMapWithM (<>) (List)"
153+ , benchIOSrc "foldMapWithM (<>) (List)"
184 (sourceFoldMapWithM value)
154 (sourceFoldMapWithM value)
185− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
155+ , benchIOSrc "S.concatFoldableWith (<>) (List)"
186 (concatFoldableWith value)
156 (concatFoldableWith value)
187− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
157+ , benchIOSrc "S.concatForFoldableWith (<>) (List)"
188 (concatForFoldableWith value)
158 (concatForFoldableWith value)
189− , benchIOSrc fromSerial "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,58 +211,53 @@ 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+-}
263
248
264−-- concatPairWith
249+-- mergeMapWith
265−
266−{-# INLINE concatPairWithAppend #-}
267−concatPairWithAppend :: Int -> Int -> Int -> IO ()
268−concatPairWithAppend = concatPairsWith Internal.append
269−
270−{-# INLINE concatPairWithInterleave #-}
271−concatPairWithInterleave :: Int -> Int -> Int -> IO ()
272−concatPairWithInterleave = concatPairsWith Internal.interleave
273−
274−{-# INLINE concatPairWithInterleaveSuffix #-}
275−concatPairWithInterleaveSuffix :: Int -> Int -> Int -> IO ()
276−concatPairWithInterleaveSuffix = concatPairsWith Internal.interleaveSuffix
277
250
278−{-# INLINE concatPairWithInterleaveInfix #-}
251+{-# INLINE mergeMapWithSerial #-}
279−concatPairWithInterleaveInfix :: Int -> Int -> Int -> IO ()
252+mergeMapWithSerial :: Int -> Int -> Int -> IO ()
280−concatPairWithInterleaveInfix = concatPairsWith Internal.interleaveInfix
253+mergeMapWithSerial = mergeMapWith Common.append
281
254
282−{-# INLINE concatPairWithInterleaveMin #-}
255+{-
283−concatPairWithInterleaveMin :: Int -> Int -> Int -> IO ()
256+{-# INLINE mergeMapWithAppend #-}
284−concatPairWithInterleaveMin = concatPairsWith Internal.interleaveMin
257+mergeMapWithAppend :: Int -> Int -> Int -> IO ()
285−
258+mergeMapWithAppend = mergeMapWith Common.append2
286−{-# INLINE concatPairWithRoundrobin #-}
259+-}
287−concatPairWithRoundrobin :: Int -> Int -> Int -> IO ()
260+#endif
288−concatPairWithRoundrobin = concatPairsWith Internal.roundrobin
289
261
290-- unfoldMany
262-- unfoldMany
291
263
@@ -294,10 +266,11 @@ concatPairWithRoundrobin = concatPairsWith Internal.roundrobin
294{-# INLINE unfoldManyRepl #-}
266{-# INLINE unfoldManyRepl #-}
295unfoldManyRepl :: Int -> Int -> Int -> IO ()
267unfoldManyRepl :: Int -> Int -> Int -> IO ()
296unfoldManyRepl outer inner n =
268unfoldManyRepl outer inner n =
297− S.drain
269+ drain
298 $ S.unfoldMany
270 $ S.unfoldMany
299− (UF.lmap return (UF.replicateM inner))
271+ UF.replicateM
300− (sourceUnfoldrM outer n)
272+ (fmap ((inner,) . return) (sourceUnfoldrM outer n))
273+
301
274
302#ifdef INSPECTION
275#ifdef INSPECTION
303inspect $ hasNoTypeClasses 'unfoldManyRepl
276inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -315,10 +288,6 @@ o_1_space_concat value = sqrtVal `seq`
315 , benchIOSrc1 "concatMapPure (1 of n)"
288 , benchIOSrc1 "concatMapPure (1 of n)"
316 (concatMapPure 1 value)
289 (concatMapPure 1 value)
317
290
318− -- This is for comparison with foldMapWith
319− , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"
320− (S.concatMap id . sourceConcatMapId value)
321−
322 , benchIOSrc1 "concatMap (n of 1)"
291 , benchIOSrc1 "concatMap (n of 1)"
323 (concatMap value 1)
292 (concatMap value 1)
324 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
293 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
@@ -326,16 +295,25 @@ o_1_space_concat value = sqrtVal `seq`
326 , benchIOSrc1 "concatMap (1 of n)"
295 , benchIOSrc1 "concatMap (1 of n)"
327 (concatMap 1 value)
296 (concatMap 1 value)
328
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+
329 , benchIOSrc1 "concatMapM (n of 1)"
303 , benchIOSrc1 "concatMapM (n of 1)"
330 (concatMapM value 1)
304 (concatMapM value 1)
331 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
305 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
332 (concatMapM sqrtVal sqrtVal)
306 (concatMapM sqrtVal sqrtVal)
333 , benchIOSrc1 "concatMapM (1 of n)"
307 , benchIOSrc1 "concatMapM (1 of n)"
334 (concatMapM 1 value)
308 (concatMapM 1 value)
309+#endif
335
310
311+#ifdef USE_STREAMK
312+ {-
336 -- This is for comparison with foldMapWith
313 -- This is for comparison with foldMapWith
337− , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
314+ , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
338− (S.concatMapWith serial id . sourceConcatMapId value)
315+ (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
316+ -}
339
317
340 , benchIOSrc1 "concatMapWith (n of 1)"
318 , benchIOSrc1 "concatMapWith (n of 1)"
341 (concatMapWithSerial value 1)
319 (concatMapWithSerial value 1)
@@ -344,41 +322,54 @@ o_1_space_concat value = sqrtVal `seq`
344 , benchIOSrc1 "concatMapWith (1 of n)"
322 , benchIOSrc1 "concatMapWith (1 of n)"
345 (concatMapWithSerial 1 value)
323 (concatMapWithSerial 1 value)
346
324
325+ {-
347 -- quadratic with number of outer streams
326 -- quadratic with number of outer streams
348 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
327 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
349 (concatMapWithAppend 2 (value `div` 2))
328 (concatMapWithAppend 2 (value `div` 2))
329+ -}
330+#endif
350
331
351 -- concatMap vs unfoldMany
332 -- concatMap vs unfoldMany
352 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
333 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
353 (concatMapRepl sqrtVal sqrtVal)
334 (concatMapRepl sqrtVal sqrtVal)
354 , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
335 , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"
355 (unfoldManyRepl sqrtVal sqrtVal)
336 (unfoldManyRepl sqrtVal sqrtVal)
337+ ]
338+ ]
356
339
357− -------------------concatPairsWith-----------------
340+ where
358−
359− , benchIOSrc1 "concatPairWithAppend"
360− (concatPairWithAppend 2 (value `div` 2))
361− , benchIOSrc1 "concatPairWithInterleave"
362− (concatPairWithInterleave 2 (value `div` 2))
363−
364− , benchIOSrc1 "concatPairWithInterleaveSuffix"
365− (concatPairWithInterleaveSuffix 2 (value `div` 2))
366−
367− , benchIOSrc1 "concatPairWithInterleaveInfix"
368− (concatPairWithInterleaveInfix 2 (value `div` 2))
369−
370− , benchIOSrc1 "concatPairWithInterleaveMin"
371− (concatPairWithInterleaveMin 2 (value `div` 2))
372
341
373− , benchIOSrc1 "concatPairWithRoundrobin"
342+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
374− (concatPairWithRoundrobin 2 (value `div` 2))
375
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+ -}
376 ]
366 ]
377 ]
367 ]
378
368
379 where
369 where
380
370
381 sqrtVal = round $ sqrt (fromIntegral value :: Double)
371 sqrtVal = round $ sqrt (fromIntegral value :: Double)
372+#endif
382
373
383-------------------------------------------------------------------------------
374-------------------------------------------------------------------------------
384-- Applicative
375-- Applicative
@@ -387,26 +378,28 @@ o_1_space_concat value = sqrtVal `seq`
387o_1_space_applicative :: Int -> [Benchmark]
378o_1_space_applicative :: Int -> [Benchmark]
388o_1_space_applicative value =
379o_1_space_applicative value =
389 [ bgroup "Applicative"
380 [ bgroup "Applicative"
390− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial
381+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
391− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial
382+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
392− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial
383+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
393− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial
384+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
394 ]
385 ]
395 ]
386 ]
396
387
388+#ifdef USE_STREAMK
397o_n_space_applicative :: Int -> [Benchmark]
389o_n_space_applicative :: Int -> [Benchmark]
398o_n_space_applicative value =
390o_n_space_applicative value =
399− [ bgroup "Applicative"
391+ [ bgroup "iterated"
400− [ benchIOSrc fromSerial "(*>) (n times)" $
392+ [ benchIOSrc "(*>) (n times)" $
401 iterateSingleton ((*>) . pure) value
393 iterateSingleton ((*>) . pure) value
402− , benchIOSrc fromSerial "(<*) (n times)" $
394+ , benchIOSrc "(<*) (n times)" $
403 iterateSingleton (\x xs -> xs <* pure x) value
395 iterateSingleton (\x xs -> xs <* pure x) value
404− , benchIOSrc fromSerial "(<*>) (n times)" $
396+ , benchIOSrc "(<*>) (n times)" $
405 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
397 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
406− , benchIOSrc fromSerial "liftA2 (n times)" $
398+ , benchIOSrc "liftA2 (n times)" $
407 iterateSingleton (AP.liftA2 (+) . pure) value
399 iterateSingleton (AP.liftA2 (+) . pure) value
408 ]
400 ]
409 ]
401 ]
402+#endif
410
403
411-------------------------------------------------------------------------------
404-------------------------------------------------------------------------------
412-- Monad
405-- Monad
@@ -415,48 +408,122 @@ o_n_space_applicative value =
415o_1_space_monad :: Int -> [Benchmark]
408o_1_space_monad :: Int -> [Benchmark]
416o_1_space_monad value =
409o_1_space_monad value =
417 [ bgroup "Monad"
410 [ bgroup "Monad"
418− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial
411+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
419− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial
412+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
420 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
413 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
421− filterAllOutM value fromSerial
414+ filterAllOutM value
422 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
415 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
423− filterAllInM value fromSerial
416+ filterAllInM value
424 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
417 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
425− filterSome value fromSerial
418+ filterSome value
426 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
419 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
427− breakAfterSome value fromSerial
420+ breakAfterSome value
428 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
421 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
429− toNullM3 value fromSerial
422+ toNullM3 value
430 ]
423 ]
431 ]
424 ]
432
425
426+#ifdef USE_STREAMK
433-- 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
434-- 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.
435{-# INLINE sieve #-}
429{-# INLINE sieve #-}
436−sieve :: Monad m => SerialT m Int -> SerialT m Int
430+sieve :: Monad m => StreamK m Int -> StreamK m Int
437−sieve s = do
431+sieve s = StreamK.concatEffect $ do
438− r <- lift $ S.uncons s
432+ r <- StreamK.uncons s
439 case r of
433 case r of
440 Just (prime, rest) ->
434 Just (prime, rest) ->
435+ -- XXX Use K.filter or rewrite to K.filter
441− 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)
442− 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
443
458
444o_n_space_monad :: Int -> [Benchmark]
459o_n_space_monad :: Int -> [Benchmark]
445o_n_space_monad value =
460o_n_space_monad value =
446 [ bgroup "Monad"
461 [ bgroup "Monad"
447− [ benchIOSrc fromSerial "(>>) (n times)" $
448− iterateSingleton ((>>) . pure) value
449− , benchIOSrc fromSerial "(>>=) (n times)" $
450− iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
451− , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
462+ [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
452− toListM value fromSerial
463+ toListM value
453 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
464 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
454− toListSome value fromSerial
465+ toListSome value
455− , benchIO "naive prime sieve (n/4)"
456− (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
457 ]
466 ]
458 ]
467 ]
459
468
469+-------------------------------------------------------------------------------
470+-- Joining
471+-------------------------------------------------------------------------------
472+
473+{-
474+toKv :: Int -> (Int, Int)
475+toKv p = (p, p)
476+
477+{-# INLINE joinWith #-}
478+joinWith :: Common.MonadAsync m =>
479+ ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)
480+ -> Int
481+ -> Int
482+ -> m ()
483+joinWith j val i =
484+ drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
485+
486+{-# INLINE joinMapWith #-}
487+joinMapWith :: Common.MonadAsync m =>
488+ (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)
489+ -> Int
490+ -> Int
491+ -> m ()
492+joinMapWith j val i =
493+ drain
494+ $ j
495+ (fmap toKv (sourceUnfoldrM val i))
496+ (fmap toKv (sourceUnfoldrM val (val `div` 2)))
497+
498+o_n_heap_buffering :: Int -> [Benchmark]
499+o_n_heap_buffering value =
500+ [ bgroup "buffered"
501+ [
502+ benchIOSrc1 "joinInnerGeneric (sqrtVal)"
503+ $ joinWith S.joinInnerGeneric sqrtVal
504+ , benchIOSrc1 "joinInner"
505+ $ joinMapWith S.joinInner halfVal
506+ , benchIOSrc1 "joinLeftGeneric (sqrtVal)"
507+ $ joinWith S.joinLeftGeneric sqrtVal
508+ , benchIOSrc1 "joinLeft "
509+ $ joinMapWith S.joinLeft halfVal
510+ , benchIOSrc1 "joinOuterGeneric (sqrtVal)"
511+ $ joinWith S.joinOuterGeneric sqrtVal
512+ , benchIOSrc1 "joinOuter"
513+ $ joinMapWith S.joinOuter halfVal
514+ , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"
515+ $ joinWith S.filterInStreamGenericBy sqrtVal
516+ , benchIOSrc1 "filterInStreamAscBy"
517+ $ joinMapWith (S.filterInStreamAscBy compare) halfVal
518+ ]
519+ ]
520+
521+ where
522+
523+ halfVal = value `div` 2
524+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
525+-}
526+
460-------------------------------------------------------------------------------
527-------------------------------------------------------------------------------
461-- Main
528-- Main
462-------------------------------------------------------------------------------
529-------------------------------------------------------------------------------
@@ -464,23 +531,33 @@ o_n_space_monad value =
464-- 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
465-- passed using the --stream-size option.
532-- passed using the --stream-size option.
466--
533--
534+{-# ANN benchmarks "HLint: ignore" #-}
467benchmarks :: String -> Int -> [Benchmark]
535benchmarks :: String -> Int -> [Benchmark]
468benchmarks moduleName size =
536benchmarks moduleName size =
469 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
537 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
470 [
538 [
471 -- multi-stream
539 -- multi-stream
472 o_1_space_joining size
540 o_1_space_joining size
541+#ifdef USE_PRELUDE
473 , o_1_space_concatFoldable size
542 , o_1_space_concatFoldable size
543+#endif
474 , o_1_space_concat size
544 , o_1_space_concat size
475−
476 , o_1_space_applicative size
545 , o_1_space_applicative size
477 , o_1_space_monad size
546 , o_1_space_monad size
478−
479 ]
547 ]
480 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
548 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
481 [
549 [
482 -- 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
483− o_n_space_applicative size
555+ , o_n_space_applicative size
484− , o_n_space_monad size
556+#endif
485 ]
557 ]
558+ {-
559+ , bgroup (o_n_heap_prefix moduleName) $
560+ -- multi-stream
561+ o_n_heap_buffering size
562+ -}
486 ]
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+25−12
@@ -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
@@ -67,7 +69,7 @@ splitOn inh =
67inspect $ hasNoTypeClasses 'splitOn
69inspect $ hasNoTypeClasses 'splitOn
68inspect $ 'splitOn `hasNoType` ''Step
70inspect $ 'splitOn `hasNoType` ''Step
69inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
71inspect $ '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.
@@ -80,7 +82,7 @@ splitOnSuffix inh =
80inspect $ hasNoTypeClasses 'splitOnSuffix
82inspect $ hasNoTypeClasses 'splitOnSuffix
81inspect $ 'splitOnSuffix `hasNoType` ''Step
83inspect $ 'splitOnSuffix `hasNoType` ''Step
82inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
84inspect $ '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.
@@ -93,7 +95,7 @@ splitWithSuffix inh =
93inspect $ hasNoTypeClasses 'splitWithSuffix
95inspect $ hasNoTypeClasses 'splitWithSuffix
94inspect $ 'splitWithSuffix `hasNoType` ''Step
96inspect $ 'splitWithSuffix `hasNoType` ''Step
95inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
97inspect $ '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.
@@ -124,7 +126,7 @@ wordsBy inh =
124inspect $ hasNoTypeClasses 'wordsBy
126inspect $ hasNoTypeClasses 'wordsBy
125inspect $ 'wordsBy `hasNoType` ''Step
127inspect $ 'wordsBy `hasNoType` ''Step
126inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
128inspect $ '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+46−5
@@ -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
@@ -409,8 +449,8 @@ unfoldManyRepl :: Int -> Int -> Int -> IO ()
409unfoldManyRepl outer inner n =
449unfoldManyRepl outer inner n =
410 S.drain
450 S.drain
411 $ S.unfoldMany
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
416inspect $ hasNoTypeClasses 'unfoldManyRepl
456inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -423,7 +463,7 @@ inspect $ 'unfoldManyRepl `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 ]
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+74−32
@@ -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,22 +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, zipWith, init, iterate
31+ ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
28 , repeat, replicate
32 , repeat, replicate
29 )
33 )
30
34
31import qualified Prelude as P
35import qualified Prelude as P
32import qualified Data.List as List
36import qualified Data.List as List
33
37
34−import qualified Streamly.Internal.Control.Concurrent as S
38+import qualified Streamly.Internal.Data.StreamK as S
35−import qualified Streamly.Internal.Data.Stream.StreamK.Type as S
36−import qualified Streamly.Internal.Data.Stream.StreamK as S
37
39
38−import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
40+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
39
41
40import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common
41
43
@@ -115,7 +117,7 @@ Benchmarks that need to be added
115-- Stream generation and elimination
117-- Stream generation and elimination
116-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
117
119
118−type Stream m a = S.Stream m a
120+type Stream m a = S.StreamK m a
119
121
120{-# INLINE unfoldr #-}
122{-# INLINE unfoldr #-}
121unfoldr :: Int -> Int -> Stream m Int
123unfoldr :: Int -> Int -> Stream m Int
@@ -127,7 +129,7 @@ unfoldr streamLen n = S.unfoldr step n
127 else Just (cnt, cnt + 1)
129 else Just (cnt, cnt + 1)
128
130
129{-# INLINE unfoldrM #-}
131{-# INLINE unfoldrM #-}
130−unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
132+unfoldrM :: Monad m => Int -> Int -> Stream m Int
131unfoldrM streamLen n = S.unfoldrMWith S.consM step n
133unfoldrM streamLen n = S.unfoldrMWith S.consM step n
132 where
134 where
133 step cnt =
135 step cnt =
@@ -140,7 +142,7 @@ repeat :: Int -> Int -> Stream m Int
140repeat streamLen = S.take streamLen . S.repeat
142repeat streamLen = S.take streamLen . S.repeat
141
143
142{-# INLINE repeatM #-}
144{-# INLINE repeatM #-}
143−repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
145+repeatM :: Monad m => Int -> Int -> Stream m Int
144repeatM streamLen = S.take streamLen . S.repeatM . return
146repeatM streamLen = S.take streamLen . S.repeatM . return
145
147
146{-# INLINE replicate #-}
148{-# INLINE replicate #-}
@@ -148,7 +150,7 @@ replicate :: Int -> Int -> Stream m Int
148replicate = S.replicate
150replicate = S.replicate
149
151
150{-# INLINE replicateM #-}
152{-# INLINE replicateM #-}
151−replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
153+replicateM :: Monad m => Int -> Int -> Stream m Int
152replicateM streamLen = S.replicateMWith S.consM streamLen . return
154replicateM streamLen = S.replicateMWith S.consM streamLen . return
153
155
154{-# INLINE iterate #-}
156{-# INLINE iterate #-}
@@ -156,7 +158,7 @@ iterate :: Int -> Int -> Stream m Int
156iterate streamLen = S.take streamLen . S.iterate (+1)
158iterate streamLen = S.take streamLen . S.iterate (+1)
157
159
158{-# INLINE iterateM #-}
160{-# INLINE iterateM #-}
159−iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
161+iterateM :: Monad m => Int -> Int -> Stream m Int
160iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
162iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
161
163
162{-# INLINE fromFoldable #-}
164{-# INLINE fromFoldable #-}
@@ -164,26 +166,27 @@ fromFoldable :: Int -> Int -> Stream m Int
164fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
166fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
165
167
166{-# INLINE fromFoldableM #-}
168{-# INLINE fromFoldableM #-}
167−fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
169+fromFoldableM :: Monad m => Int -> Int -> Stream m Int
168fromFoldableM streamLen n =
170fromFoldableM streamLen n =
169− Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
171+ List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
170
172
171{-# INLINABLE concatMapFoldableWith #-}
173{-# INLINABLE concatMapFoldableWith #-}
172−concatMapFoldableWith :: Foldable f
174+concatMapFoldableWith :: P.Foldable f
173 => (Stream m b -> Stream m b -> Stream m b)
175 => (Stream m b -> Stream m b -> Stream m b)
174 -> (a -> Stream m b)
176 -> (a -> Stream m b)
175 -> f a
177 -> f a
176 -> Stream m b
178 -> Stream m b
177−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
179+concatMapFoldableWith f g = P.foldr (f . g) S.nil
178
180
179{-# INLINE concatMapFoldableSerial #-}
181{-# INLINE concatMapFoldableSerial #-}
180concatMapFoldableSerial :: Int -> Int -> Stream m Int
182concatMapFoldableSerial :: Int -> Int -> Stream m Int
183+concatMapFoldableSerial streamLen n =
181−concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]
184+ concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
182
185
183{-# INLINE concatMapFoldableSerialM #-}
186{-# INLINE concatMapFoldableSerialM #-}
184concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
187concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
185concatMapFoldableSerialM streamLen n =
188concatMapFoldableSerialM streamLen n =
186− concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
189+ concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
187
190
188-------------------------------------------------------------------------------
191-------------------------------------------------------------------------------
189-- Elimination
192-- Elimination
@@ -268,11 +271,11 @@ fmapK :: Monad m => Int -> Stream m Int -> m ()
268fmapK n = composeN n $ P.fmap (+ 1)
271fmapK n = composeN n $ P.fmap (+ 1)
269
272
270{-# INLINE mapM #-}
273{-# INLINE mapM #-}
271−mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
274+mapM :: Monad m => Int -> Stream m Int -> m ()
272mapM n = composeN n $ S.mapMWith S.consM return
275mapM n = composeN n $ S.mapMWith S.consM return
273
276
274{-# INLINE mapMSerial #-}
277{-# INLINE mapMSerial #-}
275−mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
278+mapMSerial :: Monad m => Int -> Stream m Int -> m ()
276mapMSerial n = composeN n $ S.mapMSerial return
279mapMSerial n = composeN n $ S.mapMSerial return
277
280
278{-# INLINE filterEven #-}
281{-# INLINE filterEven #-}
@@ -324,7 +327,7 @@ foldlS :: Monad m => Int -> Stream m Int -> m ()
324foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
327foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
325
328
326{-# INLINE intersperse #-}
329{-# INLINE intersperse #-}
327−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
330+intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
328intersperse streamLen n = composeN n $ S.intersperse streamLen
331intersperse streamLen n = composeN n $ S.intersperse streamLen
329
332
330-------------------------------------------------------------------------------
333-------------------------------------------------------------------------------
@@ -333,8 +336,7 @@ intersperse streamLen n = composeN n $ S.intersperse streamLen
333
336
334{-# INLINE iterateSource #-}
337{-# INLINE iterateSource #-}
335iterateSource
338iterateSource
336− :: S.MonadAsync m
337− => Int -> (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
338iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
340iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
339 where
341 where
340 f (0 :: Int) m = g m
342 f (0 :: Int) m = g m
@@ -342,37 +344,37 @@ iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
342
344
343-- this is quadratic
345-- this is quadratic
344{-# INLINE iterateScan #-}
346{-# INLINE iterateScan #-}
345−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347+iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
346iterateScan iterStreamLen maxIters =
348iterateScan iterStreamLen maxIters =
347 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
349 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
348
350
349-- this is quadratic
351-- this is quadratic
350{-# INLINE iterateDropWhileFalse #-}
352{-# INLINE iterateDropWhileFalse #-}
351−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
353+iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
352iterateDropWhileFalse streamLen iterStreamLen maxIters =
354iterateDropWhileFalse streamLen iterStreamLen maxIters =
353 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
355 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
354
356
355{-# INLINE iterateMapM #-}
357{-# INLINE iterateMapM #-}
356−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
358+iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
357iterateMapM iterStreamLen =
359iterateMapM iterStreamLen =
358 iterateSource iterStreamLen (S.mapMWith S.consM return)
360 iterateSource iterStreamLen (S.mapMWith S.consM return)
359
361
360{-# INLINE iterateFilterEven #-}
362{-# INLINE iterateFilterEven #-}
361−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
363+iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
362iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
364iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
363
365
364{-# INLINE iterateTakeAll #-}
366{-# INLINE iterateTakeAll #-}
365−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
367+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
366iterateTakeAll streamLen iterStreamLen =
368iterateTakeAll streamLen iterStreamLen =
367 iterateSource iterStreamLen (S.take streamLen)
369 iterateSource iterStreamLen (S.take streamLen)
368
370
369{-# INLINE iterateDropOne #-}
371{-# INLINE iterateDropOne #-}
370−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
372+iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
371iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
373iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
372
374
373{-# INLINE iterateDropWhileTrue #-}
375{-# INLINE iterateDropWhileTrue #-}
374−iterateDropWhileTrue :: S.MonadAsync m =>
376+iterateDropWhileTrue ::
375− Int -> Int -> Int -> Int -> Stream m Int
377+ Monad m => Int -> Int -> Int -> Int -> Stream m Int
376iterateDropWhileTrue streamLen iterStreamLen =
378iterateDropWhileTrue streamLen iterStreamLen =
377 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
379 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
378
380
@@ -384,6 +386,18 @@ iterateDropWhileTrue streamLen iterStreamLen =
384zipWith :: Monad m => Stream m Int -> m ()
386zipWith :: Monad m => Stream m Int -> m ()
385zipWith src = drain $ S.zipWith (,) src src
387zipWith src = drain $ S.zipWith (,) src src
386
388
389+{-# INLINE zipWithM #-}
390+zipWithM :: Monad m => Stream m Int -> m ()
391+zipWithM src = drain $ S.zipWithM (curry return) src src
392+
393+{-# INLINE sortByK #-}
394+sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395+sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
396+
397+{-# INLINE sortBy #-}
398+sortBy :: Monad m => Stream m Int -> m ()
399+sortBy = drain . sortByK compare
400+
387-------------------------------------------------------------------------------
401-------------------------------------------------------------------------------
388-- Mixed Composition
402-- Mixed Composition
389-------------------------------------------------------------------------------
403-------------------------------------------------------------------------------
@@ -480,7 +494,7 @@ sourceConcatMapId val n =
480{-# INLINE concatMapBySerial #-}
494{-# INLINE concatMapBySerial #-}
481concatMapBySerial :: Int -> Int -> Int -> IO ()
495concatMapBySerial :: Int -> Int -> Int -> IO ()
482concatMapBySerial outer inner n =
496concatMapBySerial outer inner n =
483− S.drain $ S.concatMapWith S.serial
497+ S.drain $ S.concatMapWith S.append
484 (unfoldrM inner)
498 (unfoldrM inner)
485 (unfoldrM outer n)
499 (unfoldrM outer n)
486
500
@@ -488,6 +502,32 @@ concatMapBySerial outer inner n =
488-- Nested Composition
502-- Nested Composition
489-------------------------------------------------------------------------------
503-------------------------------------------------------------------------------
490
504
505+instance Monad m => Applicative (S.StreamK m) where
506+ {-# INLINE pure #-}
507+ pure = S.fromPure
508+
509+ {-# INLINE (<*>) #-}
510+ (<*>) = S.crossApply
511+
512+ {-# INLINE liftA2 #-}
513+ liftA2 f x = (<*>) (fmap f x)
514+
515+ {-# INLINE (*>) #-}
516+ (*>) = S.crossApplySnd
517+
518+ {-# INLINE (<*) #-}
519+ (<*) = S.crossApplyFst
520+
521+-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
522+-- the monad instance of StreamD is slower than StreamK after foldr/build
523+-- fusion.
524+instance Monad m => Monad (S.StreamK m) where
525+ {-# INLINE return #-}
526+ return = pure
527+
528+ {-# INLINE (>>=) #-}
529+ (>>=) = flip S.concatMap
530+
491{-# INLINE drainApplicative #-}
531{-# INLINE drainApplicative #-}
492drainApplicative :: Monad m => Stream m Int -> m ()
532drainApplicative :: Monad m => Stream m Int -> m ()
493drainApplicative s = drain $ do
533drainApplicative s = drain $ do
@@ -594,7 +634,7 @@ filterAllInNestedList str = do
594-------------------------------------------------------------------------------
634-------------------------------------------------------------------------------
595
635
596moduleName :: String
636moduleName :: String
597−moduleName = "Data.Stream.StreamK"
637+moduleName = "Data.StreamK"
598
638
599o_1_space_generation :: Int -> Benchmark
639o_1_space_generation :: Int -> Benchmark
600o_1_space_generation streamLen =
640o_1_space_generation streamLen =
@@ -691,7 +731,7 @@ o_1_space_concat streamLen =
691 -- This is for comparison with concatMapFoldableWith
731 -- This is for comparison with concatMapFoldableWith
692 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
732 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
693 (S.drain
733 (S.drain
694− . S.concatMapWith S.serial id
734+ . S.concatMapWith S.append id
695 . sourceConcatMapId streamLen)
735 . sourceConcatMapId streamLen)
696
736
697 , benchIOSrc1 "concatMapBy serial (n of 1)"
737 , benchIOSrc1 "concatMapBy serial (n of 1)"
@@ -700,6 +740,7 @@ o_1_space_concat streamLen =
700 (concatMapBySerial streamLen2 streamLen2)
740 (concatMapBySerial streamLen2 streamLen2)
701 , benchIOSrc1 "concatMapBy serial (1 of n)"
741 , benchIOSrc1 "concatMapBy serial (1 of n)"
702 (concatMapBySerial 1 streamLen)
742 (concatMapBySerial 1 streamLen)
743+ , benchFold "sortBy" sortBy (unfoldrM streamLen)
703 ]
744 ]
704 where
745 where
705 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
746 streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
@@ -736,6 +777,7 @@ o_1_space_zipping :: Int -> Benchmark
736o_1_space_zipping streamLen =
777o_1_space_zipping streamLen =
737 bgroup "zipping"
778 bgroup "zipping"
738 [ benchFold "zipWith" zipWith (unfoldrM streamLen)
779 [ benchFold "zipWith" zipWith (unfoldrM streamLen)
780+ , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
739 ]
781 ]
740
782
741o_1_space_mixed :: Int -> Benchmark
783o_1_space_mixed :: Int -> Benchmark
benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hsrenamed+6−4
@@ -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
@@ -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/Prelude/Serial/Transformation1.hs → benchmark/Streamly/Benchmark/Data/Stream/Transform.hsrenamed+284−164
@@ -1,14 +1,20 @@
1-- |
1-- |
2−-- Module : Serial.Transformation1
2+-- Module : Stream.Transform
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,30 +24,48 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
25#endif
20
26
21−module Serial.Transformation1 (benchmarks) where
27+module Stream.Transform (benchmarks) where
22
28
23−import Control.DeepSeq (NFData(..))
24import Control.Monad.IO.Class (MonadIO(..))
29import Control.Monad.IO.Class (MonadIO(..))
25−import Data.Functor.Identity (Identity)
26−import Data.IORef (newIORef, modifyIORef')
27−import System.Random (randomRIO)
28
30
29−#ifdef INSPECTION
31+import System.Random (randomRIO)
30−import Test.Inspection
31−#endif
32
32
33−import qualified Streamly.Prelude as S
34−import qualified Streamly.Internal.Data.Stream.IsStream as Internal
35import qualified Streamly.Internal.Data.Fold as FL
33import qualified Streamly.Internal.Data.Fold as FL
34+
35+import qualified Stream.Common as Common
36import qualified Streamly.Internal.Data.Unfold as Unfold
36import 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(..))
37import qualified Prelude
54import 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
38
60
39−import Gauge
61+import Test.Tasty.Bench
40−import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
62+import Stream.Common hiding (scanl')
41import Streamly.Benchmark.Common
63import Streamly.Benchmark.Common
42−import Streamly.Benchmark.Prelude
43−import Streamly.Internal.Data.Time.Units
44−import Prelude hiding (sequence, mapM, fmap)
64+import Prelude hiding (sequence, mapM)
65+
66+#ifdef USE_PRELUDE
67+type Stream = Stream.SerialT
68+#endif
45
69
46-------------------------------------------------------------------------------
70-------------------------------------------------------------------------------
47-- Pipelines (stream-to-stream transformations)
71-- Pipelines (stream-to-stream transformations)
@@ -55,28 +79,36 @@ import Prelude hiding (sequence, mapM, fmap)
55-- Traversable Instance
79-- Traversable Instance
56-------------------------------------------------------------------------------
80-------------------------------------------------------------------------------
57
81
82+#ifdef USE_STREAMK
58{-# INLINE traversableTraverse #-}
83{-# INLINE traversableTraverse #-}
59−traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
84+traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)
60traversableTraverse = traverse return
85traversableTraverse = traverse return
61
86
62{-# INLINE traversableSequenceA #-}
87{-# INLINE traversableSequenceA #-}
63−traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
88+traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)
64traversableSequenceA = sequenceA . Prelude.fmap return
89traversableSequenceA = sequenceA . Prelude.fmap return
65
90
66{-# INLINE traversableMapM #-}
91{-# INLINE traversableMapM #-}
67−traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
92+traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)
68traversableMapM = Prelude.mapM return
93traversableMapM = Prelude.mapM return
69
94
70{-# INLINE traversableSequence #-}
95{-# INLINE traversableSequence #-}
71−traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
96+traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)
72traversableSequence = Prelude.sequence . Prelude.fmap return
97traversableSequence = Prelude.sequence . Prelude.fmap return
73
98
74{-# INLINE benchPureSinkIO #-}
99{-# INLINE benchPureSinkIO #-}
75benchPureSinkIO
100benchPureSinkIO
76 :: NFData b
101 :: NFData b
77− => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
102+ => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark
78benchPureSinkIO value name f =
103benchPureSinkIO value name f =
104+ bench name
79− bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
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)
80
112
81o_n_space_traversable :: Int -> [Benchmark]
113o_n_space_traversable :: Int -> [Benchmark]
82o_n_space_traversable value =
114o_n_space_traversable value =
@@ -89,113 +121,124 @@ o_n_space_traversable value =
89 , benchPureSinkIO value "sequence" traversableSequence
121 , benchPureSinkIO value "sequence" traversableSequence
90 ]
122 ]
91 ]
123 ]
124+#endif
92
125
93-------------------------------------------------------------------------------
126-------------------------------------------------------------------------------
94-- maps and scans
127-- maps and scans
95-------------------------------------------------------------------------------
128-------------------------------------------------------------------------------
96
129
130+#ifdef USE_PRELUDE
97{-# INLINE scanl' #-}
131{-# INLINE scanl' #-}
98−scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
132+scanl' :: MonadIO m => Int -> Stream m Int -> m ()
99−scanl' n = composeN n $ S.scanl' (+) 0
133+scanl' n = composeN n $ Stream.scanl' (+) 0
100
134
101{-# INLINE scanlM' #-}
135{-# INLINE scanlM' #-}
102−scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
136+scanlM' :: MonadIO m => Int -> Stream m Int -> m ()
103−scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
137+scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
104
138
105{-# INLINE scanl1' #-}
139{-# INLINE scanl1' #-}
106−scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
140+scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
107−scanl1' n = composeN n $ S.scanl1' (+)
141+scanl1' n = composeN n $ Stream.scanl1' (+)
108
142
109{-# INLINE scanl1M' #-}
143{-# INLINE scanl1M' #-}
110−scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
144+scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()
111−scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
145+scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
146+#endif
112
147
113{-# INLINE scan #-}
148{-# INLINE scan #-}
114−scan :: MonadIO m => Int -> SerialT m Int -> m ()
149+scan :: MonadIO m => Int -> Stream m Int -> m ()
115−scan n = composeN n $ S.scan FL.sum
150+scan n = composeN n $ Stream.scan FL.sum
116
151
152+#ifdef USE_PRELUDE
117{-# INLINE postscanl' #-}
153{-# INLINE postscanl' #-}
118−postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
154+postscanl' :: MonadIO m => Int -> Stream m Int -> m ()
119−postscanl' n = composeN n $ S.postscanl' (+) 0
155+postscanl' n = composeN n $ Stream.postscanl' (+) 0
120
156
121{-# INLINE postscanlM' #-}
157{-# INLINE postscanlM' #-}
122−postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
158+postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()
123−postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
159+postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
160+#endif
124
161
125{-# INLINE postscan #-}
162{-# INLINE postscan #-}
126−postscan :: MonadIO m => Int -> SerialT m Int -> m ()
163+postscan :: MonadIO m => Int -> Stream m Int -> m ()
127−postscan n = composeN n $ S.postscan FL.sum
164+postscan n = composeN n $ Stream.postscan FL.sum
128
165
129{-# INLINE sequence #-}
166{-# INLINE sequence #-}
130−sequence ::
167+sequence :: MonadAsync m => Stream m (m Int) -> m ()
131− (S.IsStream t, S.MonadAsync m)
132− => (t m Int -> S.SerialT m Int)
133− -> t m (m Int)
134− -> m ()
135−sequence t = S.drain . t . S.sequence
168+sequence = Common.drain . Stream.sequence
136
169
137{-# INLINE tap #-}
170{-# INLINE tap #-}
138−tap :: MonadIO m => Int -> SerialT m Int -> m ()
171+tap :: MonadIO m => Int -> Stream m Int -> m ()
139−tap n = composeN n $ S.tap FL.sum
172+tap n = composeN n $ Stream.tap FL.sum
140−
141−{-# INLINE tapRate #-}
142−tapRate :: Int -> SerialT IO Int -> IO ()
143−tapRate n str = do
144− cref <- newIORef 0
145− composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
146
173
174+#ifdef USE_PRELUDE
147{-# INLINE pollCounts #-}
175{-# INLINE pollCounts #-}
148−pollCounts :: Int -> SerialT IO Int -> IO ()
176+pollCounts :: Int -> Stream IO Int -> IO ()
149pollCounts n =
177pollCounts n =
150− composeN n (Internal.pollCounts (const True) f FL.drain)
178+ composeN n (Stream.pollCounts (const True) f)
151
179
152 where
180 where
153
181
154− f = Internal.rollingMap (-) . Internal.delayPost 1
182+ f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
155
183
156{-# INLINE timestamped #-}
184{-# INLINE timestamped #-}
157−timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
185+timestamped :: (MonadAsync m) => Stream m Int -> m ()
158−timestamped = S.drain . Internal.timestamped
186+timestamped = Stream.drain . Stream.timestamped
187+#endif
159
188
189+#ifdef USE_STREAMK
160{-# INLINE foldrS #-}
190{-# INLINE foldrS #-}
161−foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
191+foldrS :: MonadIO m => Int -> Stream m Int -> m ()
192+foldrS n =
162−foldrS n = composeN n $ Internal.foldrS S.cons S.nil
193+ composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream)
163
194
164{-# INLINE foldrSMap #-}
195{-# INLINE foldrSMap #-}
165−foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
196+foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
197+foldrSMap n =
198+ composeN n
199+ ( toStream
166−foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
200+ . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil
201+ . fromStream
202+ )
203+#endif
167
204
205+{-
168{-# INLINE foldrT #-}
206{-# INLINE foldrT #-}
169−foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
207+foldrT :: MonadIO m => Int -> Stream m Int -> m ()
170−foldrT n = composeN n $ Internal.foldrT S.cons S.nil
208+foldrT n = composeN n (unCrossStream . Stream.foldrT cns (CrossStream Stream.nil))
171
209
172−{-# INLINE foldrTMap #-}
210+ where cns x (CrossStream xs) = CrossStream (Stream.cons x xs)
173−foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
174−foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
175
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+-}
176
216
177{-# INLINE trace #-}
217{-# INLINE trace #-}
178−trace :: MonadAsync m => Int -> SerialT m Int -> m ()
218+trace :: MonadAsync m => Int -> Stream m Int -> m ()
179−trace n = composeN n $ Internal.trace return
219+trace n = composeN n $ Stream.trace return
180
220
181o_1_space_mapping :: Int -> [Benchmark]
221o_1_space_mapping :: Int -> [Benchmark]
182o_1_space_mapping value =
222o_1_space_mapping value =
183 [ bgroup
223 [ bgroup
184 "mapping"
224 "mapping"
185 [
225 [
226+#ifdef USE_STREAMK
186 -- Right folds
227 -- Right folds
187 benchIOSink value "foldrS" (foldrS 1)
228 benchIOSink value "foldrS" (foldrS 1)
188 , benchIOSink value "foldrSMap" (foldrSMap 1)
229 , benchIOSink value "foldrSMap" (foldrSMap 1)
230+ ,
231+#endif
189− , benchIOSink value "foldrT" (foldrT 1)
232+ -- , benchIOSink value "foldrT" (foldrT 1)
190− , benchIOSink value "foldrTMap" (foldrTMap 1)
233+ -- , benchIOSink value "foldrTMap" (foldrTMap 1)
191
234
192 -- Mapping
235 -- Mapping
193− , benchIOSink value "map" (mapN fromSerial 1)
236+ benchIOSink value "map" (mapN 1)
194 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
237 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
195− sequence fromSerial (sourceUnfoldrAction value n)
238+ sequence (sourceUnfoldrAction value n)
196− , benchIOSink value "mapM" (mapM fromSerial 1)
239+ , benchIOSink value "mapM" (mapM 1)
197 , benchIOSink value "tap" (tap 1)
240 , benchIOSink value "tap" (tap 1)
198− , benchIOSink value "tapRate 1 second" (tapRate 1)
241+#ifdef USE_PRELUDE
199 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
242 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
200 , benchIOSink value "timestamped" timestamped
243 , benchIOSink value "timestamped" timestamped
201
244
@@ -206,7 +249,7 @@ o_1_space_mapping value =
206 , benchIOSink value "scanl1M'" (scanl1M' 1)
249 , benchIOSink value "scanl1M'" (scanl1M' 1)
207 , benchIOSink value "postscanl'" (postscanl' 1)
250 , benchIOSink value "postscanl'" (postscanl' 1)
208 , benchIOSink value "postscanlM'" (postscanlM' 1)
251 , benchIOSink value "postscanlM'" (postscanlM' 1)
209−
252+#endif
210 , benchIOSink value "scan" (scan 1)
253 , benchIOSink value "scan" (scan 1)
211 , benchIOSink value "postscan" (postscan 1)
254 , benchIOSink value "postscan" (postscan 1)
212 ]
255 ]
@@ -215,36 +258,37 @@ o_1_space_mapping value =
215o_1_space_mappingX4 :: Int -> [Benchmark]
258o_1_space_mappingX4 :: Int -> [Benchmark]
216o_1_space_mappingX4 value =
259o_1_space_mappingX4 value =
217 [ bgroup "mappingX4"
260 [ bgroup "mappingX4"
218− [ benchIOSink value "map" (mapN fromSerial 4)
261+ [ benchIOSink value "map" (mapN 4)
219− , benchIOSink value "mapM" (mapM fromSerial 4)
262+ , benchIOSink value "mapM" (mapM 4)
220 , benchIOSink value "trace" (trace 4)
263 , benchIOSink value "trace" (trace 4)
221
264
265+#ifdef USE_PRELUDE
222 , benchIOSink value "scanl'" (scanl' 4)
266 , benchIOSink value "scanl'" (scanl' 4)
223 , benchIOSink value "scanl1'" (scanl1' 4)
267 , benchIOSink value "scanl1'" (scanl1' 4)
224 , benchIOSink value "scanlM'" (scanlM' 4)
268 , benchIOSink value "scanlM'" (scanlM' 4)
225 , benchIOSink value "scanl1M'" (scanl1M' 4)
269 , benchIOSink value "scanl1M'" (scanl1M' 4)
226 , benchIOSink value "postscanl'" (postscanl' 4)
270 , benchIOSink value "postscanl'" (postscanl' 4)
227 , benchIOSink value "postscanlM'" (postscanlM' 4)
271 , benchIOSink value "postscanlM'" (postscanlM' 4)
228−
272+#endif
229 ]
273 ]
230 ]
274 ]
231
275
232{-# INLINE sieveScan #-}
276{-# INLINE sieveScan #-}
233−sieveScan :: Monad m => SerialT m Int -> SerialT m Int
277+sieveScan :: Monad m => Stream m Int -> Stream m Int
234sieveScan =
278sieveScan =
235− S.mapMaybe snd
279+ Stream.mapMaybe snd
236− . S.scanlM' (\(primes, _) n -> do
280+ . Stream.scan (FL.foldlM' (\(primes, _) n -> do
237 return $
281 return $
238 let ps = takeWhile (\p -> p * p <= n) primes
282 let ps = takeWhile (\p -> p * p <= n) primes
239 in if all (\p -> n `mod` p /= 0) ps
283 in if all (\p -> n `mod` p /= 0) ps
240 then (primes ++ [n], Just n)
284 then (primes ++ [n], Just n)
241− else (primes, Nothing)) (return ([2], Just 2))
285+ else (primes, Nothing)) (return ([2], Just 2)))
242
286
243o_n_space_mapping :: Int -> [Benchmark]
287o_n_space_mapping :: Int -> [Benchmark]
244o_n_space_mapping value =
288o_n_space_mapping value =
245 [ bgroup "mapping"
289 [ bgroup "mapping"
246 [ benchIO "naive prime sieve"
290 [ benchIO "naive prime sieve"
247− (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
291+ (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))
248 ]
292 ]
249 ]
293 ]
250
294
@@ -255,8 +299,75 @@ o_n_space_mapping value =
255o_1_space_functor :: Int -> [Benchmark]
299o_1_space_functor :: Int -> [Benchmark]
256o_1_space_functor value =
300o_1_space_functor value =
257 [ bgroup "Functor"
301 [ bgroup "Functor"
258− [ benchIOSink value "fmap" (fmapN fromSerial 1)
302+ [ benchIOSink value "fmap" (mapN 1)
259− , benchIOSink value "fmap x 4" (fmapN fromSerial 4)
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+ -}
260 ]
371 ]
261 ]
372 ]
262
373
@@ -265,121 +376,129 @@ o_1_space_functor value =
265-------------------------------------------------------------------------------
376-------------------------------------------------------------------------------
266
377
267{-# INLINE filterEven #-}
378{-# INLINE filterEven #-}
268−filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
379+filterEven :: MonadIO m => Int -> Stream m Int -> m ()
269−filterEven n = composeN n $ S.filter even
380+filterEven n = composeN n $ Stream.filter even
270
381
271{-# INLINE filterAllOut #-}
382{-# INLINE filterAllOut #-}
272−filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
383+filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
273−filterAllOut value n = composeN n $ S.filter (> (value + 1))
384+filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
274
385
275{-# INLINE filterAllIn #-}
386{-# INLINE filterAllIn #-}
276−filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
387+filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
277−filterAllIn value n = composeN n $ S.filter (<= (value + 1))
388+filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
278
389
279{-# INLINE filterMEven #-}
390{-# INLINE filterMEven #-}
280−filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
391+filterMEven :: MonadIO m => Int -> Stream m Int -> m ()
281−filterMEven n = composeN n $ S.filterM (return . even)
392+filterMEven n = composeN n $ Stream.filterM (return . even)
282
393
283{-# INLINE filterMAllOut #-}
394{-# INLINE filterMAllOut #-}
284−filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
395+filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
285−filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
396+filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
286
397
287{-# INLINE filterMAllIn #-}
398{-# INLINE filterMAllIn #-}
288−filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
399+filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
289−filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
400+filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
290
401
291{-# INLINE _takeOne #-}
402{-# INLINE _takeOne #-}
292−_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
403+_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
293−_takeOne n = composeN n $ S.take 1
404+_takeOne n = composeN n $ Stream.take 1
294
405
295{-# INLINE takeAll #-}
406{-# INLINE takeAll #-}
296−takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
407+takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
297−takeAll value n = composeN n $ S.take (value + 1)
408+takeAll value n = composeN n $ Stream.take (value + 1)
298
409
299{-# INLINE takeWhileTrue #-}
410{-# INLINE takeWhileTrue #-}
300−takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
411+takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
301−takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
412+takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
302
413
303{-# INLINE takeWhileMTrue #-}
414{-# INLINE takeWhileMTrue #-}
304−takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
415+takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
305−takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
416+takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
306
417
418+#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
307{-# INLINE takeInterval #-}
419{-# INLINE takeInterval #-}
308−takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
420+takeInterval :: Double -> Int -> Stream IO Int -> IO ()
309−takeInterval i n = composeN n (Internal.takeInterval i)
421+takeInterval i n = composeN n (Stream.takeInterval i)
310
422
423+-- Inspection testing is disabled for takeInterval
424+-- Enable it when looking at it throughly
311#ifdef INSPECTION
425#ifdef INSPECTION
312-- inspect $ hasNoType 'takeInterval ''SPEC
426-- inspect $ hasNoType 'takeInterval ''SPEC
313−inspect $ hasNoTypeClasses 'takeInterval
427+-- inspect $ hasNoTypeClasses 'takeInterval
314-- inspect $ 'takeInterval `hasNoType` ''D.Step
428-- inspect $ 'takeInterval `hasNoType` ''D.Step
315#endif
429#endif
316
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+
317{-# INLINE dropOne #-}
443{-# INLINE dropOne #-}
318−dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
444+dropOne :: MonadIO m => Int -> Stream m Int -> m ()
319−dropOne n = composeN n $ S.drop 1
445+dropOne n = composeN n $ Stream.drop 1
320
446
321{-# INLINE dropAll #-}
447{-# INLINE dropAll #-}
322−dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
448+dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
323−dropAll value n = composeN n $ S.drop (value + 1)
449+dropAll value n = composeN n $ Stream.drop (value + 1)
324
450
325{-# INLINE dropWhileTrue #-}
451{-# INLINE dropWhileTrue #-}
326−dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
452+dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
327−dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
453+dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
328
454
329{-# INLINE dropWhileMTrue #-}
455{-# INLINE dropWhileMTrue #-}
330−dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
456+dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
331−dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
457+dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
332
458
333{-# INLINE dropWhileFalse #-}
459{-# INLINE dropWhileFalse #-}
334−dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
460+dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
335−dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
461+dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
336
462
463+#ifdef USE_PRELUDE
337-- XXX Decide on the time interval
464-- XXX Decide on the time interval
338{-# INLINE _intervalsOfSum #-}
465{-# INLINE _intervalsOfSum #-}
339−_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
466+_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()
340−_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
467+_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
341−
342−{-# INLINE dropInterval #-}
343−dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
344−dropInterval i n = composeN n (Internal.dropInterval i)
345−
346−#ifdef INSPECTION
347−inspect $ hasNoTypeClasses 'dropInterval
348−-- inspect $ 'dropInterval `hasNoType` ''D.Step
349#endif
468#endif
350
469
351{-# INLINE findIndices #-}
470{-# INLINE findIndices #-}
352−findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
471+findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
353−findIndices value n = composeN n $ S.findIndices (== (value + 1))
472+findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
354
473
355{-# INLINE elemIndices #-}
474{-# INLINE elemIndices #-}
356−elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
475+elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
357−elemIndices value n = composeN n $ S.elemIndices (value + 1)
476+elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
358
477
359{-# INLINE deleteBy #-}
478{-# INLINE deleteBy #-}
360−deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
479+deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
361−deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
480+deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
362
481
363-- uniq . uniq == uniq, composeN 2 ~ composeN 1
482-- uniq . uniq == uniq, composeN 2 ~ composeN 1
364{-# INLINE uniq #-}
483{-# INLINE uniq #-}
365−uniq :: MonadIO m => Int -> SerialT m Int -> m ()
484+uniq :: MonadIO m => Int -> Stream m Int -> m ()
366−uniq n = composeN n S.uniq
485+uniq n = composeN n Stream.uniq
367
486
368{-# INLINE mapMaybe #-}
487{-# INLINE mapMaybe #-}
369−mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
488+mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
370mapMaybe n =
489mapMaybe n =
371 composeN n $
490 composeN n $
372− S.mapMaybe
491+ Stream.mapMaybe
373 (\x ->
492 (\x ->
374 if odd x
493 if odd x
375 then Nothing
494 then Nothing
376 else Just x)
495 else Just x)
377
496
378{-# INLINE mapMaybeM #-}
497{-# INLINE mapMaybeM #-}
379−mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
498+mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()
380mapMaybeM n =
499mapMaybeM n =
381 composeN n $
500 composeN n $
382− S.mapMaybeM
501+ Stream.mapMaybeM
383 (\x ->
502 (\x ->
384 if odd x
503 if odd x
385 then return Nothing
504 then return Nothing
@@ -398,18 +517,14 @@ o_1_space_filtering value =
398
517
399 -- Trimming
518 -- Trimming
400 , benchIOSink value "take-all" (takeAll value 1)
519 , benchIOSink value "take-all" (takeAll value 1)
401− , benchIOSink
402− value
403− "takeInterval-all"
404− (takeInterval (NanoSecond64 maxBound) 1)
405 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
520 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
406 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
521 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
407 , benchIOSink value "drop-one" (dropOne 1)
522 , benchIOSink value "drop-one" (dropOne 1)
408 , benchIOSink value "drop-all" (dropAll value 1)
523 , benchIOSink value "drop-all" (dropAll value 1)
409− , benchIOSink
524+#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
410− value
525+ , benchIOSink value "takeInterval-all" (takeInterval 10000 1)
411− "dropInterval-all"
526+ , benchIOSink value "dropInterval-all" (dropInterval 10000 1)
412− (dropInterval (NanoSecond64 maxBound) 1)
527+#endif
413 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
528 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
414 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
529 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
415 , benchIOSink
530 , benchIOSink
@@ -472,26 +587,26 @@ o_1_space_filteringX4 value =
472-------------------------------------------------------------------------------
587-------------------------------------------------------------------------------
473
588
474{-# INLINE intersperse #-}
589{-# INLINE intersperse #-}
475−intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
590+intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
476−intersperse value n = composeN n $ S.intersperse (value + 1)
591+intersperse value n = composeN n $ Stream.intersperse (value + 1)
477
592
478{-# INLINE intersperseM #-}
593{-# INLINE intersperseM #-}
479−intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
594+intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
480−intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
595+intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
481
596
482{-# INLINE insertBy #-}
597{-# INLINE insertBy #-}
483−insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
598+insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
484−insertBy value n = composeN n $ S.insertBy compare (value + 1)
599+insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
485
600
486{-# INLINE interposeSuffix #-}
601{-# INLINE interposeSuffix #-}
487−interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
602+interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
488interposeSuffix value n =
603interposeSuffix value n =
489− composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity
604+ composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
490
605
491{-# INLINE intercalateSuffix #-}
606{-# INLINE intercalateSuffix #-}
492−intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
607+intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
493intercalateSuffix value n =
608intercalateSuffix value n =
494− composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)
609+ composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
495
610
496o_1_space_inserting :: Int -> [Benchmark]
611o_1_space_inserting :: Int -> [Benchmark]
497o_1_space_inserting value =
612o_1_space_inserting value =
@@ -517,12 +632,12 @@ o_1_space_insertingX4 value =
517-------------------------------------------------------------------------------
632-------------------------------------------------------------------------------
518
633
519{-# INLINE indexed #-}
634{-# INLINE indexed #-}
520−indexed :: MonadIO m => Int -> SerialT m Int -> m ()
635+indexed :: MonadIO m => Int -> Stream m Int -> m ()
521−indexed n = composeN n (S.map snd . S.indexed)
636+indexed n = composeN n (fmap snd . Stream.indexed)
522
637
523{-# INLINE indexedR #-}
638{-# INLINE indexedR #-}
524−indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
639+indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()
525−indexedR value n = composeN n (S.map snd . S.indexedR value)
640+indexedR value n = composeN n (fmap snd . Stream.indexedR value)
526
641
527o_1_space_indexing :: Int -> [Benchmark]
642o_1_space_indexing :: Int -> [Benchmark]
528o_1_space_indexing value =
643o_1_space_indexing value =
@@ -561,7 +676,12 @@ benchmarks moduleName size =
561 , o_1_space_indexingX4 size
676 , o_1_space_indexingX4 size
562 ]
677 ]
563 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
678 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
679+ [
680+#ifdef USE_STREAMK
564− [ o_n_space_traversable size
681+ o_n_space_traversable size
682+ ,
683+#endif
565− , o_n_space_mapping size
684+ o_n_space_mapping size
685+ , o_n_space_iterated size
566 ]
686 ]
567 ]
687 ]
benchmark/Streamly/Benchmark/Data/Unfold.hs+89−60
@@ -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.supplySecond n UF.enumerateFromToIntegral
60+source n = UF.second n UF.enumerateFromToIntegral
58
61
59-------------------------------------------------------------------------------
62-------------------------------------------------------------------------------
60-- Benchmark helpers
63-- Benchmark helpers
@@ -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.supplySecond to UF.enumerateFromToIntegral)
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.supplySecond to UF.enumerateFromToIntegral
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) (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.enumerateFromThenIntegral)
128 (UF.take size UF.enumerateFromThenIntegral)
126− (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.enumerateFromThenIntegral)
136 (UF.take size UF.enumerateFromThenIntegral)
134− (UF.supplySecond 1)
137+ (UF.second 1)
135 start
138 start
136
139
137{-# INLINE discardFirst #-}
140{-# INLINE discardFirst #-}
@@ -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.
@@ -229,7 +232,7 @@ _fromProducer = undefined
229
232
230{-# INLINE replicateM #-}
233{-# INLINE replicateM #-}
231replicateM :: Monad m => Int -> Int -> m ()
234replicateM :: Monad m => Int -> Int -> m ()
232−replicateM size start = drainGeneration (UF.replicateM size) (return start)
235+replicateM size start = drainGeneration UF.replicateM (size, return start)
233
236
234{-# INLINE repeatM #-}
237{-# INLINE repeatM #-}
235repeatM :: Monad m => Int -> Int -> m ()
238repeatM :: Monad m => Int -> Int -> m ()
@@ -254,7 +257,7 @@ enumerateFromThenIntegral size start =
254enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
257enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
255enumerateFromToIntegral size start =
258enumerateFromToIntegral size start =
256 drainGeneration
259 drainGeneration
257− ( UF.supplySecond
260+ ( UF.second
258 (size + start)
261 (size + start)
259 UF.enumerateFromToIntegral
262 UF.enumerateFromToIntegral
260 ) start
263 ) start
@@ -278,7 +281,7 @@ enumerateFromToFractional :: Monad m => Int -> Int -> m ()
278enumerateFromToFractional size start =
281enumerateFromToFractional size start =
279 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
282 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
280 in drainGeneration
283 in drainGeneration
281− ( UF.supplySecond
284+ ( UF.second
282 (intToDouble $ start + size)
285 (intToDouble $ start + size)
283 UF.enumerateFromToFractional
286 UF.enumerateFromToFractional
284 )
287 )
@@ -288,6 +291,11 @@ enumerateFromToFractional size start =
288-- Stream transformation
291-- Stream transformation
289-------------------------------------------------------------------------------
292-------------------------------------------------------------------------------
290
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+
291{-# INLINE map #-}
299{-# INLINE map #-}
292map :: Monad m => Int -> Int -> m ()
300map :: Monad m => Int -> Int -> m ()
293map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
301map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
@@ -297,12 +305,12 @@ mapM :: Monad m => Int -> Int -> m ()
297mapM size start =
305mapM size start =
298 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
306 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
299
307
300−{-# INLINE mapMWithInput #-}
308+{-# INLINE mapM2 #-}
301−mapMWithInput :: Monad m => Int -> Int -> m ()
309+mapM2 :: Monad m => Int -> Int -> m ()
302−mapMWithInput size start =
310+mapM2 size start =
303 drainTransformationDefault
311 drainTransformationDefault
304 size
312 size
305− (UF.mapMWithInput (\a b -> return $ a + b))
313+ (UF.mapM2 (\a b -> return $ a + b))
306 start
314 start
307
315
308-------------------------------------------------------------------------------
316-------------------------------------------------------------------------------
@@ -410,13 +418,16 @@ teeZipWith size start =
410-- Applicative
418-- Applicative
411-------------------------------------------------------------------------------
419-------------------------------------------------------------------------------
412
420
421+nthRoot :: Double -> Int -> Int
422+nthRoot n value = round (fromIntegral value**(1/n))
423+
413{-# INLINE toNullAp #-}
424{-# INLINE toNullAp #-}
414toNullAp :: Monad m => Int -> Int -> m ()
425toNullAp :: Monad m => Int -> Int -> m ()
415toNullAp value start =
426toNullAp value start =
416 let end = start + nthRoot 2 value
427 let end = start + nthRoot 2 value
417 s = source end
428 s = source end
418 -- in UF.fold ((+) <$> s <*> s) FL.drain start
429 -- in UF.fold ((+) <$> s <*> s) FL.drain start
419− in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
430+ in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start
420
431
421{-# INLINE _apDiscardFst #-}
432{-# INLINE _apDiscardFst #-}
422_apDiscardFst :: Int -> Int -> m ()
433_apDiscardFst :: Int -> Int -> m ()
@@ -430,9 +441,6 @@ _apDiscardSnd = undefined
430-- Monad
441-- Monad
431-------------------------------------------------------------------------------
442-------------------------------------------------------------------------------
432
443
433−nthRoot :: Double -> Int -> Int
434−nthRoot n value = round (fromIntegral value**(1/n))
435−
436{-# INLINE concatMapM #-}
444{-# INLINE concatMapM #-}
437concatMapM :: Monad m => Int -> Int -> m ()
445concatMapM :: Monad m => Int -> Int -> m ()
438concatMapM value start =
446concatMapM value start =
@@ -441,8 +449,8 @@ concatMapM value start =
441 where
449 where
442
450
443 val = nthRoot 2 value
451 val = nthRoot 2 value
444− unfoldInGen i = return (UF.supplySecond (i + val) UF.enumerateFromToIntegral)
452+ unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
445− unfoldOut = UF.supplySecond (start + val) UF.enumerateFromToIntegral
453+ unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
446
454
447{-# INLINE toNull #-}
455{-# INLINE toNull #-}
448toNull :: Monad m => Int -> Int -> m ()
456toNull :: Monad m => Int -> Int -> m ()
@@ -593,9 +601,9 @@ concatCount :: Int -> Int
593concatCount linearCount =
601concatCount linearCount =
594 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
602 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
595
603
596−{-# INLINE concat #-}
604+{-# INLINE many #-}
597−concat :: Monad m => Int -> Int -> m ()
605+many :: Monad m => Int -> Int -> m ()
598−concat linearCount start = do
606+many linearCount start = do
599 let end = start + concatCount linearCount
607 let end = start + concatCount linearCount
600 UF.fold FL.drain (UF.many (source end) (source end)) start
608 UF.fold FL.drain (UF.many (source end) (source end)) start
601
609
@@ -612,9 +620,9 @@ o_1_space_transformation_input size =
612 "transformation/input"
620 "transformation/input"
613 [ benchIO "lmap" $ lmap size
621 [ benchIO "lmap" $ lmap size
614 , benchIO "lmapM" $ lmapM size
622 , benchIO "lmapM" $ lmapM size
615− , benchIO "supply" $ supply size
623+ , benchIO "both" $ both size
616− , benchIO "supplyFirst" $ supplyFirst size
624+ , benchIO "first" $ first size
617− , benchIO "supplySecond" $ supplySecond size
625+ , benchIO "second" $ second size
618 , benchIO "discardFirst" $ discardFirst size
626 , benchIO "discardFirst" $ discardFirst size
619 , benchIO "discardSecond" $ discardSecond size
627 , benchIO "discardSecond" $ discardSecond size
620 , benchIO "swap" $ swap size
628 , benchIO "swap" $ swap size
@@ -660,7 +668,8 @@ o_1_space_transformation size =
660 "transformation"
668 "transformation"
661 [ benchIO "map" $ map size
669 [ benchIO "map" $ map size
662 , benchIO "mapM" $ mapM size
670 , benchIO "mapM" $ mapM size
663− , benchIO "mapMWithInput" $ mapMWithInput size
671+ , benchIO "mapM2" $ mapM2 size
672+ , benchIO "postscan" $ postscan size
664 ]
673 ]
665 ]
674 ]
666
675
@@ -693,8 +702,17 @@ o_1_space_zip size =
693 ]
702 ]
694 ]
703 ]
695
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+
696−o_1_space_nested :: Int -> [Benchmark]
714+o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
697−o_1_space_nested size =
715+o_1_space_nested env size =
698 [ bgroup
716 [ bgroup
699 "nested"
717 "nested"
700 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
718 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -710,7 +728,9 @@ o_1_space_nested size =
710 , benchIO "filterAllIn" $ filterAllIn size
728 , benchIO "filterAllIn" $ filterAllIn size
711 , benchIO "filterSome" $ filterSome size
729 , benchIO "filterSome" $ filterSome size
712
730
713− , benchIO "concat" $ concat size
731+ , benchIO "many" $ many size
732+ , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
733+ $ \inh _ -> foldManySepBy inh
714 ]
734 ]
715 ]
735 ]
716
736
@@ -729,11 +749,11 @@ o_n_space_nested size =
729-- | Send the file contents to /dev/null with exception handling
749-- | Send the file contents to /dev/null with exception handling
730readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
750readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
731readWriteOnExceptionUnfold inh devNull =
751readWriteOnExceptionUnfold inh devNull =
732− let readEx = UF.onException (\_ -> hClose inh) FH.read
752+ let readEx = UF.onException (\_ -> hClose inh) FH.reader
733− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
753+ in S.fold (FH.write devNull) $ S.unfold readEx inh
734
754
735#ifdef INSPECTION
755#ifdef INSPECTION
736−inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
756+-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
737-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
757-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
738#endif
758#endif
739
759
@@ -741,45 +761,54 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
741readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
761readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
742readWriteHandleExceptionUnfold inh devNull =
762readWriteHandleExceptionUnfold inh devNull =
743 let handler (_e :: SomeException) = hClose inh >> return 10
763 let handler (_e :: SomeException) = hClose inh >> return 10
744− readEx = UF.handle (UF.functionM handler) FH.read
764+ readEx = UF.handle (UF.functionM handler) FH.reader
745− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
765+ in S.fold (FH.write devNull) $ S.unfold readEx inh
746
766
747#ifdef INSPECTION
767#ifdef INSPECTION
768+-- hasNoTypeClasses started failing in GHC 9.4.4
748−inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
769+-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
749-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
770-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
750#endif
771#endif
751
772
752-- | Send the file contents to /dev/null with exception handling
773-- | Send the file contents to /dev/null with exception handling
753readWriteFinally_Unfold :: Handle -> Handle -> IO ()
774readWriteFinally_Unfold :: Handle -> Handle -> IO ()
754readWriteFinally_Unfold inh devNull =
775readWriteFinally_Unfold inh devNull =
755− let readEx = UF.finally_ (\_ -> hClose inh) FH.read
776+ let readEx = UF.finally_ (\_ -> hClose inh) FH.reader
756− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
777+ in S.fold (FH.write devNull) $ S.unfold readEx inh
757
778
758#ifdef INSPECTION
779#ifdef INSPECTION
780+#if __GLASGOW_HASKELL__ >= 906
781+inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]
782+#else
759inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
783inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
784+#endif
760-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
785-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
761#endif
786#endif
762
787
763readWriteFinallyUnfold :: Handle -> Handle -> IO ()
788readWriteFinallyUnfold :: Handle -> Handle -> IO ()
764readWriteFinallyUnfold inh devNull =
789readWriteFinallyUnfold inh devNull =
765− let readEx = UF.finally (\_ -> hClose inh) FH.read
790+ let readEx = UF.finally (\_ -> hClose inh) FH.reader
766− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
791+ in S.fold (FH.write devNull) $ S.unfold readEx inh
767
792
768-- | Send the file contents to /dev/null with exception handling
793-- | Send the file contents to /dev/null with exception handling
769readWriteBracket_Unfold :: Handle -> Handle -> IO ()
794readWriteBracket_Unfold :: Handle -> Handle -> IO ()
770readWriteBracket_Unfold inh devNull =
795readWriteBracket_Unfold inh devNull =
771− let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
796+ let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader
772− in SP.fold (FH.write devNull) $ SP.unfold readEx inh
797+ in S.fold (FH.write devNull) $ S.unfold readEx inh
773
798
774#ifdef INSPECTION
799#ifdef INSPECTION
800+#if __GLASGOW_HASKELL__ >= 906
801+inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]
802+#else
775inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
803inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
804+#endif
776-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
805-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
777#endif
806#endif
778
807
779readWriteBracketUnfold :: Handle -> Handle -> IO ()
808readWriteBracketUnfold :: Handle -> Handle -> IO ()
780readWriteBracketUnfold inh devNull =
809readWriteBracketUnfold inh devNull =
781− let readEx = UF.bracket return (\_ -> hClose inh) FH.read
810+ let readEx = UF.bracket return (\_ -> hClose inh) FH.reader
782− in SP.fold (FH.write devNull) $ S.unfold readEx inh
811+ in S.fold (FH.write devNull) $ S.unfold readEx inh
783
812
784o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
813o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
785o_1_space_copy_read_exceptions env =
814o_1_space_copy_read_exceptions env =
@@ -819,7 +848,7 @@ main = do
819 , o_1_space_transformation size
848 , o_1_space_transformation size
820 , o_1_space_filtering size
849 , o_1_space_filtering size
821 , o_1_space_zip size
850 , o_1_space_zip size
822− , o_1_space_nested size
851+ , o_1_space_nested env size
823 , o_1_space_copy_read_exceptions env
852 , o_1_space_copy_read_exceptions env
824 ]
853 ]
825 , bgroup (o_n_space_prefix moduleName)
854 , bgroup (o_n_space_prefix moduleName)
benchmark/Streamly/Benchmark/FileSystem/Handle.hs+1−5
@@ -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
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+66−62
@@ -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,32 +26,29 @@ where
24
26
25import Data.Word (Word8)
27import Data.Word (Word8)
26import GHC.Magic (inline)
28import GHC.Magic (inline)
27−#if __GLASGOW_HASKELL__ >= 802
28import GHC.Magic (noinline)
29import GHC.Magic (noinline)
29−#else
30−#define noinline
31−#endif
32import System.IO (Handle)
30import System.IO (Handle)
33
31
32+import qualified Streamly.Data.Stream as Stream
33+import qualified Streamly.Data.Fold as Fold
34import qualified Streamly.FileSystem.Handle as FH
34import qualified Streamly.FileSystem.Handle as FH
35−import qualified Streamly.Internal.Data.Array.Foreign as A
35+import qualified Streamly.Internal.Data.Array as A
36−import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
37import qualified Streamly.Internal.Data.Fold as FL
36import qualified Streamly.Internal.Data.Fold as FL
38−import qualified Streamly.Internal.Data.Stream.IsStream as IP
37+import qualified Streamly.Internal.Data.Stream as IP
39import qualified Streamly.Internal.FileSystem.Handle as IFH
38import qualified Streamly.Internal.FileSystem.Handle as IFH
40import qualified Streamly.Internal.Unicode.Stream as IUS
39import qualified Streamly.Internal.Unicode.Stream as IUS
41−import qualified Streamly.Prelude as S
40+import qualified Streamly.Data.Stream.Prelude as S
42import qualified Streamly.Unicode.Stream as SS
41import qualified Streamly.Unicode.Stream as SS
43
42
44−import Gauge hiding (env)
43+import Test.Tasty.Bench hiding (env)
45import Prelude hiding (last, length)
44import Prelude hiding (last, length)
46import Streamly.Benchmark.Common.Handle
45import Streamly.Benchmark.Common.Handle
47
46
48#ifdef INSPECTION
47#ifdef INSPECTION
49−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)
48+import Streamly.Internal.Data.Stream (Step(..), FoldMany)
50
49
51−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
50+import qualified Streamly.Internal.Data.MutArray as MutArray
52−import qualified Streamly.Internal.Data.Stream.StreamD as D
51+import qualified Streamly.Internal.Data.Stream as D
53import qualified Streamly.Internal.Data.Unfold as IUF
52import qualified Streamly.Internal.Data.Unfold as IUF
54
53
55import Test.Inspection
54import Test.Inspection
@@ -63,49 +62,49 @@ import Test.Inspection
63
62
64-- | Get the last byte from a file bytestream.
63-- | Get the last byte from a file bytestream.
65readLast :: Handle -> IO (Maybe Word8)
64readLast :: Handle -> IO (Maybe Word8)
66−readLast = S.last . S.unfold FH.read
65+readLast = S.fold Fold.last . S.unfold FH.reader
67
66
68#ifdef INSPECTION
67#ifdef INSPECTION
69inspect $ hasNoTypeClasses 'readLast
68inspect $ hasNoTypeClasses 'readLast
70inspect $ 'readLast `hasNoType` ''Step -- S.unfold
69inspect $ 'readLast `hasNoType` ''Step -- S.unfold
71inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
70inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
72−inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
71+inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
73#endif
72#endif
74
73
75-- assert that flattenArrays constructors are not present
74-- assert that flattenArrays constructors are not present
76-- | Count the number of bytes in a file.
75-- | Count the number of bytes in a file.
77readCountBytes :: Handle -> IO Int
76readCountBytes :: Handle -> IO Int
78−readCountBytes = S.length . S.unfold FH.read
77+readCountBytes = S.fold Fold.length . S.unfold FH.reader
79
78
80#ifdef INSPECTION
79#ifdef INSPECTION
81inspect $ hasNoTypeClasses 'readCountBytes
80inspect $ hasNoTypeClasses 'readCountBytes
82inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
81inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
83inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
82inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
84−inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
83+inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
85#endif
84#endif
86
85
87-- | Count the number of lines in a file.
86-- | Count the number of lines in a file.
88readCountLines :: Handle -> IO Int
87readCountLines :: Handle -> IO Int
89readCountLines =
88readCountLines =
90− S.length
89+ S.fold Fold.length
91 . IUS.lines FL.drain
90 . IUS.lines FL.drain
92 . SS.decodeLatin1
91 . SS.decodeLatin1
93− . S.unfold FH.read
92+ . S.unfold FH.reader
94
93
95#ifdef INSPECTION
94#ifdef INSPECTION
96inspect $ hasNoTypeClasses 'readCountLines
95inspect $ hasNoTypeClasses 'readCountLines
97inspect $ 'readCountLines `hasNoType` ''Step
96inspect $ 'readCountLines `hasNoType` ''Step
98inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
97inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
99−inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
98+inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
100#endif
99#endif
101
100
102-- | Count the number of words in a file.
101-- | Count the number of words in a file.
103readCountWords :: Handle -> IO Int
102readCountWords :: Handle -> IO Int
104readCountWords =
103readCountWords =
105− S.length
104+ S.fold Fold.length
106 . IUS.words FL.drain
105 . IUS.words FL.drain
107 . SS.decodeLatin1
106 . SS.decodeLatin1
108− . S.unfold FH.read
107+ . S.unfold FH.reader
109
108
110#ifdef INSPECTION
109#ifdef INSPECTION
111inspect $ hasNoTypeClasses 'readCountWords
110inspect $ hasNoTypeClasses 'readCountWords
@@ -114,13 +113,13 @@ inspect $ hasNoTypeClasses 'readCountWords
114
113
115-- | Sum the bytes in a file.
114-- | Sum the bytes in a file.
116readSumBytes :: Handle -> IO Word8
115readSumBytes :: Handle -> IO Word8
117−readSumBytes = S.sum . S.unfold FH.read
116+readSumBytes = S.fold Fold.sum . S.unfold FH.reader
118
117
119#ifdef INSPECTION
118#ifdef INSPECTION
120inspect $ hasNoTypeClasses 'readSumBytes
119inspect $ hasNoTypeClasses 'readSumBytes
121inspect $ 'readSumBytes `hasNoType` ''Step
120inspect $ 'readSumBytes `hasNoType` ''Step
122inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
121inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
123−inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
122+inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
124#endif
123#endif
125
124
126-- 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
@@ -134,21 +133,21 @@ inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
134-- fusion-plugin to propagate INLINE phase information such that this problem
133-- fusion-plugin to propagate INLINE phase information such that this problem
135-- does not occur.
134-- does not occur.
136readDrain :: Handle -> IO ()
135readDrain :: Handle -> IO ()
137−readDrain inh = S.drain $ S.unfold FH.read inh
136+readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh
138
137
139-- XXX investigate why we need an INLINE in this case (GHC)
138-- XXX investigate why we need an INLINE in this case (GHC)
140{-# INLINE readDecodeLatin1 #-}
139{-# INLINE readDecodeLatin1 #-}
141readDecodeLatin1 :: Handle -> IO ()
140readDecodeLatin1 :: Handle -> IO ()
142readDecodeLatin1 inh =
141readDecodeLatin1 inh =
143− S.drain
142+ S.fold Fold.drain
144 $ SS.decodeLatin1
143 $ SS.decodeLatin1
145− $ S.unfold FH.read inh
144+ $ S.unfold FH.reader inh
146
145
147readDecodeUtf8 :: Handle -> IO ()
146readDecodeUtf8 :: Handle -> IO ()
148readDecodeUtf8 inh =
147readDecodeUtf8 inh =
149− S.drain
148+ S.fold Fold.drain
150 $ SS.decodeUtf8
149 $ SS.decodeUtf8
151− $ S.unfold FH.read inh
150+ $ S.unfold FH.reader inh
152
151
153#ifdef INSPECTION
152#ifdef INSPECTION
154inspect $ hasNoTypeClasses 'readDecodeUtf8
153inspect $ hasNoTypeClasses 'readDecodeUtf8
@@ -187,25 +186,25 @@ o_1_space_reduce_read env =
187-------------------------------------------------------------------------------
186-------------------------------------------------------------------------------
188
187
189-- | Count the number of lines in a file.
188-- | Count the number of lines in a file.
190−toChunksConcatUnfoldCountLines :: Handle -> IO Int
189+getChunksConcatUnfoldCountLines :: Handle -> IO Int
191−toChunksConcatUnfoldCountLines inh =
190+getChunksConcatUnfoldCountLines inh =
192− S.length
191+ S.fold Fold.length
193 $ IUS.lines FL.drain
192 $ IUS.lines FL.drain
194 $ SS.decodeLatin1
193 $ SS.decodeLatin1
195 -- XXX replace with toBytes
194 -- XXX replace with toBytes
196− $ S.unfoldMany A.read (IFH.toChunks inh)
195+ $ S.unfoldMany A.reader (IFH.readChunks inh)
197
196
198#ifdef INSPECTION
197#ifdef INSPECTION
199−inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
198+inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines
200−inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
199+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step
201−inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
200+inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
202#endif
201#endif
203
202
204o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
203o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
205o_1_space_reduce_toBytes env =
204o_1_space_reduce_toBytes env =
206 [ bgroup "reduce/toBytes"
205 [ bgroup "reduce/toBytes"
207 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
206 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
208− toChunksConcatUnfoldCountLines inh
207+ getChunksConcatUnfoldCountLines inh
209 ]
208 ]
210 ]
209 ]
211
210
@@ -214,46 +213,51 @@ o_1_space_reduce_toBytes env =
214-------------------------------------------------------------------------------
213-------------------------------------------------------------------------------
215
214
216chunksOfSum :: Int -> Handle -> IO Int
215chunksOfSum :: Int -> Handle -> IO Int
216+chunksOfSum n inh =
217−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)
218
218
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
220foldManyPostChunksOfSum n inh =
220foldManyPostChunksOfSum n inh =
221+ S.fold Fold.length
221− 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)
222
223
223foldManyChunksOfSum :: Int -> Handle -> IO Int
224foldManyChunksOfSum :: Int -> Handle -> IO Int
224foldManyChunksOfSum n inh =
225foldManyChunksOfSum n inh =
226+ S.fold Fold.length
225− 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)
226
228
227-- XXX investigate why we need an INLINE in this case (GHC)
229-- XXX investigate why we need an INLINE in this case (GHC)
228-- 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
229-- by 4x.
231-- by 4x.
230-- | 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.
231−{-# INLINE chunksOf #-}
233+{-# INLINE groupsOf #-}
232−chunksOf :: Int -> Handle -> IO Int
234+groupsOf :: Int -> Handle -> IO Int
233−chunksOf n inh =
235+groupsOf n inh =
234 -- writeNUnsafe gives 2.5x boost here over writeN.
236 -- writeNUnsafe gives 2.5x boost here over writeN.
237+ S.fold Fold.length
235− 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)
236
239
237#ifdef INSPECTION
240#ifdef INSPECTION
238−inspect $ hasNoTypeClasses 'chunksOf
241+inspect $ hasNoTypeClasses 'groupsOf
239−inspect $ 'chunksOf `hasNoType` ''Step
242+inspect $ 'groupsOf `hasNoType` ''Step
240−inspect $ 'chunksOf `hasNoType` ''FoldMany
243+inspect $ 'groupsOf `hasNoType` ''FoldMany
241−inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
244+inspect $ 'groupsOf `hasNoType` ''MutArray.ArrayUnsafe -- AT.writeNUnsafe
245+ -- FH.read/A.read
242−inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
246+inspect $ 'groupsOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
243−inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
244#endif
247#endif
245
248
246−{-# INLINE arraysOf #-}
249+{-# INLINE chunksOf #-}
247−arraysOf :: Int -> Handle -> IO Int
250+chunksOf :: Int -> Handle -> IO Int
251+chunksOf n inh =
248−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)
249
253
250o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
254o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
251o_1_space_reduce_read_grouped env =
255o_1_space_reduce_read_grouped env =
252 [ bgroup "reduce/read/chunks"
256 [ bgroup "reduce/read/chunks"
253− [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
257+ [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $
254 \inh _ ->
258 \inh _ ->
255 chunksOfSum (bigSize env) inh
259 chunksOfSum (bigSize env) inh
256− , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
260+ , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->
257 chunksOfSum 1 inh
261 chunksOfSum 1 inh
258
262
259 -- XXX investigate why we need inline/noinline in these cases (GHC)
263 -- XXX investigate why we need inline/noinline in these cases (GHC)
@@ -276,20 +280,20 @@ o_1_space_reduce_read_grouped env =
276 $ \inh _ -> inline foldManyChunksOfSum 1 inh
280 $ \inh _ -> inline foldManyChunksOfSum 1 inh
277
281
278 -- 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
279 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
291 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
280 chunksOf 1 inh
292 chunksOf 1 inh
281 , mkBench "S.chunksOf 10" env $ \inh _ ->
293 , mkBench "S.chunksOf 10" env $ \inh _ ->
282 chunksOf 10 inh
294 chunksOf 10 inh
283 , mkBench "S.chunksOf 1000" env $ \inh _ ->
295 , mkBench "S.chunksOf 1000" env $ \inh _ ->
284 chunksOf 1000 inh
296 chunksOf 1000 inh
285−
286− -- arraysOf may use a different impl than chunksOf
287− , mkBenchSmall "S.arraysOf 1" env $ \inh _ ->
288− arraysOf 1 inh
289− , mkBench "S.arraysOf 10" env $ \inh _ ->
290− arraysOf 10 inh
291− , mkBench "S.arraysOf 1000" env $ \inh _ ->
292− arraysOf 1000 inh
293 ]
297 ]
294 ]
298 ]
295
299
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+45−48
@@ -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
@@ -29,20 +31,18 @@ import Streamly.Internal.System.IO (defaultChunkSize)
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.Data.Array.Foreign as A
34+import qualified Streamly.Data.Array as A
33−import qualified Streamly.Prelude as S
35+import qualified Streamly.Data.Stream.Prelude as S
34
36
35−import Gauge hiding (env)
37+import Test.Tasty.Bench hiding (env)
36import Streamly.Benchmark.Common.Handle
38import Streamly.Benchmark.Common.Handle
37
39
38#ifdef INSPECTION
40#ifdef INSPECTION
39−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
41+import Streamly.Internal.Data.Stream (Step(..))
40
42
41−import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
43+import qualified Streamly.Internal.Data.Stream as D
42import qualified Streamly.Internal.Data.Tuple.Strict as Strict
44import qualified Streamly.Internal.Data.Tuple.Strict as Strict
43−import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS
45+import qualified Streamly.Internal.Data.MutArray as MutArray
44−import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
45−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
46
46
47import Test.Inspection
47import Test.Inspection
48#endif
48#endif
@@ -53,7 +53,7 @@ import Test.Inspection
53
53
54-- | Copy file
54-- | Copy file
55copyChunks :: Handle -> Handle -> IO ()
55copyChunks :: Handle -> Handle -> IO ()
56−copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks inh
56+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.readChunks inh
57
57
58#ifdef INSPECTION
58#ifdef INSPECTION
59inspect $ hasNoTypeClasses 'copyChunks
59inspect $ hasNoTypeClasses 'copyChunks
@@ -62,7 +62,7 @@ inspect $ 'copyChunks `hasNoType` ''Step
62
62
63o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
63o_1_space_copy_chunked :: BenchEnv -> [Benchmark]
64o_1_space_copy_chunked env =
64o_1_space_copy_chunked env =
65− [ bgroup "copy/toChunks"
65+ [ bgroup "copy/getChunks"
66 [ mkBench "toNull" env $ \inH _ ->
66 [ mkBench "toNull" env $ \inH _ ->
67 copyChunks inH (nullH env)
67 copyChunks inH (nullH env)
68 , mkBench "raw" env $ \inH outH ->
68 , mkBench "raw" env $ \inH outH ->
@@ -76,14 +76,14 @@ o_1_space_copy_chunked env =
76
76
77-- | Copy file
77-- | Copy file
78copyStream :: Handle -> Handle -> IO ()
78copyStream :: Handle -> Handle -> IO ()
79−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)
80
80
81#ifdef INSPECTION
81#ifdef INSPECTION
82inspect $ hasNoTypeClasses 'copyStream
82inspect $ hasNoTypeClasses 'copyStream
83inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
83inspect $ 'copyStream `hasNoType` ''Step -- S.unfold
84inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
84inspect $ 'copyStream `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'copyStream `hasNoType` ''MA.ReadUState -- FH.read/A.read
86−inspect $ 'copyStream `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
85+inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
86+ -- FH.read/A.read
87inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
87inspect $ 'copyStream `hasNoType` ''Strict.Tuple3' -- FH.write/chunksOf
88#endif
88#endif
89
89
@@ -103,28 +103,28 @@ o_1_space_copy_read env =
103
103
104-- | Send the file contents to /dev/null
104-- | Send the file contents to /dev/null
105readFromBytesNull :: Handle -> Handle -> IO ()
105readFromBytesNull :: Handle -> Handle -> IO ()
106−readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.read inh
106+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.reader inh
107
107
108#ifdef INSPECTION
108#ifdef INSPECTION
109inspect $ hasNoTypeClasses 'readFromBytesNull
109inspect $ hasNoTypeClasses 'readFromBytesNull
110inspect $ 'readFromBytesNull `hasNoType` ''Step
110inspect $ 'readFromBytesNull `hasNoType` ''Step
111−inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState
111+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.SpliceState
112−inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
112+inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
113inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
113inspect $ 'readFromBytesNull `hasNoType` ''D.FoldMany
114#endif
114#endif
115
115
116-- | Send the file contents ('defaultChunkSize') to /dev/null
116-- | Send the file contents ('defaultChunkSize') to /dev/null
117−readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
117+readWithFromBytesNull :: Handle -> Handle -> IO ()
118−readWithBufferOfFromBytesNull inh devNull =
118+readWithFromBytesNull inh devNull =
119 IFH.putBytes devNull
119 IFH.putBytes devNull
120− $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
120+ $ S.unfold FH.readerWith (defaultChunkSize, inh)
121
121
122#ifdef INSPECTION
122#ifdef INSPECTION
123−inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
123+inspect $ hasNoTypeClasses 'readWithFromBytesNull
124−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
124+inspect $ 'readWithFromBytesNull `hasNoType` ''Step
125−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState
125+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.SpliceState
126−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
126+inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
127−inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''D.FoldMany
127+inspect $ 'readWithFromBytesNull `hasNoType` ''D.FoldMany
128#endif
128#endif
129
129
130-- | Send the chunk content ('defaultChunkSize') to /dev/null
130-- | Send the chunk content ('defaultChunkSize') to /dev/null
@@ -135,63 +135,60 @@ _readChunks inh devNull = IUF.fold fld unf inh
135 where
135 where
136
136
137 fld = FH.write devNull
137 fld = FH.write devNull
138− unf = IUF.many FH.readChunks A.read
138+ unf = IUF.many A.reader FH.chunkReader
139
139
140-- | Send the chunk content to /dev/null
140-- | Send the chunk content to /dev/null
141−-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
141+-- Implicitly benchmarked via 'readWithFromBytesNull'
142−_readChunksWithBufferOf :: Handle -> Handle -> IO ()
142+_readChunksWith :: Handle -> Handle -> IO ()
143−_readChunksWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
143+_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
144
144
145 where
145 where
146
146
147 fld = FH.write devNull
147 fld = FH.write devNull
148− unf = IUF.many FH.readChunksWithBufferOf A.read
148+ unf = IUF.many A.reader FH.chunkReaderWith
149−
150
149
151o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
150o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
152o_1_space_copy_fromBytes env =
151o_1_space_copy_fromBytes env =
153 [ bgroup "copy/putBytes"
152 [ bgroup "copy/putBytes"
154 [ mkBench "rawToNull" env $ \inh _ ->
153 [ mkBench "rawToNull" env $ \inh _ ->
155 readFromBytesNull inh (nullH env)
154 readFromBytesNull inh (nullH env)
156− , mkBench "FH.readWithBufferOf" env $ \inh _ ->
155+ , mkBench "FH.readWith" env $ \inh _ ->
157− readWithBufferOfFromBytesNull inh (nullH env)
156+ readWithFromBytesNull inh (nullH env)
158 ]
157 ]
159 ]
158 ]
160
159
161-- | Send the file contents ('defaultChunkSize') to /dev/null
160-- | Send the file contents ('defaultChunkSize') to /dev/null
162−{-# NOINLINE writeReadWithBufferOf #-}
163−writeReadWithBufferOf :: Handle -> Handle -> IO ()
161+writeReadWith :: Handle -> Handle -> IO ()
164−writeReadWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
162+writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
165
163
166 where
164 where
167
165
168− fld = FH.writeWithBufferOf defaultChunkSize devNull
166+ fld = FH.writeWith defaultChunkSize devNull
169− unf = FH.readWithBufferOf
167+ unf = FH.readerWith
170
168
171#ifdef INSPECTION
169#ifdef INSPECTION
172−inspect $ hasNoTypeClasses 'writeReadWithBufferOf
170+inspect $ hasNoTypeClasses 'writeReadWith
173−inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
171+inspect $ 'writeReadWith `hasNoType` ''Step
174−inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
172+inspect $ 'writeReadWith `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
175−inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
176−inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
173+inspect $ 'writeReadWith `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
174+ -- FH.read/A.read
177#endif
175#endif
178
176
179-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
177-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
180−{-# NOINLINE writeRead #-}
181writeRead :: Handle -> Handle -> IO ()
178writeRead :: Handle -> Handle -> IO ()
182writeRead inh devNull = IUF.fold fld unf inh
179writeRead inh devNull = IUF.fold fld unf inh
183
180
184 where
181 where
185
182
186 fld = FH.write devNull
183 fld = FH.write devNull
187− unf = FH.read
184+ unf = FH.reader
188
185
189#ifdef INSPECTION
186#ifdef INSPECTION
190inspect $ hasNoTypeClasses 'writeRead
187inspect $ hasNoTypeClasses 'writeRead
191inspect $ 'writeRead `hasNoType` ''Step
188inspect $ 'writeRead `hasNoType` ''Step
192inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
189inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
193−inspect $ 'writeRead `hasNoType` ''MA.ReadUState -- FH.read/A.read
194−inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
190+inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
191+ -- FH.read/A.read
195#endif
192#endif
196
193
197o_1_space_copy :: BenchEnv -> [Benchmark]
194o_1_space_copy :: BenchEnv -> [Benchmark]
@@ -199,8 +196,8 @@ o_1_space_copy env =
199 [ bgroup "copy"
196 [ bgroup "copy"
200 [ mkBench "FH.write . FH.read" env $ \inh _ ->
197 [ mkBench "FH.write . FH.read" env $ \inh _ ->
201 writeRead inh (nullH env)
198 writeRead inh (nullH env)
202− , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
199+ , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->
203− writeReadWithBufferOf inh (nullH env)
200+ writeReadWith inh (nullH env)
204 ]
201 ]
205 ]
202 ]
206
203
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+11−6
@@ -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
@@ -34,11 +36,14 @@ source range = S.replicateM value $ do
34
36
35{-# INLINE run #-}
37{-# INLINE run #-}
36run :: 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 ()
37−run srange crange t = S.drain $ do
39+run srange crange t = S.drain $ S.mapM action (t $ source srange)
38− n <- t $ source srange
40+
41+ where
42+
43+ action x = liftIO $ do
39− d <- liftIO (randomRIO crange)
44+ d <- randomRIO crange
40− when (d /= 0) $ liftIO $ threadDelay d
45+ when (d /= 0) $ threadDelay d
41− return n
46+ return x
42
47
43low, medium, high :: Int
48low, medium, high :: Int
44low = 10
49low = 10
benchmark/Streamly/Benchmark/Prelude/Ahead.hs+3−1
@@ -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
@@ -13,7 +15,7 @@ import qualified Streamly.Prelude as S
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"
benchmark/Streamly/Benchmark/Prelude/Async.hs+5−3
@@ -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
@@ -14,7 +16,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform
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"
@@ -122,9 +124,9 @@ o_1_space_concatFoldable value =
122 (sourceFoldMapWithStream value)
124 (sourceFoldMapWithStream value)
123 , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
125 , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
124 (sourceFoldMapWithM value)
126 (sourceFoldMapWithM value)
125− , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
127+ , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"
126 (concatFoldableWith value)
128 (concatFoldableWith value)
127− , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
129+ , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"
128 (concatForFoldableWith value)
130 (concatForFoldableWith value)
129 , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
131 , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
130 ]
132 ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE CPP #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE RankNTypes #-}
3-- |
4-- |
@@ -14,7 +15,7 @@ import Streamly.Prelude
14 , fromWAsync, parallel, fromParallel
15 , fromWAsync, parallel, fromParallel
15 )
16 )
16
17
17−import Gauge
18+import Test.Tasty.Bench
18import qualified Streamly.Prelude as S
19import qualified Streamly.Prelude as S
19
20
20-------------------------------------------------------------------------------
21-------------------------------------------------------------------------------
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+3−1
@@ -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
@@ -20,7 +22,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20import Streamly.Benchmark.Common
22import Streamly.Benchmark.Common
21import Streamly.Benchmark.Prelude
23import Streamly.Benchmark.Prelude
22
24
23−import Gauge
25+import Test.Tasty.Bench
24
26
25moduleName :: String
27moduleName :: String
26moduleName = "Prelude.Parallel"
28moduleName = "Prelude.Parallel"
benchmark/Streamly/Benchmark/Prelude/Rate.hs+2−1
@@ -1,3 +1,4 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
2
3
3-- |
4-- |
@@ -13,7 +14,7 @@ import qualified Streamly.Prelude as S
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"
benchmark/Streamly/Benchmark/Prelude/Serial.hsdeleted−53
@@ -1,53 +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 Streamly.Benchmark.Common
26−
27−moduleName :: String
28−moduleName = "Prelude.Serial"
29−
30−-------------------------------------------------------------------------------
31−-- Main
32−-------------------------------------------------------------------------------
33−
34−-- In addition to gauge options, the number of elements in the stream can be
35−-- passed using the --stream-size option.
36−--
37−main :: IO ()
38−main = do
39− env <- mkHandleBenchEnv
40− runWithCLIOpts defaultStreamSize (allBenchmarks env)
41−
42− where
43−
44− allBenchmarks env size = Prelude.concat
45− [ Generation.benchmarks moduleName size
46− , Elimination.benchmarks moduleName size
47− , Exceptions.benchmarks moduleName env size
48− , Split.benchmarks moduleName env
49− , Transformation1.benchmarks moduleName size
50− , Transformation2.benchmarks moduleName size
51− , Transformation3.benchmarks moduleName size
52− , Nested.benchmarks moduleName size
53− ]
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, fromSerial, MonadAsync)
23−import Streamly.Benchmark.Common
24−import Streamly.Benchmark.Prelude
25−import Prelude hiding (repeat, replicate, iterate)
26−
27−-------------------------------------------------------------------------------
28−-- Generation
29−-------------------------------------------------------------------------------
30−
31−-------------------------------------------------------------------------------
32−-- fromList
33−-------------------------------------------------------------------------------
34−
35−{-# INLINE sourceIsList #-}
36−sourceIsList :: Int -> Int -> SerialT Identity Int
37−sourceIsList value n = GHC.fromList [n..n+value]
38−
39−{-# INLINE sourceIsString #-}
40−sourceIsString :: Int -> Int -> SerialT Identity Char
41−sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
42−
43−{-# INLINE readInstance #-}
44−readInstance :: String -> SerialT Identity Int
45−readInstance str =
46− let r = reads str
47− in case r of
48− [(x,"")] -> x
49− _ -> error "readInstance: no parse"
50−
51−-- For comparisons
52−{-# INLINE readInstanceList #-}
53−readInstanceList :: String -> [Int]
54−readInstanceList str =
55− let r = reads str
56− in case r of
57− [(x,"")] -> x
58− _ -> error "readInstance: no parse"
59−
60−{-# INLINE repeat #-}
61−repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
62−repeat count = S.take count . S.repeat
63−
64−{-# INLINE repeatM #-}
65−repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
66−repeatM count = S.take count . S.repeatM . return
67−
68−{-# INLINE replicate #-}
69−replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
70−replicate = S.replicate
71−
72−{-# INLINE replicateM #-}
73−replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
74−replicateM count = S.replicateM count . return
75−
76−{-# INLINE enumerateFrom #-}
77−enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
78−enumerateFrom count = S.take count . S.enumerateFrom
79−
80−{-# INLINE enumerateFromTo #-}
81−enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
82−enumerateFromTo = sourceIntFromTo
83−
84−{-# INLINE enumerateFromThen #-}
85−enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
86−enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)
87−
88−{-# INLINE enumerateFromThenTo #-}
89−enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
90−enumerateFromThenTo = sourceIntFromThenTo
91−
92−-- n ~ 1
93−{-# INLINE enumerate #-}
94−enumerate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
95−enumerate count n = S.take (count + n) S.enumerate
96−
97−-- n ~ 1
98−{-# INLINE enumerateTo #-}
99−enumerateTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
100−enumerateTo count n = S.enumerateTo (minBound + count + n)
101−
102−{-# INLINE iterate #-}
103−iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
104−iterate count = S.take count . S.iterate (+1)
105−
106−{-# INLINE iterateM #-}
107−iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
108−iterateM count = S.take count . S.iterateM (return . (+1)) . return
109−
110−{-# INLINE fromIndices #-}
111−fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
112−fromIndices value n = S.take value $ S.fromIndices (+ n)
113−
114−{-# INLINE fromIndicesM #-}
115−fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
116−fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
117−
118−o_1_space_generation :: Int -> [Benchmark]
119−o_1_space_generation value =
120− [ bgroup "generation"
121− [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
122− , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
123− , benchIOSrc fromSerial "repeat" (repeat value)
124− , benchIOSrc fromSerial "repeatM" (repeatM value)
125− , benchIOSrc fromSerial "replicate" (replicate value)
126− , benchIOSrc fromSerial "replicateM" (replicateM value)
127− , benchIOSrc fromSerial "iterate" (iterate value)
128− , benchIOSrc fromSerial "iterateM" (iterateM value)
129− , benchIOSrc fromSerial "fromIndices" (fromIndices value)
130− , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)
131− , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)
132− , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)
133− , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)
134− , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)
135− , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)
136− , benchIOSrc fromSerial "fromList" (sourceFromList value)
137− , benchPureSrc "IsList.fromList" (sourceIsList value)
138− , benchPureSrc "IsString.fromString" (sourceIsString value)
139− , benchIOSrc fromSerial "fromListM" (sourceFromListM value)
140− , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)
141− , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)
142− , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)
143− , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)
144− , benchIOSrc fromSerial "enumerate" (enumerate value)
145− , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)
146−
147− -- These essentially test cons and consM
148− , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
149− , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
150−
151− , benchIOSrc fromSerial "absTimes" $ absTimes value
152− ]
153− ]
154−
155−o_n_heap_generation :: Int -> [Benchmark]
156−o_n_heap_generation value =
157− [ bgroup "buffered"
158− -- Buffers the output of show/read.
159− -- XXX can the outputs be streaming? Can we have special read/show
160− -- style type classes, readM/showM supporting streaming effects?
161− [ bench "readsPrec pure streams" $
162− nf readInstance (mkString value)
163− , bench "readsPrec Haskell lists" $
164− nf readInstanceList (mkListString value)
165− ]
166− ]
167−
168−-------------------------------------------------------------------------------
169−-- Main
170−-------------------------------------------------------------------------------
171−
172−-- In addition to gauge options, the number of elements in the stream can be
173−-- passed using the --stream-size option.
174−--
175−benchmarks :: String -> Int -> [Benchmark]
176−benchmarks moduleName size =
177− [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
178− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
179− ]
benchmark/Streamly/Benchmark/Prelude/Serial/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, fromSerial)
30−import Streamly.Benchmark.Common
31−import Streamly.Benchmark.Prelude
32−import Prelude hiding (reverse, tail)
33−
34−-------------------------------------------------------------------------------
35−-- Iteration/looping utilities
36−-------------------------------------------------------------------------------
37−
38−{-# INLINE iterateN #-}
39−iterateN :: (Int -> a -> a) -> a -> Int -> a
40−iterateN g initial count = f count initial
41−
42− where
43−
44− f (0 :: Int) x = x
45− f i x = f (i - 1) (g i x)
46−
47−-- Iterate a transformation over a singleton stream
48−{-# INLINE iterateSingleton #-}
49−iterateSingleton :: S.MonadAsync m
50− => (Int -> SerialT m Int -> SerialT m Int)
51− -> Int
52− -> Int
53− -> SerialT m Int
54−iterateSingleton g count n = iterateN g (return n) count
55−
56−-- XXX need to check why this is slower than the explicit recursion above, even
57−-- if the above code is written in a foldr like head recursive way. We also
58−-- need to try this with foldlM' once #150 is fixed.
59−-- However, it is perhaps best to keep the iteration benchmarks independent of
60−-- foldrM and any related fusion issues.
61−{-# INLINE _iterateSingleton #-}
62−_iterateSingleton ::
63− S.MonadAsync m
64− => (Int -> SerialT m Int -> SerialT m Int)
65− -> Int
66− -> Int
67− -> SerialT m Int
68−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
69−
70−-- Apply transformation g count times on a stream of length len
71−{-# INLINE iterateSource #-}
72−iterateSource ::
73− S.MonadAsync m
74− => (SerialT m Int -> SerialT m Int)
75− -> Int
76− -> Int
77− -> Int
78− -> SerialT m Int
79−iterateSource g count len n = f count (sourceUnfoldrM len n)
80−
81− where
82−
83− f (0 :: Int) stream = stream
84− f i stream = f (i - 1) (g stream)
85−
86−-------------------------------------------------------------------------------
87−-- Functor
88−-------------------------------------------------------------------------------
89−
90−o_n_space_functor :: Int -> [Benchmark]
91−o_n_space_functor value =
92− [ bgroup "Functor"
93− [ benchIO "(+) (n times) (baseline)" $ \i0 ->
94− iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
95− , benchIOSrc fromSerial "(<$) (n times)" $
96− iterateSingleton (<$) value
97− , benchIOSrc fromSerial "fmap (n times)" $
98− iterateSingleton (fmap . (+)) value
99− {-
100− , benchIOSrc fromSerial "_(<$) (n times)" $
101− _iterateSingleton (<$) value
102− , benchIOSrc fromSerial "_fmap (n times)" $
103− _iterateSingleton (fmap . (+)) value
104− -}
105− ]
106− ]
107−
108−-------------------------------------------------------------------------------
109−-- Grouping transformations
110−-------------------------------------------------------------------------------
111−
112−{-# INLINE groups #-}
113−groups :: MonadIO m => SerialT m Int -> m ()
114−groups = S.drain . S.groups FL.drain
115−
116−-- XXX Change this test when the order of comparison is later changed
117−{-# INLINE groupsByGT #-}
118−groupsByGT :: MonadIO m => SerialT m Int -> m ()
119−groupsByGT = S.drain . S.groupsBy (>) FL.drain
120−
121−{-# INLINE groupsByEq #-}
122−groupsByEq :: MonadIO m => SerialT m Int -> m ()
123−groupsByEq = S.drain . S.groupsBy (==) FL.drain
124−
125−-- XXX Change this test when the order of comparison is later changed
126−{-# INLINE groupsByRollingLT #-}
127−groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
128−groupsByRollingLT =
129− S.drain . S.groupsByRolling (<) FL.drain
130−
131−{-# INLINE groupsByRollingEq #-}
132−groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
133−groupsByRollingEq =
134− S.drain . S.groupsByRolling (==) FL.drain
135−
136−{-# INLINE foldMany #-}
137−foldMany :: Monad m => SerialT m Int -> m ()
138−foldMany =
139− S.drain
140− . S.map getSum
141− . Internal.foldMany (FL.take 2 FL.mconcat)
142− . S.map Sum
143−
144−{-# INLINE 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 fromSerial)
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 fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10
373− , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $
374− iterateScan by100 100
375− , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
376− , benchIOSrc fromSerial "filterEven (n/10 x 10)" $
377− iterateFilterEven by10 10
378− , benchIOSrc fromSerial "takeAll (n/10 x 10)" $
379− iterateTakeAll value by10 10
380− , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10
381− , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $
382− iterateDropWhileFalse value by10 10
383− , benchIOSrc fromSerial "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 fromSerial 1)
403− , benchIOSink value "compose" (transformComposeMapM fromSerial 1)
404− , benchIOSink value "tee" (transformTeeMapM fromSerial 1)
405−#ifdef DEVBUILD
406− -- XXX this take 1 GB memory to compile
407− , benchIOSink value "zip" (transformZipMapM fromSerial 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 fromSerial 4)
416− , benchIOSink value "compose" (transformComposeMapM fromSerial 4)
417− , benchIOSink value "tee" (transformTeeMapM fromSerial 4)
418−#ifdef DEVBUILD
419− -- XXX this take 1 GB memory to compile
420− , benchIOSink value "zip" (transformZipMapM fromSerial 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−123
@@ -1,123 +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, fromSerial)
23−import Streamly.Benchmark.Common
24−import Streamly.Benchmark.Prelude
25−import Prelude hiding (reverse, tail)
26−
27−-------------------------------------------------------------------------------
28−-- Monad transformation (hoisting etc.)
29−-------------------------------------------------------------------------------
30−
31−{-# INLINE sourceUnfoldrState #-}
32−sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
33− => Int -> Int -> t (StateT Int m) Int
34−sourceUnfoldrState value n = S.unfoldrM step n
35− where
36− step cnt =
37− if cnt > n + value
38− then return Nothing
39− else do
40− s <- get
41− put (s + 1)
42− return (Just (s, cnt + 1))
43−
44−{-# INLINE evalStateT #-}
45−evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
46−evalStateT value n =
47− Internal.evalStateT (return 0) (sourceUnfoldrState value n)
48−
49−{-# INLINE withState #-}
50−withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
51−withState value n =
52− Internal.evalStateT
53− (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
54−
55−o_1_space_hoisting :: Int -> [Benchmark]
56−o_1_space_hoisting value =
57− [ bgroup "hoisting"
58− [ benchIOSrc fromSerial "evalState" (evalStateT value)
59− , benchIOSrc fromSerial "withState" (withState value)
60− ]
61− ]
62−
63−{-# INLINE iterateStateIO #-}
64−iterateStateIO ::
65− (S.MonadAsync m)
66− => Int
67− -> StateT Int m Int
68−iterateStateIO n = do
69− x <- get
70− if x > n
71− then do
72− put (x - 1)
73− iterateStateIO n
74− else return x
75−
76−{-# INLINE iterateStateT #-}
77−iterateStateT :: Int -> SerialT (StateT Int IO) Int
78−iterateStateT n = do
79− x <- lift get
80− if x > n
81− then do
82− lift $ put (x - 1)
83− iterateStateT n
84− else return x
85−
86−{-# INLINE iterateState #-}
87−{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
88−iterateState ::
89− (S.MonadAsync m, MonadState Int m)
90− => Int
91− -> SerialT m Int
92−iterateState n = do
93− x <- get
94− if x > n
95− then do
96− put (x - 1)
97− iterateState n
98− else return x
99−
100−o_n_heap_transformer :: Int -> [Benchmark]
101−o_n_heap_transformer value =
102− [ bgroup "transformer"
103− [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
104− State.evalStateT (iterateStateIO n) value
105− , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
106− State.evalStateT (S.drain (iterateStateT n)) value
107− , benchIO "MonadState Int m => SerialT m Int" $ \n ->
108− State.evalStateT (S.drain (iterateState n)) value
109− ]
110− ]
111−
112−-------------------------------------------------------------------------------
113−-- Main
114−-------------------------------------------------------------------------------
115−
116−-- In addition to gauge options, the number of elements in the stream can be
117−-- passed using the --stream-size option.
118−--
119−benchmarks :: String -> Int -> [Benchmark]
120−benchmarks moduleName size =
121− [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
122− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
123− ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hs+3−1
@@ -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
@@ -13,7 +15,7 @@ import qualified Streamly.Prelude as S
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"
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+214−63
@@ -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
@@ -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
@@ -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 unfoldManyInterleaveRepl4xN #-}
194+ where
126−unfoldManyInterleaveRepl4xN :: Int -> Int -> IO ()
127−unfoldManyInterleaveRepl4xN value n =
128− S.drain $ Internal.unfoldManyInterleave
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 'unfoldManyInterleaveRepl4xN
134−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType` ''SPEC
135−-- inspect $ 'unfoldManyInterleaveRepl4xN `hasNoType`
136−-- ''D.ConcatUnfoldInterleaveState
137−#endif
138
197
139−{-# INLINE unfoldManyRoundRobinRepl4xN #-}
198+o_n_space_concat :: Int -> [Benchmark]
140−unfoldManyRoundRobinRepl4xN :: Int -> Int -> IO ()
199+o_n_space_concat value =
141−unfoldManyRoundRobinRepl4xN value n =
200+ [ bgroup "concatMapWith"
142− S.drain $ Internal.unfoldManyRoundRobin
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 'unfoldManyRoundRobinRepl4xN
217+
148−-- inspect $ 'unfoldManyRoundRobinRepl4xN `hasNoType` ''SPEC
218+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
149−-- inspect $ 'unfoldManyRoundRobinRepl4xN `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− "unfoldManyInterleaveRepl (x/4,4)"
241+ "unfoldManyInterleave (n of 1)"
163− (unfoldManyInterleaveRepl4xN value)
242+ (unfoldManyInterleave value 1)
243+ , benchIOSrc1
244+ "unfoldManyInterleave (sqrtVal of sqrtVal)"
245+ (unfoldManyInterleave sqrtVal sqrtVal)
246+
164 , benchIOSrc1
247 , benchIOSrc1
165− "unfoldManyRoundRobinRepl (x/4,4)"
248+ "unfoldManyRoundRobin (n of 1)"
166− (unfoldManyRoundRobinRepl4xN value)
249+ (unfoldManyRoundRobin value 1)
250+ , benchIOSrc1
251+ "unfoldManyRoundRobin (sqrtVal of sqrtVal)"
252+ (unfoldManyRoundRobin sqrtVal sqrtVal)
253+
254+ , benchIOSrc1
255+ "concatPairsWithWSerial (n of 1)"
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 fromWSerial
311+ (toNullAp value fromWSerial)
312+ , benchIO
313+ "drain monad (+) (sqrtVal of sqrtVal)"
178− , benchIO "toNullM" $ toNullM value fromWSerial
314+ (toNullM value fromWSerial)
315+ , benchIO
316+ "drain monad (+) (cbrtVal of cbrtVal of cbrtVal)"
179− , benchIO "toNullM3" $ toNullM3 value fromWSerial
317+ (toNullM3 value fromWSerial)
318+ , benchIO
319+ "filterAllOut monad (+) (sqrtVal of sqrtVal)"
180− , benchIO "filterAllOutM" $ filterAllOutM value fromWSerial
320+ (filterAllOutM value fromWSerial)
321+ , benchIO
322+ "filterAllIn monad (+) (sqrtVal of sqrtVal)"
181− , benchIO "filterAllInM" $ filterAllInM value fromWSerial
323+ (filterAllInM value fromWSerial)
324+ , benchIO
325+ "filterSome monad (+) (sqrtVal of sqrtVal)"
182− , benchIO "filterSome" $ filterSome value fromWSerial
326+ (filterSome value fromWSerial)
327+ , benchIO
328+ "breakAfterSome monad (+) (sqrtVal of sqrtVal)"
183− , benchIO "breakAfterSome" $ breakAfterSome value fromWSerial
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 fromWSerial
339+ (toListM value fromWSerial)
340+ , benchIO
341+ "toListSome monad (+) (sqrtVal of sqrtVal)"
192− , benchIO "toListSome" $ toListSome value fromWSerial
342+ (toListSome value fromWSerial)
193 ]
343 ]
194 ]
344 ]
195
345
@@ -214,5 +364,6 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
214 , o_1_space_outerProduct size
364 , o_1_space_outerProduct size
215 ]
365 ]
216 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
366 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_concat size)
217− , 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
218 ]
369 ]
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+17−1
@@ -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
@@ -13,7 +15,7 @@ import qualified Streamly.Prelude as S
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"
@@ -41,6 +43,12 @@ zipAsyncAp count n =
41 S.fromZipAsync $
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"
@@ -53,6 +61,13 @@ o_1_space_joining value =
53 ]
61 ]
54 ]
62 ]
55
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)
68+ ]
69+ ]
70+
56-------------------------------------------------------------------------------
71-------------------------------------------------------------------------------
57-- Monad outer product
72-- Monad outer product
58-------------------------------------------------------------------------------
73-------------------------------------------------------------------------------
@@ -78,4 +93,5 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
78 [ o_1_space_joining size
93 [ o_1_space_joining size
79 , o_1_space_outerProduct size
94 , o_1_space_outerProduct size
80 ]
95 ]
96+ , bgroup (o_n_heap_prefix moduleName) $ o_n_heap_joining size
81 ]
97 ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+52−4
@@ -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
@@ -27,13 +29,13 @@ import qualified Streamly.Prelude as S
27import Streamly.Benchmark.Common
29import Streamly.Benchmark.Common
28import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
30import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
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
@@ -84,11 +86,26 @@ inspect $ 'zipWithM `hasNoType` ''SPEC
84inspect $ 'zipWithM `hasNoType` ''D.Step
86inspect $ 'zipWithM `hasNoType` ''D.Step
85#endif
87#endif
86
88
89+{-
90+{-# INLINE concatMapWithZip #-}
91+concatMapWithZip :: Int -> Int -> Int -> IO ()
92+concatMapWithZip = concatStreamsWith (S.zipWith (+))
93+-}
94+
95+{-# INLINE concatPairsWithZip #-}
96+concatPairsWithZip :: Int -> Int -> Int -> IO ()
97+concatPairsWithZip = concatPairsWith (S.zipWith (+))
98+
87o_1_space_joining :: Int -> [Benchmark]
99o_1_space_joining :: Int -> [Benchmark]
88o_1_space_joining value =
100o_1_space_joining value =
89 [ bgroup "joining"
101 [ bgroup "joining"
90− [ benchIOSrc1 "zip (2,x/2)" (zipWith (value `div` 2))
102+ [ benchIOSrc1 "zip (2 of n/2)" (zipWith (value `div` 2))
91− , benchIOSrc1 "zipM (2,x/2)" (zipWithM (value `div` 2))
103+ , benchIOSrc1 "zipM (2 of n/2)" (zipWithM (value `div` 2))
104+ {-
105+ -- Not correct because of nil stream at end issue.
106+ , benchIOSrc1 "concatMapWithZip (+) (2 of n/2)"
107+ (concatMapWithZip 2 (value `div` 2))
108+ -}
92 ]
109 ]
93 ]
110 ]
94
111
@@ -103,11 +120,39 @@ o_1_space_mapping value =
103 ]
120 ]
104 ]
121 ]
105
122
123+-------------------------------------------------------------------------------
124+-- Concat
125+-------------------------------------------------------------------------------
126+
127+o_n_heap_concat :: Int -> [Benchmark]
128+o_n_heap_concat value =
129+ [ bgroup "concatPairsWith"
130+ [ {- -- This fails with stack overflow.
131+ benchIOSrc1 "concatMapWithZip (n of 1)"
132+ (concatMapWithZip value 1)
133+ -- Not correct because of nil stream at end issue.
134+ , benchIOSrc1 "concatMapWithZip (sqrtVal of sqrtVal)"
135+ (concatMapWithZip sqrtVal sqrtVal)
136+ -}
137+ benchIOSrc1 "concatPairsWithZip (n of 1)"
138+ (concatPairsWithZip value 1)
139+ , benchIOSrc1 "concatPairsWithZip (sqrtVal of sqrtVal)"
140+ (concatPairsWithZip sqrtVal sqrtVal)
141+ , benchIOSrc1 "concatPairsWithZip (+) (2 of n/2)"
142+ (concatPairsWithZip 2 (value `div` 2))
143+ ]
144+ ]
145+
146+ where
147+
148+ sqrtVal = round $ sqrt (fromIntegral value :: Double)
149+
106-------------------------------------------------------------------------------
150-------------------------------------------------------------------------------
107-- Monad outer product
151-- Monad outer product
108-------------------------------------------------------------------------------
152-------------------------------------------------------------------------------
109
153
110{-
154{-
155+-- Not correct because of nil stream at end issue.
111o_1_space_outerProduct :: Int -> [Benchmark]
156o_1_space_outerProduct :: Int -> [Benchmark]
112o_1_space_outerProduct value =
157o_1_space_outerProduct value =
113 [ bgroup "monad-outer-product"
158 [ bgroup "monad-outer-product"
@@ -136,4 +181,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
136 -- XXX need to fix, timing in ns
181 -- XXX need to fix, timing in ns
137 -- , o_1_space_outerProduct size
182 -- , o_1_space_outerProduct size
138 ]
183 ]
184+ , bgroup (o_n_heap_prefix moduleName) $ concat
185+ [ o_n_heap_concat size
186+ ]
139 ]
187 ]
benchmark/Streamly/Benchmark/Unicode/Char.hs+18−10
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}
2+
1--
3--
2-- Module : Streamly.Unicode.Char
4-- Module : Streamly.Unicode.Char
3-- Copyright : (c) 2021 Composewell Technologies
5-- Copyright : (c) 2021 Composewell Technologies
@@ -10,19 +12,19 @@
10-- Imports
12-- Imports
11--------------------------------------------------------------------------------
13--------------------------------------------------------------------------------
12
14
13−import Control.DeepSeq (NFData)
15+import Control.DeepSeq (NFData(..))
14−import Streamly.Internal.Data.Array.Foreign (Array)
16+import Streamly.Internal.Data.Array (Array)
15import System.FilePath (dropExtensions, takeFileName)
17import System.FilePath (dropExtensions, takeFileName)
16import System.FilePath.Posix ((</>))
18import System.FilePath.Posix ((</>))
17−import Gauge.Main (Benchmark, bench, bgroup, defaultMain, env, nfIO)
19+import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, env, nfIO)
18import Streamly.Internal.Unicode.Char
20import Streamly.Internal.Unicode.Char
19 ( NormalizationMode(NFC, NFD, NFKC, NFKD)
21 ( NormalizationMode(NFC, NFD, NFKC, NFKD)
20 , normalize
22 , normalize
21 )
23 )
22import Streamly.Benchmark.Common (o_1_space_prefix)
24import Streamly.Benchmark.Common (o_1_space_prefix)
23
25
24−import qualified Streamly.Internal.Data.Array.Foreign as Array
26+import qualified Streamly.Internal.Data.Array as Array
25−import qualified Streamly.Internal.Data.Stream.IsStream as IsStream
27+import qualified Streamly.Internal.Data.Stream as IsStream
26import qualified System.Directory as Dir
28import qualified System.Directory as Dir
27
29
28--------------------------------------------------------------------------------
30--------------------------------------------------------------------------------
@@ -41,7 +43,13 @@ dataDir = "benchmark/Streamly/Benchmark/Unicode/data"
41dataSetSize :: Int
43dataSetSize :: Int
42dataSetSize = 1000000
44dataSetSize = 1000000
43
45
46+-- Unboxed arrays are fully evaluated.
47+instance NFData (Array a) where
48+ {-# INLINE rnf #-}
49+ rnf _ = ()
50+
51+makeBench ::
44−makeBench :: (NFData a) => (String, a -> IO ()) -> (String, IO a) -> Benchmark
52+ (String, Array Char -> IO ()) -> (String, IO (Array Char)) -> Benchmark
45makeBench (implName, func) (dataName, setup) =
53makeBench (implName, func) (dataName, setup) =
46 env setup (bench (implName ++ "/" ++ dataName) . nfIO . func)
54 env setup (bench (implName ++ "/" ++ dataName) . nfIO . func)
47
55
@@ -65,10 +73,10 @@ arrInput file = second (fmap Array.fromList) (strInput file)
65
73
66benchFunctions :: [(String, Array Char -> IO ())]
74benchFunctions :: [(String, Array Char -> IO ())]
67benchFunctions =
75benchFunctions =
68− [ ("NFD", IsStream.drain . normalize NFD . Array.toStream)
76+ [ ("NFD", IsStream.drain . normalize NFD . Array.read)
69− , ("NFKD", IsStream.drain . normalize NFKD . Array.toStream)
77+ , ("NFKD", IsStream.drain . normalize NFKD . Array.read)
70− , ("NFC", IsStream.drain . normalize NFC . Array.toStream)
78+ , ("NFC", IsStream.drain . normalize NFC . Array.read)
71− , ("NFKC", IsStream.drain . normalize NFKC . Array.toStream)
79+ , ("NFKC", IsStream.drain . normalize NFKC . Array.read)
72 ]
80 ]
73
81
74main :: IO ()
82main :: IO ()
benchmark/Streamly/Benchmark/Unicode/Parser.hsnew file+107
@@ -0,0 +1,107 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Parser
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+{-# LANGUAGE ScopedTypeVariables #-}
11+{-# OPTIONS_GHC -Wno-orphans #-}
12+
13+#undef FUSION_CHECK
14+#ifdef FUSION_CHECK
15+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
16+#endif
17+
18+module Main
19+ (
20+ main
21+ ) where
22+
23+import Control.DeepSeq (NFData(..))
24+import Control.Monad (replicateM_)
25+import Streamly.Internal.Data.Parser (ParseError(..))
26+import Streamly.Internal.Data.Stream (Stream)
27+import Prelude hiding
28+ (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)
29+
30+import qualified Streamly.Data.Array as Array
31+import qualified Streamly.Data.Stream as Stream
32+import qualified Streamly.Internal.Unicode.Parser as PRU
33+
34+import Test.Tasty.Bench hiding (env)
35+import Streamly.Benchmark.Common
36+
37+runParser :: Int -> (Stream IO Char -> IO a) -> IO ()
38+runParser count p = do
39+ let v = "+123456789.123456789e-123"
40+ let !(arr :: Array.Array Char) = Array.fromListN (length v) v
41+ let s = Stream.unfold Array.reader arr
42+ replicateM_ count (p s)
43+
44+-- | Takes a fold method, and uses it with a default source.
45+{-# INLINE benchIOSink #-}
46+benchIOSink :: Int -> String -> (Stream IO Char -> IO b) -> Benchmark
47+benchIOSink value name f = bench name $ nfIO $ runParser value f
48+
49+{-# INLINE doubleParser #-}
50+doubleParser :: Monad m => Stream m Char -> m (Either ParseError (Int, Int))
51+doubleParser = Stream.parse PRU.doubleParser
52+
53+{-# INLINE number #-}
54+number :: Monad m => Stream m Char -> m (Either ParseError (Integer, Int))
55+number = Stream.parse PRU.number
56+
57+{-# INLINE double #-}
58+double :: Monad m => Stream m Char -> m (Either ParseError Double)
59+double = Stream.parse PRU.double
60+
61+{-# INLINE numberDouble #-}
62+numberDouble :: Monad m => Stream m Char -> m (Either ParseError Double)
63+numberDouble = Stream.parse p
64+ where p = uncurry PRU.mkDouble <$> PRU.number
65+
66+-------------------------------------------------------------------------------
67+-- Benchmarks
68+-------------------------------------------------------------------------------
69+
70+moduleName :: String
71+moduleName = "Unicode.Parser"
72+
73+instance NFData ParseError where
74+ {-# INLINE rnf #-}
75+ rnf (ParseError x) = rnf x
76+
77+o_n_heap_serial :: Int -> [Benchmark]
78+o_n_heap_serial value =
79+ [
80+ benchIOSink value "doubleParser" doubleParser
81+ , benchIOSink value "number" number
82+ , benchIOSink value "double (doubleParser)" double
83+ , benchIOSink value "double (number)" numberDouble
84+ ]
85+
86+-------------------------------------------------------------------------------
87+-- Driver
88+-------------------------------------------------------------------------------
89+
90+main :: IO ()
91+main = do
92+#ifndef FUSION_CHECK
93+ runWithCLIOpts defaultStreamSize allBenchmarks
94+
95+ where
96+
97+ allBenchmarks value =
98+ [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
99+ ]
100+#else
101+ -- Enable FUSION_CHECK macro at the beginning of the file
102+ -- Enable one benchmark below, and run the benchmark
103+ -- Check the .dump-simpl output
104+ let value = 100000
105+ runParser value double
106+ return ()
107+#endif
benchmark/Streamly/Benchmark/Unicode/Stream.hs+78−31
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1--
3--
2-- Module : Streamly.Unicode.Stream
4-- Module : Streamly.Unicode.Stream
3-- Copyright : (c) 2019 Composewell Technologies
5-- Copyright : (c) 2019 Composewell Technologies
@@ -9,6 +11,11 @@
9{-# LANGUAGE CPP #-}
11{-# LANGUAGE CPP #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
11
13
14+#undef FUSION_CHECK
15+#ifdef FUSION_CHECK
16+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
17+#endif
18+
12#ifdef __HADDOCK_VERSION__
19#ifdef __HADDOCK_VERSION__
13#undef INSPECTION
20#undef INSPECTION
14#endif
21#endif
@@ -18,29 +25,30 @@
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
19#endif
26#endif
20
27
28+import Streamly.Data.Stream (Stream)
29+import Streamly.Data.Fold (Fold)
21import Prelude hiding (last, length)
30import Prelude hiding (last, length)
22import System.IO (Handle)
31import System.IO (Handle)
23
32
24−import qualified Streamly.Data.Array.Foreign as Array
33+import qualified Streamly.Data.Array as Array
25import qualified Streamly.Data.Fold as Fold
34import qualified Streamly.Data.Fold as Fold
26−import qualified Streamly.FileSystem.Handle as Handle
27−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
35+import qualified Streamly.Internal.Data.Stream as Stream
28import qualified Streamly.Internal.Data.Unfold as Unfold
36import qualified Streamly.Internal.Data.Unfold as Unfold
29import qualified Streamly.Internal.FileSystem.Handle as Handle
37import qualified Streamly.Internal.FileSystem.Handle as Handle
30−import qualified Streamly.Internal.Unicode.Array.Char as UnicodeArr
38+import qualified Streamly.Internal.Unicode.Array as UnicodeArr
31import qualified Streamly.Internal.Unicode.Stream as Unicode
39import qualified Streamly.Internal.Unicode.Stream as Unicode
32
40
33−import Gauge hiding (env)
41+import Test.Tasty.Bench hiding (env)
34import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common
35import Streamly.Benchmark.Common.Handle
43import Streamly.Benchmark.Common.Handle
36
44
37#ifdef INSPECTION
45#ifdef INSPECTION
38−import Foreign.Storable (Storable)
46+import Streamly.Internal.Data.MutByteArray (Unbox)
39−import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
47+import Streamly.Internal.Data.Stream (Step(..))
40−import qualified Streamly.Internal.Data.Fold.Type as Fold
48+import qualified Streamly.Internal.Data.Array as Array
49+import qualified Streamly.Internal.Data.MutArray as MutArray
50+import qualified Streamly.Internal.Data.Fold as Fold
41import qualified Streamly.Internal.Data.Tuple.Strict as Strict
51import qualified Streamly.Internal.Data.Tuple.Strict as Strict
42−import qualified Streamly.Internal.Data.Array.Foreign.Type as Array
43−import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MArray
44
52
45import Test.Inspection
53import Test.Inspection
46#endif
54#endif
@@ -54,8 +62,8 @@ copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
54copyCodecUtf8ArraysLenient inh outh =
62copyCodecUtf8ArraysLenient inh outh =
55 Stream.fold (Handle.write outh)
63 Stream.fold (Handle.write outh)
56 $ Unicode.encodeUtf8'
64 $ Unicode.encodeUtf8'
57− $ Unicode.decodeUtf8Arrays
65+ $ Unicode.decodeUtf8Chunks
58− $ Handle.toChunks inh
66+ $ Handle.readChunks inh
59
67
60#ifdef INSPECTION
68#ifdef INSPECTION
61inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
69inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
@@ -75,23 +83,29 @@ o_1_space_decode_encode_chunked env =
75-- copy with group/ungroup transformations
83-- copy with group/ungroup transformations
76-------------------------------------------------------------------------------
84-------------------------------------------------------------------------------
77
85
86+{-# INLINE splitOnSuffix #-}
87+splitOnSuffix
88+ :: (Monad m)
89+ => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
90+splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)
91+
78{-# NOINLINE linesUnlinesCopy #-}
92{-# NOINLINE linesUnlinesCopy #-}
79linesUnlinesCopy :: Handle -> Handle -> IO ()
93linesUnlinesCopy :: Handle -> Handle -> IO ()
80linesUnlinesCopy inh outh =
94linesUnlinesCopy inh outh =
81 Stream.fold (Handle.write outh)
95 Stream.fold (Handle.write outh)
82 $ Unicode.encodeLatin1'
96 $ Unicode.encodeLatin1'
83 $ Unicode.unlines Unfold.fromList
97 $ Unicode.unlines Unfold.fromList
84− $ Stream.splitOnSuffix (== '\n') Fold.toList
98+ $ splitOnSuffix (== '\n') Fold.toList
85 $ Unicode.decodeLatin1
99 $ Unicode.decodeLatin1
86− $ Stream.unfold Handle.read inh
100+ $ Stream.unfold Handle.reader inh
87
101
88{-# NOINLINE linesUnlinesArrayWord8Copy #-}
102{-# NOINLINE linesUnlinesArrayWord8Copy #-}
89linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
103linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
90linesUnlinesArrayWord8Copy inh outh =
104linesUnlinesArrayWord8Copy inh outh =
91 Stream.fold (Handle.write outh)
105 Stream.fold (Handle.write outh)
92− $ Stream.interposeSuffix 10 Array.read
106+ $ Stream.interposeSuffix 10 Array.reader
93− $ Stream.splitOnSuffix (== 10) Array.write
107+ $ splitOnSuffix (== 10) Array.write
94− $ Stream.unfold Handle.read inh
108+ $ Stream.unfold Handle.reader inh
95
109
96-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
110-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
97-- | Lines and unlines
111-- | Lines and unlines
@@ -103,10 +117,10 @@ linesUnlinesArrayCharCopy inh outh =
103 $ UnicodeArr.unlines
117 $ UnicodeArr.unlines
104 $ UnicodeArr.lines
118 $ UnicodeArr.lines
105 $ Unicode.decodeLatin1
119 $ Unicode.decodeLatin1
106− $ Stream.unfold Handle.read inh
120+ $ Stream.unfold Handle.reader inh
107
121
108#ifdef INSPECTION
122#ifdef INSPECTION
109−inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
123+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox]
110-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
124-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
111#endif
125#endif
112
126
@@ -131,7 +145,7 @@ wordsUnwordsCopyWord8 inh outh =
131 Stream.fold (Handle.write outh)
145 Stream.fold (Handle.write outh)
132 $ Stream.interposeSuffix 32 Unfold.fromList
146 $ Stream.interposeSuffix 32 Unfold.fromList
133 $ Stream.wordsBy isSp Fold.toList
147 $ Stream.wordsBy isSp Fold.toList
134− $ Stream.unfold Handle.read inh
148+ $ Stream.unfold Handle.reader inh
135
149
136#ifdef INSPECTION
150#ifdef INSPECTION
137inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
151inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
@@ -155,7 +169,7 @@ wordsUnwordsCopy inh outh =
155 $ Stream.wordsBy isSpace Fold.toList
169 $ Stream.wordsBy isSpace Fold.toList
156 -- -- $ Stream.splitOn isSpace Fold.toList
170 -- -- $ Stream.splitOn isSpace Fold.toList
157 $ Unicode.decodeLatin1
171 $ Unicode.decodeLatin1
158− $ Stream.unfold Handle.read inh
172+ $ Stream.unfold Handle.reader inh
159
173
160#ifdef INSPECTION
174#ifdef INSPECTION
161-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
175-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
@@ -170,7 +184,7 @@ wordsUnwordsCharArrayCopy inh outh =
170 $ UnicodeArr.unwords
184 $ UnicodeArr.unwords
171 $ UnicodeArr.words
185 $ UnicodeArr.words
172 $ Unicode.decodeLatin1
186 $ Unicode.decodeLatin1
173− $ Stream.unfold Handle.read inh
187+ $ Stream.unfold Handle.reader inh
174
188
175o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
189o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
176o_1_space_copy_read_group_ungroup env =
190o_1_space_copy_read_group_ungroup env =
@@ -202,16 +216,16 @@ copyStreamLatin1' inh outh =
202 Stream.fold (Handle.write outh)
216 Stream.fold (Handle.write outh)
203 $ Unicode.encodeLatin1'
217 $ Unicode.encodeLatin1'
204 $ Unicode.decodeLatin1
218 $ Unicode.decodeLatin1
205− $ Stream.unfold Handle.read inh
219+ $ Stream.unfold Handle.reader inh
206
220
207#ifdef INSPECTION
221#ifdef INSPECTION
208inspect $ hasNoTypeClasses 'copyStreamLatin1'
222inspect $ hasNoTypeClasses 'copyStreamLatin1'
209inspect $ 'copyStreamLatin1' `hasNoType` ''Step
223inspect $ 'copyStreamLatin1' `hasNoType` ''Step
210inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
224inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
211−inspect $ 'copyStreamLatin1' `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
212
225
213inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step
226inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step
214−inspect $ 'copyStreamLatin1' `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
227+inspect $ 'copyStreamLatin1' `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
228+ -- Handle.read/Array.read
215inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
229inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
216#endif
230#endif
217
231
@@ -222,17 +236,17 @@ copyStreamLatin1 inh outh =
222 Stream.fold (Handle.write outh)
236 Stream.fold (Handle.write outh)
223 $ Unicode.encodeLatin1
237 $ Unicode.encodeLatin1
224 $ Unicode.decodeLatin1
238 $ Unicode.decodeLatin1
225− $ Stream.unfold Handle.read inh
239+ $ Stream.unfold Handle.reader inh
226
240
227#ifdef INSPECTION
241#ifdef INSPECTION
228inspect $ hasNoTypeClasses 'copyStreamLatin1
242inspect $ hasNoTypeClasses 'copyStreamLatin1
229inspect $ 'copyStreamLatin1 `hasNoType` ''Step
243inspect $ 'copyStreamLatin1 `hasNoType` ''Step
230inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
244inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
231−inspect $ 'copyStreamLatin1 `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
232
245
233inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState
246inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState
234inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step
247inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step
235−inspect $ 'copyStreamLatin1 `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
248+inspect $ 'copyStreamLatin1 `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
249+ -- Handle.read/Array.read
236inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
250inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
237#endif
251#endif
238
252
@@ -242,7 +256,7 @@ _copyStreamUtf8' inh outh =
242 Stream.fold (Handle.write outh)
256 Stream.fold (Handle.write outh)
243 $ Unicode.encodeUtf8'
257 $ Unicode.encodeUtf8'
244 $ Unicode.decodeUtf8'
258 $ Unicode.decodeUtf8'
245− $ Stream.unfold Handle.read inh
259+ $ Stream.unfold Handle.reader inh
246
260
247#ifdef INSPECTION
261#ifdef INSPECTION
248inspect $ hasNoTypeClasses '_copyStreamUtf8'
262inspect $ hasNoTypeClasses '_copyStreamUtf8'
@@ -258,7 +272,7 @@ copyStreamUtf8 inh outh =
258 Stream.fold (Handle.write outh)
272 Stream.fold (Handle.write outh)
259 $ Unicode.encodeUtf8
273 $ Unicode.encodeUtf8
260 $ Unicode.decodeUtf8
274 $ Unicode.decodeUtf8
261− $ Stream.unfold Handle.read inh
275+ $ Stream.unfold Handle.reader inh
262
276
263#ifdef INSPECTION
277#ifdef INSPECTION
264inspect $ hasNoTypeClasses 'copyStreamUtf8
278inspect $ hasNoTypeClasses 'copyStreamUtf8
@@ -267,6 +281,24 @@ inspect $ hasNoTypeClasses 'copyStreamUtf8
267-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
281-- inspect $ 'copyStreamUtf8Lax `hasNoType` ''D.ConcatMapUState
268#endif
282#endif
269
283
284+{-# NOINLINE _copyStreamUtf8'Fold #-}
285+_copyStreamUtf8'Fold :: Handle -> Handle -> IO ()
286+_copyStreamUtf8'Fold inh outh =
287+ Stream.fold (Handle.write outh)
288+ $ Unicode.encodeUtf8
289+ $ Stream.catRights
290+ $ Stream.parseMany Unicode.writeCharUtf8'
291+ $ Stream.unfold Handle.reader inh
292+
293+{-# NOINLINE _copyStreamUtf8Parser #-}
294+_copyStreamUtf8Parser :: Handle -> Handle -> IO ()
295+_copyStreamUtf8Parser inh outh =
296+ Stream.fold (Handle.write outh)
297+ $ Unicode.encodeUtf8
298+ $ Stream.catRights $ Stream.parseMany
299+ (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)
300+ $ Stream.unfold Handle.reader inh
301+
270o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]
302o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]
271o_1_space_decode_encode_read env =
303o_1_space_decode_encode_read env =
272 [ bgroup "decode-encode"
304 [ bgroup "decode-encode"
@@ -276,11 +308,15 @@ o_1_space_decode_encode_read env =
276 copyStreamLatin1' inh outh
308 copyStreamLatin1' inh outh
277 , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh ->
309 , mkBench "encodeLatin1 . decodeLatin1" env $ \inh outh ->
278 copyStreamLatin1 inh outh
310 copyStreamLatin1 inh outh
279−#ifdef DEVBUILD
311+#ifdef INCLUDE_STRICT_UTF8
280 -- Requires valid unicode input
312 -- Requires valid unicode input
281 , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh ->
313 , mkBench "encodeUtf8' . decodeUtf8'" env $ \inh outh ->
282 _copyStreamUtf8' inh outh
314 _copyStreamUtf8' inh outh
315+ , mkBench "encodeUtf8' . foldMany writeCharUtf8'" env $ \inh outh ->
316+ _copyStreamUtf8'Fold inh outh
283#endif
317#endif
318+ , mkBenchSmall "encodeUtf8 . parseMany parseCharUtf8" env
319+ $ \inh outh -> _copyStreamUtf8Parser inh outh
284 , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->
320 , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->
285 copyStreamUtf8 inh outh
321 copyStreamUtf8 inh outh
286 ]
322 ]
@@ -288,6 +324,7 @@ o_1_space_decode_encode_read env =
288
324
289main :: IO ()
325main :: IO ()
290main = do
326main = do
327+#ifndef FUSION_CHECK
291 env <- mkHandleBenchEnv
328 env <- mkHandleBenchEnv
292 defaultMain (allBenchmarks env)
329 defaultMain (allBenchmarks env)
293
330
@@ -300,3 +337,13 @@ main = do
300 , o_1_space_decode_encode_read env
337 , o_1_space_decode_encode_read env
301 ]
338 ]
302 ]
339 ]
340+#else
341+ -- Enable FUSION_CHECK macro at the beginning of the file
342+ -- Enable one benchmark below, and run the benchmark
343+ -- Check the .dump-simpl output
344+ env <- mkHandleBenchEnv
345+ let mkHandles (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh
346+ (Handles inh outh) <- getHandles env mkHandles
347+ copyStreamLatin1' inh outh
348+ return ()
349+#endif
benchmark/Streamly/Benchmark/Unicode/Utf8.hs+3−3
@@ -13,7 +13,7 @@
13import Data.Char (chr)
13import Data.Char (chr)
14import Streamly.Internal.Unicode.Utf8 (Utf8)
14import Streamly.Internal.Unicode.Utf8 (Utf8)
15
15
16−import Gauge hiding (env)
16+import Test.Tasty.Bench hiding (env)
17import Streamly.Benchmark.Common
17import Streamly.Benchmark.Common
18
18
19import qualified Streamly.Internal.Unicode.Utf8 as Utf8
19import qualified Streamly.Internal.Unicode.Utf8 as Utf8
@@ -49,7 +49,7 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
49 allBenchmarks value =
49 allBenchmarks value =
50 [ bgroup
50 [ bgroup
51 moduleName
51 moduleName
52− [ bench "pack" $ nf pack value
52+ [ bench "pack" $ whnf pack value
53− , bench "pack + unpack" $ nf packUnpack value
53+ , bench "pack + unpack" $ whnf packUnpack value
54 ]
54 ]
55 ]
55 ]
benchmark/bench-report/BenchReport.hsdeleted−273
@@ -1,273 +0,0 @@
1−{-# LANGUAGE RecordWildCards #-}
2−{-# LANGUAGE ScopedTypeVariables #-}
3−
4−module Main where
5−
6−import Control.Exception (catch, ErrorCall(..))
7−import Control.Monad (mzero)
8−import Control.Monad.IO.Class (liftIO)
9−import Control.Monad.Trans.Maybe
10−import Control.Monad.Trans.State
11−import Data.Char (toLower)
12−import Data.List
13−import GHC.Real (infinity)
14−import System.Environment (getArgs)
15−import Text.Read (readMaybe)
16−
17−import BenchShow
18−
19−------------------------------------------------------------------------------
20−-- Command line parsing
21−------------------------------------------------------------------------------
22−
23−data BenchType
24− = Compare String
25− | Standard String
26− deriving Show
27−
28−data Options = Options
29− { genGraphs :: Bool
30− , sortByName :: Bool
31− , useGauge :: Bool
32− , benchType :: Maybe BenchType
33− , fields :: [String]
34− , diffStyle :: GroupStyle
35− , cutOffPercent :: Double
36− } deriving Show
37−
38−defaultOptions :: Options
39−defaultOptions = Options False False False Nothing ["time"] PercentDiff 0
40−
41−setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
42−setGenGraphs val = do
43− (args, opts) <- get
44− put (args, opts { genGraphs = val })
45−
46−setSortByName :: Monad m => Bool -> StateT (a, Options) m ()
47−setSortByName val = do
48− (args, opts) <- get
49− put (args, opts { sortByName = val })
50−
51−setUseGauge :: Monad m => Bool -> StateT (a, Options) m ()
52−setUseGauge val = do
53− (args, opts) <- get
54− put (args, opts { useGauge = val })
55−
56−setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
57−setBenchType val = do
58− (args, opts) <- get
59− put (args, opts { benchType = Just val })
60−
61−setFields :: Monad m => [String] -> StateT (a, Options) m ()
62−setFields val = do
63− (args, opts) <- get
64− put (args, opts { fields = val })
65−
66−setDiff :: Monad m => String -> StateT (a, Options) m ()
67−setDiff val = do
68− (args, opts) <- get
69− let cmpStyle =
70− case val of
71− "absolute" -> Absolute
72− "multiples" -> Multiples
73− "percent" -> PercentDiff
74− x -> error $ "Unknown diff option: " ++ show x
75− in put (args, opts { diffStyle = cmpStyle })
76−
77−setCutOff :: Monad m => String -> StateT (a, Options) m ()
78−setCutOff val = do
79− (args, opts) <- get
80− case readMaybe val of
81− Just x -> put (args, opts { cutOffPercent = x })
82− Nothing -> error $ "Invalid cutoff value: " ++ show val
83−
84−-- Like the shell "shift" to shift the command line arguments
85−shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
86−shift = do
87− s <- get
88− case s of
89− ([], _) -> return Nothing
90− (x : xs, opts) -> put (xs, opts) >> return (Just x)
91−
92−parseBench :: StateT ([String], Options) (MaybeT IO) ()
93−parseBench = do
94− x <- shift
95− case x of
96− Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
97− Just str -> setBenchType (Standard str)
98− Nothing -> do
99− liftIO $ putStrLn "please provide a benchmark type "
100− mzero
101−
102−parseFields :: StateT ([String], Options) (MaybeT IO) ()
103−parseFields = do
104− x <- shift
105− case x of
106− Just str -> setFields (words str)
107− Nothing -> do
108− liftIO $ putStrLn
109− "please provide a list of fields after --fields"
110− mzero
111−
112−parseDiff :: StateT ([String], Options) (MaybeT IO) ()
113−parseDiff = do
114− x <- shift
115− case x of
116− Just str -> setDiff str
117− Nothing -> do
118− liftIO $ putStrLn "please provide a diff type"
119− mzero
120−
121−parseCutOff :: StateT ([String], Options) (MaybeT IO) ()
122−parseCutOff = do
123− x <- shift
124− case x of
125− Just str -> setCutOff str
126− Nothing -> do
127− liftIO $ putStrLn "please provide a cutoff percent"
128− mzero
129−
130−-- totally imperative style option parsing
131−parseOptions :: IO (Maybe Options)
132−parseOptions = do
133− args <- getArgs
134− runMaybeT $ flip evalStateT (args, defaultOptions) $ do
135− parseLoop
136− fmap snd get
137−
138− where
139−
140− parseOpt opt =
141− case opt of
142− "--graphs" -> setGenGraphs True
143− "--sort-by-name" -> setSortByName True
144− "--use-gauge" -> setUseGauge True
145− "--benchmark" -> parseBench
146− "--fields" -> parseFields
147− "--diff-style" -> parseDiff
148− "--diff-cutoff-percent" -> parseCutOff
149− str -> do
150− liftIO $ putStrLn $ "Unrecognized option " <> str
151− mzero
152−
153− parseLoop = do
154− next <- shift
155− case next of
156− Just opt -> parseOpt opt >> parseLoop
157− Nothing -> return ()
158−
159−ignoringErr :: IO () -> IO ()
160−ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
161− putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
162−
163−------------------------------------------------------------------------------
164−-- Generic
165−------------------------------------------------------------------------------
166−
167−makeGraphs :: String -> Config -> String -> IO ()
168−makeGraphs name cfg@Config{..} inputFile =
169− ignoringErr $ graph inputFile name cfg
170−
171−------------------------------------------------------------------------------
172−-- Arrays
173−------------------------------------------------------------------------------
174−
175−showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
176−showComparisons Options{..} cfg inp out =
177− let cfg1 = cfg { classifyBenchmark = classifyComparison }
178− in if genGraphs
179− then ignoringErr $ graph inp "comparison"
180− cfg1 { outputDir = Just out
181− , presentation = Groups Absolute
182− }
183− else ignoringErr $ report inp Nothing cfg1
184−
185− where
186−
187− separator = if useGauge then '/' else '.'
188− dropComponent sep = dropWhile (== sep) . dropWhile (/= sep)
189−
190− -- In case of tasty-bench the names could be like
191− -- All.Data.Array.Prim.Pinned/o-1-space.generation.show
192− -- All.Data.Array.Foreign/o-1-space.generation.show
193− classifyComparison b =
194− let b1 =
195− if useGauge
196− then b
197− else dropComponent separator b --- drop "All." at the beginning
198− in Just
199− ( takeWhile (/= '/') b1
200− , dropComponent '/' b1 -- for tasty-bench drop up to "/"
201− )
202−
203−------------------------------------------------------------------------------
204−-- text reports
205−------------------------------------------------------------------------------
206−
207−selectBench
208− :: Options
209− -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
210− -> [String]
211−selectBench Options{..} f =
212− reverse
213− $ fmap fst
214− $ filter (\(_,y) -> filterPred y)
215− $ either
216− (const $ either error sortFunc $ f (ColumnIndex 0) (Just PercentDiff))
217− sortFunc
218− $ f (ColumnIndex 1) (Just PercentDiff)
219−
220− where
221−
222− sortFunc = if sortByName then sortOn fst else sortOn snd
223−
224− cutOffMultiples = 1 + cutOffPercent / 100
225−
226− filterPred x =
227− case benchType of
228− Just (Compare _) ->
229− x <= negate cutOffPercent || x >= cutOffPercent
230− _ -> True
231−
232−benchShow ::
233− Options
234− -> Config
235− -> (Config -> String -> IO ())
236− -> String
237− -> FilePath
238− -> IO ()
239−benchShow Options{..} cfg func inp out =
240− if genGraphs
241− then func cfg {outputDir = Just out} inp
242− else ignoringErr $ report inp Nothing cfg
243−
244−main :: IO ()
245−main = do
246− res <- parseOptions
247− case res of
248− Nothing -> do
249− putStrLn "cannot parse options"
250− return ()
251− Just opts@Options{fields = fs, benchType = btype} ->
252− let cfg = defaultConfig
253− { presentation = Groups (diffStyle opts)
254− , selectBenchmarks = selectBench opts
255− , selectFields = filter
256− ( flip elem (fmap (fmap toLower) fs)
257− . fmap toLower
258− )
259− }
260− in case btype of
261− Just (Compare str) ->
262− showComparisons opts cfg
263− { title = Just str }
264− ("charts/" ++ str ++ "/results.csv")
265− ("charts/" ++ str)
266− Just (Standard str) ->
267− benchShow opts cfg
268− { title = Just str }
269− (makeGraphs str)
270− ("charts/" ++ str ++ "/results.csv")
271− ("charts/" ++ str)
272− Nothing ->
273− error "Please specify a benchmark using --benchmark."
benchmark/bench-report/bench-report.cabaldeleted−23
@@ -1,23 +0,0 @@
1−cabal-version: 2.2
2−name: bench-report
3−version: 0.0.0
4−synopsis: Benchmark report generation
5−description: Benchmark reporting application is not included in the overall
6− cabal project so that the dependencies of both can remain independent.
7− Benchmark reporting has a lot of dependencies that usually lag behind
8− when new GHC releases arrive.
9−
10−-------------------------------------------------------------------------------
11−-- benchmark comparison and presentation
12−-------------------------------------------------------------------------------
13−
14−executable bench-report
15− default-language: Haskell2010
16− ghc-options: -Wall
17− hs-source-dirs: .
18− main-is: BenchReport.hs
19− buildable: True
20− build-Depends:
21− base >= 4.9 && < 5
22− , bench-show >= 0.3 && < 0.4
23− , transformers >= 0.4 && < 0.6
benchmark/bench-report/bin/bench-runner.shdeleted−667
@@ -1,667 +0,0 @@
1−#!/usr/bin/env bash
2−
3−# Note that this script is used in the "streamly" package as well as
4−# in "streaming-benchmarks" package. Any changes to the script should be
5−# generic enough so that it works in both the cases.
6−
7−#------------------------------------------------------------------------------
8−
9−set -o pipefail
10−
11−SCRIPT_DIR=$(cd `dirname $0`; pwd)
12−
13−RUNNING_BENCHMARKS=y
14−source $SCRIPT_DIR/build-lib.sh
15−
16−print_help () {
17− echo "Usage: $0 "
18− echo " [--benchmarks <"bench1 bench2 ..." | help>]"
19− echo " [--prefix <benchmark name prefix to match>"
20− echo " [--fields <"field1 field2 ..." | help>]"
21− echo " [--sort-by-name]"
22− echo " [--compare]"
23− echo " [--diff-style <absolute|percent|multiples>]"
24− echo " [--cutoff-percent <percent-value>]"
25− echo " [--graphs]"
26− echo " [--no-measure]"
27− echo " [--append]"
28− echo " [--long]"
29− echo " [--slow]"
30− echo " [--quick]"
31− echo " [--raw]"
32− echo " [--dev-build]"
33− echo " [--use-nix]"
34− echo " [--with-compiler <compiler exe name>]"
35− echo " [--cabal-build-options <options>]"
36− echo " [--rtsopts <opts>]"
37− echo " [--commit-compare] [--base <commit>] [--candidate <commit>]"
38− #echo " -- <gauge options or benchmarks>"
39− echo
40− echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"
41− echo "--compare: compare the specified benchmarks with each other"
42− echo "--fields: measurement fields to report, use 'help' for a list"
43− echo "--graphs: Generate graphical reports"
44− echo "--no-measure: Don't run benchmarks, run reports from previous results"
45− echo "--append: Don't overwrite previous results, append for comparison"
46− echo "--long: Use much longer stream size for infinite stream benchmarks"
47− echo "--slow: Slightly more accurate results at the expense of speed"
48− echo "--quick: Faster results, useful for longer benchmarks"
49− echo "--raw: Run the benchmarks but don't report them. This is useful when"
50− echo " you only want to work with the csv files generated."
51− echo "--cabal-build-options: Pass any cabal build options to be used for build"
52− echo " e.g. --cabal-build-options \"--flag dev\""
53− echo
54− echo "When specific space complexity group is chosen then (and only then) "
55− echo "RTS memory restrictions are used accordingly. For example, "
56− echo "bench.sh --benchmarks Data.Parser -- Data.Parser/o-1-space "
57− echo "restricts Heap/Stack space for O(1) characterstics"
58− echo
59− echo "When using --commit-compare, by default comparative chart of HEAD^ vs HEAD"
60− echo "commit is generated, in the 'charts' directory."
61− echo "Use --base and --candidate to select the commits to compare."
62− echo
63− #echo "Any arguments after a '--' are passed directly to gauge"
64− exit
65−}
66−
67−#-----------------------------------------------------------------------------
68−# Reporting utility functions
69−#-----------------------------------------------------------------------------
70−
71−list_comparisons () {
72− echo "Comparison groups:"
73− for i in $COMPARISONS
74− do
75− echo -n "$i ["
76− eval "echo -n \$$i"
77− echo "]"
78− done
79− echo
80−}
81−
82−build_report_prog() {
83− local prog_path=$BENCH_REPORT_DIR/bin/bench-report
84−
85− hash -r
86− if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"
87− then
88− echo "Building bench-report executables"
89− BUILD_ONCE=1
90− pushd $BENCH_REPORT_DIR
91− local cmd
92− cmd="$CABAL_EXECUTABLE install --installdir bin bench-report"
93− if test "$USE_NIX" -eq 0
94− then
95− $cmd || die "bench-report build failed"
96− else
97− nix-shell --run "$cmd" || die "bench-report build failed"
98− fi
99− popd
100− elif test ! -x "$prog_path"
101− then
102− return 1
103− fi
104− return 0
105−}
106−
107−build_report_progs() {
108− if test "$RAW" = "0"
109− then
110− build_report_prog || exit 1
111− local prog
112− prog=$BENCH_REPORT_DIR/bin/bench-report
113− test -x $prog || die "Cannot find bench-report executable"
114− echo "Using bench-report executable [$prog]"
115− fi
116−}
117−
118−# We run the benchmarks in isolation in a separate process so that different
119−# benchmarks do not interfere with other. To enable that we need to pass the
120−# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
121−# own path currently.
122−
123−# The path is dependent on the architecture and cabal version.
124−
125−bench_output_file() {
126− local bench_name=$1
127− echo "charts/$bench_name/results.csv"
128−}
129−
130−#------------------------------------------------------------------------------
131−# Speed options
132−#------------------------------------------------------------------------------
133−
134−# tasty-bench does not like an option set twice
135−set_super_quick_mode () {
136− echo -n super_quick
137−}
138−
139−# For certain long benchmarks if the user has not requested super quick
140−# mode we anyway use a slightly quicker mode.
141−use_quicker_mode () {
142− if test "$QUICK_MODE" -eq 0
143− then
144− echo quicker
145− fi
146−}
147−
148−#------------------------------------------------------------------------------
149−# Determine options from benchmark name
150−#------------------------------------------------------------------------------
151−
152−# Global environment passed:
153−# BENCH_EXEC_PATH: the benchmark executable
154−# RTS_OPTIONS: additional RTS options
155−# QUICK_MODE: whether we are in quick mode
156−# USE_GAUGE: whether to use gauge or tasty-bench
157−# LONG: whether to use a large stream size
158−
159−# $1: bench name
160−bench_exec_one() {
161− local BENCH_NAME_ORIG
162− BENCH_NAME_ORIG="$1"
163− shift
164−
165− local SUPER_QUICK_OPTIONS
166− local QUICKER_OPTIONS
167− if test "$USE_GAUGE" -eq 0
168− then
169− SUPER_QUICK_OPTIONS="--stdev 1000000"
170− QUICKER_OPTIONS="--stdev 100"
171− else
172− # Do not keep time limit as 0 otherwise GC stats may remain 0 in some cases.
173− SUPER_QUICK_OPTIONS="--quick --min-duration 0 --time-limit 0.01 --include-first-iter"
174− QUICKER_OPTIONS="--min-samples 3 --time-limit 1"
175− fi
176−
177− local BENCH_NAME0
178− local BENCH_NAME1
179− local BENCH_NAME2
180− local BENCH_NAME
181− # XXX this is a hack to make the "/" separated names used in the functions
182− # determining options based on benchmark name. For tasty-bench the benchmark
183− # names are separated by "." instead of "/" and are prefixed by "All".
184− #
185− # For example, All.Prelude.Serial/x.y.z => Prelude.Serial/x/y/z
186− if test "$USE_GAUGE" -eq 0
187− then
188− # Remove the prefix "All."
189− BENCH_NAME0=$(echo $BENCH_NAME_ORIG | sed -e s/^All\.//)
190−
191− # Module names could contain dots e.g. "Prelude.Serial". So we insert
192− # an explicit "/" to separate the module name part and the rest of
193− # the benchmark name. For example, Prelude.Serial/elimination.drain
194− BENCH_NAME1=$(echo $BENCH_NAME0 | cut -f1 -d '/')
195−
196− if test "$BENCH_NAME1" = "$BENCH_NAME0"
197− then
198− # There is no "/" separator
199− BENCH_NAME1=$(echo $BENCH_NAME0 | sed -e 's/\./\//g')
200− BENCH_NAME2=""
201− else
202− BENCH_NAME2=/$(echo $BENCH_NAME0 | cut -f2- -d '/' | sed -e 's/\./\//g')
203− fi
204− BENCH_NAME="${BENCH_NAME1}${BENCH_NAME2}"
205− else
206− BENCH_NAME=$BENCH_NAME_ORIG
207− fi
208−
209− local RTS_OPTIONS1
210− RTS_OPTIONS1="\
211−+RTS -T \
212−$(bench_rts_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME) \
213−$RTS_OPTIONS \
214−-RTS"
215−
216− local QUICK_MODE_TYPE
217− QUICK_MODE_TYPE="\
218− $(if test "$QUICK_MODE" -ne 0; then set_super_quick_mode; fi) \
219− $(bench_speed_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME)"
220−
221− local QUICK_BENCH_OPTIONS
222− for i in $QUICK_MODE_TYPE
223− do
224− case "$i" in
225− super_quick) QUICK_BENCH_OPTIONS="$SUPER_QUICK_OPTIONS"; break ;;
226− quicker) QUICK_BENCH_OPTIONS="$QUICKER_OPTIONS"; break ;;
227− esac
228− done
229−
230− local STREAM_SIZE
231− local STREAM_LEN
232− local STREAM_SIZE_OPT
233− if test "$LONG" -ne 0
234− then
235− STREAM_SIZE=10000000
236− STREAM_LEN=$(env LC_ALL=en_US.UTF-8 printf "--stream-size %'.f\n" $STREAM_SIZE)
237− STREAM_SIZE_OPT="--stream-size $STREAM_SIZE"
238− fi
239−
240− echo "$BENCH_NAME_ORIG: \
241− $RTS_OPTIONS1 \
242− $STREAM_LEN \
243− $QUICK_BENCH_OPTIONS" \
244− "$@"
245−
246− #------------------------------------------------------------------------------
247− # Run benchmark with options and collect results
248− #------------------------------------------------------------------------------
249−
250− local output_file
251− output_file=$(bench_output_file $(basename $BENCH_EXEC_PATH))
252− mkdir -p `dirname $output_file`
253− rm -f ${output_file}.tmp
254−
255− local BENCH_NAME_ESC
256− if test $USE_GAUGE -eq 0
257− then
258− # Escape "\" and double quotes in benchmark names
259− BENCH_NAME_ESC=$(echo "$BENCH_NAME_ORIG" | sed -e 's/\\/\\\\/g' | sed -e 's/"/\\"/g')
260− $BENCH_EXEC_PATH \
261− -j 1 \
262− $RTS_OPTIONS1 \
263− $STREAM_SIZE_OPT \
264− $QUICK_BENCH_OPTIONS \
265− "$@" \
266− --csv=${output_file}.tmp \
267− -p '$0 == "'"$BENCH_NAME_ESC"'"' || die "Benchmark execution failed."
268−
269− # Convert cpuTime field from picoseconds to seconds
270− awk --version 2>&1 | grep -q "GNU Awk" \
271− || die "Need GNU awk. [$(which awk)] is not GNU awk."
272− tail -n +2 ${output_file}.tmp | \
273− awk 'BEGIN {FPAT = "([^,]+)|(\"[^\"]+\")";OFS=","} {$2=$2/1000000000000;print}' \
274− >> $output_file
275− else
276− $BENCH_EXEC_PATH \
277− $RTS_OPTIONS1 \
278− $STREAM_SIZE_OPT \
279− $QUICK_BENCH_OPTIONS \
280− "$@" \
281− --csvraw=${output_file}.tmp \
282− -m exact "$BENCH_NAME" || die "Benchmark execution failed."
283− tail -n +2 ${output_file}.tmp \
284− >> $output_file
285− fi
286−}
287−
288−invoke_gauge () {
289− local target_prog="$1"
290− local target_name="$2"
291− local output_file="$3"
292−
293− local MATCH=""
294− if test "$LONG" -ne 0
295− then
296− MATCH="$target_name/o-1-space"
297− else
298− MATCH="$BENCH_PREFIX"
299− fi
300− echo "name,iters,time,cycles,cpuTime,utime,stime,maxrss,minflt,majflt,nvcsw,nivcsw,allocated,numGcs,bytesCopied,mutatorWallSeconds,mutatorCpuSeconds,gcWallSeconds,gcCpuSeconds" >> $output_file
301− # keep only benchmark names with shortest prefix e.g. "a/b/c" and "a/b", we
302− # should only keep "a/b" otherwise benchmarks will run multiple times. why?
303− $target_prog -l \
304− | grep "^$MATCH" \
305− | while read -r name; \
306− do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
307− || die "Benchmark execution failed."
308−}
309−
310−invoke_tasty_bench () {
311− local target_prog="$1"
312− local target_name="$2"
313− local output_file="$3"
314−
315− local MATCH=""
316− if test "$LONG" -ne 0
317− then
318− MATCH="-p /$target_name\/o-1-space/"
319− else
320− if test -n "$BENCH_PREFIX"
321− then
322− # escape "/"
323− local escaped_name=$(echo "$BENCH_PREFIX" | sed -e 's/\//\\\//g')
324− MATCH="-p /$escaped_name/"
325− fi
326− fi
327− echo "Name,cpuTime,2*Stdev (ps),Allocated,bytesCopied" >> $output_file
328− $target_prog -l $MATCH \
329− | grep "^All" \
330− | while read -r name; \
331− do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
332− || die "Benchmark execution failed."
333−}
334−
335−run_bench_target () {
336− local package_name=$1
337− local component=$2
338− local target_name=$3
339−
340− local target_prog
341− if test -z "$BENCHMARK_PACKAGE_VERSION"
342− then
343− echo "Please set BENCHMARK_PACKAGE_VERSION in bench_config"
344− exit 1
345− fi
346− target_prog=$(cabal_target_prog $package_name-$BENCHMARK_PACKAGE_VERSION $component $target_name) || \
347− die "Cannot find executable for target $target_name"
348−
349− echo "Running executable $target_name ..."
350−
351− # Needed by bench_exec_one
352− BENCH_EXEC_PATH=$target_prog
353−
354− local output_file=$(bench_output_file $target_name)
355− mkdir -p `dirname $output_file`
356− if test "$USE_GAUGE" -eq 0
357− then invoke_tasty_bench "$target_prog" "$target_name" "$output_file"
358− else invoke_gauge "$target_prog" "$target_name" "$output_file"
359− fi
360−}
361−
362−# $1: package name
363−# $2: component
364−# $3: targets
365−run_bench_targets() {
366− for i in $3
367− do
368− run_bench_target $1 $2 $i
369− done
370−}
371−
372−run_benches_comparing() {
373− local bench_list=$1
374−
375− if test -z "$CANDIDATE"
376− then
377− CANDIDATE=$(git rev-parse HEAD)
378− fi
379− if test -z "$BASE"
380− then
381− # XXX Should be where the current branch is forked from master
382− BASE="$CANDIDATE^"
383− fi
384− echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"
385− echo "Checking out base commit [$BASE] for benchmarking"
386− git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"
387−
388− $BUILD_BENCH || die "build failed"
389− run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
390−
391− echo "Checking out candidate commit [$CANDIDATE] for benchmarking"
392− git checkout "$CANDIDATE" || \
393− die "Checkout of candidate [$CANDIDATE] commit failed"
394−
395− $BUILD_BENCH || die "build failed"
396− run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
397− # XXX reset back to the original commit
398−}
399−
400−backup_output_file() {
401− local bench_name=$1
402− local output_file=$(bench_output_file $bench_name)
403−
404− if test -e $output_file -a "$APPEND" != 1
405− then
406− mv -f -v $output_file ${output_file}.prev
407− fi
408−}
409−
410−run_measurements() {
411− local bench_list=$1
412−
413− for i in $bench_list
414− do
415− backup_output_file $i
416− done
417−
418− if test "$COMMIT_COMPARE" = "0"
419− then
420− run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
421− else
422− run_benches_comparing "$bench_list"
423− fi
424−}
425−
426−run_reports() {
427− local prog
428− prog=$BENCH_REPORT_DIR/bin/bench-report
429− test -x $prog || die "Cannot find bench-report executable"
430− echo
431−
432− for i in $1
433− do
434− echo "Generating reports for ${i}..."
435− $prog \
436− --benchmark $i \
437− $(test "$USE_GAUGE" = 1 && echo "--use-gauge") \
438− $(test "$GRAPH" = 1 && echo "--graphs") \
439− $(test "$SORT_BY_NAME" = 1 && echo "--sort-by-name") \
440− $(test -n "$BENCH_DIFF_STYLE" && echo "--diff-style $BENCH_DIFF_STYLE") \
441− $(test -n "$BENCH_CUTOFF_PERCENT" && echo "--diff-cutoff-percent $BENCH_CUTOFF_PERCENT") \
442− --fields "$FIELDS"
443− done
444−}
445−
446−#-----------------------------------------------------------------------------
447−# Execution starts here
448−#-----------------------------------------------------------------------------
449−
450−USE_GIT_CABAL=1 # This is used by set_common_vars
451−set_common_vars
452−
453−USE_NIX=0
454−COMPARE=0
455−COMMIT_COMPARE=0
456−BASE=
457−CANDIDATE=
458−
459−APPEND=0
460−LONG=0
461−RAW=0
462−SORT_BY_NAME=0
463−GRAPH=0
464−MEASURE=1
465−
466−GAUGE_ARGS=
467−BUILD_ONCE=0
468−
469−CABAL_BUILD_OPTIONS="--flag fusion-plugin --flag limit-build-mem"
470−
471−#-----------------------------------------------------------------------------
472−# Read command line
473−#-----------------------------------------------------------------------------
474−
475−while test -n "$1"
476−do
477− case $1 in
478− -h|--help|help) print_help ;;
479− # options with arguments
480− --benchmarks) shift; TARGETS=$1; shift ;;
481− --targets) shift; TARGETS=$1; shift ;;
482− --prefix) shift; BENCH_PREFIX="$1"; shift ;;
483− --fields) shift; FIELDS=$1; shift ;;
484− --base) shift; BASE=$1; shift ;;
485− --candidate) shift; CANDIDATE=$1; shift ;;
486− --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;
487− --cabal-build-flags) shift; CABAL_BUILD_OPTIONS+=$1; shift ;;
488− --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=$1; shift ;;
489− --rtsopts) shift; RTS_OPTIONS=$1; shift ;;
490− --config) shift; BENCH_CONFIG_FILE=$1; shift ;;
491− --diff-style) shift; BENCH_DIFF_STYLE=$1; shift ;;
492− --diff-cutoff-percent) shift; BENCH_CUTOFF_PERCENT=$1; shift ;;
493− # flags
494− --slow) SLOW=1; shift ;;
495− --quick) QUICK_MODE=1; shift ;;
496− --compare) COMPARE=1; shift ;;
497− --commit-compare) COMMIT_COMPARE=1; shift ;;
498− --raw) RAW=1; shift ;;
499− --append) APPEND=1; shift ;;
500− --long) LONG=1; shift ;;
501− --sort-by-name) SORT_BY_NAME=1; shift ;;
502− --graphs) GRAPH=1; shift ;;
503− --no-measure) MEASURE=0; shift ;;
504− --dev-build) RUNNING_DEVBUILD=1; shift ;;
505− --use-nix) USE_NIX=1; shift ;;
506− --use-gauge) USE_GAUGE=1; shift ;;
507− --) shift; break ;;
508− *) echo "Unknown flags: $*"; echo; print_help ;;
509− esac
510−done
511−GAUGE_ARGS=("$@")
512−
513−if test -z "$BENCH_CONFIG_FILE"
514−then
515− die "Please use --config to specify config file"
516−fi
517−
518−source "$BENCH_CONFIG_FILE" || \
519− die "Failed to source config file $BENCH_CONFIG_FILE"
520−
521−# Defined in $BENCH_CONFIG_FILE
522−bench_config
523−
524−if test -z "$FIELDS"
525−then
526− FIELDS=$DEFAULT_FIELDS
527−fi
528−
529−set_derived_vars
530−
531−#-----------------------------------------------------------------------------
532−# Determine targets
533−#-----------------------------------------------------------------------------
534−
535−only_real_benchmarks () {
536− for i in $TARGETS
537− do
538− local SKIP=0
539− for j in $COMPARISONS
540− do
541− if test $i == $j
542− then
543− SKIP=1
544− fi
545− done
546− if test "$SKIP" -eq 0
547− then
548− echo -n "$i "
549− fi
550− done
551−}
552−
553−# defined in $BENCH_CONFIG_FILE
554−bench_targets
555−
556−if test "$(has_item "$TARGETS" help)" = "help"
557−then
558− list_target_groups
559− list_comparisons
560− list_targets
561− exit
562−fi
563−
564−COMMON_FIELDS="allocated bytescopied cputime maxrss"
565−if test "$USE_GAUGE" -eq 1
566−then
567− ALL_FIELDS="$COMMON_FIELDS time cycles utime stime minflt majflt nvcsw nivcsw"
568−else
569− ALL_FIELDS="$COMMON_FIELDS"
570−fi
571−if test "$(has_item "$FIELDS" help)" = "help"
572−then
573− echo "Supported fields: $ALL_FIELDS"
574− echo "Default fields: $DEFAULT_FIELDS"
575− exit
576−fi
577−
578−if test "$LONG" -ne 0
579−then
580− if test -n "$TARGETS"
581− then
582− echo "Cannot specify benchmarks [$TARGETS] with --long"
583− exit
584− fi
585− TARGETS=$infinite_grp
586−fi
587−
588−DEFAULT_TARGETS="$(all_grp)"
589−TARGETS=$(set_targets)
590−
591−TARGETS_ORIG=$TARGETS
592−TARGETS=$(only_real_benchmarks)
593−
594−echo "Using benchmark suites [$TARGETS]"
595−
596−#-----------------------------------------------------------------------------
597−# Build reporting utility
598−#-----------------------------------------------------------------------------
599−
600−# We need to build the report progs first at the current (latest) commit before
601−# checking out any other commit for benchmarking.
602−build_report_progs
603−
604−#-----------------------------------------------------------------------------
605−# Build and run targets
606−#-----------------------------------------------------------------------------
607−
608−if test "$USE_GAUGE" -eq 1
609−then
610− BUILD_FLAGS="--flag use-gauge"
611−fi
612−
613−BUILD_BENCH="$CABAL_EXECUTABLE v2-build $BUILD_FLAGS $CABAL_BUILD_OPTIONS --enable-benchmarks"
614−if test "$MEASURE" = "1"
615−then
616− run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
617− run_measurements "$TARGETS"
618−fi
619−
620−#-----------------------------------------------------------------------------
621−# Run reports
622−#-----------------------------------------------------------------------------
623−
624−# $1: var name
625−build_comparison_results () {
626− local name
627− local constituents
628−
629− name=$1
630− constituents=$(eval "echo -n \$${name}")
631− mkdir -p "charts/$name"
632− dest_file="charts/$name/results.csv"
633− : > $dest_file
634− for j in $constituents
635− do
636− cat "charts/$j/results.csv" >> $dest_file
637− done
638−}
639−
640−if test "$COMPARE" -eq 1
641−then
642− DYN_CMP_GRP="$(echo "$TARGETS" | sed -e 's/ /_/g')_cmp"
643− eval "$DYN_CMP_GRP=\"$TARGETS\""
644− COMPARISON_REPORTS=$DYN_CMP_GRP
645− build_comparison_results $DYN_CMP_GRP
646−else
647− COMPARISON_REPORTS=""
648−fi
649−
650−for i in $COMPARISONS
651−do
652− if test "$(has_item "$TARGETS_ORIG" $i)" = $i
653− then
654− COMPARISON_REPORTS="$COMPARISON_REPORTS $i"
655− build_comparison_results $i
656− fi
657−done
658−
659−if test "$RAW" = "0"
660−then
661− run_reports "$TARGETS"
662− run_reports "$COMPARISON_REPORTS"
663− if test -n "$DYN_CMP_GRP"
664− then
665− rm -rf "charts/$DYN_CMP_GRP"
666− fi
667−fi
benchmark/bench-report/bin/build-lib.shdeleted−206
@@ -1,206 +0,0 @@
1−# $1: message
2−die () {
3− >&2 echo -e "Error: $1"
4− exit 1
5−}
6−
7−warn () {
8− >&2 echo -e "Warning: $1"
9−}
10−
11−# $1: command
12−function run_verbose() {
13− echo "$*"
14− bash -c "$*"
15−}
16−
17−has_item () {
18− for i in $1
19− do
20− if test "$i" = "$2"
21− then
22− echo "$i"
23− break
24− fi
25− done
26−}
27−
28−#------------------------------------------------------------------------------
29−# target groups
30−#------------------------------------------------------------------------------
31−
32−test_only () {
33− if test -n "$RUNNING_TESTS"
34− then
35− echo $1
36− fi
37−}
38−
39−bench_only () {
40− if test -n "$RUNNING_BENCHMARKS"
41− then
42− echo $1
43− fi
44−}
45−
46−dev_build () {
47− if test -n "$RUNNING_DEVBUILD"
48− then
49− echo $1
50− fi
51−}
52−
53−# A group consisting of all known individual targets
54−all_grp () {
55− { for i in $GROUP_TARGETS
56− do
57− for j in $(eval "echo \$$i")
58− do
59− echo $j
60− done
61− done
62− for i in $INDIVIDUAL_TARGETS
63− do
64− echo $i
65− done
66− } | sort | uniq
67−}
68−
69−# All groups
70−all_target_groups () {
71− echo $GROUP_TARGETS
72−}
73−
74−# XXX pass as arg
75−list_targets () {
76− echo "Individual targets:"
77− for i in $(all_grp)
78− do
79− echo "$i"
80− done
81− echo
82−}
83−
84−# XXX pass as arg
85−list_target_groups () {
86− echo "All Targets: all_grp"
87− echo "Target groups:"
88− for i in $(all_target_groups)
89− do
90− echo -n "$i ["
91− eval "echo -n \$$i"
92− echo "]"
93− done
94− echo
95−}
96−
97−# XXX pass as arg
98−set_targets() {
99− if test -z "$TARGETS"
100− then
101− echo $DEFAULT_TARGETS
102− else
103− for i in $(echo $TARGETS)
104− do
105− case $i in
106− *_grp) eval "echo -n \$${i}" ;;
107− *_cmp) eval "echo -n \$${i} $i" ;;
108− *) echo -n $i ;;
109− esac
110− echo -n " "
111− done
112− fi
113−}
114−
115−# XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables
116−
117−# $1: builddir
118−# $2: package name with version
119−# $3: component ("" (lib), t (test), b (benchmark), x (executable))
120−# $4: command to find
121−cabal_which_builddir() {
122− local path=$(echo $1/build/*/ghc-${GHC_VERSION}/${2}/$3/$4/build/$4/$4)
123− test -f "$path" && echo $path
124−}
125−
126−# $1: package name with version
127−# $2: component
128−# $3: command to find
129−cabal_which() {
130− cabal_which_builddir $BUILD_DIR $1 $2 $3
131−}
132−
133−# We run the benchmarks in isolation in a separate process so that different
134−# benchmarks do not interfere with other. To enable that we need to pass the
135−# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
136−# own path currently.
137−
138−# The path is dependent on the architecture and cabal version.
139−
140−# $1: package name with version
141−# $2: component
142−# $3: target
143−cabal_target_prog () {
144− local target_prog=`cabal_which $1 $2 $3`
145− if test -x "$target_prog"
146− then
147− echo $target_prog
148− else
149− return 1
150− fi
151−}
152−
153−set_common_vars () {
154− SLOW=0
155− QUICK_MODE=0
156−
157− RUNNING_DEVBUILD=
158−
159− TARGET_EXE_ARGS=
160− RTS_OPTIONS=
161−
162− CABAL_BUILD_OPTIONS=""
163− CABAL_EXECUTABLE=cabal
164−
165− # Use branch specific builds if git-cabal is present in PATH
166− BUILD_DIR=dist-newstyle
167− if test "$USE_GIT_CABAL" -eq 1
168− then
169− if which git-cabal 2>/dev/null
170− then
171− echo "Using git-cabal for branch specific builds"
172− CABAL_EXECUTABLE=git-cabal
173− BUILD_DIR=$(git-cabal show-builddir)
174− fi
175− fi
176−}
177−
178−# To be called after parsing CLI arguments
179−set_derived_vars () {
180− if test -n "$CABAL_WITH_COMPILER"
181− then
182− CABAL_BUILD_OPTIONS+=" --with-compiler $CABAL_WITH_COMPILER"
183− else
184− CABAL_WITH_COMPILER=ghc
185− fi
186−
187− GHC_VERSION=$($CABAL_WITH_COMPILER --numeric-version)
188−}
189−
190−# $1: build program
191−# $2: package name
192−# $3: component prefix
193−# $4: targets
194−run_build () {
195− local build_prog=$1
196− local package=$2
197− local component_prefix=$3
198− local COMPONENTS
199− local c
200−
201− for c in $4
202− do
203− COMPONENTS+="$package:$component_prefix:$c "
204− done
205− run_verbose $build_prog $COMPONENTS || die "build failed"
206−}
benchmark/bench-report/default.nixdeleted−50
@@ -1,50 +0,0 @@
1−{
2− nixpkgs ?
3− # nixpkgs 21.05 needs a revised version of bench-show and we do not
4− # know how to use a revised version in nix.
5− #import (builtins.fetchTarball https://github.com/NixOS/nixpkgs/archive/refs/tags/21.05.tar.gz)
6− import (builtins.fetchTarball https://github.com/composewell/nixpkgs/archive/01dd2b4e738.tar.gz)
7− {}
8−#, compiler ? "ghc884" # For nix 21.05
9−, compiler ? "default"
10−}:
11−let haskellPackages =
12− if compiler == "default"
13− then nixpkgs.haskellPackages
14− else nixpkgs.haskell.packages.${compiler};
15−
16− mkPackage = super: pkg: path: opts: inShell:
17− let orig = super.callCabal2nixWithOptions pkg path opts {};
18− in if inShell
19− # Avoid copying the source directory to nix store by using
20− # src = null.
21− then orig.overrideAttrs (oldAttrs: { src = null; })
22− else orig;
23−
24− mkHaskellPackages = inShell:
25− haskellPackages.override {
26− overrides = self: super:
27− with nixpkgs.haskell.lib;
28− {
29− bench-report = mkPackage super "bench-report" ./. "" inShell;
30− };
31− };
32−
33− drv = mkHaskellPackages true;
34−
35− shell = drv.shellFor {
36− packages = p:
37− [ p.bench-report
38− ];
39− # Use a better prompt
40− shellHook = ''
41− export CABAL_DIR="$(pwd)/.cabal.nix"
42− if test -n "$PS_SHELL"
43− then
44− export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
45− fi
46− '';
47− };
48−in if nixpkgs.lib.inNixShell
49− then shell
50− else (mkHaskellPackages false).bench-report
benchmark/bench-runner/Main.hsnew file+183
@@ -0,0 +1,183 @@
1+module Main (main) where
2+
3+import BenchRunner (mainWith)
4+import BuildLib (Quickness(..))
5+import Control.Applicative ((<|>))
6+import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
7+
8+import Targets (targets)
9+
10+rtsOpts :: String -> String -> String
11+rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]
12+
13+ where
14+
15+ -- Drop All.
16+ benchName = drop 4 benchName0
17+
18+ general
19+ -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
20+ | "o-1-sp" `isInfixOf` benchName = "-K36K -M32M"
21+ | "o-n-h" `isInfixOf` benchName = "-K36K -M32M"
22+ -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
23+ | "o-n-st" `isInfixOf` benchName = "-K1M -M32M"
24+ | "o-n-sp" `isInfixOf` benchName = "-K1M -M32M"
25+ | otherwise = ""
26+
27+ exeSpecific
28+ | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M"
29+ | otherwise = ""
30+
31+ benchSpecific
32+ -- GHC-9.6 requires 64M, earlier it was 16M
33+ | "Data.Fold/o-n-heap.key-value.toHashMapIO (max buckets) sum" == benchName =
34+ "-M64M"
35+
36+ -- This is required only for the --long case because we allocate all
37+ -- the arrays upfront. depends on the size of the stream.
38+ | "Data.Parser/o-1-space" `isPrefixOf` benchName =
39+ "-M128M"
40+
41+ -----------------------------------------------------------------------
42+
43+ | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = "-M256M"
44+ | "Prelude.Parallel/o-n-heap.monad-outer-product."
45+ `isPrefixOf` benchName = "-M256M"
46+ | "Prelude.Parallel/o-n-space.monad-outer-product."
47+ `isPrefixOf` benchName = "-K2M -M256M"
48+ | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
49+ | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
50+ | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
51+ | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
52+ "-K4M"
53+ | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
54+ "-K128K -M32M"
55+ | "Prelude.Ahead/o-1-space." `isPrefixOf` benchName = "-K128K"
56+ | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
57+ "-K4M"
58+ | "Prelude.WAsync/o-n-heap.monad-outer-product.toNull3" == benchName =
59+ "-M64M"
60+ | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
61+ "-K4M"
62+
63+ -- This module is dev only now, and can be removed at some point
64+ | "Data.Stream.StreamDK/o-1-space.grouping.classifySessionsOf"
65+ `isPrefixOf` benchName = "-K512K"
66+ | "Data.Stream.StreamDK/o-n-space.foldr.foldrM/"
67+ `isPrefixOf` benchName = "-K4M"
68+ | "Data.Stream.StreamDK/o-n-space.iterated."
69+ `isPrefixOf` benchName = "-K4M -M64M"
70+ -- GHC 9.4.4 requires 4M
71+ | "Data.Stream.StreamDK/o-n-space.traversable."
72+ `isPrefixOf` benchName = "-K4M"
73+ -- GHC-9.6 requires 64M, earlier it was 32M
74+ | "Data.Stream.StreamDK/o-n-heap.buffered.readsPrec pure streams" == benchName =
75+ "-M64M"
76+ -- GHC-9.6 requires 64M, earlier it was 32M
77+ | "Data.Stream.StreamDK/o-n-heap.buffered.showPrec Haskell lists" == benchName =
78+ "-M64M"
79+
80+ -----------------------------------------------------------------------
81+
82+ | "Data.StreamD/o-n-space.elimination.toList" == benchName =
83+ "-K2M"
84+ | "Data.StreamK/o-n-space.elimination.toList" == benchName =
85+ "-K2M"
86+
87+ -----------------------------------------------------------------------
88+
89+ | "Data.Stream/o-1-space.grouping.classifySessionsOf"
90+ `isPrefixOf` benchName = "-K512K"
91+ | "Data.Stream/o-n-space.foldr.foldrM/"
92+ `isPrefixOf` benchName = "-K4M"
93+ | "Data.Stream/o-n-space.iterated."
94+ `isPrefixOf` benchName = "-K4M"
95+
96+ -- GHC-9.6 requires 64M, earlier it was 32M
97+ | "Data.Stream/o-n-heap.buffered.showPrec Haskell lists" == benchName =
98+ "-M64M"
99+ -- GHC-9.6 requires 64M, earlier it was 32M
100+ | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" == benchName =
101+ "-M64M"
102+
103+ | "Data.Stream.ConcurrentEager/o-n-heap.monad-outer-product.toNullAp"
104+ `isPrefixOf` benchName = "-M1024M"
105+ | "Data.Stream.ConcurrentEager/o-1-space."
106+ `isPrefixOf` benchName = "-M128M"
107+
108+ | "Data.Stream.ConcurrentOrdered/o-1-space.concat-foldable.foldMapWith"
109+ `isPrefixOf` benchName = "-K128K"
110+
111+ ----------------------------------------------------------------------
112+
113+ | "Data.Array" `isPrefixOf` benchName
114+ && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M"
115+ -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
116+ | "Data.Array" `isPrefixOf` benchName
117+ && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M64M"
118+ -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
119+ | "Data.Array.Generic/o-1-space.transformationX4.map"
120+ `isPrefixOf` benchName = "-M64M"
121+
122+ -- XXX For --long option, need to check why so much heap is required.
123+ -- Note, if we remove the chunked stream module we need to keep the
124+ -- chunked stream benchmarks in the stream module.
125+ | "Data.Array.Stream/o-1-space"
126+ `isPrefixOf` benchName = "-K4M -M512M"
127+ -- XXX Takes up to 160MB heap for --long, we use chunked stream for
128+ -- this, so the reason may be related to chunked streams.
129+ | "Data.ParserK/o-1-space"
130+ `isPrefixOf` benchName = "-K4M -M256M"
131+
132+ -----------------------------------------------------------------------
133+
134+ | "Unicode.Char/o-1-space." `isPrefixOf` benchName = "-M32M"
135+
136+ | otherwise = ""
137+
138+speedOpts :: String -> String -> Maybe Quickness
139+speedOpts exeName benchName0 = exeSpecific <|> benchSpecific
140+
141+ where
142+
143+ -- slowestOf Quicker _ = Quicker
144+ -- slowestOf _ Quicker = Quicker
145+ -- slowestOf _ _ = SuperQuick
146+
147+ -- Drop All.
148+ benchName = drop 4 benchName0
149+ exeSpecific
150+ | "Prelude.Concurrent" == exeName = Just SuperQuick
151+ | "Prelude.Rate" == exeName = Just SuperQuick
152+ | "Prelude.Adaptive" == exeName = Just SuperQuick
153+ | otherwise = Nothing
154+ benchSpecific
155+ | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName =
156+ Just SuperQuick
157+ | "Prelude.Parallel/o-n-heap.monad-outer-product."
158+ `isPrefixOf` benchName = Just SuperQuick
159+ | "Prelude.Parallel.o-n-space.monad-outer-product."
160+ `isPrefixOf` benchName = Just SuperQuick
161+ | "Prelude.Parallel/o-n-heap.generation." `isPrefixOf` benchName =
162+ Just Quicker
163+ | "Prelude.Parallel/o-n-heap.mapping." `isPrefixOf` benchName =
164+ Just Quicker
165+ | "Prelude.Parallel/o-n-heap.concat-foldable." `isPrefixOf` benchName =
166+ Just Quicker
167+ | "Prelude.Async/o-1-space.monad-outer-product." `isPrefixOf` benchName =
168+ Just Quicker
169+ | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
170+ Just Quicker
171+ | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
172+ Just Quicker
173+ | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
174+ Just Quicker
175+ | "Prelude.WAsync/o-n-heap.monad-outer-product." `isPrefixOf` benchName =
176+ Just Quicker
177+ | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
178+ Just Quicker
179+ | "FileSystem.Handle." `isPrefixOf` benchName = Just Quicker
180+ | otherwise = Nothing
181+
182+main :: IO ()
183+main = mainWith targets speedOpts rtsOpts
benchmark/bench-runner/bench-runner.cabalnew file+42
@@ -0,0 +1,42 @@
1+cabal-version: 2.4
2+name: bench-runner
3+version: 0.1.0.0
4+
5+-- A short (one-line) description of the package.
6+-- synopsis:
7+
8+-- A longer description of the package.
9+-- description:
10+
11+-- A URL where users can report bugs.
12+-- bug-reports:
13+
14+-- The license under which the package is released.
15+-- license:
16+
17+-- The package author(s).
18+-- author:
19+
20+-- An email address to which users can send suggestions, bug reports, and patches.
21+-- maintainer:
22+
23+-- A copyright notice.
24+-- copyright:
25+-- category:
26+-- extra-source-files: CHANGELOG.md
27+
28+executable bench-runner
29+ ghc-options: -Wall
30+ main-is: Main.hs
31+
32+ -- Modules included in this executable, other than Main.
33+ -- other-modules:
34+
35+ -- LANGUAGE extensions used by modules in this package.
36+ -- other-extensions:
37+ build-depends: base
38+ , bench-report
39+ , containers
40+ , streamly-targets
41+ hs-source-dirs: .
42+ default-language: Haskell2010
benchmark/bench-runner/cabal.projectnew file+4
@@ -0,0 +1,4 @@
1+packages: . ../../targets
2+
3+package bench-report
4+ flags: +no-charts
benchmark/bench-runner/default.nixnew file+164
@@ -0,0 +1,164 @@
1+let
2+ nixpkgsPath_21_11 =
3+ "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.11.tar.gz";
4+ nixpkgsDefault = import (builtins.fetchTarball nixpkgsPath_21_11) { };
5+in
6+{
7+ nixpkgs ? nixpkgsDefault
8+, compiler ? "default"
9+}:
10+let haskellPackages =
11+ if compiler == "default"
12+ then nixpkgs.haskellPackages
13+ else nixpkgs.haskell.packages.${compiler};
14+
15+ mkPackage = super: pkg: path: opts: inShell:
16+ let orig = super.callCabal2nixWithOptions pkg path opts {};
17+ in if inShell
18+ # Avoid copying the source directory to nix store by using
19+ # src = null.
20+ then orig.overrideAttrs (oldAttrs: { src = null; })
21+ else orig;
22+
23+ mkPkgGit = super: gitSrc: rev: name:
24+ let
25+ src = builtins.fetchGit {
26+ url = gitSrc;
27+ rev = rev;
28+ };
29+ in super.callCabal2nix name src { };
30+
31+ mkPkgGitRef = super: gitSrc: rev: ref: name:
32+ let
33+ src = builtins.fetchGit {
34+ url = gitSrc;
35+ rev = rev;
36+ ref = ref;
37+ };
38+ in super.callCabal2nix name src { };
39+
40+ mkHaskellPackages = inShell:
41+ haskellPackages.override {
42+ overrides = self: super:
43+ with nixpkgs.haskell.lib;
44+ {
45+ bench-runner = mkPackage super "bench-runner" ./. "" inShell;
46+ streamly-targets = mkPackage super "streamly-targets" ../../targets "" false;
47+
48+ bench-report =
49+ nixpkgs.haskell.lib.overrideCabal
50+ (let src = fetchGit {
51+ url = "git@github.com:composewell/bench-report.git";
52+ rev = "3b50bf0ad06f746bca42f30c8d40a0426e159af3";
53+ }; in super.callCabal2nix "bench-report" src {})
54+ (old:
55+ { enableLibraryProfiling = false;
56+ doHaddock = false;
57+ });
58+
59+ bench-show = super.callHackageDirect {
60+ pkg = "bench-show";
61+ ver = "0.3.2";
62+ sha256 = "16b8vyzdp9b5bh34kqmbfwjsyv8wgnxxwl8kjcpgxjsh52xzyaa0";
63+ } { };
64+
65+# streamly-coreutils = let
66+# src = "git@github.com:composewell/streamly-coreutils.git";
67+# rev = "a12756efe24bbf303f2f6d66a95426c7657d297b";
68+# in mkPkgGit super src rev "streamly-coreutils";
69+
70+ streamly-coreutils =
71+ nixpkgs.haskell.lib.overrideCabal
72+ (let src = fetchGit {
73+ url = "git@github.com:composewell/streamly-coreutils.git";
74+ rev = "b1e6fc37f0e898c54378129750d3ccc1c034f611";
75+ }; in super.callCabal2nix "streamly-coreutils" src {})
76+ (old:
77+ { librarySystemDepends =
78+ if builtins.currentSystem == "x86_64-darwin"
79+ then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
80+ else [];
81+ #enableLibraryProfiling = false;
82+ doHaddock = false;
83+ doCheck = false;
84+ });
85+
86+ streamly-shell = let
87+ src = "https://github.com/composewell/streamly-shell.git";
88+ rev = "1b3fea3239ebe47963955d81565b9d5e34567ab7";
89+ in mkPkgGit super src rev "streamly-shell";
90+
91+ streamly-process = let
92+ src = "https://github.com/composewell/streamly-process.git";
93+ rev = "e310c8a9c6e61515373a2f5f1fb82f6e15fe452b";
94+ in nixpkgs.haskell.lib.dontCheck
95+ (mkPkgGit super src rev "streamly-process");
96+
97+ #streamly-process = nixpkgs.haskell.lib.dontCheck
98+ # (super.callHackageDirect {
99+ # pkg = "streamly-process";
100+ # ver = "0.1.0";
101+ # sha256 = "01nxisqfmn29fbirdsx71sfjp2rdqwrf469qyjcql2d11i1bxn94";
102+ # } { });
103+
104+ # streamly = super.callHackageDirect {
105+ # pkg = "streamly";
106+ # ver = "0.8.0";
107+ # sha256 = "0vy2lkljizlhpbpbybmg9jcmj2g4s1aaqd2dzy5c0y0n4rgwxask";
108+ # } { };
109+ streamly =
110+ nixpkgs.haskell.lib.overrideCabal
111+ #(super.callHackageDirect
112+ # { pkg = "streamly";
113+ # ver = "0.8.2";
114+ # sha256 = "sha256-CjFq9SCdbgLZa7NqOE4OtC8OaFg4vK8VmIDjGU5rGko=";
115+ # } {})
116+ (let src = fetchGit {
117+ url = "git@github.com:composewell/streamly.git";
118+ rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
119+ }; in super.callCabal2nix "streamly" src {})
120+ (old:
121+ { librarySystemDepends =
122+ if builtins.currentSystem == "x86_64-darwin"
123+ then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
124+ else [];
125+ #enableLibraryProfiling = false;
126+ doHaddock = false;
127+ });
128+
129+ streamly-core =
130+ nixpkgs.haskell.lib.overrideCabal
131+ (let src = fetchGit {
132+ url = "git@github.com:composewell/streamly.git";
133+ rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
134+ }; in super.callCabal2nix "streamly-core" "${src}/core" {})
135+ (old:
136+ { librarySystemDepends =
137+ if builtins.currentSystem == "x86_64-darwin"
138+ then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
139+ else [];
140+ #enableLibraryProfiling = false;
141+ doHaddock = false;
142+ });
143+
144+ };
145+ };
146+
147+ drv = mkHaskellPackages true;
148+
149+ shell = drv.shellFor {
150+ packages = p:
151+ [ p.bench-runner
152+ ];
153+ # Use a better prompt
154+ shellHook = ''
155+ export CABAL_DIR="$(pwd)/.cabal.nix"
156+ if test -n "$PS_SHELL"
157+ then
158+ export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
159+ fi
160+ '';
161+ };
162+in if nixpkgs.lib.inNixShell
163+ then shell
164+ else (mkHaskellPackages false).bench-runner
benchmark/lib/Streamly/Benchmark/Common.hs+11−12
@@ -1,7 +1,5 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−#if __GLASGOW_HASKELL__ >= 800
3{-# OPTIONS_GHC -Wno-orphans #-}
2{-# OPTIONS_GHC -Wno-orphans #-}
4−#endif
5
3
6-- |
4-- |
7-- Module : Streamly.Benchmark.Common
5-- Module : Streamly.Benchmark.Common
@@ -55,10 +53,10 @@ import Control.DeepSeq (NFData(..))
55import Data.Functor.Identity (Identity, runIdentity)
53import Data.Functor.Identity (Identity, runIdentity)
56import System.Random (randomRIO)
54import System.Random (randomRIO)
57
55
58−import qualified Streamly.Prelude as S
56+import qualified Streamly.Internal.Data.Fold as Fold
57+import qualified Streamly.Internal.Data.Stream as S
59
58
60−import Streamly.Prelude (SerialT)
59+import Test.Tasty.Bench
61−import Gauge
62
60
63-------------------------------------------------------------------------------
61-------------------------------------------------------------------------------
64-- Benchmark Prefixes
62-- Benchmark Prefixes
@@ -80,10 +78,6 @@ o_n_stack_prefix name = name ++ "/o-n-stack"
80-- Benchmarking utilities
78-- Benchmarking utilities
81-------------------------------------------------------------------------------
79-------------------------------------------------------------------------------
82
80
83−#if !MIN_VERSION_deepseq(1,4,3)
84−instance NFData Ordering where rnf = (`seq` ())
85−#endif
86−
87-- XXX once we convert all the functions to use this we can rename this to
81-- XXX once we convert all the functions to use this we can rename this to
88-- benchIOSink
82-- benchIOSink
89{-# INLINE benchIOSink1 #-}
83{-# INLINE benchIOSink1 #-}
@@ -113,8 +107,12 @@ benchPureSink1 name f =
113 bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
107 bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
114
108
115{-# INLINE benchPureSrc #-}
109{-# INLINE benchPureSrc #-}
116−benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
110+benchPureSrc :: String -> (Int -> S.Stream Identity a) -> Benchmark
117−benchPureSrc name src = benchPure name src (runIdentity . S.drain)
111+benchPureSrc name src = benchPure name src (runIdentity . drain)
112+
113+ where
114+
115+ drain = S.fold Fold.drain
118
116
119-------------------------------------------------------------------------------
117-------------------------------------------------------------------------------
120-- String/List generation for read instances
118-- String/List generation for read instances
@@ -244,8 +242,9 @@ runWithCLIOptsEnv defStreamSize alloc mkBench = do
244 r <- alloc value
242 r <- alloc value
245 value `seq` runMode (mode cfg) cfg benches (mkBench r value)
243 value `seq` runMode (mode cfg) cfg benches (mkBench r value)
246#else
244#else
245+ r0 <- alloc 0
247 (value, ingredients) <-
246 (value, ingredients) <-
248− parseCLIOpts defStreamSize $ bgroup "All" (mkBench undefined 0)
247+ parseCLIOpts defStreamSize $ bgroup "All" (mkBench r0 0)
249 r <- alloc value
248 r <- alloc value
250 value `seq` defaultMainWithIngredients ingredients
249 value `seq` defaultMainWithIngredients ingredients
251 $ bgroup "All" (mkBench r value)
250 $ bgroup "All" (mkBench r value)
benchmark/lib/Streamly/Benchmark/Common/Handle.hs+15−4
@@ -30,20 +30,25 @@ module Streamly.Benchmark.Common.Handle
30 , isSpace
30 , isSpace
31 , isSp
31 , isSp
32 , mkHandleBenchEnv
32 , mkHandleBenchEnv
33+ , Handles(..)
34+ , getHandles
33 )
35 )
34where
36where
35
37
36import Control.DeepSeq (NFData(rnf))
38import Control.DeepSeq (NFData(rnf))
37import Data.Char (ord, chr)
39import Data.Char (ord, chr)
40+#if MIN_VERSION_base(4,17,0)
41+import Data.Char (generalCategory, GeneralCategory(Space))
42+#endif
38import Data.Word (Word8)
43import Data.Word (Word8)
39import System.Directory (getFileSize)
44import System.Directory (getFileSize)
40import System.Environment (lookupEnv)
45import System.Environment (lookupEnv)
41import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)
46import System.IO (openFile, IOMode(..), Handle, hClose, stderr, hPutStrLn)
42−import System.Process.Typed (shell, runProcess_)
47+import System.Process (callCommand)
43
48
44import Data.IORef
49import Data.IORef
45import Prelude hiding (last, length)
50import Prelude hiding (last, length)
46−import Gauge hiding (env)
51+import Test.Tasty.Bench hiding (env)
47
52
48
53
49scratchDir :: String
54scratchDir :: String
@@ -140,8 +145,10 @@ mkBenchSmall name env action =
140
145
141 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
146 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
142
147
148+#if !MIN_VERSION_base(4,17,0)
143foreign import ccall unsafe "u_iswspace"
149foreign import ccall unsafe "u_iswspace"
144 iswspace :: Int -> Int
150 iswspace :: Int -> Int
151+#endif
145
152
146-- Code copied from base/Data.Char to INLINE it
153-- Code copied from base/Data.Char to INLINE it
147{-# INLINE isSpace #-}
154{-# INLINE isSpace #-}
@@ -154,7 +161,11 @@ isSpace :: Char -> Bool
154-- so we'll do it like this until there's a way around that.
161-- so we'll do it like this until there's a way around that.
155isSpace c
162isSpace c
156 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
163 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
164+#if MIN_VERSION_base(4,17,0)
165+ | otherwise = generalCategory c == Space
166+#else
157 | otherwise = iswspace (ord c) /= 0
167 | otherwise = iswspace (ord c) /= 0
168+#endif
158 where
169 where
159 uc = fromIntegral (ord c) :: Word
170 uc = fromIntegral (ord c) :: Word
160
171
@@ -183,8 +194,8 @@ mkHandleBenchEnv = do
183 ++ "\" && head -c " ++ show size
194 ++ "\" && head -c " ++ show size
184 ++ " </dev/urandom >" ++ infile
195 ++ " </dev/urandom >" ++ infile
185 ++ ";}"
196 ++ ";}"
186− runProcess_ (shell (cmd inFileSmall smallFileSize))
197+ callCommand (cmd inFileSmall smallFileSize)
187− runProcess_ (shell (cmd inFileBig bigFileSize))
198+ callCommand (cmd inFileBig bigFileSize)
188 return (inFileSmall, inFileBig)
199 return (inFileSmall, inFileBig)
189
200
190 hPutStrLn stderr $ "Using small input file: " ++ small
201 hPutStrLn stderr $ "Using small input file: " ++ small
benchmark/lib/Streamly/Benchmark/Prelude.hs+59−7
@@ -1,3 +1,5 @@
1+{-# OPTIONS_GHC -Wno-deprecations #-}
2+
1-- |
3-- |
2-- Module : Streamly.Benchmark.Prelude
4-- Module : Streamly.Benchmark.Prelude
3-- Copyright : (c) 2018 Composewell Technologies
5-- Copyright : (c) 2018 Composewell Technologies
@@ -10,16 +12,66 @@
10{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE RankNTypes #-}
13{-# LANGUAGE RankNTypes #-}
12
14
13−module Streamly.Benchmark.Prelude where
15+module Streamly.Benchmark.Prelude
16+ ( absTimes
17+ , apDiscardFst
18+ , apDiscardSnd
19+ , apLiftA2
20+ , benchIO
21+ , benchIOSink
22+ , benchIOSrc
23+ , breakAfterSome
24+ , composeN
25+ , concatFoldableWith
26+ , concatForFoldableWith
27+ , concatPairsWith
28+ , concatStreamsWith
29+ , filterAllInM
30+ , filterAllOutM
31+ , filterSome
32+ , fmapN
33+ , mapM
34+ , mapN
35+ , mkAsync
36+ , monadThen
37+ , runToList
38+ , sourceConcatMapId
39+ , sourceFoldMapM
40+ , sourceFoldMapWith
41+ , sourceFoldMapWithM
42+ , sourceFoldMapWithStream
43+ , sourceFracFromThenTo
44+ , sourceFracFromTo
45+ , sourceFromFoldable
46+ , sourceFromFoldableM
47+ , sourceFromList
48+ , sourceFromListM
49+ , sourceIntegerFromStep
50+ , sourceIntFromThenTo
51+ , sourceIntFromTo
52+ , sourceUnfoldr
53+ , sourceUnfoldrAction
54+ , sourceUnfoldrM
55+ , sourceUnfoldrMSerial
56+ , toListM
57+ , toListSome
58+ , toNull
59+ , toNullAp
60+ , toNullM
61+ , toNullM3
62+ , transformComposeMapM
63+ , transformMapM
64+ , transformTeeMapM
65+ , transformZipMapM
66+ )
67+where
14
68
15import Control.Applicative (liftA2)
69import Control.Applicative (liftA2)
16import Control.DeepSeq (NFData(..))
70import Control.DeepSeq (NFData(..))
17import Control.Exception (try)
71import Control.Exception (try)
18import Data.Functor.Identity (Identity)
72import Data.Functor.Identity (Identity)
19−#if !(MIN_VERSION_base(4,11,0))
20−import Data.Semigroup (Semigroup((<>)))
21−#endif
22import GHC.Exception (ErrorCall)
73import GHC.Exception (ErrorCall)
74+import Prelude hiding (mapM)
23import System.Random (randomRIO)
75import System.Random (randomRIO)
24
76
25import qualified Data.Foldable as F
77import qualified Data.Foldable as F
@@ -30,7 +82,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
30import qualified Streamly.Internal.Data.Pipe as Pipe
82import qualified Streamly.Internal.Data.Pipe as Pipe
31import qualified Streamly.Internal.Data.Stream.Serial as Serial
83import qualified Streamly.Internal.Data.Stream.Serial as Serial
32
84
33−import Gauge
85+import Test.Tasty.Bench
34import Streamly.Internal.Data.Time.Units
86import Streamly.Internal.Data.Time.Units
35
87
36-- Common polymorphic stream APIs used across multiple stream modules
88-- Common polymorphic stream APIs used across multiple stream modules
@@ -346,7 +398,7 @@ sourceConcatMapId value n =
346
398
347{-# INLINE concatStreamsWith #-}
399{-# INLINE concatStreamsWith #-}
348concatStreamsWith
400concatStreamsWith
349− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
401+ :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)
350 -> Int
402 -> Int
351 -> Int
403 -> Int
352 -> Int
404 -> Int
@@ -358,7 +410,7 @@ concatStreamsWith op outer inner n =
358
410
359{-# INLINE concatPairsWith #-}
411{-# INLINE concatPairsWith #-}
360concatPairsWith
412concatPairsWith
361− :: (forall c. S.SerialT IO c -> S.SerialT IO c -> S.SerialT IO c)
413+ :: (S.SerialT IO Int -> S.SerialT IO Int -> S.SerialT IO Int)
362 -> Int
414 -> Int
363 -> Int
415 -> Int
364 -> Int
416 -> Int
benchmark/streamly-benchmarks.cabal+426−169
@@ -39,6 +39,11 @@ flag dev
39 manual: True
39 manual: True
40 default: False
40 default: False
41
41
42+flag include-strict-utf8
43+ description: Include strict utf8 input benchmarks
44+ manual: True
45+ default: False
46+
42flag has-llvm
47flag has-llvm
43 description: Use llvm backend for better performance
48 description: Use llvm backend for better performance
44 manual: True
49 manual: True
@@ -49,8 +54,13 @@ flag opt
49 manual: True
54 manual: True
50 default: True
55 default: True
51
56
52−flag use-gauge
57+flag use-streamly-core
58+ description: Benchmark only core package
59+ manual: True
60+ default: False
61+
62+flag use-prelude
53− description: Use gauge instead of tasty-bench for benchmarking
63+ description: Use Prelude instead of Data.Stream for serial benchmarks
54 manual: True
64 manual: True
55 default: False
65 default: False
56
66
@@ -58,24 +68,81 @@ flag use-gauge
58-- Common stanzas
68-- Common stanzas
59-------------------------------------------------------------------------------
69-------------------------------------------------------------------------------
60
70
71+common default-extensions
72+ default-extensions:
73+ BangPatterns
74+ CApiFFI
75+ CPP
76+ ConstraintKinds
77+ DeriveDataTypeable
78+ DeriveGeneric
79+ DeriveTraversable
80+ ExistentialQuantification
81+ FlexibleContexts
82+ FlexibleInstances
83+ GeneralizedNewtypeDeriving
84+ InstanceSigs
85+ KindSignatures
86+ LambdaCase
87+ MagicHash
88+ MultiParamTypeClasses
89+ PatternSynonyms
90+ RankNTypes
91+ RecordWildCards
92+ ScopedTypeVariables
93+ TupleSections
94+ TypeApplications
95+ TypeFamilies
96+ TypeOperators
97+ ViewPatterns
98+
99+ -- MonoLocalBinds, enabled by TypeFamilies, causes performance
100+ -- regressions. Disable it. This must come after TypeFamilies,
101+ -- otherwise TypeFamilies will enable it again.
102+ NoMonoLocalBinds
103+
104+ -- UndecidableInstances -- Does not show any perf impact
105+ -- UnboxedTuples -- interferes with (#.)
106+
61common compile-options
107common compile-options
108+ import: default-extensions
62 default-language: Haskell2010
109 default-language: Haskell2010
63
110
111+ if flag(use-streamly-core)
112+ cpp-options: -DUSE_STREAMLY_CORE
113+
64 if flag(dev)
114 if flag(dev)
65 cpp-options: -DDEVBUILD
115 cpp-options: -DDEVBUILD
66
116
117+ if flag(include-strict-utf8)
118+ cpp-options: -DINCLUDE_STRICT_UTF8
119+
67 if flag(inspection)
120 if flag(inspection)
68 cpp-options: -DINSPECTION
121 cpp-options: -DINSPECTION
69
122
70− ghc-options: -Wall
123+ ghc-options: -Weverything
71− -Wcompat
124+ -Wno-implicit-prelude
72− -Wunrecognised-warning-flags
125+ -Wno-missing-deriving-strategies
73− -Widentities
126+ -Wno-missing-exported-signatures
74− -Wincomplete-record-updates
127+ -Wno-missing-import-lists
75− -Wincomplete-uni-patterns
128+ -Wno-missing-local-signatures
76− -Wredundant-constraints
129+ -Wno-missing-safe-haskell-mode
77− -Wnoncanonical-monad-instances
130+ -Wno-missed-specialisations
131+ -Wno-all-missed-specialisations
132+ -Wno-monomorphism-restriction
133+ -Wno-prepositive-qualified-module
134+ -Wno-unsafe
135+ -Wno-unused-packages
78− -Rghc-timing
136+ -Rghc-timing
137+
138+ if impl(ghc >= 9.2)
139+ ghc-options:
140+ -Wno-missing-kind-signatures
141+ -Wno-operator-whitespace
142+
143+ if impl(ghc >= 9.8)
144+ ghc-options:
145+ -Wno-missing-role-annotations
79
146
80 if flag(has-llvm)
147 if flag(has-llvm)
81 ghc-options: -fllvm
148 ghc-options: -fllvm
@@ -84,15 +151,17 @@ common compile-options
84 ghc-options: -Wmissed-specialisations
151 ghc-options: -Wmissed-specialisations
85 -Wall-missed-specialisations
152 -Wall-missed-specialisations
86
153
87− if flag(dev) || flag(debug)
88− ghc-options: -fno-ignore-asserts
89−
90common optimization-options
154common optimization-options
91 if flag(opt)
155 if flag(opt)
92 ghc-options: -O2
156 ghc-options: -O2
93 -fdicts-strict
157 -fdicts-strict
94 -fspec-constr-recursive=16
158 -fspec-constr-recursive=16
95 -fmax-worker-args=16
159 -fmax-worker-args=16
160+
161+ -- For this to be effective it must come after the -O2 option
162+ if flag(dev) || flag(debug)
163+ ghc-options: -fno-ignore-asserts
164+
96 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
165 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
97 ghc-options: -fplugin Fusion.Plugin
166 ghc-options: -fplugin Fusion.Plugin
98 else
167 else
@@ -106,37 +175,34 @@ common bench-depends
106 -- Core libraries shipped with ghc, the min and max
175 -- Core libraries shipped with ghc, the min and max
107 -- constraints of these libraries should match with
176 -- constraints of these libraries should match with
108 -- the GHC versions we support
177 -- the GHC versions we support
109− base >= 4.9 && < 5
178+ base >= 4.9 && < 4.20
110− , deepseq >= 1.4.1 && < 1.5
179+ , deepseq >= 1.4.1 && < 1.6
111− , mtl >= 2.2 && < 3
180+ , mtl >= 2.2 && < 2.3.2
112
181
113 -- other libraries
182 -- other libraries
114− , streamly >= 0.7.0
183+ , exceptions >= 0.8 && < 0.11
115 , random >= 1.0 && < 2.0
184 , random >= 1.0 && < 2.0
116− , transformers >= 0.4 && < 0.6
185+ , transformers >= 0.4 && < 0.7
117− , containers >= 0.5 && < 0.7
186+ , containers >= 0.5 && < 0.8
118− , typed-process >= 0.2.3 && < 0.3
187+ , hashable >= 1.3 && < 1.5
188+ , unordered-containers >= 0.2 && < 0.3
189+ , process >= 1.4 && < 1.7
119 , directory >= 1.2.2 && < 1.4
190 , directory >= 1.2.2 && < 1.4
120− , filepath >= 1.4.1 && < 1.5
191+ , filepath >= 1.4.1 && < 1.6
121− , ghc-prim >= 0.4 && < 0.8
192+ , ghc-prim >= 0.4 && < 0.12
193+ , tasty-bench >= 0.3 && < 0.4
194+ , tasty >= 1.4.1 && < 1.6
195+ , streamly-core
122
196
123− if flag(use-gauge)
197+ if !flag(use-streamly-core)
124− build-depends: gauge >= 0.2.4 && < 0.3
125− else
126− build-depends: tasty-bench >= 0.2.5 && < 0.3
198+ build-depends: streamly
127− , tasty >= 1.4.1
128− mixins: tasty-bench
129− (Test.Tasty.Bench as Gauge
130− , Test.Tasty.Bench as Gauge.Main
131− )
132
199
133 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
200 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
134 build-depends:
201 build-depends:
135 fusion-plugin >= 0.2 && < 0.3
202 fusion-plugin >= 0.2 && < 0.3
136 if flag(inspection)
203 if flag(inspection)
137− build-depends: template-haskell >= 2.14 && < 2.17
204+ build-depends: template-haskell >= 2.14 && < 2.22
138− , inspection-testing >= 0.4 && < 0.5
205+ , inspection-testing >= 0.4 && < 0.6
139− , ghc-prim >= 0.2 && < 0.7
140 -- Array uses a Storable constraint in dev build making several inspection
206 -- Array uses a Storable constraint in dev build making several inspection
141 -- tests fail
207 -- tests fail
142 if flag(dev) && flag(inspection)
208 if flag(dev) && flag(inspection)
@@ -150,8 +216,10 @@ library
150 import: lib-options, bench-depends
216 import: lib-options, bench-depends
151 hs-source-dirs: lib
217 hs-source-dirs: lib
152 exposed-modules: Streamly.Benchmark.Common
218 exposed-modules: Streamly.Benchmark.Common
153− , Streamly.Benchmark.Common.Handle
219+ , Streamly.Benchmark.Common.Handle
220+ if flag(use-prelude)
154− , Streamly.Benchmark.Prelude
221+ exposed-modules: Streamly.Benchmark.Prelude
222+
155
223
156-------------------------------------------------------------------------------
224-------------------------------------------------------------------------------
157-- Benchmarks
225-- Benchmarks
@@ -159,6 +227,7 @@ library
159
227
160common bench-options
228common bench-options
161 import: compile-options, optimization-options, bench-depends
229 import: compile-options, optimization-options, bench-depends
230+ include-dirs: .
162 ghc-options: -rtsopts
231 ghc-options: -rtsopts
163 if flag(limit-build-mem)
232 if flag(limit-build-mem)
164 ghc-options: +RTS -M512M -RTS
233 ghc-options: +RTS -M512M -RTS
@@ -178,110 +247,142 @@ common bench-options-threaded
178-- Serial Streams
247-- Serial Streams
179-------------------------------------------------------------------------------
248-------------------------------------------------------------------------------
180
249
181−benchmark Prelude.Serial
250+benchmark Data.Stream
182 import: bench-options
251 import: bench-options
183 type: exitcode-stdio-1.0
252 type: exitcode-stdio-1.0
184− hs-source-dirs: Streamly/Benchmark/Prelude
253+ hs-source-dirs: Streamly/Benchmark/Data
185− main-is: Serial.hs
254+ main-is: Stream.hs
186 other-modules:
255 other-modules:
187− Serial.Generation
256+ Stream.Generate
188− , Serial.Elimination
257+ Stream.Eliminate
189− , Serial.Transformation1
258+ Stream.Transform
190− , Serial.Transformation2
259+ Stream.Reduce
191− , Serial.Transformation3
260+ Stream.Expand
192− , Serial.Nested
261+ Stream.Lift
193− , Serial.Exceptions
262+ Stream.Common
194− , Serial.Split
263+ if !flag(use-streamly-core)
195− if impl(ghcjs)
264+ other-modules:
196− buildable: False
265+ Stream.Exceptions
197− else
198− buildable: True
199 if flag(limit-build-mem)
266 if flag(limit-build-mem)
267+ if flag(dev)
200− ghc-options: +RTS -M2000M -RTS
268+ ghc-options: +RTS -M3500M -RTS
201−
269+ else
270+ ghc-options: +RTS -M2500M -RTS
202
271
203−benchmark Prelude.WSerial
272+-- Use StreamK functions where possible, converting to StreaK to StreamD
273+benchmark Data.Stream.StreamDK
204 import: bench-options
274 import: bench-options
205 type: exitcode-stdio-1.0
275 type: exitcode-stdio-1.0
206− hs-source-dirs: Streamly/Benchmark/Prelude
276+ hs-source-dirs: Streamly/Benchmark/Data
207− main-is: WSerial.hs
277+ main-is: Stream.hs
208− if impl(ghcjs)
278+ other-modules:
279+ Stream.Generate
280+ Stream.Eliminate
281+ Stream.Transform
282+ Stream.Reduce
283+ Stream.Expand
284+ Stream.Lift
285+ Stream.Common
286+ if !flag(use-streamly-core)
287+ other-modules:
288+ Stream.Exceptions
289+ -- Cannot use USE_STREAMK and USE_PRELUDE together
290+ if flag(use-prelude)
209 buildable: False
291 buildable: False
292+ cpp-options: -DUSE_STREAMK
293+ if flag(limit-build-mem)
294+ if flag(dev)
295+ ghc-options: +RTS -M3500M -RTS
210− else
296+ else
211− buildable: True
297+ ghc-options: +RTS -M2500M -RTS
212
298
213−benchmark Prelude.ZipSerial
299+benchmark Data.Stream.Concurrent
214− import: bench-options
300+ import: bench-options-threaded
215 type: exitcode-stdio-1.0
301 type: exitcode-stdio-1.0
216− hs-source-dirs: Streamly/Benchmark/Prelude
302+ hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
217− main-is: ZipSerial.hs
303+ main-is: Concurrent.hs
304+ other-modules:
305+ Stream.ConcurrentCommon
306+ Stream.Common
218− if impl(ghcjs)
307+ if flag(use-streamly-core) || impl(ghcjs)
219 buildable: False
308 buildable: False
220 else
309 else
221 buildable: True
310 buildable: True
222
311
223−benchmark Prelude.ZipAsync
312+benchmark Data.Stream.ConcurrentInterleaved
224− import: bench-options
313+ import: bench-options-threaded
225 type: exitcode-stdio-1.0
314 type: exitcode-stdio-1.0
226− hs-source-dirs: Streamly/Benchmark/Prelude
315+ hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
227− main-is: ZipAsync.hs
316+ main-is: ConcurrentInterleaved.hs
317+ other-modules:
318+ Stream.ConcurrentCommon
319+ Stream.Common
228− if impl(ghcjs)
320+ if flag(use-streamly-core) || impl(ghcjs)
229 buildable: False
321 buildable: False
230 else
322 else
231 buildable: True
323 buildable: True
232− if flag(limit-build-mem)
233− ghc-options: +RTS -M1000M -RTS
234
324
235−
325+benchmark Data.Stream.ConcurrentEager
236−benchmark Prelude.Ahead
237 import: bench-options-threaded
326 import: bench-options-threaded
238 type: exitcode-stdio-1.0
327 type: exitcode-stdio-1.0
239− hs-source-dirs: Streamly/Benchmark/Prelude
328+ hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
240− main-is: Ahead.hs
329+ main-is: ConcurrentEager.hs
330+ other-modules:
331+ Stream.ConcurrentCommon
332+ Stream.Common
241− if impl(ghcjs)
333+ if flag(use-streamly-core) || impl(ghcjs)
242 buildable: False
334 buildable: False
243 else
335 else
244 buildable: True
336 buildable: True
245
337
246−benchmark Prelude.Async
338+benchmark Data.Stream.ConcurrentOrdered
247 import: bench-options-threaded
339 import: bench-options-threaded
248 type: exitcode-stdio-1.0
340 type: exitcode-stdio-1.0
249− hs-source-dirs: Streamly/Benchmark/Prelude
341+ hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
250− main-is: Async.hs
342+ main-is: ConcurrentOrdered.hs
343+ other-modules:
344+ Stream.ConcurrentCommon
345+ Stream.Common
251− if impl(ghcjs)
346+ if flag(use-streamly-core) || impl(ghcjs)
252 buildable: False
347 buildable: False
253 else
348 else
254 buildable: True
349 buildable: True
255
350
256−benchmark Prelude.WAsync
351+benchmark Data.Unbox
257− import: bench-options-threaded
352+ import: bench-options
258 type: exitcode-stdio-1.0
353 type: exitcode-stdio-1.0
259− hs-source-dirs: Streamly/Benchmark/Prelude
354+ hs-source-dirs: .
260− main-is: WAsync.hs
355+ cpp-options: -DUSE_UNBOX
261− if impl(ghcjs)
356+ main-is: Streamly/Benchmark/Data/Serialize.hs
262− buildable: False
263− else
264− buildable: True
265
357
266−benchmark Prelude.Parallel
358+benchmark Data.Unbox.Derive.TH
267− import: bench-options-threaded
359+ import: bench-options
268 type: exitcode-stdio-1.0
360 type: exitcode-stdio-1.0
269− hs-source-dirs: Streamly/Benchmark/Prelude
361+ hs-source-dirs: .
270− main-is: Parallel.hs
362+ cpp-options: -DUSE_UNBOX
271− if impl(ghcjs)
363+ cpp-options: -DUSE_TH
272− buildable: False
364+ main-is: Streamly/Benchmark/Data/Serialize.hs
273− else
274− buildable: True
275− if flag(limit-build-mem)
276− ghc-options: +RTS -M2000M -RTS
277
365
366+benchmark Data.Serialize
367+ import: bench-options
368+ type: exitcode-stdio-1.0
369+ hs-source-dirs: .
370+ cpp-options: -DUSE_TH
371+ main-is: Streamly/Benchmark/Data/Serialize.hs
372+ build-depends: QuickCheck, template-haskell
373+ other-modules:
374+ Streamly.Benchmark.Data.Serialize.TH
375+ Streamly.Benchmark.Data.Serialize.RecCompatible
376+ Streamly.Benchmark.Data.Serialize.RecNonCompatible
377+ if flag(limit-build-mem)
378+ ghc-options: +RTS -M1000M -RTS
278
379
279benchmark Data.Unfold
380benchmark Data.Unfold
280 import: bench-options
381 import: bench-options
281 type: exitcode-stdio-1.0
382 type: exitcode-stdio-1.0
282 hs-source-dirs: .
383 hs-source-dirs: .
283 main-is: Streamly/Benchmark/Data/Unfold.hs
384 main-is: Streamly/Benchmark/Data/Unfold.hs
284− if impl(ghcjs)
385+ if flag(use-streamly-core) || impl(ghcjs)
285 buildable: False
386 buildable: False
286 else
387 else
287 buildable: True
388 buildable: True
@@ -291,28 +392,42 @@ benchmark Data.Fold
291 type: exitcode-stdio-1.0
392 type: exitcode-stdio-1.0
292 hs-source-dirs: Streamly/Benchmark/Data
393 hs-source-dirs: Streamly/Benchmark/Data
293 main-is: Fold.hs
394 main-is: Fold.hs
294− if impl(ghcjs)
395+ if flag(use-streamly-core) || impl(ghcjs)
396+ buildable: False
397+ else
398+ buildable: True
399+
400+benchmark Data.Fold.Window
401+ import: bench-options
402+ type: exitcode-stdio-1.0
403+ hs-source-dirs: Streamly/Benchmark/Data/Fold
404+ main-is: Window.hs
405+ if flag(use-streamly-core)
295 buildable: False
406 buildable: False
296 else
407 else
297 buildable: True
408 buildable: True
298
409
299−benchmark Data.Parser.ParserD
410+benchmark Data.Parser
300 import: bench-options
411 import: bench-options
301 type: exitcode-stdio-1.0
412 type: exitcode-stdio-1.0
302− hs-source-dirs: Streamly/Benchmark/Data/Parser
413+ hs-source-dirs: Streamly/Benchmark/Data
303− main-is: ParserD.hs
414+ main-is: Parser.hs
304 if impl(ghcjs)
415 if impl(ghcjs)
305 buildable: False
416 buildable: False
306 else
417 else
307 buildable: True
418 buildable: True
308 build-depends: exceptions >= 0.8 && < 0.11
419 build-depends: exceptions >= 0.8 && < 0.11
309 if flag(limit-build-mem)
420 if flag(limit-build-mem)
421+ if flag(dev)
422+ ghc-options: +RTS -M3000M -RTS
423+ else
310− ghc-options: +RTS -M750M -RTS
424+ ghc-options: +RTS -M2000M -RTS
311
425
312−benchmark Data.Parser.ParserK
426+benchmark Data.ParserK
313 import: bench-options
427 import: bench-options
314 type: exitcode-stdio-1.0
428 type: exitcode-stdio-1.0
315− hs-source-dirs: Streamly/Benchmark/Data/Parser
429+ hs-source-dirs: Streamly/Benchmark/Data
430+ cpp-options: -DBENCH_SINGULAR
316 main-is: ParserK.hs
431 main-is: ParserK.hs
317 if impl(ghcjs)
432 if impl(ghcjs)
318 buildable: False
433 buildable: False
@@ -320,15 +435,11 @@ benchmark Data.Parser.ParserK
320 buildable: True
435 buildable: True
321 build-depends: exceptions >= 0.8 && < 0.11
436 build-depends: exceptions >= 0.8 && < 0.11
322
437
323−-- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that
324−-- the rewrite rules are disabled. We can also use the "no-fusion" build
325−-- flag but we need to keep in mind that it disables fusion for streams
326−-- as well.
327−benchmark Data.Parser.FromParserK
438+benchmark Data.ParserK.Chunked
328 import: bench-options
439 import: bench-options
329 type: exitcode-stdio-1.0
440 type: exitcode-stdio-1.0
330− hs-source-dirs: Streamly/Benchmark/Data/Parser
441+ hs-source-dirs: Streamly/Benchmark/Data
331− cpp-options: -DFROM_PARSERK
442+ cpp-options: -DBENCH_CHUNKED
332 main-is: ParserK.hs
443 main-is: ParserK.hs
333 if impl(ghcjs)
444 if impl(ghcjs)
334 buildable: False
445 buildable: False
@@ -336,62 +447,167 @@ benchmark Data.Parser.FromParserK
336 buildable: True
447 buildable: True
337 build-depends: exceptions >= 0.8 && < 0.11
448 build-depends: exceptions >= 0.8 && < 0.11
338
449
339−benchmark Data.Parser
450+benchmark Data.ParserK.Chunked.Generic
340 import: bench-options
451 import: bench-options
341 type: exitcode-stdio-1.0
452 type: exitcode-stdio-1.0
342 hs-source-dirs: Streamly/Benchmark/Data
453 hs-source-dirs: Streamly/Benchmark/Data
454+ cpp-options: -DBENCH_CHUNKED_GENERIC
343− main-is: Parser.hs
455+ main-is: ParserK.hs
344 if impl(ghcjs)
456 if impl(ghcjs)
345 buildable: False
457 buildable: False
346 else
458 else
347 buildable: True
459 buildable: True
348 build-depends: exceptions >= 0.8 && < 0.11
460 build-depends: exceptions >= 0.8 && < 0.11
349− if flag(limit-build-mem)
350− ghc-options: +RTS -M1000M -RTS
351
461
352-------------------------------------------------------------------------------
462-------------------------------------------------------------------------------
353-- Raw Streams
463-- Raw Streams
354-------------------------------------------------------------------------------
464-------------------------------------------------------------------------------
355
465
356−benchmark Data.Stream.StreamD
466+benchmark Data.StreamD
357 import: bench-options
467 import: bench-options
358 type: exitcode-stdio-1.0
468 type: exitcode-stdio-1.0
359 hs-source-dirs: Streamly/Benchmark/Data/Stream
469 hs-source-dirs: Streamly/Benchmark/Data/Stream
360 main-is: StreamD.hs
470 main-is: StreamD.hs
361 if impl(ghcjs)
471 if impl(ghcjs)
362 buildable: False
472 buildable: False
363− else
364− buildable: True
365
473
366−benchmark Data.Stream.StreamK
474+benchmark Data.StreamK
367 import: bench-options
475 import: bench-options
368 type: exitcode-stdio-1.0
476 type: exitcode-stdio-1.0
369 hs-source-dirs: Streamly/Benchmark/Data/Stream
477 hs-source-dirs: Streamly/Benchmark/Data/Stream
370 main-is: StreamK.hs
478 main-is: StreamK.hs
371 if impl(ghcjs)
479 if impl(ghcjs)
372 buildable: False
480 buildable: False
373− else
374− buildable: True
375
481
376−benchmark Data.Stream.StreamDK
482+benchmark Data.Stream.ToStreamK
377 import: bench-options
483 import: bench-options
378 type: exitcode-stdio-1.0
484 type: exitcode-stdio-1.0
379 hs-source-dirs: Streamly/Benchmark/Data/Stream
485 hs-source-dirs: Streamly/Benchmark/Data/Stream
380− main-is: StreamDK.hs
486+ main-is: ToStreamK.hs
487+ if !flag(dev) || impl(ghcjs)
488+ buildable: False
489+
490+benchmark Data.StreamK.Alt
491+ import: bench-options
492+ type: exitcode-stdio-1.0
493+ hs-source-dirs: Streamly/Benchmark/Data/Stream
494+ main-is: StreamKAlt.hs
381− if impl(ghcjs)
495+ if !flag(dev) || impl(ghcjs)
382 buildable: False
496 buildable: False
383− else
384− buildable: True
385
497
386executable nano-bench
498executable nano-bench
387 import: bench-options
499 import: bench-options
388 hs-source-dirs: .
500 hs-source-dirs: .
389 main-is: NanoBenchmarks.hs
501 main-is: NanoBenchmarks.hs
390− if flag(dev)
502+ if !flag(dev)
391− buildable: True
392− else
393 buildable: False
503 buildable: False
394
504
505+-------------------------------------------------------------------------------
506+-- Streamly.Prelude
507+-------------------------------------------------------------------------------
508+
509+benchmark Prelude
510+ import: bench-options
511+ type: exitcode-stdio-1.0
512+ hs-source-dirs: Streamly/Benchmark/Data
513+ main-is: Stream.hs
514+ other-modules:
515+ Stream.Generate
516+ Stream.Eliminate
517+ Stream.Transform
518+ Stream.Reduce
519+ Stream.Expand
520+ Stream.Lift
521+ Stream.Common
522+ Stream.Split
523+ Stream.Exceptions
524+ cpp-options: -DUSE_PRELUDE
525+ if !flag(use-prelude)
526+ buildable: False
527+ if flag(limit-build-mem)
528+ if flag(dev)
529+ ghc-options: +RTS -M3500M -RTS
530+ else
531+ ghc-options: +RTS -M2500M -RTS
532+
533+benchmark Prelude.WSerial
534+ import: bench-options
535+ type: exitcode-stdio-1.0
536+ hs-source-dirs: Streamly/Benchmark/Prelude
537+ main-is: WSerial.hs
538+ cpp-options: -DUSE_PRELUDE
539+ if !flag(use-prelude)
540+ buildable: False
541+ if flag(limit-build-mem)
542+ ghc-options: +RTS -M750M -RTS
543+
544+benchmark Prelude.Merge
545+ import: bench-options
546+ type: exitcode-stdio-1.0
547+ hs-source-dirs: Streamly/Benchmark/Prelude
548+ main-is: Merge.hs
549+ cpp-options: -DUSE_PRELUDE
550+ if !flag(use-prelude)
551+ buildable: False
552+
553+benchmark Prelude.ZipSerial
554+ import: bench-options
555+ type: exitcode-stdio-1.0
556+ hs-source-dirs: Streamly/Benchmark/Prelude
557+ main-is: ZipSerial.hs
558+ cpp-options: -DUSE_PRELUDE
559+ if !flag(use-prelude)
560+ buildable: False
561+
562+benchmark Prelude.ZipAsync
563+ import: bench-options
564+ type: exitcode-stdio-1.0
565+ hs-source-dirs: Streamly/Benchmark/Prelude
566+ main-is: ZipAsync.hs
567+ cpp-options: -DUSE_PRELUDE
568+ if !flag(use-prelude)
569+ buildable: False
570+ if flag(limit-build-mem)
571+ ghc-options: +RTS -M1000M -RTS
572+
573+benchmark Prelude.Ahead
574+ import: bench-options-threaded
575+ type: exitcode-stdio-1.0
576+ hs-source-dirs: Streamly/Benchmark/Prelude
577+ main-is: Ahead.hs
578+ cpp-options: -DUSE_PRELUDE
579+ if !flag(use-prelude)
580+ buildable: False
581+
582+benchmark Prelude.Async
583+ import: bench-options-threaded
584+ type: exitcode-stdio-1.0
585+ hs-source-dirs: Streamly/Benchmark/Prelude
586+ main-is: Async.hs
587+ cpp-options: -DUSE_PRELUDE
588+ if !flag(use-prelude)
589+ buildable: False
590+
591+benchmark Prelude.WAsync
592+ import: bench-options-threaded
593+ type: exitcode-stdio-1.0
594+ hs-source-dirs: Streamly/Benchmark/Prelude
595+ main-is: WAsync.hs
596+ cpp-options: -DUSE_PRELUDE
597+ if !flag(use-prelude)
598+ buildable: False
599+
600+benchmark Prelude.Parallel
601+ import: bench-options-threaded
602+ type: exitcode-stdio-1.0
603+ hs-source-dirs: Streamly/Benchmark/Prelude
604+ main-is: Parallel.hs
605+ cpp-options: -DUSE_PRELUDE
606+ if !flag(use-prelude)
607+ buildable: False
608+ if flag(limit-build-mem)
609+ ghc-options: +RTS -M2000M -RTS
610+
395-------------------------------------------------------------------------------
611-------------------------------------------------------------------------------
396-- Concurrent Streams
612-- Concurrent Streams
397-------------------------------------------------------------------------------
613-------------------------------------------------------------------------------
@@ -401,82 +617,101 @@ benchmark Prelude.Concurrent
401 type: exitcode-stdio-1.0
617 type: exitcode-stdio-1.0
402 hs-source-dirs: Streamly/Benchmark/Prelude
618 hs-source-dirs: Streamly/Benchmark/Prelude
403 main-is: Concurrent.hs
619 main-is: Concurrent.hs
620+ cpp-options: -DUSE_PRELUDE
621+ if !flag(use-prelude)
622+ buildable: False
404
623
405benchmark Prelude.Adaptive
624benchmark Prelude.Adaptive
406 import: bench-options-threaded
625 import: bench-options-threaded
407 type: exitcode-stdio-1.0
626 type: exitcode-stdio-1.0
408 hs-source-dirs: Streamly/Benchmark/Prelude
627 hs-source-dirs: Streamly/Benchmark/Prelude
409 main-is: Adaptive.hs
628 main-is: Adaptive.hs
410− if impl(ghcjs)
629+ cpp-options: -DUSE_PRELUDE
630+ if !flag(use-prelude)
411 buildable: False
631 buildable: False
412− else
413− buildable: True
414
632
415benchmark Prelude.Rate
633benchmark Prelude.Rate
416 import: bench-options-threaded
634 import: bench-options-threaded
417 type: exitcode-stdio-1.0
635 type: exitcode-stdio-1.0
418 hs-source-dirs: Streamly/Benchmark/Prelude
636 hs-source-dirs: Streamly/Benchmark/Prelude
419 main-is: Rate.hs
637 main-is: Rate.hs
420− if impl(ghcjs)
638+ cpp-options: -DUSE_PRELUDE
639+ if !flag(use-prelude)
421 buildable: False
640 buildable: False
422− else
423− buildable: True
424
641
425-------------------------------------------------------------------------------
642-------------------------------------------------------------------------------
426-- Array Benchmarks
643-- Array Benchmarks
427-------------------------------------------------------------------------------
644-------------------------------------------------------------------------------
428
645
429−benchmark Data.Array
646+benchmark Data.Array.Generic
430 import: bench-options
647 import: bench-options
431 type: exitcode-stdio-1.0
648 type: exitcode-stdio-1.0
432− hs-source-dirs: .
649+ hs-source-dirs: ., Streamly/Benchmark/Data
433− main-is: Streamly/Benchmark/Data/Array.hs
650+ main-is: Streamly/Benchmark/Data/Array/Generic.hs
434− other-modules: Streamly.Benchmark.Data.ArrayOps
651+ other-modules:
435− cpp-options: -DDATA_ARRAY
652+ Stream.Common
653+ if flag(use-streamly-core)
654+ buildable: False
655+ else
656+ buildable: True
657+ if flag(limit-build-mem)
658+ ghc-options: +RTS -M1000M -RTS
436
659
437−benchmark Data.Array.Prim
660+benchmark Data.SmallArray
438 import: bench-options
661 import: bench-options
439 type: exitcode-stdio-1.0
662 type: exitcode-stdio-1.0
440− hs-source-dirs: .
441− main-is: Streamly/Benchmark/Data/Array.hs
663+ main-is: Streamly/Benchmark/Data/Array/SmallArray.hs
442− other-modules: Streamly.Benchmark.Data.ArrayOps
664+ if flag(dev) && !flag(use-streamly-core)
443− cpp-options: -DDATA_ARRAY_PRIM
665+ buildable: True
444− build-depends: primitive
666+ else
667+ buildable: False
445
668
446−benchmark Data.SmallArray
669+benchmark Data.Array
447 import: bench-options
670 import: bench-options
448 type: exitcode-stdio-1.0
671 type: exitcode-stdio-1.0
449− hs-source-dirs: .
672+ hs-source-dirs: ., Streamly/Benchmark/Data
450 main-is: Streamly/Benchmark/Data/Array.hs
673 main-is: Streamly/Benchmark/Data/Array.hs
451− other-modules: Streamly.Benchmark.Data.ArrayOps
674+ other-modules:
452− cpp-options: -DDATA_SMALLARRAY
675+ Stream.Common
676+ if flag(use-streamly-core)
677+ buildable: False
678+ else
679+ buildable: True
680+ if flag(limit-build-mem)
681+ ghc-options: +RTS -M1500M -RTS
453
682
454−benchmark Data.Array.Prim.Pinned
683+benchmark Data.MutArray
455 import: bench-options
684 import: bench-options
456 type: exitcode-stdio-1.0
685 type: exitcode-stdio-1.0
457− hs-source-dirs: .
458− main-is: Streamly/Benchmark/Data/Array.hs
686+ main-is: Streamly/Benchmark/Data/MutArray.hs
459− other-modules: Streamly.Benchmark.Data.ArrayOps
687+ if flag(limit-build-mem)
460− cpp-options: -DDATA_ARRAY_PRIM_PINNED
688+ ghc-options: +RTS -M1500M -RTS
689+ if flag(use-streamly-core)
690+ buildable: False
691+ else
692+ buildable: True
461
693
694+-------------------------------------------------------------------------------
695+-- Ring Benchmarks
696+-------------------------------------------------------------------------------
697+
462−benchmark Data.Array.Foreign
698+benchmark Data.Ring.Unboxed
463 import: bench-options
699 import: bench-options
464 type: exitcode-stdio-1.0
700 type: exitcode-stdio-1.0
465− hs-source-dirs: .
466− main-is: Streamly/Benchmark/Data/Array.hs
701+ main-is: Streamly/Benchmark/Data/Ring/Unboxed.hs
467− other-modules: Streamly.Benchmark.Data.ArrayOps
702+ if flag(limit-build-mem)
468− cpp-options: -DMEMORY_ARRAY
703+ ghc-options: +RTS -M1500M -RTS
469
704
470-------------------------------------------------------------------------------
705-------------------------------------------------------------------------------
471-- Array Stream Benchmarks
706-- Array Stream Benchmarks
472-------------------------------------------------------------------------------
707-------------------------------------------------------------------------------
473
708
474−benchmark Data.Array.Stream.Foreign
709+benchmark Data.Array.Stream
475 import: bench-options
710 import: bench-options
476 type: exitcode-stdio-1.0
711 type: exitcode-stdio-1.0
477− hs-source-dirs: Streamly/Benchmark/Data/Array/Stream
712+ hs-source-dirs: Streamly/Benchmark/Data/Array
478− main-is: Foreign.hs
713+ main-is: Stream.hs
479− if impl(ghcjs)
714+ if flag(use-streamly-core) || impl(ghcjs)
480 buildable: False
715 buildable: False
481 else
716 else
482 buildable: True
717 buildable: True
@@ -494,6 +729,12 @@ benchmark FileSystem.Handle
494 other-modules:
729 other-modules:
495 Handle.Read
730 Handle.Read
496 , Handle.ReadWrite
731 , Handle.ReadWrite
732+ if flag(limit-build-mem)
733+ ghc-options: +RTS -M1000M -RTS
734+ if flag(use-streamly-core)
735+ buildable: False
736+ else
737+ buildable: True
497
738
498-------------------------------------------------------------------------------
739-------------------------------------------------------------------------------
499-- Unicode Benchmarks
740-- Unicode Benchmarks
@@ -504,6 +745,12 @@ benchmark Unicode.Stream
504 type: exitcode-stdio-1.0
745 type: exitcode-stdio-1.0
505 hs-source-dirs: Streamly/Benchmark/Unicode
746 hs-source-dirs: Streamly/Benchmark/Unicode
506 main-is: Stream.hs
747 main-is: Stream.hs
748+ if flag(limit-build-mem)
749+ ghc-options: +RTS -M1000M -RTS
750+ if flag(use-streamly-core)
751+ buildable: False
752+ else
753+ buildable: True
507
754
508benchmark Unicode.Char
755benchmark Unicode.Char
509 import: bench-options
756 import: bench-options
@@ -511,11 +758,21 @@ benchmark Unicode.Char
511 hs-source-dirs: Streamly/Benchmark/Unicode
758 hs-source-dirs: Streamly/Benchmark/Unicode
512 main-is: Char.hs
759 main-is: Char.hs
513 -- Takes too much memory for ghcjs
760 -- Takes too much memory for ghcjs
514− if impl(ghcjs)
761+ if flag(use-streamly-core) || impl(ghcjs)
515− buildable: false
762+ buildable: False
516
763
517benchmark Unicode.Utf8
764benchmark Unicode.Utf8
518 import: bench-options
765 import: bench-options
519 type: exitcode-stdio-1.0
766 type: exitcode-stdio-1.0
520 hs-source-dirs: Streamly/Benchmark/Unicode
767 hs-source-dirs: Streamly/Benchmark/Unicode
521 main-is: Utf8.hs
768 main-is: Utf8.hs
769+ if flag(use-streamly-core)
770+ buildable: False
771+ else
772+ buildable: True
773+
774+benchmark Unicode.Parser
775+ import: bench-options
776+ type: exitcode-stdio-1.0
777+ hs-source-dirs: Streamly/Benchmark/Unicode
778+ main-is: Parser.hs
bin/bench-config.shdeleted−160
@@ -1,160 +0,0 @@
1−#!/usr/bin/env bash
2−
3−BENCH_CONFIG_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" &> /dev/null && pwd)"
4−source $BENCH_CONFIG_DIR/targets.sh \
5− || { echo "Cannot source $BENCH_CONFIG_DIR/targets.sh"; exit 1; }
6−
7−# Customization options
8−bench_config () {
9− BENCH_REPORT_DIR=benchmark/bench-report
10− BENCHMARK_PACKAGE_NAME=streamly-benchmarks
11− BENCHMARK_PACKAGE_VERSION=0.0.0
12−
13− USE_GAUGE=0
14− DEFAULT_FIELDS="allocated cputime bytescopied"
15−}
16−
17−#------------------------------------------------------------------------------
18−# benchmark groups
19−#------------------------------------------------------------------------------
20−
21−bench_targets () {
22− targets
23−}
24−
25−#------------------------------------------------------------------------------
26−# RTS options based on the benchmark executable name and benchmark name
27−#------------------------------------------------------------------------------
28−
29−bench_rts_options () {
30− local exe_name
31− local bench_name
32−
33− exe_name="$1"
34− bench_name="$2"
35−
36− # Based on benchmark class
37− case "$bench_name" in
38− */o-1-sp*) echo -n "-K36K -M16M" ;;
39− */o-n-h*) echo -n "-K36K -M32M" ;;
40− */o-n-st*) echo -n "-K1M -M16M" ;;
41− */o-n-sp*) echo -n "-K1M -M32M" ;;
42− *) echo -n "" ;;
43− esac
44−
45− echo -n " "
46− case "$exe_name" in
47− Prelude.Concurrent*) echo -n "-K256K -M384M" ;;
48− *) echo -n "" ;;
49− esac
50−
51− echo -n " "
52− # Based on specific benchmark
53− # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
54− # with "/" for matching with this. It may not work reliably if the benchmark
55− # name already contains ".".
56− case "$bench_name" in
57− Data.Stream.StreamD/o-n-space/elimination/toList) echo -n "-K2M" ;;
58− Data.Stream.StreamK/o-n-space/elimination/toList) echo -n "-K2M" ;;
59−
60− Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
61− Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
62− Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
63−
64− Prelude.Rate/o-1-space/*) echo -n "-K128K" ;;
65− Prelude.Rate/o-1-space/asyncly/*) echo -n "-K128K" ;;
66−
67− # XXX For GHC-9.0
68− Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;
69−
70− # XXX These should be moved to o-n-space?
71− Prelude.Serial/o-n-heap/grouping/classifySessionsOf) echo -n "-K1M -M32M" ;;
72− Prelude.Serial/o-n-heap/Functor/*) echo -n "-K4M -M32M" ;;
73− Prelude.Serial/o-n-heap/transformer/*) echo -n "-K8M -M64M" ;;
74−
75− Prelude.Serial/o-n-space/Functor/*) echo -n "-K4M -M64M" ;;
76− Prelude.Serial/o-n-space/Applicative/*) echo -n "-K8M -M128M" ;;
77− Prelude.Serial/o-n-space/Monad/*) echo -n "-K8M -M64M" ;;
78−
79− # Use -K4M for o-n-space except for grouping
80− Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
81− Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
82−
83− Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
84−
85− Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
86− Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
87− Prelude.Ahead/o-1-space/*) echo -n "-K128K" ;;
88−
89− Prelude.WAsync/o-n-heap/monad-outer-product/toNull3) echo -n "-M64M" ;;
90− Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
91−
92− # XXX need to investigate these, taking too much stack
93− Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;
94− Data.Parser/o-1-space/some) echo -n "-K8M" ;;
95− Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
96− Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
97− Data.Parser/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
98− Data.Parser/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
99− Data.Parser/o-n-heap/choice) echo -n "-K16M -M32M" ;;
100− Data.Parser.ParserK/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
101− Data.Parser.ParserK/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
102− Data.Parser.ParserK/o-n-heap/sequence) echo -n "-M64M";;
103− Data.Parser.ParserK/o-n-heap/sequenceA) echo -n "-M64M";;
104−
105− Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
106− # For tasty-bench
107− Data.Array*/o-1-space/generation/show) echo -n "-M32M" ;;
108− # XXX For GHC-8.10
109− Data.Array/o-1-space/transformationX4/map) echo -n "-M32M" ;;
110− # DEVBUILD only benchmarks - array foldable instance
111− Data.Array.Foreign/o-1-space/elimination/foldable/foldl*) echo -n "-K8M" ;;
112− Data.Array.Foreign/o-1-space/elimination/foldable/sum) echo -n "-K8M" ;;
113− *) echo -n "" ;;
114− esac
115−}
116−
117−#------------------------------------------------------------------------------
118−# Speed options
119−#------------------------------------------------------------------------------
120−
121−bench_speed_options () {
122− local exe_name
123− local bench_name
124−
125− exe_name="$1"
126− bench_name="$2"
127−
128− case "$exe_name" in
129− Prelude.Concurrent) set_super_quick_mode ;;
130− Prelude.Rate) set_super_quick_mode ;;
131− Prelude.Adaptive) set_super_quick_mode;;
132− *) echo -n "" ;;
133− esac
134−
135− # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
136− # with "/" for matching with this. It may not work reliably if the benchmark
137− # name already contains ".".
138−
139− # Use quick options for benchmarks that take too long
140− case "$bench_name" in
141− Prelude.Parallel/o-n-heap/mapping/mapM) set_super_quick_mode ;;
142− Prelude.Parallel/o-n-heap/monad-outer-product/*) set_super_quick_mode ;;
143− Prelude.Parallel/o-n-space/monad-outer-product/*) set_super_quick_mode ;;
144− Prelude.Parallel/o-n-heap/generation/*) use_quicker_mode ;;
145− Prelude.Parallel/o-n-heap/mapping/*) use_quicker_mode ;;
146− Prelude.Parallel/o-n-heap/concat-foldable/*) use_quicker_mode ;;
147−
148− Prelude.Async/o-1-space/monad-outer-product/*) use_quicker_mode ;;
149− Prelude.Async/o-n-space/monad-outer-product/*) use_quicker_mode ;;
150−
151− Prelude.Ahead/o-1-space/monad-outer-product/*) use_quicker_mode ;;
152− Prelude.Ahead/o-n-space/monad-outer-product/*) use_quicker_mode ;;
153−
154− Prelude.WAsync/o-n-heap/monad-outer-product/*) use_quicker_mode ;;
155− Prelude.WAsync/o-n-space/monad-outer-product/*) use_quicker_mode ;;
156−
157− FileSystem.Handle/*) use_quicker_mode ;;
158− *) echo -n "" ;;
159− esac
160−}
bin/bench.shdeleted−15
@@ -1,15 +0,0 @@
1−#!/usr/bin/env bash
2−
3−SCRIPT_DIR=$(cd `dirname $0`; pwd)
4−source $SCRIPT_DIR/bench-config.sh \
5− || { echo "Cannot source $SCRIPT_DIR/bench-config.sh"; exit 1; }
6−
7−bench_config
8−if test -z "$BENCH_REPORT_DIR"
9−then
10− echo "BENCH_REPORT_DIR variable not defined by bench-config() in $SCRIPT_DIR/bench-config.sh"
11− exit 1
12−fi
13−
14−cd $SCRIPT_DIR/..
15−$BENCH_REPORT_DIR/bin/bench-runner.sh --config $SCRIPT_DIR/bench-config.sh "$@"
bin/mk-hscope.sh+1−1
@@ -1,7 +1,7 @@
1#!/usr/bin/env bash
1#!/usr/bin/env bash
2
2
3GHC_VERSION=8.10.4
3GHC_VERSION=8.10.4
4−STREAMLY_VERSION=0.8.0
4+STREAMLY_VERSION=0.9.0
5
5
6case `uname` in
6case `uname` in
7 Darwin) SYSTEM=x86_64-osx;;
7 Darwin) SYSTEM=x86_64-osx;;
bin/replnew file+3
@@ -0,0 +1,3 @@
1+#!/bin/bash
2+
3+cabal repl --project-file cabal.project.O0
bin/run-ci.sh+45−36
@@ -10,7 +10,6 @@
10
10
11SCRIPT_DIR=$(cd "$(dirname "$0")" || exit; pwd)
11SCRIPT_DIR=$(cd "$(dirname "$0")" || exit; pwd)
12SCRIPT_NAME=$(basename "$0")
12SCRIPT_NAME=$(basename "$0")
13−source "$SCRIPT_DIR/../benchmark/bench-report/bin/build-lib.sh"
14
13
15CABAL_BUILD_OPTIONS="--flag limit-build-mem"
14CABAL_BUILD_OPTIONS="--flag limit-build-mem"
16
15
@@ -19,32 +18,36 @@ CABAL_BUILD_OPTIONS="--flag limit-build-mem"
19#------------------------------------------------------------------------------
18#------------------------------------------------------------------------------
20
19
21# XXX take these from command line
20# XXX take these from command line
22−GHC_PRIME_NIX="ghc8104"
21+GHC_PRIME_NIX="ghc922"
23−GHC_PRIME_VER="8.10"
22+GHC_PRIME_VER="9.2.2"
24JOBS=1
23JOBS=1
25
24
26# Without cabal project file, it will not run any tests
25# Without cabal project file, it will not run any tests
26+# XXX Added DISABLE_SDIST_BUILD because of a cabal issue, need to remove it
27ghc_prime_dist () {
27ghc_prime_dist () {
28 nix-shell \
28 nix-shell \
29 --argstr compiler "$GHC_PRIME_NIX" \
29 --argstr compiler "$GHC_PRIME_NIX" \
30 --run "\
30 --run "\
31 packcheck.sh cabal-v2 \
31 packcheck.sh cabal-v2 \
32 GHCVER=$GHC_PRIME_VER \
32 GHCVER=$GHC_PRIME_VER \
33− CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
33+ CABAL_BUILD_OPTIONS=\"$CABAL_BUILD_OPTIONS --jobs=$JOBS\" \
34 CABAL_DISABLE_DEPS=y \
34 CABAL_DISABLE_DEPS=y \
35+ DISABLE_SDIST_BUILD=y \
35 CABAL_CHECK_RELAX=y"
36 CABAL_CHECK_RELAX=y"
36}
37}
37
38
38# With cabal.project file, it will run the tests
39# With cabal.project file, it will run the tests
40+# XXX Added DISABLE_SDIST_BUILD because of a cabal issue, need to remove it
39ghc_prime_dist_tests () {
41ghc_prime_dist_tests () {
40 nix-shell \
42 nix-shell \
41 --argstr compiler "$GHC_PRIME_NIX" \
43 --argstr compiler "$GHC_PRIME_NIX" \
42 --run "\
44 --run "\
43 packcheck.sh cabal-v2 \
45 packcheck.sh cabal-v2 \
44 GHCVER=$GHC_PRIME_VER \
46 GHCVER=$GHC_PRIME_VER \
45− CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
47+ CABAL_BUILD_OPTIONS=\"$CABAL_BUILD_OPTIONS --jobs=$JOBS\" \
46 CABAL_PROJECT=cabal.project \
48 CABAL_PROJECT=cabal.project \
47 CABAL_DISABLE_DEPS=y \
49 CABAL_DISABLE_DEPS=y \
50+ DISABLE_SDIST_BUILD=y \
48 CABAL_CHECK_RELAX=y"
51 CABAL_CHECK_RELAX=y"
49}
52}
50
53
@@ -55,7 +58,7 @@ ghc_prime_dist_tests_stack () {
55 --run "\
58 --run "\
56 packcheck.sh stack \
59 packcheck.sh stack \
57 GHCVER=$GHC_PRIME_VER \
60 GHCVER=$GHC_PRIME_VER \
58− STACK_BUILD_OPTIONS="--jobs $JOBS --system-ghc" \
61+ STACK_BUILD_OPTIONS=\"--jobs $JOBS --system-ghc\" \
59 STACK_YAML=stack.yaml"
62 STACK_YAML=stack.yaml"
60}
63}
61
64
@@ -69,9 +72,9 @@ ghc_prime_perf () {
69 --argstr compiler "$GHC_PRIME_NIX" \
72 --argstr compiler "$GHC_PRIME_NIX" \
70 --argstr c2nix "--flag inspection" \
73 --argstr c2nix "--flag inspection" \
71 --run "\
74 --run "\
72− bin/test.sh --cabal-build-options \
75+ bin/test-runner --cabal-build-options \
73 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\";\
76 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\";\
74− bin/bench.sh --cabal-build-options \
77+ bin/bench-runner --cabal-build-options \
75 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\" \
78 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\" \
76 --quick --raw;"
79 --quick --raw;"
77}
80}
@@ -80,7 +83,7 @@ ghc_prime_O0 () {
80 nix-shell \
83 nix-shell \
81 --argstr compiler "$GHC_PRIME_NIX" \
84 --argstr compiler "$GHC_PRIME_NIX" \
82 --run "\
85 --run "\
83− bin/test.sh --cabal-build-options \
86+ bin/test-runner --cabal-build-options \
84 \"--jobs=$JOBS --project-file cabal.project.O0\""
87 \"--jobs=$JOBS --project-file cabal.project.O0\""
85}
88}
86
89
@@ -91,7 +94,7 @@ ghc_prime_O0 () {
91# XXX avoid rebuilding if nothing has changed in the source
94# XXX avoid rebuilding if nothing has changed in the source
92# XXX run hlint only on changed files
95# XXX run hlint only on changed files
93lint () {
96lint () {
94− packcheck cabal \
97+ packcheck.sh cabal \
95 HLINT_OPTIONS="lint --cpp-include=src --cpp-include=test" \
98 HLINT_OPTIONS="lint --cpp-include=src --cpp-include=test" \
96 HLINT_TARGETS="src test benchmark"
99 HLINT_TARGETS="src test benchmark"
97}
100}
@@ -105,14 +108,13 @@ werror () {
105ghc_prime_Werror () {
108ghc_prime_Werror () {
106 nix-shell \
109 nix-shell \
107 --argstr compiler "$GHC_PRIME_NIX" \
110 --argstr compiler "$GHC_PRIME_NIX" \
108− --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror all"
111+ --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror --enable-tests --enable-benchmarks all"
109}
112}
110
113
111ghc_prime_doctests () {
114ghc_prime_doctests () {
112 nix-shell \
115 nix-shell \
113 --argstr compiler "$GHC_PRIME_NIX" \
116 --argstr compiler "$GHC_PRIME_NIX" \
114− --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.doctest all"
117+ --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.doctest all && cabal-docspec --timeout 60"
115− cabal-docspec --timeout 60
116}
118}
117
119
118#------------------------------------------------------------------------------
120#------------------------------------------------------------------------------
@@ -125,39 +127,33 @@ ghc_prime_doctests () {
125ghc_prime_coverage () {
127ghc_prime_coverage () {
126 nix-shell \
128 nix-shell \
127 --argstr compiler "$GHC_PRIME_NIX" \
129 --argstr compiler "$GHC_PRIME_NIX" \
128− --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS\" --coverage"
130+ --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS\" --coverage"
129}
131}
130
132
131#------------------------------------------------------------------------------
133#------------------------------------------------------------------------------
132# Flags
134# Flags
133#------------------------------------------------------------------------------
135#------------------------------------------------------------------------------
134
136
135−ghc_prime_dev_perf () {
137+ghc_prime_dev_test () {
136 nix-shell \
138 nix-shell \
137 --argstr compiler "$GHC_PRIME_NIX" \
139 --argstr compiler "$GHC_PRIME_NIX" \
138 --run "\
140 --run "\
139− bin/test.sh --cabal-build-options \
140− \"--jobs=$JOBS --flag dev\";\
141− bin/bench.sh --cabal-build-options \
141+ bin/test-runner --cabal-build-options \
142− \"--jobs=$JOBS --flag dev $PERF_FLAGS\" --quick --raw"
142+ \"--jobs=$JOBS --flag dev\""
143}
143}
144
144
145−ghc_prime_c_malloc () {
145+ghc_prime_dev_perf () {
146 nix-shell \
146 nix-shell \
147 --argstr compiler "$GHC_PRIME_NIX" \
147 --argstr compiler "$GHC_PRIME_NIX" \
148+ --run "\
148− --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag use-c-malloc\""
149+ bin/bench-runner --cabal-build-options \
150+ \"--jobs=$JOBS --flag dev $PERF_FLAGS\" --quick --raw"
149}
151}
150
152
151ghc_prime_debug () {
153ghc_prime_debug () {
152 nix-shell \
154 nix-shell \
153 --argstr compiler "$GHC_PRIME_NIX" \
155 --argstr compiler "$GHC_PRIME_NIX" \
154− --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag debug\""
156+ --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS --flag debug\""
155−}
156−
157−ghc_prime_streamk () {
158− nix-shell \
159− --argstr compiler "$GHC_PRIME_NIX" \
160− --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag streamk\""
161}
157}
162
158
163#------------------------------------------------------------------------------
159#------------------------------------------------------------------------------
@@ -173,7 +169,7 @@ ghc () {
173 --run "\
169 --run "\
174 packcheck.sh cabal-v2 \
170 packcheck.sh cabal-v2 \
175 GHCVER=$2 \
171 GHCVER=$2 \
176− CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
172+ CABAL_BUILD_OPTIONS=\"$CABAL_BUILD_OPTIONS --jobs=$JOBS\" \
177 CABAL_DISABLE_DEPS=y \
173 CABAL_DISABLE_DEPS=y \
178 CABAL_CHECK_RELAX=y \
174 CABAL_CHECK_RELAX=y \
179 DISABLE_SDIST_BUILD=y \
175 DISABLE_SDIST_BUILD=y \
@@ -204,11 +200,15 @@ ghcHEAD () {
204# ghcjs
200# ghcjs
205#------------------------------------------------------------------------------
201#------------------------------------------------------------------------------
206
202
203+# Use the following nix expression for ghcjs
204+# nix-env -f https://github.com/composewell/nixpkgs/archive/refs/tags/22.05-composewell.tar.gz -iA pkgs.haskell.compiler.ghcjs
207ghcjs () {
205ghcjs () {
208− export PATH=~/.local/bin:/opt/ghc/bin:/opt/ghcjs/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:$PATH
206+ # We don't pass 'CABAL_BUILD_OPTIONS="--flag limit-build-mem"' here as
207+ # ghcjs requires more memory to build. Adding a conditional for ghcjs in
208+ # the cabal file is a maintainence overhead.
209 packcheck.sh cabal-v2 \
209 packcheck.sh cabal-v2 \
210− GHCVER=8.4.0 \
210+ GHCVER=8.10.7 \
211− CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
211+ CABAL_BUILD_OPTIONS="--jobs=$JOBS" \
212 CABAL_CHECK_RELAX=y \
212 CABAL_CHECK_RELAX=y \
213 DISABLE_SDIST_BUILD=y \
213 DISABLE_SDIST_BUILD=y \
214 DISABLE_TEST=y \
214 DISABLE_TEST=y \
@@ -223,21 +223,19 @@ ghcjs () {
223RELEASE_CI_TARGETS="\
223RELEASE_CI_TARGETS="\
224ghc_prime_dist \
224ghc_prime_dist \
225ghc_prime_dist_tests \
225ghc_prime_dist_tests \
226+ghc_prime_dev_test \
226ghc_prime_perf \
227ghc_prime_perf \
227ghc_prime_O0 \
228ghc_prime_O0 \
228ghc_prime_Werror \
229ghc_prime_Werror \
229ghc_prime_doctests \
230ghc_prime_doctests \
230ghc_prime_coverage \
231ghc_prime_coverage \
231−ghc_prime_c_malloc \
232ghc_prime_debug \
232ghc_prime_debug \
233−ghc_prime_streamk \
234ghc901 \
233ghc901 \
235ghc884 \
234ghc884 \
236ghcjs \
235ghcjs \
237lint"
236lint"
238
237
239−# XXX We should include dev as well but it has some test and benchmark
238+# XXX Include flaky tests flag in manual tests
240−# failures to be fixed.
241ALL_TARGETS="\
239ALL_TARGETS="\
242$RELEASE_CI_TARGETS \
240$RELEASE_CI_TARGETS \
243ghc_prime_dist_tests_stack \
241ghc_prime_dist_tests_stack \
@@ -290,6 +288,17 @@ else
290 fi
288 fi
291fi
289fi
292
290
291+has_item () {
292+ for i in $1
293+ do
294+ if test "$i" = "$2"
295+ then
296+ echo "$i"
297+ break
298+ fi
299+ done
300+}
301+
293for i in $TARGETS
302for i in $TARGETS
294do
303do
295 if test "$(has_item "$ALL_TARGETS" "$i")" != "$i"
304 if test "$(has_item "$ALL_TARGETS" "$i")" != "$i"
bin/run-repl-quick.shnew file+113
@@ -0,0 +1,113 @@
1+#!/usr/bin/env bash
2+
3+# XXX Having a repl-ish option on packcheck can be very useful for quick type
4+# checking. Running that in a loop in a smart way will work like ghcid.
5+
6+# The idea is to have an extremely light version of run-ci.sh
7+# This can be very helpful on any refactoring change.
8+
9+# This script should be majorly improved but it solves my use case for the time
10+# being.
11+
12+set -e
13+
14+SCRIPT_DIR=$(dirname $0)
15+
16+STREAMLY_VERSION=0.9.0
17+BENCH_REPORT_DIR=benchmark/bench-report
18+source $SCRIPT_DIR/targets.sh
19+
20+#------------------------------------------------------------------------------
21+# Script
22+#------------------------------------------------------------------------------
23+
24+print_help () {
25+ echo "Usage: $0"
26+ echo
27+ echo "Very dumb script."
28+ echo "Currently runs everything in the repl and exits."
29+ echo "Useful for type checking and displaying warnings."
30+ echo
31+ exit
32+}
33+
34+#------------------------------------------------------------------------------
35+# Helper functions
36+#------------------------------------------------------------------------------
37+
38+run_build_repl () {
39+ local prefix=$1
40+ local targets=$2
41+ local COMPONENTS
42+ local c
43+
44+ for c in $targets
45+ do
46+ CABAL_BUILD_OPTIONS=$(dev_build "--flag dev")
47+ echo "|--------------------------------------------------------------------"
48+ echo "|" $CABAL_EXECUTABLE repl "$prefix:$c" $CABAL_BUILD_OPTIONS <<< :q
49+ echo "|--------------------------------------------------------------------"
50+ run_verbose $CABAL_EXECUTABLE repl "$prefix:$c" $CABAL_BUILD_OPTIONS <<< :q
51+ done
52+}
53+
54+#------------------------------------------------------------------------------
55+# Setup
56+#------------------------------------------------------------------------------
57+
58+source $BENCH_REPORT_DIR/bin/build-lib.sh
59+
60+USE_GIT_CABAL=0
61+set_common_vars
62+
63+#------------------------------------------------------------------------------
64+# Library
65+#------------------------------------------------------------------------------
66+
67+# XXX Ideally run for all the valid flag combinations
68+CABAL_BUILD_OPTIONS=""
69+run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
70+
71+CABAL_BUILD_OPTIONS="--flag dev"
72+run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
73+
74+CABAL_BUILD_OPTIONS="--flag streamk"
75+run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
76+
77+CABAL_BUILD_OPTIONS="--flag use-c-malloc"
78+run_verbose $CABAL_EXECUTABLE repl $CABAL_BUILD_OPTIONS <<< :q
79+
80+#------------------------------------------------------------------------------
81+# Benchmarks
82+#------------------------------------------------------------------------------
83+
84+RUNNING_BENCHMARKS=y
85+RUNNING_TESTS=
86+
87+RUNNING_DEVBUILD=
88+targets
89+TARGETS="$(all_grp)"
90+run_build_repl "bench" "$TARGETS"
91+
92+
93+RUNNING_DEVBUILD=y
94+targets
95+TARGETS="$(all_grp)"
96+run_build_repl "bench" "$TARGETS"
97+
98+#------------------------------------------------------------------------------
99+# Tests
100+#------------------------------------------------------------------------------
101+
102+RUNNING_TESTS=y
103+RUNNING_BENCHMARKS=
104+
105+RUNNING_DEVBUILD=
106+targets
107+TARGETS="$(all_grp)"
108+run_build_repl "test" "$TARGETS"
109+
110+RUNNING_DEVBUILD=y
111+targets
112+TARGETS="$(all_grp)"
113+run_build_repl "test" "$TARGETS"
bin/targets.shdeleted−120

This diff is too big to show here.

bin/test.shdeleted−231

This diff is too big to show here.

cabal.project+1

This diff is too big to show here.

cabal.project.O0+8−3

This diff is too big to show here.

cabal.project.Werror+4

This diff is too big to show here.

cabal.project.Werror-nocode+8

This diff is too big to show here.

cabal.project.coverage+4

This diff is too big to show here.

cabal.project.doctest+14−3

This diff is too big to show here.

cabal.project.ghc-head+21−41

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+9−237

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.

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

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.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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

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.

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

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.

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

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.

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

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.

src/Streamly/Internal/Data/Parser/ParserD/Type.hs → core/src/Streamly/Internal/Data/Parser/Type.hsrenamed+653−299

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+6−13

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.

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

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.

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

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+940−242

This diff is too big to show here.

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

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

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

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.

src/Streamly/Internal/Data/Unfold.hs → core/src/Streamly/Internal/Data/Unfold.hsrenamed+358−420

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Unfold/Type.hs → core/src/Streamly/Internal/Data/Unfold/Type.hsrenamed+386−79

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/FileSystem/File.hs → core/src/Streamly/Internal/FileSystem/File.hsrenamed+217−149

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Handle.hs → core/src/Streamly/Internal/FileSystem/Handle.hsrenamed+238−233

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.

src/Streamly/Internal/System/IO.hs → core/src/Streamly/Internal/System/IO.hsrenamed+19−13

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.

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

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+20−17

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.

default.nix+28−14

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.

dev/MAINTAINING.md → docs/Developer/MAINTAINING.mdrenamed+154−46

This diff is too big to show here.

docs/Developer/Tests.mdnew file+139

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

docs/Developer/overview.mdnew file+24

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

dev/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/Overview.md → docs/User/Explanatory/Overview.mdrenamed+2−2

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

The content is the same.

docs/unified-abstractions.md → docs/User/Explanatory/unified-abstractions.mdrenamed+12−9

This diff is too big to show here.

docs/building.md → docs/User/HowTo/Compiling.mdrenamed+54−45

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/interoperation.md → docs/User/HowTo/interoperation.mdrenamed

The content is the same.

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

The content is the same.

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

This diff is too big to show here.

docs/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+4−2

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/API-changelog.txt → docs/User/Project/ApiChangelogs/0.8.3.txtrenamed+19−8

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.

docs/CONTRIBUTORS.md → docs/User/Project/CONTRIBUTORS.mdrenamed+37

This diff is too big to show here.

Changelog.md → docs/User/Project/Changelog.mdrenamed+163−2

This diff is too big to show here.

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

The content is the same.

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/ConcurrentStreams.hs → docs/User/Tutorials/ConcurrentStreams.hsrenamed+31−40

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

docs/Tutorial.hs → docs/User/Tutorials/Tutorial.hsrenamed+49−81

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/resources.md → docs/User/resources.mdrenamed

The content is the same.

docs/faq.mddeleted−70

This diff is too big to show here.

docs/getting-started.mddeleted−296

This diff is too big to show here.

docs/streamly-docs.cabal+25−6

This diff is too big to show here.

hie.yaml+95−36

This diff is too big to show here.

src/Streamly.hsdeleted−690

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

This diff is too big to show here.

src/Streamly/Data/Fold.hsdeleted−289

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

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

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/Internal/Control/Concurrent.hs+44−67

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Array/Foreign/Mut.hsdeleted−146

This diff is too big to show here.

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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/IsMap/HashMap.hsnew file+42

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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

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+47−23

This diff is too big to show here.

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

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+9−16

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Common.hs+102−46

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+34−75

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+429−333

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+249−107

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Transform.hs+118−191

This diff is too big to show here.

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

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/PreludeCommon.hsdeleted−139

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar.hsnew file+18

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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

This diff is too big to show here.

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

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

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

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+218−162

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Linux.hs+281−221

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Windows.hs+223−166

This diff is too big to show here.

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

This diff is too big to show here.

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

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+166−128

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+195−246

This diff is too big to show here.

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

This diff is too big to show here.

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

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+21−12

This diff is too big to show here.

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

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+45−6

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Prelude.hs+14−8

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+9−2

This diff is too big to show here.

streamly.cabal+298−288

This diff is too big to show here.

targets/Targets.hsnew file+213

This diff is too big to show here.

benchmark/bench-report/cabal.project → targets/cabal.projectrenamed

The content is the same.

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

This diff is too big to show here.

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

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/Array/Stream/Foreign.hsdeleted−72

This diff is too big to show here.

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

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

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+779−194

This diff is too big to show here.

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

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

This diff is too big to show here.

test/Streamly/Test/FileSystem/Event.hs+13−387

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+31−35

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Prelude/Async.hs+39−5

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Prelude/Serial.hs+181−116

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

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

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

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

This diff is too big to show here.

test/streamly-tests.cabal+237−42

This diff is too big to show here.

test/test-runner/Main.hsnew file+33

This diff is too big to show here.

test/test-runner/cabal.projectnew file+4

This diff is too big to show here.

test/test-runner/default.nixnew file+164

This diff is too big to show here.

test/test-runner/test-runner.cabalnew file+41

This diff is too big to show here.