on 020be24 help sign in
.circleci/config.yml+277−75
since splitsnapshots
unifiedsplit
@@ -1,7 +1,7 @@
1version: 2.1
1version: 2.1
2
2
3#-----------------------------------------------------------------------------
3#-----------------------------------------------------------------------------
4−# packcheck-0.7.0
4+# packcheck-0.4.2
5# Packcheck global environment variables
5# Packcheck global environment variables
6#-----------------------------------------------------------------------------
6#-----------------------------------------------------------------------------
7
7
@@ -11,8 +11,6 @@ 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
16 CABAL_REINIT_CONFIG: "y"
14 CABAL_REINIT_CONFIG: "y"
17 LC_ALL: "C.UTF-8"
15 LC_ALL: "C.UTF-8"
18
16
@@ -24,6 +22,7 @@ env: &env
24 # DISABLE_DOCS: "y"
22 # DISABLE_DOCS: "y"
25 # DISABLE_SDIST_BUILD: "y"
23 # DISABLE_SDIST_BUILD: "y"
26 # DISABLE_DIST_CHECKS: "y"
24 # DISABLE_DIST_CHECKS: "y"
25+ ENABLE_INSTALL: "y"
27
26
28 # ------------------------------------------------------------------------
27 # ------------------------------------------------------------------------
29 # stack options
28 # stack options
@@ -39,12 +38,15 @@ env: &env
39 # cabal options
38 # cabal options
40 # ------------------------------------------------------------------------
39 # ------------------------------------------------------------------------
41 CABAL_CHECK_RELAX: "y"
40 CABAL_CHECK_RELAX: "y"
41+ CABAL_NO_SANDBOX: "y"
42+ CABAL_HACKAGE_MIRROR: "hackage.haskell.org:http://hackage.fpcomplete.com"
42 CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
43 CABAL_BUILD_OPTIONS: "-j1 --flag limit-build-mem"
43
44
44 # ------------------------------------------------------------------------
45 # ------------------------------------------------------------------------
45 # Where to find the required tools
46 # Where to find the required tools
46 # ------------------------------------------------------------------------
47 # ------------------------------------------------------------------------
47− PATH: /sbin:/usr/sbin:/bin:/usr/bin
48+ PATH: /opt/ghc/bin:/opt/ghcjs/bin:/sbin:/usr/sbin:/bin:/usr/bin
49+ TOOLS_DIR: /opt
48
50
49 # ------------------------------------------------------------------------
51 # ------------------------------------------------------------------------
50 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
52 # Location of packcheck.sh (the shell script invoked to perform CI tests ).
@@ -57,15 +59,15 @@ env: &env
57 # If you have not committed packcheck.sh in your repo at PACKCHECK
59 # If you have not committed packcheck.sh in your repo at PACKCHECK
58 # then it is automatically pulled from this URL.
60 # then it is automatically pulled from this URL.
59 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
61 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
60− PACKCHECK_GITHUB_COMMIT: "f6cfd7b7a33b4bf6fd63cce6a3fb3d26f5031403"
62+ PACKCHECK_GITHUB_COMMIT: "35efa99b2082d13722b8a0183ac6455df98e91b9"
61
63
62executors:
64executors:
63 amd64-executor:
65 amd64-executor:
64 docker:
66 docker:
65− - image: ubuntu:latest
67+ - image: ubuntu:xenial
66 x86-executor:
68 x86-executor:
67 docker:
69 docker:
68− - image: i386/ubuntu:focal
70+ - image: i386/ubuntu:eoan
69
71
70#-----------------------------------------------------------------------------
72#-----------------------------------------------------------------------------
71# Common utility stuff, not to be modified usually
73# Common utility stuff, not to be modified usually
@@ -77,50 +79,38 @@ preinstall: &preinstall
77 # required for https/cache save and restore
79 # required for https/cache save and restore
78 apt-get install -y ca-certificates
80 apt-get install -y ca-certificates
79
81
80− # Alternative way of installing ghc and cabal, directly from
82+ # required to (re)generate the configure script
81− # haskell.org instead of using ghcup. NOTE: this is for Debian
82− # only and is debian release specific.
83− # gnupg is required for apt-key to work
84− #apt-get install -y gnupg
85− #apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
86− #echo "deb http://downloads.haskell.org/debian buster main" >> /etc/apt/sources.list
87− #apt-get update
88−
89− # required for outbound https for stack and for stack setup
90− apt-get install -y netbase xz-utils make
83+ apt-get install -y autoconf
91− apt-get install -y zlib1g-dev
92
84
93− # For ghcup to install ghc
85+ # For ghc and cabal-install packages from hvr's ppa
94− if test -n "$GHCUP_VERSION"
86+ # gnupg is required for apt-key to work
95− then
87+ apt-get install -y gnupg
88+ apt-get install -y apt-transport-https
89+ apt-key adv --keyserver keyserver.ubuntu.com --recv-keys BA3CBA3FFE22B574
96− apt-get install -y gcc
90+ apt-get install -y software-properties-common
97− apt-get install -y g++
91+ add-apt-repository -y ppa:hvr/ghc
98− fi
92+ # echo "deb http://downloads.haskell.org/debian stretch main" >> /etc/apt/sources.list
93+ echo "deb-src http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main" >> /etc/apt/sources.list
94+ apt-get update
99
95
100− # libgmp required by ghc for linking
96+ # required for packcheck
101− apt-get install -y libgmp-dev
97+ apt-get install -y curl
102− apt-get install -y libtinfo-dev
103
98
104− # Required by cabal when git URL is specified in project file
99+ # required for circleci.
100+ apt-get install -y libcurl4-gnutls-dev
105 apt-get install -y git
101 apt-get install -y git
102+ apt-get install -y libtinfo-dev
106
103
107− # Required for and by packcheck
104+ # required for outbound https for stack and for stack setup
108− apt-get install -y curl
105+ apt-get install -y netbase xz-utils make
109
106
107+project-preinstall: &project-preinstall
108+ run: |
110 # Get packcheck if needed
109 # Get packcheck if needed
111− if test ! -e "$PACKCHECK"
110+ CURL=$(which curl)
112− then
113− if test -z "$PACKCHECK_GITHUB_COMMIT"
114− then
115− die "PACKCHECK_GITHUB_COMMIT is not specified."
116− fi
117− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
111+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
118− curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
112+ if test ! -e "$PACKCHECK"; then $CURL -sL -o "$PACKCHECK" $PACKCHECK_URL; fi;
119− chmod +x $PACKCHECK
120− elif test ! -x "$PACKCHECK"
121− then
122− chmod +x $PACKCHECK
113+ chmod +x $PACKCHECK
123− fi
124
114
125restore: &restore
115restore: &restore
126 # Needs to happen after installing ca-certificates
116 # Needs to happen after installing ca-certificates
@@ -136,71 +126,269 @@ save: &save
136 save_cache:
126 save_cache:
137 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
127 key: v1-{{ .Environment.CIRCLE_JOB }}-{{ .Branch }}
138 paths:
128 paths:
139− - ~/.local
140 - ~/.cabal
129 - ~/.cabal
130+ - ~/.ghc
131+ - ~/.local
141 - ~/.stack
132 - ~/.stack
142− - ~/.ghcup
143
133
144#-----------------------------------------------------------------------------
134#-----------------------------------------------------------------------------
145# Build matrix
135# Build matrix
146#-----------------------------------------------------------------------------
136#-----------------------------------------------------------------------------
147
137
148jobs:
138jobs:
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
149 cabal-ghc-8_6_5:
177 cabal-ghc-8_6_5:
150 <<: *env
178 <<: *env
151 executor: amd64-executor
179 executor: amd64-executor
152 steps:
180 steps:
181+ - *preinstall
153 - checkout
182 - checkout
183+ - *project-preinstall
154 - *restore
184 - *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:
155 - *preinstall
194 - *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
156 - run:
217 - run:
157 environment:
218 environment:
158− GHCVER: "8.6.5"
219+ BUILD: "cabal-v2"
159− CABAL_VERSION: "3.6.2.0"
220+ DISABLE_TEST: "yes"
160− CABAL_PROJECT: "cabal.project"
221+ DISABLE_BENCH: "yes"
222+ DISABLE_DOCS: "yes"
161 DISABLE_SDIST_BUILD: "yes"
223 DISABLE_SDIST_BUILD: "yes"
162− CABAL_BUILD_OPTIONS: "--flag debug --flag -opt"
224+ DISABLE_DIST_CHECKS: "yes"
163 command: |
225 command: |
226+ apt-get install -y ghc-8.2.2
227+ apt-get install -y cabal-install-3.2
164− bash -c "$PACKCHECK cabal"
228+ bash -c "$PACKCHECK $BUILD"
165 - *save
229 - *save
166− cabal-ghc-9_8_1-docspec:
230+ cabal-ghc-8_0_2:
167 <<: *env
231 <<: *env
168 executor: amd64-executor
232 executor: amd64-executor
169 steps:
233 steps:
234+ - *preinstall
170 - checkout
235 - checkout
236+ - *project-preinstall
171 - *restore
237 - *restore
172− - *preinstall
173 - run:
238 - run:
174 environment:
239 environment:
175− GHCVER: "9.8.1"
240+ BUILD: "cabal-v2"
176− CABAL_VERSION: "3.10.1.0"
177− CABAL_PROJECT: "cabal.project.doctest"
178− DISABLE_SDIST_BUILD: "y"
179− DISABLE_TEST: "y"
241+ DISABLE_TEST: "yes"
180− DISABLE_BENCH: "y"
242+ DISABLE_BENCH: "yes"
181− DISABLE_DOCS: "y"
243+ DISABLE_DOCS: "yes"
182− ENABLE_DOCSPEC: "y"
244+ DISABLE_SDIST_BUILD: "yes"
183− DOCSPEC_URL: https://github.com/phadej/cabal-extras/releases/download/cabal-docspec-0.0.0.20210111/cabal-docspec-0.0.0.20210111.xz
245+ DISABLE_DIST_CHECKS: "yes"
184− DOCSPEC_OPTIONS: "--timeout 60 --check-properties --property-variables xs"
185 command: |
246 command: |
247+ apt-get install -y ghc-8.0.2
248+ apt-get install -y cabal-install-3.2
186− bash -c "$PACKCHECK cabal"
249+ bash -c "$PACKCHECK $BUILD"
187 - *save
250 - *save
188− hlint-trailing-spaces:
251+ cabal-ghc-7_10_3:
189 <<: *env
252 <<: *env
190 executor: amd64-executor
253 executor: amd64-executor
191 steps:
254 steps:
255+ - *preinstall
192 - checkout
256 - checkout
257+ - *project-preinstall
193 - *restore
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:
194 - *preinstall
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
195 - run:
294 - run:
196− name: hlint and trailing spaces
295+ name: GHCJS 8.4+no-test+no-docs
197 environment:
296 environment:
297+ BUILD: cabal-v2
298+ ENABLE_GHCJS: "yes"
299+ DISABLE_TEST: "yes"
300+ ENABLE_INSTALL: ""
301+ DISABLE_DOCS: "yes"
198 DISABLE_SDIST_BUILD: "yes"
302 DISABLE_SDIST_BUILD: "yes"
199− HLINT_VERSION: 3.6.1
303+ command: |
304+ add-apt-repository -y ppa:hvr/ghcjs
305+ add-apt-repository -y 'deb https://deb.nodesource.com/node_11.x xenial main'
306+ curl -sSL https://deb.nodesource.com/gpgkey/nodesource.gpg.key | apt-key add -
307+ apt-get update
308+ apt-get install -y cabal-install-3.2
309+ apt-get install -y nodejs
310+ apt-get install -y ghcjs-8.4
311+ cabal user-config update -a "jobs: 1"
312+ bash -c "$PACKCHECK $BUILD"
313+ - *save
314+ coveralls-ghc-8_2_2:
315+ <<: *env
316+ executor: amd64-executor
317+ steps:
318+ - *preinstall
319+ - checkout
320+ - *project-preinstall
321+ - *restore
322+ - run:
323+ environment:
324+ BUILD: cabal
325+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test test"
326+ GHC_OPTIONS: "-DCOVERAGE_BUILD"
327+ command: |
328+ apt-get install -y ghc-8.2.2
329+ apt-get install -y cabal-install-2.4
330+ bash -c "$PACKCHECK cabal-v1"
331+ - *save
332+ coveralls-ghc-8_8_3:
333+ <<: *env
334+ executor: amd64-executor
335+ steps:
336+ - *preinstall
337+ - checkout
338+ - *project-preinstall
339+ - *restore
340+ - run:
341+ environment:
342+ BUILD: cabal-v2
343+ COVERALLS_OPTIONS: "--repo-token=\"$REPO_TOKEN\" --coverage-mode=StrictlyFullLines --exclude-dir=test"
344+ CABAL_PROJECT: "cabal.project.coverage"
345+ CABAL_BUILD_TARGETS: ""
346+ command: |
347+ apt-get install -y ghc-8.8.3
348+ apt-get install -y cabal-install-3.0
349+ bash -c "$PACKCHECK cabal-v2"
350+ no_output_timeout: 25m
351+ - *save
352+ coveralls-ghc-8_10_2:
353+ <<: *env
354+ executor: amd64-executor
355+ steps:
356+ - *preinstall
357+ - checkout
358+ - *project-preinstall
359+ - *restore
360+ - run:
361+ name: Build and test with inspection, coverage, Werror
362+ command: |
363+ apt-get install -y ghc-8.10.2
364+ apt-get install -y cabal-install-3.2
365+ # Run tests with coverage
366+ cabal update
367+ cabal user-config update -a "jobs: 1"
368+ bin/test.sh --coverage --raw
369+ # Upload results to coveralls.io
370+ PATH=$HOME/.cabal/bin:$PATH
371+ export PATH
372+ which hpc-coveralls 2>/dev/null || cabal install --project-file cabal.project.hpc-coveralls hpc-coveralls
373+ hpc-coveralls --repo-token="$REPO_TOKEN" --coverage-mode=StrictlyFullLines
374+ no_output_timeout: 25m
375+ - *save
376+ hlint-src:
377+ <<: *env
378+ executor: amd64-executor
379+ steps:
380+ - *preinstall
381+ - checkout
382+ - *project-preinstall
383+ - *restore
384+ - run:
385+ name: Hlint src
386+ environment:
387+ BUILD: cabal-v2
200 HLINT_OPTIONS: lint
388 HLINT_OPTIONS: lint
201− HLINT_TARGETS: core/src src test benchmark
389+ HLINT_TARGETS: src test benchmark
202 command: |
390 command: |
203− bash -c "$PACKCHECK hlint" || exit 1
391+ bash -c "$PACKCHECK $BUILD" || exit 1
204 echo "Checking trailing spaces..."
392 echo "Checking trailing spaces..."
205 count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
393 count=$(find . -name "*.hs" -exec grep -H '\ $' {} \; | tee /dev/tty | wc -l)
206 exit $count
394 exit $count
@@ -210,9 +398,23 @@ workflows:
210 version: 2
398 version: 2
211 build:
399 build:
212 jobs:
400 jobs:
213− #- cabal-ghc-8_6_5:
401+ - cabal-ghc-8_10_4:
214− # name: 8.6.5-debug-unoptimized
402+ name: GHC 8.10.4 + sdist + no-test + no-bench
403+ #- cabal-ghc-8.6.5
404+ #- cabal-ghc-8_4_4:
405+ # name: GHC 8.4.4 + x86 + debug
406+ - cabal-ghc-8_2_2:
407+ name: GHC 8.2.2 + no-test + no-bench + no-docs
215− - cabal-ghc-9_8_1-docspec:
408+ - cabal-ghc-8_0_2:
216− name: ghc-9.8.1-docspec
409+ name: GHC 8.0.2 + no-test + no-bench + no-docs
217− - hlint-trailing-spaces:
410+ #- cabal-ghc-7.10.3
218− name: hlint and trailing spaces
411+ - cabal-ghcjs-8_4:
412+ name: GHCJS 8.4 + no-test + no-docs
413+ #- stack-ghc-8.4
414+ #- stack-ghc-8.2
415+ #- coveralls-ghc-8.2.2
416+ #- coveralls-ghc-8.8.3
417+ #- coveralls-ghc-8_10_2:
418+ # name: GHC 8.10.2 + inspection + coverage + Werror
419+ - hlint-src:
420+ name: Hlint src + Trailing Spaces
.github/workflows/haskell.yml+108−129
@@ -13,15 +13,8 @@ jobs:
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 }}
21 GHCVER: ${{ matrix.ghc_version }}
16 GHCVER: ${{ matrix.ghc_version }}
22− CABALVER: ${{ matrix.cabal_version }}
23 DISABLE_DOCS: ${{ matrix.disable_docs }}
17 DISABLE_DOCS: ${{ matrix.disable_docs }}
24− ENABLE_DOCSPEC: ${{ matrix.enable_docspec }}
25 DISABLE_TEST: ${{ matrix.disable_test }}
18 DISABLE_TEST: ${{ matrix.disable_test }}
26 DISABLE_BENCH: ${{ matrix.disable_bench }}
19 DISABLE_BENCH: ${{ matrix.disable_bench }}
27 DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
20 DISABLE_DIST_CHECKS: ${{ matrix.disable_dist_checks }}
@@ -45,21 +38,14 @@ jobs:
45 STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
38 STACK_BUILD_OPTIONS: ${{ matrix.stack_build_options }}
46
39
47 # packcheck location and revision
40 # packcheck location and revision
48− PACKCHECK: "./packcheck.sh"
41+ PACKCHECK_LOCAL_PATH: "./packcheck.sh"
49 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
42 PACKCHECK_GITHUB_URL: "https://raw.githubusercontent.com/composewell/packcheck"
50− PACKCHECK_GITHUB_COMMIT: "v0.7.0"
43+ PACKCHECK_GITHUB_COMMIT: "075e13ab716c67d2110db4905ae42b0280af046d"
51
44
52 # Pull token from "secrets" setting of the github repo
45 # Pull token from "secrets" setting of the github repo
53 COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
46 COVERALLS_TOKEN: ${{ secrets.COVERALLS_TOKEN }}
54 COVERAGE: ${{ matrix.coverage }}
47 COVERAGE: ${{ matrix.coverage }}
55−
48+ DOCTEST: ${{ matrix.doctest }}
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 }}
63
49
64 runs-on: ${{ matrix.runner }}
50 runs-on: ${{ matrix.runner }}
65 continue-on-error: ${{ matrix.ignore_error }}
51 continue-on-error: ${{ matrix.ignore_error }}
@@ -68,8 +54,8 @@ jobs:
68 matrix:
54 matrix:
69 # The order is important to optimize fail-fast.
55 # The order is important to optimize fail-fast.
70 name:
56 name:
71− - 9.8.1-Werror
57+ - 8.10.7-sdist-fusion-inspection-Werror
72− # - 9.8.1-docspec
58+ - 9.2.1-docspec
73 # - 8.10.7-coverage
59 # - 8.10.7-coverage
74
60
75 # Note: if cabal.project is not specified benchmarks and tests won't
61 # Note: if cabal.project is not specified benchmarks and tests won't
@@ -78,159 +64,164 @@ jobs:
78 include:
64 include:
79 - name: head
65 - name: head
80 ghc_version: head
66 ghc_version: head
81− # The URL may change, to find a working URL go to https://gitlab.haskell.org/ghc/ghc/-/jobs/
82− # Find a debian10/11/12 job, click on a passed/failed status, at the
83− # end of the output you will find the tar.xz name, put that tar
84− # name after "raw/", and put the job name after "job=".
85− # Also see https://github.com/mpickering/ghc-artefact-nix/blob/master/gitlab-artifact.nix
86− #
87− # May also use ghcup for installing ghc head version, use the
88− # version "LatestNightly", and the following config:
89− # ghcup config add-release-channel https://ghc.gitlab.haskell.org/ghcup-metadata/ghcup-nightlies-0.0.7.yaml
90− ghcup_ghc_options: "-u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-deb10-int_native-validate.tar.xz?job=x86_64-linux-deb10-int_native-validate"
91 runner: ubuntu-latest
67 runner: ubuntu-latest
92 build: cabal
68 build: cabal
93− cabal_version: 3.10.2.0
69+ cabal_version: latest
94 cabal_project: cabal.project.ghc-head
70 cabal_project: cabal.project.ghc-head
95 disable_sdist_build: "y"
71 disable_sdist_build: "y"
96 ignore_error: true
72 ignore_error: true
97− # Note: use linux for warning build for convenient dev testing
98− - name: 9.8.1-Werror
99− ghc_version: 9.8.1
100− runner: ubuntu-latest
101− build: cabal
102− cabal_version: 3.10.1.0
103− disable_sdist_build: "y"
104− cabal_project: cabal.project.Werror
105− ignore_error: false
106− #- name: 9.8.1-docspec
73+ - name: 9.2.1
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
74+ ghc_version: 9.2.1
120 runner: ubuntu-latest
75 runner: ubuntu-latest
121 build: cabal
76 build: cabal
122− cabal_version: 3.10.1.0
123− disable_sdist_build: "y"
124 cabal_project: cabal.project
77 cabal_project: cabal.project
125− cabal_build_options: "--flag fusion-plugin --flag inspection"
126− ignore_error: false
127− - name: 9.6.3-macos
128− ghc_version: 9.6.3
129− runner: macos-latest
130− build: cabal
131− cabal_version: 3.10.1.0
78+ cabal_version: 3.6
132 disable_sdist_build: "y"
79 disable_sdist_build: "y"
133− cabal_project: cabal.project
134 ignore_error: false
80 ignore_error: false
135− - name: 9.4.7
81+ - name: 9.2.1-docspec
136− ghc_version: 9.4.7
82+ ghc_version: 9.2.1
137 runner: ubuntu-latest
83 runner: ubuntu-latest
138− build: cabal
84+ doctest: "y"
139− cabal_version: 3.8.1.0
85+ cabal_version: 3.6
140− disable_sdist_build: "y"
141− cabal_project: cabal.project
142 ignore_error: false
86 ignore_error: false
143− - name: 9.2.8
87+ - name: 9.0.1
144− ghc_version: 9.2.8
88+ ghc_version: 9.0.1
145 runner: ubuntu-latest
89 runner: ubuntu-latest
146 build: cabal
90 build: cabal
91+ cabal_version: 3.6
147 cabal_project: cabal.project
92 cabal_project: cabal.project
148− cabal_version: 3.6.2.0
149 disable_sdist_build: "y"
93 disable_sdist_build: "y"
150 ignore_error: false
94 ignore_error: false
151− - name: 9.0.2-streamly-sdist
152− ghc_version: 9.0.2
153− runner: ubuntu-latest
154− build: cabal
155− cabal_version: 3.6.2.0
156− cabal_project: cabal.project.streamly
157− ignore_error: true
158− - name: 9.0.2-streamly-core-sdist
159− ghc_version: 9.0.2
160− runner: ubuntu-latest
161− build: cabal
162− cabal_version: 3.6.2.0
163− subdir: core
164− ignore_error: false
165− - name: 8.10.7-streamly-sdist-stack
95+ - name: 8.10.7-sdist-stack
166 runner: ubuntu-latest
96 runner: ubuntu-latest
167 build: stack
97 build: stack
168− resolver: lts-20.13
98+ resolver: lts-18.23
169 stack_yaml: stack.yaml
99 stack_yaml: stack.yaml
170 sdist_options: "--ignore-check"
100 sdist_options: "--ignore-check"
171 stack_build_options: "--flag streamly-benchmarks:-opt"
101 stack_build_options: "--flag streamly-benchmarks:-opt"
172− cabal_version: 3.6.2.0
102+ cabal_version: 3.6
103+ ignore_error: false
104+ - name: 8.10.7-macos
105+ ghc_version: 8.10.7
106+ runner: macos-latest
107+ build: cabal
108+ cabal_version: 3.6
109+ cabal_project: cabal.project
110+ disable_sdist_build: "y"
173 ignore_error: false
111 ignore_error: false
174 # - name: 8.10.7-coverage
112 # - name: 8.10.7-coverage
175 # ghc_version: 8.10.7
113 # ghc_version: 8.10.7
176 # runner: ubuntu-latest
114 # runner: ubuntu-latest
177 # coverage: "y"
115 # coverage: "y"
178− # cabal_version: 3.6.2.0
116+ # cabal_version: 3.6
179 # ignore_error: false
117 # ignore_error: false
180− - name: 8.8.4
118+ - name: 8.10.7-sdist-fusion-inspection-Werror
119+ ghc_version: 8.10.7
120+ runner: ubuntu-latest
121+ build: cabal
122+ cabal_version: 3.6
123+ cabal_project: cabal.project.Werror
124+ cabal_build_options: "--flag fusion-plugin --flag inspection"
125+ ignore_error: false
126+ - name: 8.10.7-sdist-streamly-core
127+ ghc_version: 8.10.7
128+ runner: ubuntu-latest
129+ build: cabal
130+ cabal_version: 3.6
131+ cabal_project: cabal.project
132+ cabal_build_targets: "streamly"
133+ cabal_build_options: "--flag streamly-core"
134+ disable_test: "y"
135+ disable_bench: "y"
136+ ignore_error: false
137+ - name: 8.8.4-sdist-fusion
181 ghc_version: 8.8.4
138 ghc_version: 8.8.4
182 runner: ubuntu-latest
139 runner: ubuntu-latest
183 build: cabal
140 build: cabal
184− cabal_version: 3.6.2.0
141+ cabal_version: 3.6
185 cabal_project: cabal.project
142 cabal_project: cabal.project
186− disable_sdist_build: "y"
143+ cabal_build_options: "--flag fusion-plugin"
187 ignore_error: false
144 ignore_error: false
188− - name: 8.6.5-debug-unoptimized
145+ - name: 8.6.5-sdist-streamk-unoptimized
189 ghc_version: 8.6.5
146 ghc_version: 8.6.5
190 runner: ubuntu-latest
147 runner: ubuntu-latest
191 build: cabal
148 build: cabal
192− cabal_version: 3.6.2.0
149+ cabal_version: 3.6
150+ cabal_project: cabal.project
151+ cabal_build_options: "--flag streamk --flag -opt"
152+ ignore_error: false
153+ - name: 8.6.5-sdist-debug-unoptimized
154+ ghc_version: 8.6.5
155+ runner: ubuntu-latest
156+ build: cabal
157+ cabal_version: 3.6
193 cabal_project: cabal.project
158 cabal_project: cabal.project
194 cabal_build_options: "--flag debug --flag -opt"
159 cabal_build_options: "--flag debug --flag -opt"
195− disable_sdist_build: "y"
196 ignore_error: false
160 ignore_error: false
197− - name: hlint
161+ - name: 8.4.4-sdist
198− build: hlint
162+ ghc_version: 8.4.4
199 runner: ubuntu-latest
163 runner: ubuntu-latest
164+ build: cabal
165+ cabal_version: 3.6
200− ignore_error: true
166+ ignore_error: false
201
167
202 steps:
168 steps:
203 - uses: actions/checkout@v2
169 - uses: actions/checkout@v2
204
170
205 - uses: actions/cache@v1
171 - uses: actions/cache@v1
206− name: Cache common directories
172+ name: Cache ~/.cabal
207 with:
173 with:
208− path: |
209− ~/.local
210− ~/.cabal
174+ path: ~/.cabal
211− ~/.stack
212− ~/.ghcup
213 # Bump the key version to clear the cache
175 # Bump the key version to clear the cache
214− key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v2
176+ key: ${{ runner.os }}-${{ matrix.ghc_version }}-cabal-v1
215
177
216 - name: Download packcheck
178 - name: Download packcheck
217 run: |
179 run: |
218− if test ! -e "$PACKCHECK"
180+ # Get packcheck if needed
219− then
181+ CURL=$(which curl)
220− if test -z "$PACKCHECK_GITHUB_COMMIT"
182+ PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
221− then
183+ if test ! -e "$PACKCHECK_LOCAL_PATH"; then $CURL -sL -o "$PACKCHECK_LOCAL_PATH" $PACKCHECK_URL; fi;
222− die "PACKCHECK_GITHUB_COMMIT is not specified."
184+ chmod +x $PACKCHECK_LOCAL_PATH
223− fi
185+
224− PACKCHECK_URL=${PACKCHECK_GITHUB_URL}/${PACKCHECK_GITHUB_COMMIT}/packcheck.sh
186+ os=$(uname -s -m)
225− curl --fail -sL -o "$PACKCHECK" $PACKCHECK_URL || exit 1
187+ case "$os" in
188+ "Linux x86_64") GHCUP_ARCH="x86_64-linux" ;;
189+ "Darwin x86_64") GHCUP_ARCH="x86_64-apple-darwin" ;;
190+ *) echo "Unknown OS/Arch: $os"; exit 1;;
191+ esac
192+
193+ $CURL -sL -o ./ghcup https://downloads.haskell.org/~ghcup/0.1.17.4/${GHCUP_ARCH}-ghcup-0.1.17.4
226− chmod +x $PACKCHECK
194+ chmod +x ./ghcup
227− elif test ! -x "$PACKCHECK"
195+ if test "$GHCVER" = "head"
228 then
196 then
229− chmod +x $PACKCHECK
197+ ./ghcup install ghc -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-deb10-linux-integer-simple.tar.xz?job=validate-x86_64-linux-deb10-integer-simple head
198+ else
199+ ./ghcup install ghc $GHCVER
230 fi
200 fi
201+ ./ghcup set ghc $GHCVER
231
202
232 - name: Run tests
203 - name: Run tests
233 run: |
204 run: |
205+ if test -n "$DOCTEST"
206+ then
207+ mkdir -p $HOME/.cabal/bin
208+ 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
209+ echo '0829bd034fba901cbcfe491d98ed8b28fd54f9cb5c91fa8e1ac62dc4413c9562 cabal-docspec.xz' | sha256sum -c -
210+ xz -d < cabal-docspec.xz > $HOME/.cabal/bin/cabal-docspec
211+ rm -f cabal-docspec.xz
212+ chmod a+x $HOME/.cabal/bin/cabal-docspec
213+ cabal update
214+ cabal build all
215+ $HOME/.cabal/bin/cabal-docspec --version
216+ $HOME/.cabal/bin/cabal-docspec --timeout 60 --check-properties --property-variables xs
217+ elif test -z "$COVERAGE"
218+ then
219+ export TOOLS_DIR=/opt
220+ # /usr/local/opt/curl/bin for macOS
221+ export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
222+ bash -c "$PACKCHECK_LOCAL_PATH $BUILD"
223+ fi
224+
234 if test -n "$COVERAGE"
225 if test -n "$COVERAGE"
235 then
226 then
236 # Run tests with coverage
227 # Run tests with coverage
@@ -243,16 +234,4 @@ jobs:
243 bin/test.sh --coverage --raw
234 bin/test.sh --coverage --raw
244 # XXX Uncomment this and fix it properly later
235 # XXX Uncomment this and fix it properly later
245 # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
236 # hpc-coveralls --repo-token="$COVERALLS_TOKEN" --coverage-mode=StrictlyFullLines
246− else
247− # /usr/local/opt/curl/bin for macOS
248− export PATH=$HOME/.local/bin:$HOME/.ghcup/bin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/local/opt/curl/bin
249− if test -n "$SUBDIR"
250− then
251− mv "$PACKCHECK" "$SUBDIR/packcheck.sh"
252− # This is required as dist-newstyle will be created on the top level
253− # directory as it is considered the working dir.
254− rm cabal.project
255− cd "$SUBDIR"
256− fi
257− bash -c "$PACKCHECK $BUILD"
258 fi
237 fi
.github/workflows/packdiff.ymldeleted−39
@@ -1,39 +0,0 @@
1−name: Packdiff
2−
3−on: pull_request
4−
5−jobs:
6− packdiff:
7−
8− runs-on: ubuntu-latest
9−
10− steps:
11−
12− - name: Download ghc
13− run: |
14− GHCUP_VER=0.1.18.0
15− curl -sL -o ./ghcup https://downloads.haskell.org/~ghcup/$GHCUP_VER/x86_64-linux-ghcup-$GHCUP_VER
16− chmod +x ./ghcup
17− GHCVER=8.10.7
18− ./ghcup install ghc $GHCVER
19− ./ghcup set ghc $GHCVER
20− cabal update
21−
22− - uses: actions/cache@v2
23− name: Cache ~/.cabal
24− with:
25− path: |
26− ~/.cabal
27− # Bump the key version to clear the cache
28− key: cache-v2
29−
30− - name: Checkout the current branch
31− uses: actions/checkout@v2
32− with:
33− fetch-depth: 0
34−
35− - name: Run packdiff on streamly-core
36− run: cabal run packdiff --project-file=cabal.project.packdiff -- streamly-core $(git rev-parse origin/master) $(git rev-parse HEAD)
37−
38− - name: Run packdiff on streamly
39− run: cabal run packdiff --project-file=cabal.project.packdiff -- streamly $(git rev-parse origin/master) $(git rev-parse HEAD)
.github/workflows/regression-check.yml+46−54
@@ -1,8 +1,7 @@
1name: Regression checking
1name: Regression checking
2
2
3−on:
4− workflow_dispatch:
5− pull_request:
3+on: pull_request
4+
6
5
7# References:
6# References:
8# https://docs.github.com/en/actions/managing-workflow-runs/manually-running-a-workflow
7# https://docs.github.com/en/actions/managing-workflow-runs/manually-running-a-workflow
@@ -17,24 +16,30 @@ on:
17jobs:
16jobs:
18 check-regressions:
17 check-regressions:
19 env:
18 env:
19+ CI_BENCH_SH: bin/bench.sh
20 CI_BENCHMARKS_WITH_CUTOFF: >-
20 CI_BENCHMARKS_WITH_CUTOFF: >-
21 Data.Array
21 Data.Array
22− Data.MutArray
22+ Data.Array.Foreign
23− Data.Array.Generic
23+ Data.Array.Prim
24− Data.Ring.Unboxed
24+ Data.Array.Prim.Pinned
25 Data.Fold
25 Data.Fold
26− Data.Fold.Window
27 Data.Parser
26 Data.Parser
27+ Data.Parser.ParserD
28− Data.ParserK
28+ Data.Parser.ParserK
29+ Data.SmallArray
29− Data.StreamD
30+ Data.Stream.StreamD
31+ Data.Stream.StreamDK
30− Data.StreamK:6
32+ Data.Stream.StreamK:6
31 Data.Unfold
33 Data.Unfold
32− Data.Stream
33− Data.Stream.Concurrent
34− Data.Stream.ConcurrentEager
35− Data.Stream.ConcurrentInterleaved
36− Data.Stream.ConcurrentOrdered
37 FileSystem.Handle
34 FileSystem.Handle
35+ Prelude.Ahead
36+ Prelude.Async:12
37+ Prelude.Parallel
38+ Prelude.Serial
39+ Prelude.WAsync:6
40+ Prelude.WSerial
41+ Prelude.ZipAsync
42+ Prelude.ZipSerial
38 Unicode.Char
43 Unicode.Char
39 Unicode.Stream
44 Unicode.Stream
40 Unicode.Utf8
45 Unicode.Utf8
@@ -55,60 +60,47 @@ jobs:
55 done
60 done
56 echo "CI_BENCHMARKS=$CI_BENCHMARKS" >> $GITHUB_ENV
61 echo "CI_BENCHMARKS=$CI_BENCHMARKS" >> $GITHUB_ENV
57
62
58− - name: Download ghc
63+ - name: Setup haskell
59− run: |
64+ uses: actions/setup-haskell@v1
60− GHCUP_VER=0.1.18.0
65+ with:
61− curl -sL -o ./ghcup https://downloads.haskell.org/~ghcup/$GHCUP_VER/x86_64-linux-ghcup-$GHCUP_VER
66+ ghc-version: 8.8.4
62− chmod +x ./ghcup
67+ cabal-version: 3.2
63− GHCVER=9.2.7
64− ./ghcup install ghc $GHCVER
65− ./ghcup set ghc $GHCVER
66− cabal update
67
68
68 - uses: actions/cache@v2
69 - uses: actions/cache@v2
69− name: Cache ~/.cabal
70+ name: Cache ~/.cabal and bench-report
70 with:
71 with:
71 path: |
72 path: |
72 ~/.cabal
73 ~/.cabal
74+ ./benchmark/bench-report/bin/bench-report
73 # Bump the key version to clear the cache
75 # Bump the key version to clear the cache
74− key: cache-v2
76+ key: cache-v1
75
77
76− - name: Cache bench-runner from pr
78+ - name: Cache charts from master
77− id: cache-bench-runner-pr
79+ id: cache-charts-master
78 uses: actions/cache@v2
80 uses: actions/cache@v2
79 with:
81 with:
80− path: bench-runner
82+ path: charts-master
81 # Bump the key version to clear the cache
83 # Bump the key version to clear the cache
82− key: bench-runner-v1
84+ key: charts-master-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
85
97 # -----------------------------------------------------------------
86 # -----------------------------------------------------------------
98 # -- Generate reports for the base branch and upload
87 # -- Generate reports for the base branch and upload
99 # -----------------------------------------------------------------
88 # -----------------------------------------------------------------
100
89
101 - name: Checkout the base branch
90 - name: Checkout the base branch
91+ if: steps.cache-charts-master.outputs.cache-hit != 'true'
102 uses: actions/checkout@v2
92 uses: actions/checkout@v2
103 with:
93 with:
104 ref: master
94 ref: master
105− clean: false
106
95
107 - name: Run benchmarks
96 - name: Run benchmarks
97+ if: steps.cache-charts-master.outputs.cache-hit != 'true'
108 run: |
98 run: |
99+ chmod +x $CI_BENCH_SH
109− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --raw
100+ $CI_BENCH_SH --benchmarks "$CI_BENCHMARKS" --raw
110
101
111 - name: Move charts to charts-master
102 - name: Move charts to charts-master
103+ if: steps.cache-charts-master.outputs.cache-hit != 'true'
112 run: mv charts charts-master
104 run: mv charts charts-master
113
105
114 # -----------------------------------------------------------------
106 # -----------------------------------------------------------------
@@ -125,7 +117,8 @@ jobs:
125
117
126 - name: Run benchmarks and append
118 - name: Run benchmarks and append
127 run: |
119 run: |
120+ chmod +x $CI_BENCH_SH
128− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --raw --append
121+ $CI_BENCH_SH --benchmarks "$CI_BENCHMARKS" --raw --append
129
122
130 # -----------------------------------------------------------------
123 # -----------------------------------------------------------------
131 # -- Compare
124 # -- Compare
@@ -133,10 +126,12 @@ jobs:
133
126
134 - name: List all benchmarks
127 - name: List all benchmarks
135 run: |
128 run: |
136− ./bench-runner --package-name streamly-benchmarks --package-version 0.0.0 --targets "$CI_BENCHMARKS" --no-measure
129+ chmod +x $CI_BENCH_SH
130+ $CI_BENCH_SH --no-measure
137
131
138 - name: Compare benchmarks
132 - name: Compare benchmarks
139 run: |
133 run: |
134+ chmod +x $CI_BENCH_SH
140
135
141 EXIT_STATUS=0
136 EXIT_STATUS=0
142
137
@@ -151,13 +146,10 @@ jobs:
151
146
152 echo
147 echo
153 echo "Checking $bname for regressions greater than $cutoff percent"
148 echo "Checking $bname for regressions greater than $cutoff percent"
154− ! ./bench-runner \
149+ ! $CI_BENCH_SH --benchmarks "$bname" \
155− --package-name streamly-benchmarks \
156− --package-version 0.0.0 \
157− --targets "$bname" \
158− --fields "$CI_FIELDS" \
150+ --fields "$CI_FIELDS" \
159− --no-measure --silent \
151+ --no-measure --silent \
160− --diff-cutoff-percent $cutoff \
152+ --diff-cutoff-percent $cutoff \
161 | grep -v "^$"
153 | grep -v "^$"
162 test $? -eq 1 && EXIT_STATUS=1
154 test $? -eq 1 && EXIT_STATUS=1
163 done
155 done
.hlint.ignore+23−12
@@ -1,40 +1,51 @@
1−core/src/Streamly/Internal/Data/Stream/StreamK/Type.hs
1+src/Streamly/Internal/Data/Stream/Prelude.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
6src/Streamly/Internal/Data/Stream/Serial.hs
3src/Streamly/Internal/Data/Stream/Serial.hs
7src/Streamly/Internal/Data/Stream/Zip.hs
4src/Streamly/Internal/Data/Stream/Zip.hs
5+src/Streamly/Internal/Data/Stream/StreamK/Type.hs
6+src/Streamly/Internal/Data/Pipe/Type.hs
7+src/Streamly/Internal/Data/SmallArray/Type.hs
8+src/Streamly/Internal/Unicode/Stream.hs
9+src/Streamly/Internal/Data/Array/Prim/Type.hs
10+src/Streamly/Internal/Data/Array/Prim/Mut/Type.hs
11+src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs
12+src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Type.hs
13+src/Streamly/Internal/Data/Array/Prim/Pinned/Type.hs
14+src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs
8test/Streamly/Test/Data/Array.hs
15test/Streamly/Test/Data/Array.hs
16+test/Streamly/Test/Data/Array/Prim.hs
17+test/Streamly/Test/Data/Array/Prim/Pinned.hs
18+test/Streamly/Test/Data/Array/Foreign.hs
9test/Streamly/Test/Data/Parser.hs
19test/Streamly/Test/Data/Parser.hs
10−test/Streamly/Test/Data/ParserK.hs
20+test/Streamly/Test/Data/Parser/ParserD.hs
11test/Streamly/Test/Data/SmallArray.hs
21test/Streamly/Test/Data/SmallArray.hs
12test/Streamly/Test/Data/Unfold.hs
22test/Streamly/Test/Data/Unfold.hs
13test/Streamly/Test/FileSystem/Event.hs
23test/Streamly/Test/FileSystem/Event.hs
14test/Streamly/Test/Prelude/Concurrent.hs
24test/Streamly/Test/Prelude/Concurrent.hs
15−test/Streamly/Test/Data/Stream/Concurrent.hs
16−test/lib/Streamly/Test/Prelude/Common.hs
17test/Streamly/Test/Prelude/Fold.hs
25test/Streamly/Test/Prelude/Fold.hs
18test/Streamly/Test/Prelude/Rate.hs
26test/Streamly/Test/Prelude/Rate.hs
19test/Streamly/Test/Prelude/Serial.hs
27test/Streamly/Test/Prelude/Serial.hs
20test/Streamly/Test/Unicode/Stream.hs
28test/Streamly/Test/Unicode/Stream.hs
21−test/Streamly/Test/Data/Unbox.hs
22benchmark/lib/Streamly/Benchmark/Common.hs
29benchmark/lib/Streamly/Benchmark/Common.hs
23benchmark/lib/Streamly/Benchmark/Common/Handle.hs
30benchmark/lib/Streamly/Benchmark/Common/Handle.hs
24benchmark/lib/Streamly/Benchmark/Prelude.hs
31benchmark/lib/Streamly/Benchmark/Prelude.hs
25benchmark/NanoBenchmarks.hs
32benchmark/NanoBenchmarks.hs
26benchmark/Streamly/Benchmark/Data/Array.hs
33benchmark/Streamly/Benchmark/Data/Array.hs
34+benchmark/Streamly/Benchmark/Data/ArrayOps.hs
35+benchmark/Streamly/Benchmark/Data/NestedUnfoldOps.hs
27benchmark/Streamly/Benchmark/Data/Parser.hs
36benchmark/Streamly/Benchmark/Data/Parser.hs
28−benchmark/Streamly/Benchmark/Data/ParserK.hs
37+benchmark/Streamly/Benchmark/Data/Parser/ParserD.hs
29benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
38benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hs
30benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
39benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs
31benchmark/Streamly/Benchmark/Data/Unfold.hs
40benchmark/Streamly/Benchmark/Data/Unfold.hs
32benchmark/Streamly/Benchmark/FileSystem/Handle.hs
41benchmark/Streamly/Benchmark/FileSystem/Handle.hs
33benchmark/Streamly/Benchmark/Prelude/Async.hs
42benchmark/Streamly/Benchmark/Prelude/Async.hs
34−benchmark/Streamly/Benchmark/Prelude/Concurrent.hs
35benchmark/Streamly/Benchmark/Prelude/Merge.hs
43benchmark/Streamly/Benchmark/Prelude/Merge.hs
36benchmark/Streamly/Benchmark/Prelude/Parallel.hs
44benchmark/Streamly/Benchmark/Prelude/Parallel.hs
37benchmark/Streamly/Benchmark/Prelude/Rate.hs
45benchmark/Streamly/Benchmark/Prelude/Rate.hs
46+benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hs
47+benchmark/Streamly/Benchmark/Prelude/Serial/Nested.hs
48+benchmark/Streamly/Benchmark/Prelude/Serial/Split.hs
38benchmark/Streamly/Benchmark/Prelude/WAsync.hs
49benchmark/Streamly/Benchmark/Prelude/WAsync.hs
39benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
50benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs
40−benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
51+benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs
.hlint.yaml+7−6
@@ -24,14 +24,15 @@
24- ignore: {name: "Use uncurry"}
24- ignore: {name: "Use uncurry"}
25- ignore: {name: "Redundant $!"}
25- ignore: {name: "Redundant $!"}
26- ignore: {name: "Use fmap"}
26- ignore: {name: "Use fmap"}
27−- ignore: {name: "Use ++"}
28
27
29# Warnings ignored in specific places
28# Warnings ignored in specific places
30−- ignore: {name: "Use mapM", within: Stream.Transform}
29+- ignore: {name: "Use ++", within: Serial.Transformation}
30+- ignore: {name: "Use mapM", within: Serial.Transformation}
31−- ignore: {name: "Use traverse", within: Stream.Transform}
31+- ignore: {name: "Use traverse", within: Serial.Transformation}
32+
32−- ignore: {name: "Redundant <*", within: Stream.Expand}
33+- ignore: {name: "Redundant <*", within: Serial.NestedStream}
33−- ignore: {name: "Redundant bracket", within: Stream.Split}
34+- ignore: {name: "Use ++", within: Serial.NestedStream}
34−- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Parser}
35+- ignore: {name: "Use isDigit", within: Streamly.Internal.Unicode.Char.Parser}
35
36
36# Specify additional command line arguments
37# Specify additional command line arguments
37#
38#
.packcheck.ignore+1−12
@@ -2,16 +2,13 @@
2.ghci
2.ghci
3.github/workflows/haskell.yml
3.github/workflows/haskell.yml
4.github/workflows/regression-check.yml
4.github/workflows/regression-check.yml
5−.github/workflows/packdiff.yml
6.gitignore
5.gitignore
7.hlint.ignore
6.hlint.ignore
8.hlint.yaml
7.hlint.yaml
9.packcheck.ignore
8.packcheck.ignore
10appveyor.yml
9appveyor.yml
11−benchmark/bench-runner/default.nix
10+benchmark/bench-report/default.nix
12−benchmark/bench-runner/cabal.project
13bin/ghc.sh
11bin/ghc.sh
14−bin/repl
15bin/run-ci.sh
12bin/run-ci.sh
16bin/run-repl-quick.sh
13bin/run-repl-quick.sh
17cabal.project
14cabal.project
@@ -20,17 +17,9 @@ cabal.project.doctest
20cabal.project.ghc-head
17cabal.project.ghc-head
21cabal.project.hpc-coveralls
18cabal.project.hpc-coveralls
22cabal.project.O0
19cabal.project.O0
23−cabal.project.report
24−cabal.project.packdiff
25−cabal.project.streamly
26cabal.project.Werror
20cabal.project.Werror
27cabal.project.Werror-nocode
21cabal.project.Werror-nocode
28−core/
29default.nix
22default.nix
30examples/README.md
23examples/README.md
31hie.yaml
24hie.yaml
32stack.yaml
25stack.yaml
33−targets/default.nix
34−targets/cabal.project
35−test/test-runner/default.nix
36−test/test-runner/cabal.project
CHANGELOG.md+1−1
@@ -1 +1 @@
1−docs/User/Project/Changelog.md
1+docs/Changelog.md
CONTRIBUTING.mdmode 120000 → 100644+272−1
@@ -1 +0,0 @@
1−docs/Developer/Contributing.md
@@ -0,0 +1,272 @@
1+# Contributors' Guide
2+
3+## Bug Reports
4+
5+Please feel free to [open an
6+issue](https://github.com/composewell/streamly/issues) for any questions,
7+suggestions, issues or bugs in the library. In case you are reporting a bug
8+we will appreciate if you provide as much detail as possible to reproduce or
9+understand the problem, but nevertheless you are encouraged to open an issue
10+for any problem that you may encounter.
11+
12+## Picking Issues to Work on
13+
14+Beginners are encouraged to pick up issues that are marked `help wanted`. It is
15+a good idea to update the issue expressing your intent so that others do not
16+duplicate the effort and people with a background on the issue can help.
17+
18+## Build and test
19+
20+Some common commands:
21+
22+```
23+$ cabal repl
24+$ cabal build
25+$ cabal build --disable-optimization --flags -opt
26+$ bin/test.sh --quick
27+$ bin/bench.sh --quick # For nix use "--use-nix"
28+$ bin/run-ci --targets help # Only supported with nix
29+$ cabal haddock
30+$ cabal-docspec --timeout 60 --check-properties --property-variables xs
31+```
32+
33+The `bin/test.sh` and `bin/bench.sh` are custom scripts to perform test
34+and benchmarking tasks conveniently. They support running a group of
35+tests or benchmarks, coverage, using correct optimization flags for
36+benchmarking, benchmark comparison reports etc. Use the `--help` option
37+to see how to use these. See [benchmark/README.md](/benchmark/README.md)
38+and [test/README.md](/test/README.md) for more details.
39+
40+You can also run tests or benchmarks directly for example:
41+
42+```
43+$ cabal test --disable-optimization --flags -opt --test-show-details=streaming --test-option=--color streamly-tests
44+```
45+
46+To view haddock docs open the link printed at the end of the haddock
47+command, in your browser.
48+
49+Nix users: There is a `default.nix` available which can be used to start
50+a nix-shell and then use the above commands as usual. nix-shell started
51+by `default.nix` creates a `.cabal.nix` for cabal configuration and sets
52+`CABAL_DIR` environment variable to point to that. Therefore, `~/.cabal`
53+would not be used.
54+
55+## Contributing A Change
56+
57+If the feature makes significant changes to design, we encourage you to open an
58+issue as early as possible so that you do not have to redo much work because of
59+changes in design decisions. However, if you are confident, you can still go
60+ahead and take that risk as the maintainers are supposed to be reasonable
61+people.
62+
63+### Pull Requests (PR)
64+
65+Please feel free to [send a pull
66+request (PR)](https://github.com/composewell/streamly/pulls) whether it is a
67+single letter typo fix or a complex change. We will accept any PR that makes a
68+net positive change to the package. We encourage you to provide a complete,
69+consistent change with test, documentation and benchmarks. You can contact the
70+[maintainers](https://gitter.im/composewell/streamly) for any help or
71+collaboration needed in that regard. However, if due to lack of time you are
72+not able to complete the PR, you are still welcome to submit it, maintainers
73+will try their best to actively contribute and pick up your change as long as
74+the change is approved.
75+
76+### Pull Request (PR) Checklist
77+
78+Here is a quick checklist for a PR, for details please see the next section:
79+
80+* PR contains one logical changeset
81+* Each commit in the PR consists of a logical change
82+* Commits are rebased/squashed/fixup/reordered as needed
83+* Stylistic changes to irrelevant parts of the code are separated in
84+ independent commits.
85+* Code is formatted as per the style of the file or that of other files
86+* Compiler warnings are fixed
87+* Reasonable hlint suggestions are accepted
88+* Tests are added to cover the changed parts
89+* All [tests](/test) pass
90+* [Performance benchmarks](/benchmark) are added, where applicable
91+* No significant regressions are reported by [performance benchmarks](/benchmark/README.md)
92+* Haddock documentation is added to user visible APIs and data types
93+* Tutorial module, [Introduction](/docs/Introduction.md), and [guides](/docs) are
94+ updated if necessary.
95+* [Changelog](/docs/Changelog.md) is updated if needed
96+* The code conforms to the license, it is not stolen, credit is given,
97+ copyright notices are retained, original license is included if needed.
98+
99+### Structuring Pull Requests
100+
101+__Lean PR:__ Please keep the reviewer in mind when sending pull
102+requests. Use one PR for each logical changeset. A lean and thin
103+PR with one independent logical change is more likely to be reviewed and
104+merged quickly than a big monolithic PR with several unrelated changes.
105+
106+__PR Dependencies:__ If your change depends on an earlier PR you can
107+create a branch from the old PR's branch, and raise a new PR targeting
108+to merge into the old PR branch. Do not push the commits to the same PR
109+just because the commit depends on that PR.
110+
111+__Commits:__ You are encouraged to group a logically related set of
112+changes into a single commit. When the overall changeset is largish you
113+can divide it into multiple smaller commits, with each commit having
114+a logically grouped changeset and the title summarizing the logical
115+grouping. Always keep in mind a logical division helps reviewers
116+understand and review your code quickly, easier history tracking and
117+when required clean reversal changes.
118+
119+__Functional Changes:__ Keep the reviewer in mind when making
120+changes. Please resist the temptation to make style related changes to
121+surrounding code unless you are changing that code anyway . Whenever
122+possible, try to separate unrelated refactoring changes which do not
123+affect functionality in separate commits so that it is easier for the
124+reviewer to verify functional changes.
125+
126+__Style Changes:__ Make sure that your IDE/Editor is not automatically
127+making sweeping style changes to all the files you are editing. That
128+makes separating the signal from the noise very difficult and makes
129+everything harder. If you would like to make style related changes
130+then please send a separate PR with just those changes and no other
131+functionality changes.
132+
133+__Rebasing:__ If your commits reflect how you fixed intermediate
134+problems during testing or made random changes at different times you
135+may have to squash your changes (`git rebase -i`) into a single commit
136+or logically related set of commits.
137+
138+### Resolving Conflicts
139+
140+If during the course of development or before you send the PR you find that
141+your changes are conflicting with the master branch then use `git rebase
142+master` to rebase your changes on top of master. DO NOT MERGE MASTER INTO YOUR
143+BRANCH.
144+
145+### Testing
146+
147+It is a good idea to include tests for the changes where applicable. See
148+the existing tests in the [test](/test) directory. Also see the
149+[test/README.md](/test/README.md) for more details on how to run the tests.
150+
151+### Documentation
152+
153+For user visible APIs, it is a good idea to provide haddock documentation that
154+is easily understood by the end programmer and does not sound highfalutin,
155+and preferably with examples. If your change affects the tutorial or needs to
156+be mentioned in the tutorial then please update the tutorial. Check if the
157+additional [guides](/docs) are affected or need to updated.
158+
159+### Performance Benchmarks
160+
161+It is a good idea to run performance benchmarks to see if your change affects
162+any of the existing performance benchmarks. If you introduced something new
163+then you may want to add benchmarks to check if it performs as well as expected
164+by the programmers to deem it usable.
165+
166+See the [README](/benchmark/README.md) file in the `benchmark` directory for more
167+details on how to run the benchmarks.
168+
169+The first level of check is the regression in "allocations", this is
170+the most stable measure of regression. "bytesCopied" is another stable
171+measure, it gives an idea of the amount of long lived data being copied
172+across generations of GC.
173+
174+The next measure to look at is "cpuTime" this may have some variance
175+from run to run because of factors like cpu frequency scaling, load on
176+the system or the number of context switches etc. However, the variance
177+would usually be within 5-10%, anything more than that is likely to be a
178+red flag.
179+
180+Quite often an increase in "cpuTime" would correspond to an increase
181+in "allocations". Increase in "allocations" indicates an inefficiency
182+in computing due to too much GC activity e.g. due to lack of
183+fusion. However, it is also possible for the cpu time to go up without
184+the allocations going up, this indicates an inefficiency in processing
185+in general or more CPU being used for the same task. It could be because
186+of inefficient code generation, branch mis-predictions or lack of cache
187+locality etc.
188+
189+For concurrent benchmarks we can compare "cpuTime" and "time" to check
190+the degree of concurrency and total efficiency.
191+
192+### Changelog
193+
194+Any new changes that affect the user of the library in some way must be
195+documented under `Unreleased` section at the top of the `Changelog`. The
196+changes in the changelog must be organized in the following categories, in that
197+order:
198+
199+* Breaking Changes
200+* Enhancements
201+* Bug Fixes
202+* Deprecations
203+
204+If there are very few changes then you can just prefix a bullet with these
205+annotations. If there are many changes make sections to group them. A section
206+can be absent if there is nothing to add in it.
207+
208+If you make changes that are incompatible with the released versions
209+of the library please indicate that in the `Changelog` as `Breaking Changes`
210+and also write short notes regarding what the programmers need to do to adapt
211+their existing code to the new change.
212+
213+### Licensing
214+
215+If you have copied code from elsewhere you need to conform to the
216+licensing terms of the original code. Usually you would need to add a
217+copyright notice in the source header, and include the license of the
218+original code as per the terms of the license. If the code you are
219+copying does not have an associated license please do not use it.
220+
221+## Developer documentation
222+
223+* Use https://streamly.composewell.com/ for searching in reference docs
224+* Build haddock docs for latest reference docs
225+* See [the dev directory](/dev) for design guidelines and dev documents.
226+
227+## Coding Guidelines
228+
229+### Coding Style
230+
231+Please see [the Haskell coding style guide](https://github.com/composewell/haskell-dev/blob/master/coding-style.rst).
232+
233+### Type variable ordering
234+
235+Ordering of variables in `forall` may be important in type applications. In
236+streams, we usually declare them in this order `t m a`.
237+
238+Use the same order in constraints as well
239+
240+Example,
241+
242+```
243+func :: forall m a. (MonadIO m, Storable a) => ...
244+```
245+
246+### StreamD coding style
247+
248+Some conventions that we follow in the StreamD code are illustrated by the
249+following example:
250+
251+```
252+mapM f (Stream step1 state1) = Stream step state
253+ where
254+
255+ step gst st = do
256+ r <- step1 (adaptState gst) st
257+ case r of
258+ Yield x s -> f x >>= \a -> return $ Yield a s
259+ Skip s -> return $ Skip s
260+ Stop -> return Stop
261+```
262+
263+* For the input streams use numbering for `step` and `state` e.g.
264+ step1/state1. For the output stream use `step` and `state`.
265+* For state argument of `step`, use `st`.
266+* For result of executing a `step` use `r` or `res`
267+* For the yielded element use `x`
268+* For the yielded state use `s`
269+
270+In general, the rule is - the shorter the scope of a variable the shorter its
271+name can be. For example, `s` has the shortest scope in the above code, `st`
272+has a bigger scope and `state` has the biggest scope.
LICENSE+254
@@ -26,6 +26,172 @@ 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+
29-------------------------------------------------------------------------------
195-------------------------------------------------------------------------------
30fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
196fsnotify-0.3.0.1 (http://hackage.haskell.org/package/fsnotify-0.3.0.1/)
31-------------------------------------------------------------------------------
197-------------------------------------------------------------------------------
@@ -93,3 +259,91 @@ DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
93THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
259THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
94(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
260(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
95OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
261OF 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.md+1−1
@@ -1 +1 @@
1−docs/User/Project/README.md
1+docs/Introduction.md
appveyor.yml−2
@@ -14,8 +14,6 @@ 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
19 GHC_OPTIONS: "-Werror"
17 GHC_OPTIONS: "-Werror"
20 CABAL_REINIT_CONFIG: "y"
18 CABAL_REINIT_CONFIG: "y"
21 LC_ALL: "C.UTF-8"
19 LC_ALL: "C.UTF-8"
benchmark/NanoBenchmarks.hs+22−27
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-------------------------------------------------------------------------------
1-------------------------------------------------------------------------------
4-- Investigate specific benchmarks more closely in isolation, possibly looking
2-- Investigate specific benchmarks more closely in isolation, possibly looking
5-- at GHC generated code for optimizing specific problematic cases.
3-- at GHC generated code for optimizing specific problematic cases.
@@ -8,27 +6,30 @@
8{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE ScopedTypeVariables #-}
10
8
11−import Data.Char (ord)
9+import Streamly.Prelude (SerialT)
12−import Streamly.Internal.Data.Stream (Stream)
10+import Streamly.Internal.Data.SVar (MonadAsync)
13−import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
14
11
15−import qualified Streamly.Data.Array as A
12+import qualified Streamly.Data.Array.Foreign as A
13+import qualified Streamly.FileSystem.Handle as FH
16import qualified Streamly.Internal.FileSystem.Handle as IFH
14import qualified Streamly.Internal.FileSystem.Handle as IFH
17import qualified Streamly.Data.Fold as FL
15import qualified Streamly.Data.Fold as FL
18−import qualified Streamly.Internal.Data.Stream as S
19import qualified Streamly.Internal.Data.Stream.IsStream as Internal
16import 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
20
19
21−import Test.Tasty.Bench
20+import Data.Char (ord)
21+import Gauge
22+import System.IO (hSeek, SeekMode(..), openFile, IOMode(..))
22import System.Random
23import System.Random
23
24
24maxValue :: Int
25maxValue :: Int
25maxValue = 100000
26maxValue = 100000
26
27
27−drain :: Monad m => S.Stream m a -> m ()
28+-- type Stream = K.Stream
28−drain = S.fold FL.drain
29+type Stream = SerialT
29
30
30{-# INLINE sourceUnfoldrM #-}
31{-# INLINE sourceUnfoldrM #-}
31−sourceUnfoldrM :: Monad m => Stream m Int
32+sourceUnfoldrM :: MonadAsync m => Stream m Int
32sourceUnfoldrM = S.unfoldrM step 0
33sourceUnfoldrM = S.unfoldrM step 0
33 where
34 where
34 step cnt =
35 step cnt =
@@ -37,7 +38,7 @@ sourceUnfoldrM = S.unfoldrM step 0
37 else return (Just (cnt, cnt + 1))
38 else return (Just (cnt, cnt + 1))
38
39
39{-# INLINE sourceUnfoldrMN #-}
40{-# INLINE sourceUnfoldrMN #-}
40−sourceUnfoldrMN :: Monad m => Int -> Stream m Int
41+sourceUnfoldrMN :: MonadAsync m => Int -> Stream m Int
41sourceUnfoldrMN n = S.unfoldrM step n
42sourceUnfoldrMN n = S.unfoldrM step n
42 where
43 where
43 step cnt =
44 step cnt =
@@ -66,7 +67,7 @@ takeAllDropOne = S.drop 1 . S.take maxValue
66
67
67{-# INLINE takeDrop #-}
68{-# INLINE takeDrop #-}
68takeDrop :: Monad m => Stream m Int -> m ()
69takeDrop :: Monad m => Stream m Int -> m ()
69−takeDrop = drain .
70+takeDrop = S.drain .
70 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
71 takeAllDropOne . takeAllDropOne . takeAllDropOne . takeAllDropOne
71
72
72-------------------------------------------------------------------------------
73-------------------------------------------------------------------------------
@@ -81,7 +82,7 @@ dropWhileFalse = S.dropWhile (> maxValue)
81
82
82{-# INLINE dropWhileFalseX4 #-}
83{-# INLINE dropWhileFalseX4 #-}
83dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
84dropWhileFalseX4 :: Monad m => Stream m Int -> m ()
84−dropWhileFalseX4 = drain
85+dropWhileFalseX4 = S.drain
85 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
86 . dropWhileFalse . dropWhileFalse . dropWhileFalse . dropWhileFalse
86
87
87-------------------------------------------------------------------------------
88-------------------------------------------------------------------------------
@@ -90,7 +91,7 @@ dropWhileFalseX4 = drain
90
91
91{-# INLINE iterateSource #-}
92{-# INLINE iterateSource #-}
92iterateSource
93iterateSource
93− :: Monad m
94+ :: MonadAsync m
94 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
95 => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
95iterateSource g i n = f i (sourceUnfoldrMN n)
96iterateSource g i n = f i (sourceUnfoldrMN n)
96 where
97 where
@@ -102,26 +103,20 @@ iterateSource g i n = f i (sourceUnfoldrMN n)
102main :: IO ()
103main :: IO ()
103main = do
104main = do
104 defaultMain [bench "unfoldr" $ nfIO $
105 defaultMain [bench "unfoldr" $ nfIO $
105− randomRIO (1,1) >>= \n -> drain (sourceUnfoldr n)]
106+ randomRIO (1,1) >>= \n -> S.drain (sourceUnfoldr n)]
106 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
107 defaultMain [bench "take-drop" $ nfIO $ takeDrop sourceUnfoldrM]
107 defaultMain [bench "dropWhileFalseX4" $
108 defaultMain [bench "dropWhileFalseX4" $
108 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
109 nfIO $ dropWhileFalseX4 sourceUnfoldrM]
109 defaultMain [bench "iterate-mapM" $
110 defaultMain [bench "iterate-mapM" $
110− nfIO $ drain $ iterateSource (S.mapM return) 100000 10]
111+ nfIO $ S.drain $ iterateSource (S.mapM return) 100000 10]
111
112
112 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
113 inText <- openFile "benchmark/text-processing/gutenberg-500.txt" ReadMode
113 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
114 defaultMain [mkBenchText "splitOn abc...xyz" inText $ do
114− S.fold FL.length
115− (Internal.splitOnSeq
115+ (S.length $ Internal.splitOnSeq (A.fromList $ map (fromIntegral . ord)
116− (A.fromList
117− $ map (fromIntegral . ord) "abcdefghijklmnopqrstuvwxyz"
116+ "abcdefghijklmnopqrstuvwxyz") FL.drain
118− )
119− FL.drain
120− $ IFH.read inText
117+ $ IFH.toBytes inText) >>= print
121− )
122− >>= print
123 ]
118 ]
124 where
119 where
125
120
126 mkBenchText name h action =
121 mkBenchText name h action =
127− env (hSeek h AbsoluteSeek 0) (\_ -> bench name $ nfIO action)
122+ bench name $ perRunEnv (hSeek h AbsoluteSeek 0) (\_ -> action)
benchmark/README.mdmode 120000 → 100644+321−1
@@ -1 +0,0 @@
1−../docs/Developer/Benchmarks.md
@@ -0,0 +1,321 @@
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+## Running benchmarks on valid UTF8 input
133+
134+To run the unicode benchmarks on valid utf8 input, you can do the following,
135+
136+```
137+$ Benchmark_FileSystem_Handle_InputFile=<valid-unicode-filepath> bin/bench.sh --benchmarks Unicode.Stream --cabal-build-options "-f include-strict-utf8"
138+```
139+
140+## Benchmarking notes
141+
142+We run each benchmark in an isolated process to minimize interference
143+of benchmarks and to be able to control the RTS memory restrictions per
144+benchmark.
145+
146+### Gotchas
147+
148+Gauge forces a GC before and after the measurement. However, we have observed
149+that sometimes the GC stats may not be accurate when the number of iterations
150+in the measurement is small (e.g. 1 iteration). In such cases usually the
151+number of GCs and GC times would also be 0.
152+
153+## Diagnosing Performance Issues
154+
155+### Reproducible comparison
156+
157+When comparing different compilers we need to make sure that we are
158+using exactly the same versions of the libraries for apples to apples
159+comparison. We have seen cases where a change in the "random" library
160+caused allocations regressions in the new version of compiler because of
161+the way in which the benchmark code was generated due to the change.
162+
163+When it is required to reproduce benchmark results precisely across
164+different systems, it is recommended that you create and use a cabal
165+freeze file so that the versions of all libraries are pinned.
166+
167+### Identifying issues
168+
169+There are two ways to find problematic code:
170+
171+1. Run performance benchmarks using `bench.sh`, select the benchmarks
172+ that are taking more than expected time.
173+2. When making a new change, compare with the baseline and select benchmarks
174+ with the most regression reported by `bench.sh`.
175+
176+Number of allocations are the most stable measure that do not vary from
177+run to run. `cpuTime` and `bytesCopied` may vary. When comparing two
178+runs for regression the first thing to look at is the difference in
179+allocations. Also note that allocations may vary from run to run for
180+concurrent benchmarks.
181+
182+The next thing to look at is cpuTime. Please note that cpuTime may
183+fluctuate quite a bit, you may want to run the relevant benchmarks
184+without the --quick mode for confirming and make sure no other load is
185+running on the system when measuring.
186+
187+Usually the increase is cpuTime is proportional to the increase in
188+allocations but sometimes it may increase independently because more cpu
189+instructions are being executed. TBD - we should count the instructions
190+instead.
191+
192+### Inspection Testing
193+
194+Before you proceed make sure have to run the benchmarks with
195+`inspection` flag on. It may catch any obvious issues or regressions.
196+
197+```
198+$ cabal build --flag inspection --flag fusion-plugin --enable-benchmarks streamly-benchmarks
199+```
200+
201+### Compiling with diagnostics
202+
203+1. Comment out all other benchmarks in the given benchmark suite, and
204+ keep only the one you are examining.
205+2. Edit the file and add the following line on top:
206+
207+```
208+{-# OPTIONS_GHC
209+ -ddump-simpl
210+ -ddump-to-file
211+ -dsuppress-all
212+ -Wmissed-specialisations
213+ -Wall-missed-specialisations
214+ -fplugin-opt=Fusion.Plugin:verbose=2
215+ -fplugin-opt=Fusion.Plugin:dump-core
216+#-}
217+```
218+3. Build the benchmark suite with fusion-plugin enabled:
219+
220+```
221+$ cabal build bench:Prelude.Serial --flag fusion-plugin
222+```
223+
224+See the `.dump-simpl` file in the cabal build directory. You can find it
225+like this:
226+
227+```
228+$ find dist-newstyle/ -name "*.dump-simpl"
229+```
230+
231+Make sure you are looking into the right build dir (`--build-dir` may change
232+`dist-newstyle` to something else), and check in the appropriate GHC
233+version dir.
234+
235+### Compiling standalone example
236+
237+Sometimes you may want to create a separate program from the benchmark code
238+removing the benchmarking harness to simplify and isolate the code for better
239+reasoning and simpler core.
240+
241+Add the following GHC options at the top of your file, say, example.hs:
242+
243+```
244+{-# OPTIONS_GHC
245+ -ddump-simpl
246+ -ddump-to-file
247+ -dsuppress-all
248+ -Wmissed-specialisations
249+ -Wall-missed-specialisations
250+ -fplugin Fusion.Plugin
251+ -fplugin-opt=Fusion.Plugin:verbose=2
252+ -fplugin-opt=Fusion.Plugin:dump-core
253+#-}
254+```
255+
256+Do not include the optimization options in OPTIONS_GHC pragma, instead, specify
257+them on the command line. This is to avoid optimization failing if you import
258+another module which is not compiled with the same optimization options.
259+
260+```
261+$ cabal build # build and write ghc environment file
262+$ ghc -O2 -fspec-constr-recursive=16 -fmax-worker-args=16 example.hs
263+```
264+
265+To pinpoint where the optimization is going wrong you can examine the
266+plugin generated core files for each optimization pass. The files are
267+numbered for each optimization pass. You can compare successive files
268+using side-by-side diff and see what the compiler is doing between each
269+pass.
270+
271+### Diagnosing the Problem
272+
273+#### Specialization Issues
274+
275+Look for missed specialization messages. When you are comparing against a
276+baseline, check if something that was specialized before is no longer
277+specialized.
278+
279+In the core you have to look for type class dictionaries e.g.
280+
281+```
282+exc_r6DD = \ @s_a6ai -> try $fMonadCatchIO $fExceptionSomeException
283+```
284+
285+Search for `$f` in the core.
286+
287+#### Fusion Issues
288+
289+Look for unfused function warnings emitted by fusion-plugin. You may
290+want to take a look at the unfused constructors or functions that
291+fusion-plugin is warning about. Beware that:
292+
293+* fusion-plugin emits warnings for unfused stuff in intermediate functions as
294+ well, those should be ignored.
295+* the constructors may remain genuinely unfused unless the loop is
296+ closed. So you should look at the warnings in the file where the loop is
297+ closed and everything is supposed to be fused.
298+
299+Also, look at the core for unfused constructors. At times you may need
300+to look for the boxed primitive type constructors e.g. W8# or I#, these
301+may not be eliminated, usually, due to strictness issues.
302+
303+Often it is useful to diff and compare the core without the problem and
304+the core with the problem especially in cases when the problem is due to
305+GHC version changes, or smaller changes in the code.
306+
307+Note, some operations are inherently fusion breaking, those cannot fuse,
308+they are usually annotated so in their documentation.
309+
310+### Resolving the problem
311+
312+Review the problematic code, see [the optimization
313+guide](/dev/optimization-guidelines.md) for common problems and how to
314+solve those. If no obvious issues are found on review, then generate and
315+examine the core.
316+
317+You may want to add the `Fuse` annotation on some of those constructors
318+to make the code fuse. Please note that unnecessary `Fuse` annotations
319+may cause unnecessary inlining. Also, make sure that the constructor you
320+are adding fuse annotation is not shared by any other code where you may
321+not want inlining/fusion.
benchmark/Streamly/Benchmark/Data/Array.hs+4−33
@@ -1,6 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
5
2
6#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
3#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
@@ -8,31 +5,18 @@
8import Control.DeepSeq (deepseq)
5import Control.DeepSeq (deepseq)
9
6
10import qualified Streamly.Internal.Data.Array as IA
7import qualified Streamly.Internal.Data.Array as IA
11−import qualified GHC.Exts as GHC
12−
13−-- import qualified Streamly.Data.Array as A
14import qualified Streamly.Internal.Data.Array as A
8import qualified Streamly.Internal.Data.Array as A
15−
16type Stream = A.Array
9type Stream = A.Array
17
10
18#include "Streamly/Benchmark/Data/Array/Common.hs"
11#include "Streamly/Benchmark/Data/Array/Common.hs"
19
12
20−instance NFData (A.Array a) where
21− {-# INLINE rnf #-}
22− rnf _ = ()
23−
24-------------------------------------------------------------------------------
13-------------------------------------------------------------------------------
25-- Benchmark helpers
14-- Benchmark helpers
26-------------------------------------------------------------------------------
15-------------------------------------------------------------------------------
27
16
28−-- Drain a source that generates a pure array
29−{-# INLINE benchPureSrc #-}
30−benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
31−benchPureSrc name src = benchPure name src id
32−
33-- Drain a source that generates an array in the IO monad
17-- Drain a source that generates an array in the IO monad
34{-# INLINE benchIOSrc #-}
18{-# INLINE benchIOSrc #-}
35−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
19+benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark
36benchIOSrc name src = benchIO name src id
20benchIOSrc name src = benchIO name src id
37
21
38-------------------------------------------------------------------------------
22-------------------------------------------------------------------------------
@@ -43,6 +27,7 @@ benchIOSrc name src = benchIO name src id
43sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
27sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
44sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
28sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
45
29
30+
46{-# INLINE readInstance #-}
31{-# INLINE readInstance #-}
47readInstance :: P.String -> Stream Int
32readInstance :: P.String -> Stream Int
48readInstance str =
33readInstance str =
@@ -63,14 +48,6 @@ foldableSum = P.sum
63-}
48-}
64#endif
49#endif
65
50
66−{-# INLINE sourceIsList #-}
67−sourceIsList :: Int -> Int -> Stream Int
68−sourceIsList value n = GHC.fromList [n..n+value]
69−
70−{-# INLINE sourceIsString #-}
71−sourceIsString :: Int -> Int -> Stream P.Char
72−sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
73−
74{-# INLINE sourceIntFromToFromStream #-}
51{-# INLINE sourceIntFromToFromStream #-}
75sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
52sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
76sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
53sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
@@ -84,21 +61,15 @@ o_1_space_generation value =
84 [ bgroup
61 [ bgroup
85 "generation"
62 "generation"
86 [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
63 [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
87− , let testStr = "fromList " ++ mkListString value
64+ , let testStr = mkListString value
88 in testStr `deepseq` bench "read" (nf readInstance testStr)
65 in testStr `deepseq` bench "read" (nf readInstance testStr)
89− , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)
90− , benchPureSrc
91− "writeN . IsString.fromString"
92− (sourceIsString value)
93−
94 ]
66 ]
95 ]
67 ]
96
68
97o_1_space_elimination :: Int -> [Benchmark]
69o_1_space_elimination :: Int -> [Benchmark]
98o_1_space_elimination value =
70o_1_space_elimination value =
99 [ bgroup "elimination"
71 [ bgroup "elimination"
100− [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
101− , benchFold "writeLastN.1"
72+ [ benchFold "writeLastN.1"
102 (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
73 (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
103 , benchFold "writeLastN.10"
74 , benchFold "writeLastN.10"
104 (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
75 (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
benchmark/Streamly/Benchmark/Data/Array/Common.hs+11−8
@@ -1,3 +1,5 @@
1+
2+
1-------------------------------------------------------------------------------
3-------------------------------------------------------------------------------
2-- Benchmark helpers
4-- Benchmark helpers
3-------------------------------------------------------------------------------
5-------------------------------------------------------------------------------
@@ -66,14 +68,14 @@ scanl' , scanl1', map
66
68
67{-# INLINE onArray #-}
69{-# INLINE onArray #-}
68onArray
70onArray
69− :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
71+ :: MonadIO m => Int -> (S.SerialT m Int -> S.SerialT m Int)
70 -> Stream Int
72 -> Stream Int
71 -> m (Stream Int)
73 -> m (Stream Int)
72−onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.reader arr
74+onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.read arr
73
75
74−scanl' value n = composeN n $ onArray value $ S.scan (Fold.foldl' (+) 0)
76+scanl' value n = composeN n $ onArray value $ S.scanl' (+) 0
75−scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
77+scanl1' value n = composeN n $ onArray value $ S.scanl1' (+)
76−map value n = composeN n $ onArray value $ fmap (+1)
78+map value n = composeN n $ onArray value $ S.map (+1)
77-- map n = composeN n $ A.map (+1)
79-- map n = composeN n $ A.map (+1)
78
80
79{-# INLINE eqInstance #-}
81{-# INLINE eqInstance #-}
@@ -98,7 +100,8 @@ showInstance = P.show
98
100
99{-# INLINE pureFoldl' #-}
101{-# INLINE pureFoldl' #-}
100pureFoldl' :: MonadIO m => Stream Int -> m Int
102pureFoldl' :: MonadIO m => Stream Int -> m Int
101−pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader
103+pureFoldl' = S.foldl' (+) 0 . S.unfold A.read
104+
102
105
103-------------------------------------------------------------------------------
106-------------------------------------------------------------------------------
104-- Elimination
107-- Elimination
@@ -106,11 +109,11 @@ pureFoldl' = S.fold (Fold.foldl' (+) 0) . S.unfold A.reader
106
109
107{-# INLINE unfoldReadDrain #-}
110{-# INLINE unfoldReadDrain #-}
108unfoldReadDrain :: MonadIO m => Stream Int -> m ()
111unfoldReadDrain :: MonadIO m => Stream Int -> m ()
109−unfoldReadDrain = S.fold Fold.drain . S.unfold A.reader
112+unfoldReadDrain = S.drain . S.unfold A.read
110
113
111{-# INLINE toStreamRevDrain #-}
114{-# INLINE toStreamRevDrain #-}
112toStreamRevDrain :: MonadIO m => Stream Int -> m ()
115toStreamRevDrain :: MonadIO m => Stream Int -> m ()
113−toStreamRevDrain = S.fold Fold.drain . A.readRev
116+toStreamRevDrain = S.drain . A.toStreamRev
114
117
115-------------------------------------------------------------------------------
118-------------------------------------------------------------------------------
116-- Bench groups
119-- Bench groups
benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs+8−7
@@ -1,16 +1,17 @@
1{-# LANGUAGE FlexibleContexts #-}
1{-# LANGUAGE FlexibleContexts #-}
2
2
3import Control.DeepSeq (NFData(..))
3import Control.DeepSeq (NFData(..))
4−import Control.Monad.IO.Class (MonadIO)
5−import Data.Functor ((<&>))
6import System.Random (randomRIO)
4import System.Random (randomRIO)
7
5
8−import qualified Streamly.Data.Fold as Fold
6+import qualified Streamly.Prelude as S
9−import qualified Streamly.Data.Stream as S
10−import qualified Streamly.Internal.Data.Stream as Stream
11
7
12−import Test.Tasty.Bench
8+import Gauge
13import Streamly.Benchmark.Common hiding (benchPureSrc)
9import Streamly.Benchmark.Common hiding (benchPureSrc)
14−import qualified Stream.Common as P
10+import qualified Streamly.Benchmark.Prelude as P
11+
12+
13+import Control.Monad.IO.Class (MonadIO)
15
14
16import Prelude as P hiding (map)
15import Prelude as P hiding (map)
16+
17+import Data.Functor ((<&>))
benchmark/Streamly/Benchmark/Data/Array/Generic.hs → benchmark/Streamly/Benchmark/Data/Array/Foreign.hsrenamed+28−15
@@ -1,30 +1,30 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
5
2
6#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
3#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
7
4
8import Control.DeepSeq (deepseq)
5import Control.DeepSeq (deepseq)
9
6
10−import qualified Streamly.Internal.Data.Array.Generic as IA
7+import qualified Streamly.Internal.Data.Array.Foreign as IA
11−import qualified Streamly.Internal.Data.Array.Generic as A
8+import qualified GHC.Exts as GHC
12
9
10+import qualified Streamly.Data.Array.Foreign as A
11+import qualified Streamly.Internal.Data.Array.Foreign as A
13type Stream = A.Array
12type Stream = A.Array
14
13
15#include "Streamly/Benchmark/Data/Array/Common.hs"
14#include "Streamly/Benchmark/Data/Array/Common.hs"
16
15
17−instance NFData a => NFData (A.Array a) where
18− {-# INLINE rnf #-}
19− rnf = A.foldl' (\_ x -> rnf x) ()
20−
21-------------------------------------------------------------------------------
16-------------------------------------------------------------------------------
22-- Benchmark helpers
17-- Benchmark helpers
23-------------------------------------------------------------------------------
18-------------------------------------------------------------------------------
24
19
20+-- Drain a source that generates a pure array
21+{-# INLINE benchPureSrc #-}
22+benchPureSrc :: String -> (Int -> Stream a) -> Benchmark
23+benchPureSrc name src = benchPure name src id
24+
25-- Drain a source that generates an array in the IO monad
25-- Drain a source that generates an array in the IO monad
26{-# INLINE benchIOSrc #-}
26{-# INLINE benchIOSrc #-}
27−benchIOSrc :: NFData a => String -> (Int -> IO (Stream a)) -> Benchmark
27+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
28benchIOSrc name src = benchIO name src id
28benchIOSrc name src = benchIO name src id
29
29
30-------------------------------------------------------------------------------
30-------------------------------------------------------------------------------
@@ -55,10 +55,17 @@ foldableSum = P.sum
55-}
55-}
56#endif
56#endif
57
57
58+{-# INLINE sourceIsList #-}
59+sourceIsList :: Int -> Int -> Stream Int
60+sourceIsList value n = GHC.fromList [n..n+value]
61+
62+{-# INLINE sourceIsString #-}
63+sourceIsString :: Int -> Int -> Stream P.Char
64+sourceIsString value n = GHC.fromString (P.replicate (n + value) 'a')
65+
58{-# INLINE sourceIntFromToFromStream #-}
66{-# INLINE sourceIntFromToFromStream #-}
59sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
67sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
60−sourceIntFromToFromStream value n =
61− S.fold A.write $ S.enumerateFromTo n (n + value)
68+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
62
69
63-------------------------------------------------------------------------------
70-------------------------------------------------------------------------------
64-- Bench groups
71-- Bench groups
@@ -69,15 +76,21 @@ o_1_space_generation value =
69 [ bgroup
76 [ bgroup
70 "generation"
77 "generation"
71 [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
78 [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
72− , let testStr = "fromList " ++ mkListString value
79+ , let testStr = mkListString value
73 in testStr `deepseq` bench "read" (nf readInstance testStr)
80 in testStr `deepseq` bench "read" (nf readInstance testStr)
81+ , benchPureSrc "writeN . IsList.fromList" (sourceIsList value)
82+ , benchPureSrc
83+ "writeN . IsString.fromString"
84+ (sourceIsString value)
85+
74 ]
86 ]
75 ]
87 ]
76
88
77o_1_space_elimination :: Int -> [Benchmark]
89o_1_space_elimination :: Int -> [Benchmark]
78o_1_space_elimination value =
90o_1_space_elimination value =
79 [ bgroup "elimination"
91 [ bgroup "elimination"
92+ [ benchPureSink value "length . IsList.toList" (length . GHC.toList)
80− [ benchFold "writeLastN.1"
93+ , benchFold "writeLastN.1"
81 (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
94 (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)
82 , benchFold "writeLastN.10"
95 , benchFold "writeLastN.10"
83 (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
96 (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)
@@ -101,7 +114,7 @@ o_n_heap_serial value =
101 ]
114 ]
102
115
103moduleName :: String
116moduleName :: String
104−moduleName = "Data.Array.Generic"
117+moduleName = "Data.Array.Foreign"
105
118
106defStreamSize :: Int
119defStreamSize :: Int
107defStreamSize = defaultStreamSize
120defStreamSize = defaultStreamSize
benchmark/Streamly/Benchmark/Data/Array/Foreign/Mut.hsnew file+82
@@ -0,0 +1,82 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.Array.Foreign.Mut
3+-- Copyright : (c) 2021 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+
11+#ifdef __HADDOCK_VERSION__
12+#undef INSPECTION
13+#endif
14+
15+#ifdef INSPECTION
16+{-# LANGUAGE TemplateHaskell #-}
17+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18+#endif
19+
20+module Main (main) where
21+
22+import Control.DeepSeq (NFData(..))
23+import Streamly.Prelude (MonadAsync, SerialT, IsStream)
24+import System.Random (randomRIO)
25+
26+import qualified Streamly.Prelude as Stream
27+import qualified Streamly.Internal.Data.Array.Foreign.Mut as MArray
28+
29+import Gauge hiding (env)
30+import Streamly.Benchmark.Common
31+
32+-------------------------------------------------------------------------------
33+-- Utilities
34+-------------------------------------------------------------------------------
35+
36+{-# INLINE sourceUnfoldrM #-}
37+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
38+sourceUnfoldrM value n = Stream.unfoldrM step n
39+ where
40+ step cnt =
41+ if cnt > n + value
42+ then return Nothing
43+ else return (Just (cnt, cnt + 1))
44+
45+{-# INLINE benchIO #-}
46+benchIO
47+ :: NFData b
48+ => String -> (Int -> a) -> (a -> IO b) -> Benchmark
49+benchIO name src sink =
50+ bench name $ nfIO $ randomRIO (1,1) >>= sink . src
51+
52+o_n_space_serial_marray :: Int -> MArray.Array Int -> [Benchmark]
53+o_n_space_serial_marray value array =
54+ [ benchIO "partitionBy (< 0)" (const array)
55+ $ MArray.partitionBy (< 0)
56+ , benchIO "partitionBy (> 0)" (const array)
57+ $ MArray.partitionBy (> 0)
58+ , benchIO "partitionBy (< value/2)" (const array)
59+ $ MArray.partitionBy (< (value `div` 2))
60+ , benchIO "partitionBy (> value/2)" (const array)
61+ $ MArray.partitionBy (> (value `div` 2))
62+ ]
63+
64+-------------------------------------------------------------------------------
65+-- Driver
66+-------------------------------------------------------------------------------
67+
68+moduleName :: String
69+moduleName = "Data.Array.Foreign.Mut"
70+
71+main :: IO ()
72+main = do
73+ runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
74+
75+ where
76+
77+ alloc value = MArray.fromStream (sourceUnfoldrM value 0 :: SerialT IO Int)
78+
79+ allBenchmarks array value =
80+ [ bgroup (o_1_space_prefix moduleName) $
81+ o_n_space_serial_marray value array
82+ ]
benchmark/Streamly/Benchmark/Data/Array/Prim.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE CPP #-}
2+
3+#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
4+
5+import qualified Streamly.Internal.Data.Array.Prim as A
6+type Stream = A.Array
7+
8+#include "Streamly/Benchmark/Data/Array/Common.hs"
9+
10+-------------------------------------------------------------------------------
11+-- Benchmark helpers
12+-------------------------------------------------------------------------------
13+
14+-- Drain a source that generates an array in the IO monad
15+{-# INLINE benchIOSrc #-}
16+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
17+benchIOSrc name src = benchIO name src id
18+
19+-------------------------------------------------------------------------------
20+-- Bench Ops
21+-------------------------------------------------------------------------------
22+
23+{-# INLINE sourceIntFromToFromList #-}
24+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
25+sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
26+
27+-- CPP:
28+{-# INLINE sourceIntFromToFromStream #-}
29+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
30+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
31+
32+-------------------------------------------------------------------------------
33+-- Bench groups
34+-------------------------------------------------------------------------------
35+
36+o_1_space_generation :: Int -> [Benchmark]
37+o_1_space_generation value =
38+ [ bgroup
39+ "generation"
40+ [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
41+ ]
42+ ]
43+
44+moduleName :: String
45+moduleName = "Data.Array.Prim"
46+
47+defStreamSize :: Int
48+defStreamSize = defaultStreamSize
49+
50+main :: IO ()
51+main = runWithCLIOpts defStreamSize allBenchmarks
52+
53+ where
54+
55+ allBenchmarks size =
56+ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
57+ : commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/Prim/Pinned.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE CPP #-}
2+
3+#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
4+
5+import qualified Streamly.Internal.Data.Array.Prim.Pinned as A
6+type Stream = A.Array
7+
8+#include "Streamly/Benchmark/Data/Array/Common.hs"
9+
10+-------------------------------------------------------------------------------
11+-- Benchmark helpers
12+-------------------------------------------------------------------------------
13+
14+-- Drain a source that generates an array in the IO monad
15+{-# INLINE benchIOSrc #-}
16+benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
17+benchIOSrc name src = benchIO name src id
18+
19+-------------------------------------------------------------------------------
20+-- Bench Ops
21+-------------------------------------------------------------------------------
22+
23+{-# INLINE sourceIntFromToFromList #-}
24+sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
25+sourceIntFromToFromList value n = P.return $ A.fromListN value [n..n + value]
26+
27+-- CPP:
28+{-# INLINE sourceIntFromToFromStream #-}
29+sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
30+sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)
31+
32+-------------------------------------------------------------------------------
33+-- Bench groups
34+-------------------------------------------------------------------------------
35+
36+o_1_space_generation :: Int -> [Benchmark]
37+o_1_space_generation value =
38+ [ bgroup
39+ "generation"
40+ [ benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
41+ ]
42+ ]
43+
44+moduleName :: String
45+moduleName = "Data.Array.Prim.Pinned"
46+
47+defStreamSize :: Int
48+defStreamSize = defaultStreamSize
49+
50+main :: IO ()
51+main = runWithCLIOpts defStreamSize allBenchmarks
52+
53+ where
54+
55+ allBenchmarks size =
56+ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
57+ : commonBenchmarks size
benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs−2
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
4
2
5#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
3#include "Streamly/Benchmark/Data/Array/CommonImports.hs"
benchmark/Streamly/Benchmark/Data/Array/Stream.hs → benchmark/Streamly/Benchmark/Data/Array/Stream/Foreign.hsrenamed+44−80
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Streamly.Benchmark.Data.ParserD
2-- Module : Streamly.Benchmark.Data.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
3-- Copyright : (c) 2020 Composewell Technologies
@@ -26,35 +24,31 @@ module Main
26 ) where
24 ) where
27
25
28import Control.DeepSeq (NFData(..))
26import Control.DeepSeq (NFData(..))
29−import Control.Monad (void, when)
27+import Control.Monad (void)
30−import Control.Monad.Catch (MonadCatch)
28+import Control.Monad.Catch (MonadThrow)
31import Data.Functor.Identity (runIdentity)
29import Data.Functor.Identity (runIdentity)
32−import Data.Maybe (isJust)
33import Data.Word (Word8)
30import Data.Word (Word8)
34−import Streamly.Internal.Data.Stream (Stream)
35−import Streamly.Internal.Data.StreamK (StreamK)
36import System.IO (Handle)
31import System.IO (Handle)
37import System.Random (randomRIO)
32import System.Random (randomRIO)
38import Prelude hiding ()
33import Prelude hiding ()
39
34
40−import qualified Streamly.Data.Stream as Stream
35+import qualified Streamly.Prelude as Stream
41−import qualified Streamly.Internal.Data.Array as Array
36+import qualified Streamly.Internal.Data.Array.Foreign as Array
42−import qualified Streamly.Internal.Data.Array.Stream as ArrayStream
37+import qualified Streamly.Internal.Data.Array.Stream.Foreign as ArrayStream
43import qualified Streamly.Internal.Data.Fold as Fold
38import qualified Streamly.Internal.Data.Fold as Fold
44−import qualified Streamly.Internal.Data.Parser as Parser
39+import qualified Streamly.Internal.Data.Parser.ParserD as ParserD
45−import qualified Streamly.Internal.Data.Stream as Stream
40+import qualified Streamly.Internal.Data.Stream.IsStream as Stream (arraysOf)
46−import qualified Streamly.Internal.Data.StreamK as StreamK
47import qualified Streamly.Internal.FileSystem.Handle as Handle
41import qualified Streamly.Internal.FileSystem.Handle as Handle
48import qualified Streamly.Internal.Unicode.Stream as Unicode
42import qualified Streamly.Internal.Unicode.Stream as Unicode
49
43
50−import Test.Tasty.Bench hiding (env)
44+import Gauge hiding (env)
45+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
51import Streamly.Benchmark.Common
46import Streamly.Benchmark.Common
52import Streamly.Benchmark.Common.Handle
47import Streamly.Benchmark.Common.Handle
53−import Control.Monad.IO.Class (MonadIO)
54
48
55#ifdef INSPECTION
49#ifdef INSPECTION
56−import Streamly.Internal.Data.MutByteArray (Unbox)
50+import Foreign.Storable (Storable)
57−import Streamly.Internal.Data.Stream (Step(..))
51+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
58import Test.Inspection
52import Test.Inspection
59#endif
53#endif
60
54
@@ -65,7 +59,7 @@ import Test.Inspection
65-- XXX these can be moved to the common module
59-- XXX these can be moved to the common module
66
60
67{-# INLINE sourceUnfoldrM #-}
61{-# INLINE sourceUnfoldrM #-}
68−sourceUnfoldrM :: MonadIO m => Int -> Int -> Stream.Stream m Int
62+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
69sourceUnfoldrM value n = Stream.unfoldrM step n
63sourceUnfoldrM value n = Stream.unfoldrM step n
70 where
64 where
71 step cnt =
65 step cnt =
@@ -76,7 +70,7 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
76{-# INLINE benchIO #-}
70{-# INLINE benchIO #-}
77benchIO
71benchIO
78 :: NFData b
72 :: NFData b
79− => String -> (Int -> Stream IO a) -> (Stream IO a -> IO b) -> Benchmark
73+ => String -> (Int -> t IO a) -> (t IO a -> IO b) -> Benchmark
80benchIO name src sink =
74benchIO name src sink =
81 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
75 bench name $ nfIO $ randomRIO (1,1) >>= sink . src
82
76
@@ -87,7 +81,7 @@ benchIO name src sink =
87-- | Get the last byte from a file bytestream.
81-- | Get the last byte from a file bytestream.
88toChunksLast :: Handle -> IO (Maybe Word8)
82toChunksLast :: Handle -> IO (Maybe Word8)
89toChunksLast inh = do
83toChunksLast inh = do
90− let s = Handle.readChunks inh
84+ let s = Handle.toChunks inh
91 larr <- Stream.last s
85 larr <- Stream.last s
92 return $ case larr of
86 return $ case larr of
93 Nothing -> Nothing
87 Nothing -> Nothing
@@ -101,8 +95,8 @@ inspect $ 'toChunksLast `hasNoType` ''Step
101-- | Count the number of bytes in a file.
95-- | Count the number of bytes in a file.
102toChunksSumLengths :: Handle -> IO Int
96toChunksSumLengths :: Handle -> IO Int
103toChunksSumLengths inh =
97toChunksSumLengths inh =
104− let s = Handle.readChunks inh
98+ let s = Handle.toChunks inh
105− in Stream.fold Fold.sum (Stream.map Array.length s)
99+ in Stream.sum (Stream.map Array.length s)
106
100
107#ifdef INSPECTION
101#ifdef INSPECTION
108inspect $ hasNoTypeClasses 'toChunksSumLengths
102inspect $ hasNoTypeClasses 'toChunksSumLengths
@@ -112,8 +106,8 @@ inspect $ 'toChunksSumLengths `hasNoType` ''Step
112-- | Sum the bytes in a file.
106-- | Sum the bytes in a file.
113toChunksCountBytes :: Handle -> IO Word8
107toChunksCountBytes :: Handle -> IO Word8
114toChunksCountBytes inh = do
108toChunksCountBytes inh = do
115− let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.read
109+ let foldlArr' f z = runIdentity . Stream.foldl' f z . Array.toStream
116− let s = Handle.readChunks inh
110+ let s = Handle.toChunks inh
117 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
111 Stream.foldl' (\acc arr -> acc + foldlArr' (+) 0 arr) 0 s
118
112
119#ifdef INSPECTION
113#ifdef INSPECTION
@@ -123,7 +117,7 @@ inspect $ 'toChunksCountBytes `hasNoType` ''Step
123
117
124toChunksDecodeUtf8Arrays :: Handle -> IO ()
118toChunksDecodeUtf8Arrays :: Handle -> IO ()
125toChunksDecodeUtf8Arrays =
119toChunksDecodeUtf8Arrays =
126− Stream.drain . Unicode.decodeUtf8Chunks . Handle.readChunks
120+ Stream.drain . Unicode.decodeUtf8Arrays . Handle.toChunks
127
121
128#ifdef INSPECTION
122#ifdef INSPECTION
129inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
123inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
@@ -137,9 +131,7 @@ inspect $ hasNoTypeClasses 'toChunksDecodeUtf8Arrays
137-- | Count the number of lines in a file.
131-- | Count the number of lines in a file.
138toChunksSplitOnSuffix :: Handle -> IO Int
132toChunksSplitOnSuffix :: Handle -> IO Int
139toChunksSplitOnSuffix =
133toChunksSplitOnSuffix =
140− Stream.fold Fold.length
141− . ArrayStream.splitOnSuffix 10
134+ Stream.length . ArrayStream.splitOnSuffix 10 . Handle.toChunks
142− . Handle.readChunks
143
135
144#ifdef INSPECTION
136#ifdef INSPECTION
145inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
137inspect $ hasNoTypeClasses 'toChunksSplitOnSuffix
@@ -149,10 +141,7 @@ inspect $ 'toChunksSplitOnSuffix `hasNoType` ''Step
149-- XXX use a word splitting combinator instead of splitOn and test it.
141-- XXX use a word splitting combinator instead of splitOn and test it.
150-- | Count the number of words in a file.
142-- | Count the number of words in a file.
151toChunksSplitOn :: Handle -> IO Int
143toChunksSplitOn :: Handle -> IO Int
152−toChunksSplitOn =
153− Stream.fold Fold.length
154− . ArrayStream.splitOn 32
144+toChunksSplitOn = Stream.length . ArrayStream.splitOn 32 . Handle.toChunks
155− . Handle.readChunks
156
145
157#ifdef INSPECTION
146#ifdef INSPECTION
158inspect $ hasNoTypeClasses 'toChunksSplitOn
147inspect $ hasNoTypeClasses 'toChunksSplitOn
@@ -190,11 +179,12 @@ o_1_space_read_chunked env =
190copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
179copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO ()
191copyChunksSplitInterposeSuffix inh outh =
180copyChunksSplitInterposeSuffix inh outh =
192 Stream.fold (Handle.write outh)
181 Stream.fold (Handle.write outh)
193− $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10
182+ $ ArrayStream.interposeSuffix 10
183+ $ ArrayStream.splitOnSuffix 10
194− $ Handle.readChunks inh
184+ $ Handle.toChunks inh
195
185
196#ifdef INSPECTION
186#ifdef INSPECTION
197−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Unbox]
187+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterposeSuffix [''Storable]
198inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
188inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
199#endif
189#endif
200
190
@@ -203,12 +193,13 @@ inspect $ 'copyChunksSplitInterposeSuffix `hasNoType` ''Step
203copyChunksSplitInterpose :: Handle -> Handle -> IO ()
193copyChunksSplitInterpose :: Handle -> Handle -> IO ()
204copyChunksSplitInterpose inh outh =
194copyChunksSplitInterpose inh outh =
205 Stream.fold (Handle.write outh)
195 Stream.fold (Handle.write outh)
196+ $ ArrayStream.interpose 32
206 -- XXX this is not correct word splitting combinator
197 -- XXX this is not correct word splitting combinator
207− $ ArrayStream.interpose 32 . ArrayStream.splitOn 32
198+ $ ArrayStream.splitOn 32
208− $ Handle.readChunks inh
199+ $ Handle.toChunks inh
209
200
210#ifdef INSPECTION
201#ifdef INSPECTION
211−inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Unbox]
202+inspect $ hasNoTypeClassesExcept 'copyChunksSplitInterpose [''Storable]
212inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
203inspect $ 'copyChunksSplitInterpose `hasNoType` ''Step
213#endif
204#endif
214
205
@@ -227,53 +218,30 @@ o_1_space_copy_toChunks_group_ungroup env =
227-------------------------------------------------------------------------------
218-------------------------------------------------------------------------------
228
219
229{-# INLINE drainWhile #-}
220{-# INLINE drainWhile #-}
230−drainWhile :: MonadCatch m => (a -> Bool) -> Parser.Parser a m ()
221+drainWhile :: MonadThrow m => (a -> Bool) -> ParserD.Parser m a ()
231−drainWhile p = Parser.takeWhile p Fold.drain
222+drainWhile p = ParserD.takeWhile p Fold.drain
232
223
233-------------------------------------------------------------------------------
224-------------------------------------------------------------------------------
234-- Folds and parsers
225-- Folds and parsers
235-------------------------------------------------------------------------------
226-------------------------------------------------------------------------------
236
227
237{-# INLINE fold #-}
228{-# INLINE fold #-}
238−fold :: Stream IO (Array.Array Int) -> IO ()
229+fold :: SerialT IO (Array.Array Int) -> IO ()
239−fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s
230+fold s = void $ ArrayStream.fold Fold.drain s
240−
231+
241−{-# INLINE parse #-}
232+{-# INLINE parseArray #-}
242−parse :: Int -> Stream IO (Array.Array Int) -> IO ()
233+parseArray :: Int -> SerialT IO (Array.Array Int) -> IO ()
243−parse value s =
244− void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s
234+parseArray value s = void $ ArrayStream.parse (drainWhile (< value)) s
245−
246−{-# INLINE foldBreak #-}
247−foldBreak :: StreamK IO (Array.Array Int) -> IO ()
248−foldBreak s = do
249− (r, s1) <- ArrayStream.foldBreak Fold.one s
250− when (isJust r) $ foldBreak s1
251−
252−{-# INLINE parseBreak #-}
253−parseBreak :: StreamK IO (Array.Array Int) -> IO ()
254−parseBreak s = do
255− r <- ArrayStream.parseBreak Parser.one s
256− case r of
257− (Left _, _) -> return ()
258− (Right _, s1) -> parseBreak s1
259
235
260o_1_space_serial_array ::
236o_1_space_serial_array ::
261 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
237 Int -> [Array.Array Int] -> [Array.Array Int] -> [Benchmark]
262o_1_space_serial_array bound arraysSmall arraysBig =
238o_1_space_serial_array bound arraysSmall arraysBig =
263 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
239 [ benchIO "fold (of 100)" (\_ -> Stream.fromList arraysSmall) fold
264 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
240 , benchIO "fold (single)" (\_ -> Stream.fromList arraysBig) fold
265− , benchIO
266− "foldBreak (recursive, small arrays)"
267− (\_ -> Stream.fromList arraysSmall)
268− (foldBreak . StreamK.fromStream)
269 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
241 , benchIO "parse (of 100)" (\_ -> Stream.fromList arraysSmall)
270− $ parse bound
242+ $ parseArray bound
271 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
243 , benchIO "parse (single)" (\_ -> Stream.fromList arraysBig)
272− $ parse bound
244+ $ parseArray bound
273− , benchIO
274− "parseBreak (recursive, small arrays)"
275− (\_ -> Stream.fromList arraysSmall)
276− (parseBreak . StreamK.fromStream)
277 ]
245 ]
278
246
279-------------------------------------------------------------------------------
247-------------------------------------------------------------------------------
@@ -281,7 +249,7 @@ o_1_space_serial_array bound arraysSmall arraysBig =
281-------------------------------------------------------------------------------
249-------------------------------------------------------------------------------
282
250
283moduleName :: String
251moduleName :: String
284−moduleName = "Data.Array.Stream"
252+moduleName = "Data.Array.Stream.Foreign"
285
253
286main :: IO ()
254main :: IO ()
287main = do
255main = do
@@ -290,14 +258,10 @@ main = do
290
258
291 where
259 where
292
260
293− alloc value =
261+ alloc value = do
294− if value <= 0
295− then return (undefined, undefined)
296− else
297− do
298− small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
262+ small <- Stream.toList $ Stream.arraysOf 100 $ sourceUnfoldrM value 0
299− big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0
263+ big <- Stream.toList $ Stream.arraysOf value $ sourceUnfoldrM value 0
300− return (small, big)
264+ return (small, big)
301
265
302 allBenchmarks env arrays value =
266 allBenchmarks env arrays value =
303 let (arraysSmall, arraysBig) = arrays
267 let (arraysSmall, arraysBig) = arrays
benchmark/Streamly/Benchmark/Data/Fold.hs+140−291
@@ -6,51 +6,35 @@
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
19
9
20module Main (main) where
10module Main (main) where
21
11
22import Control.DeepSeq (NFData(..))
12import Control.DeepSeq (NFData(..))
23−import Control.Monad (when)
24−import Control.Monad.IO.Class (MonadIO(..))
25−import Data.Functor.Identity (Identity(..))
13+import Data.Functor.Identity (Identity)
26import Data.Map.Strict (Map)
14import Data.Map.Strict (Map)
27−import Data.Hashable (Hashable)
28−import Data.HashMap.Strict (HashMap)
29−import Data.IntMap.Strict (IntMap)
30import Data.Monoid (Last(..), Sum(..))
15import Data.Monoid (Last(..), Sum(..))
31import System.Random (randomRIO)
16import System.Random (randomRIO)
32
17
33−import Streamly.Internal.Data.Stream (Stream)
18+import Streamly.Prelude (SerialT)
34import Streamly.Internal.Data.Fold (Fold(..))
19import Streamly.Internal.Data.Fold (Fold(..))
35−import Streamly.Internal.Data.IsMap.HashMap ()
36−import Streamly.Internal.Data.MutArray (MutArray)
37
20
21+import qualified Data.Map.Strict as Map
38import qualified Streamly.Internal.Data.Fold as FL
22import 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
41import qualified Streamly.Internal.Data.Pipe as Pipe
23import qualified Streamly.Internal.Data.Pipe as Pipe
42−import qualified Streamly.Internal.Data.Stream as Stream
24+import qualified Streamly.Internal.Data.Sink as Sink
25+import qualified Streamly.Internal.Data.Stream.IsStream as IP
26+import qualified Streamly.Prelude as S
43
27
44−import Test.Tasty.Bench
28+import Gauge
45import Streamly.Benchmark.Common
29import Streamly.Benchmark.Common
46−import Prelude hiding (all, any, take, unzip, sequence_, filter)
30+import Prelude hiding (all, any, take, unzip, sequence_)
47
31
48-- We need a monadic bind here to make sure that the function f does not get
32-- We need a monadic bind here to make sure that the function f does not get
49-- completely optimized out by the compiler in some cases.
33-- completely optimized out by the compiler in some cases.
50
34
51{-# INLINE sourceUnfoldrM #-}
35{-# INLINE sourceUnfoldrM #-}
52−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
36+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
53−sourceUnfoldrM value n = Stream.unfoldrM step n
37+sourceUnfoldrM value n = S.unfoldrM step n
54 where
38 where
55 step cnt =
39 step cnt =
56 if cnt > n + value
40 if cnt > n + value
@@ -58,14 +42,14 @@ sourceUnfoldrM value n = Stream.unfoldrM step n
58 else return (Just (cnt, cnt + 1))
42 else return (Just (cnt, cnt + 1))
59
43
60{-# INLINE source #-}
44{-# INLINE source #-}
61−source :: Monad m => Int -> Int -> Stream m Int
45+source :: (S.MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
62source = sourceUnfoldrM
46source = sourceUnfoldrM
63
47
64-- | Takes a fold method, and uses it with a default source.
48-- | Takes a fold method, and uses it with a default source.
65{-# INLINE benchIOSink #-}
49{-# INLINE benchIOSink #-}
66benchIOSink
50benchIOSink
67− :: NFData b
51+ :: (S.IsStream t, NFData b)
68− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
52+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
69benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
53benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value
70
54
71-------------------------------------------------------------------------------
55-------------------------------------------------------------------------------
@@ -73,16 +57,16 @@ benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source va
73-------------------------------------------------------------------------------
57-------------------------------------------------------------------------------
74
58
75{-# INLINE any #-}
59{-# INLINE any #-}
76−any :: (Monad m, Ord a) => a -> Stream m a -> m Bool
60+any :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
77−any value = Stream.fold (FL.any (> value))
61+any value = IP.fold (FL.any (> value))
78
62
79{-# INLINE all #-}
63{-# INLINE all #-}
80−all :: (Monad m, Ord a) => a -> Stream m a -> m Bool
64+all :: (Monad m, Ord a) => a -> SerialT m a -> m Bool
81−all value = Stream.fold (FL.all (<= value))
65+all value = IP.fold (FL.all (<= value))
82
66
83{-# INLINE take #-}
67{-# INLINE take #-}
84−take :: Monad m => Int -> Stream m a -> m ()
68+take :: Monad m => Int -> SerialT m a -> m ()
85−take value = Stream.fold (FL.take value FL.drain)
69+take value = IP.fold (FL.take value FL.drain)
86
70
87{-# INLINE sequence_ #-}
71{-# INLINE sequence_ #-}
88sequence_ :: Monad m => Int -> Fold m a ()
72sequence_ :: Monad m => Int -> Fold m a ()
@@ -94,80 +78,55 @@ sequence_ value =
94 {-# INLINE f #-}
78 {-# INLINE f #-}
95 f m k = FL.concatMap (const k) m
79 f m k = FL.concatMap (const k) m
96
80
97−-------------------------------------------------------------------------------
98−-- Filter
99−-------------------------------------------------------------------------------
100−
101−{-# INLINE filter #-}
102−filter :: Monad m => Int -> Stream m Int -> m ()
103−filter _ = Stream.fold (FL.filter even FL.drain)
104−
105−{-# INLINE scanMaybe #-}
106−scanMaybe :: Monad m => Int -> Stream m Int -> m ()
107−scanMaybe _ = Stream.fold (FL.scanMaybe (FL.filtering even) FL.drain)
108−
109−{-# INLINE scanMaybe2 #-}
110−scanMaybe2 :: Monad m => Int -> Stream m Int -> m ()
111−scanMaybe2 _ =
112− Stream.fold
113− $ FL.scanMaybe (FL.filtering even)
114− $ FL.scanMaybe (FL.filtering odd) FL.drain
115−
116-------------------------------------------------------------------------------
81-------------------------------------------------------------------------------
117-- Splitting by serial application
82-- Splitting by serial application
118-------------------------------------------------------------------------------
83-------------------------------------------------------------------------------
119
84
120{-# INLINE takeEndBy_ #-}
85{-# INLINE takeEndBy_ #-}
121−takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()
86+takeEndBy_ :: Monad m => Int -> SerialT m Int -> m ()
122−takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)
87+takeEndBy_ value = IP.fold (FL.takeEndBy_ (>= value) FL.drain)
123
88
124{-# INLINE many #-}
89{-# INLINE many #-}
125−many :: Monad m => Stream m Int -> m ()
90+many :: Monad m => SerialT m Int -> m ()
126−many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)
91+many = IP.fold (FL.many (FL.take 1 FL.drain) FL.drain)
127
92
128{-# INLINE splitAllAny #-}
93{-# INLINE splitAllAny #-}
129−splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool)
94+splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)
130splitAllAny value =
95splitAllAny value =
131− Stream.fold
96+ IP.fold
132− (FL.splitWith (,)
97+ (FL.serialWith (,)
133 (FL.all (<= (value `div` 2)))
98 (FL.all (<= (value `div` 2)))
134 (FL.any (> value))
99 (FL.any (> value))
135 )
100 )
136
101
137−{-# INLINE split_ #-}
102+{-# INLINE serial_ #-}
138−split_ :: Monad m => Int -> Stream m Int -> m Bool
103+serial_ :: Monad m => Int -> SerialT m Int -> m Bool
139−split_ value =
104+serial_ value =
140− Stream.fold
105+ IP.fold
141− (FL.split_
106+ (FL.serial_
142 (FL.all (<= (value `div` 2)))
107 (FL.all (<= (value `div` 2)))
143 (FL.any (> value))
108 (FL.any (> value))
144 )
109 )
145
110
146{-# INLINE shortest #-}
111{-# INLINE shortest #-}
147−shortest :: Monad m => Stream m Int -> m (Either Int Int)
112+shortest :: Monad m => SerialT m Int -> m (Either Int Int)
148−shortest = Stream.fold (FL.shortest FL.sum FL.length)
113+shortest = IP.fold (FL.shortest FL.sum FL.length)
149
114
150{-# INLINE longest #-}
115{-# INLINE longest #-}
151−longest :: Monad m => Stream m Int -> m (Either Int Int)
116+longest :: Monad m => SerialT m Int -> m (Either Int Int)
152−longest = Stream.fold (FL.longest FL.sum FL.length)
117+longest = IP.fold (FL.longest FL.sum FL.length)
153−
154−{-# INLINE foldBreak #-}
155−foldBreak :: Monad m => Stream m Int -> m ()
156−foldBreak s = do
157− (r, s1) <- Stream.foldBreak (FL.take 1 FL.length) s
158− when (r /= 0) $ foldBreak s1
159
118
160-------------------------------------------------------------------------------
119-------------------------------------------------------------------------------
161-- Distributing by parallel application
120-- Distributing by parallel application
162-------------------------------------------------------------------------------
121-------------------------------------------------------------------------------
163
122
164{-# INLINE teeSumLength #-}
123{-# INLINE teeSumLength #-}
165−teeSumLength :: Monad m => Stream m Int -> m (Int, Int)
124+teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)
166−teeSumLength = Stream.fold (FL.teeWith (,) FL.sum FL.length)
125+teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)
167
126
168{-# INLINE teeAllAny #-}
127{-# INLINE teeAllAny #-}
169−teeAllAny :: (Monad m, Ord a) => a -> Stream m a -> m (Bool, Bool)
128+teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)
170−teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
129+teeAllAny value = IP.fold (FL.teeWith (,) all_ any_)
171
130
172 where
131 where
173
132
@@ -175,16 +134,16 @@ teeAllAny value = Stream.fold (FL.teeWith (,) all_ any_)
175 any_ = FL.any (> value)
134 any_ = FL.any (> value)
176
135
177{-# INLINE teeWithFst #-}
136{-# INLINE teeWithFst #-}
178−teeWithFst :: Monad m => Stream m Int -> m (Int, Int)
137+teeWithFst :: Monad m => SerialT m Int -> m (Int, Int)
179−teeWithFst = Stream.fold (FL.teeWithFst (,) FL.sum FL.length)
138+teeWithFst = IP.fold (FL.teeWithFst (,) FL.sum FL.length)
180
139
181{-# INLINE teeWithMin #-}
140{-# INLINE teeWithMin #-}
182−teeWithMin :: Monad m => Stream m Int -> m (Int, Int)
141+teeWithMin :: Monad m => SerialT m Int -> m (Int, Int)
183−teeWithMin = Stream.fold (FL.teeWithMin (,) FL.sum FL.length)
142+teeWithMin = IP.fold (FL.teeWithMin (,) FL.sum FL.length)
184
143
185{-# INLINE distribute #-}
144{-# INLINE distribute #-}
186−distribute :: Monad m => Stream m Int -> m [Int]
145+distribute :: Monad m => SerialT m Int -> m [Int]
187−distribute = Stream.fold (FL.distribute [FL.sum, FL.length])
146+distribute = IP.fold (FL.distribute [FL.sum, FL.length])
188
147
189-------------------------------------------------------------------------------
148-------------------------------------------------------------------------------
190-- Partitioning
149-- Partitioning
@@ -195,99 +154,61 @@ oddEven :: Int -> Either Int Int
195oddEven x = if odd x then Left x else Right x
154oddEven x = if odd x then Left x else Right x
196
155
197{-# INLINE partition #-}
156{-# INLINE partition #-}
198−partition :: Monad m => Stream m Int -> m (Int, Int)
157+partition :: Monad m => SerialT m Int -> m (Int, Int)
199−partition = Stream.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
158+partition = IP.fold $ FL.lmap oddEven (FL.partition FL.sum FL.length)
200
159
201{-# INLINE partitionByFstM #-}
160{-# INLINE partitionByFstM #-}
202−partitionByFstM :: Monad m => Stream m Int -> m (Int, Int)
161+partitionByFstM :: Monad m => SerialT m Int -> m (Int, Int)
203partitionByFstM =
162partitionByFstM =
204− Stream.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
163+ IP.fold (FL.partitionByFstM (return . oddEven) FL.sum FL.length)
205
164
206{-# INLINE partitionByMinM #-}
165{-# INLINE partitionByMinM #-}
207−partitionByMinM :: Monad m => Stream m Int -> m (Int, Int)
166+partitionByMinM :: Monad m => SerialT m Int -> m (Int, Int)
208partitionByMinM =
167partitionByMinM =
209− Stream.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
168+ IP.fold (FL.partitionByMinM (return . oddEven) FL.sum FL.length)
210−
169+
211−{-# INLINE demuxToMap #-}
170+{-# INLINE demuxWith #-}
171+demuxWith ::
212−demuxToMap :: (Monad m, Ord k) =>
172+ (Monad m, Ord k)
213− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
173+ => (a -> (k, a'))
214−demuxToMap f g = Stream.fold (FL.demuxToContainer f g)
174+ -> Map k (Fold m a' b)
215−
175+ -> SerialT m a
216−{-# INLINE demuxToIntMap #-}
176+ -> m (Map k b)
217−demuxToIntMap :: Monad m =>
177+demuxWith f mp = S.fold (FL.demuxWith f mp)
218− (a -> Int) -> (a -> m (Fold m a b)) -> Stream m a -> m (IntMap b)
178+
219−demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g)
179+{-# INLINE demuxDefaultWith #-}
220−
180+demuxDefaultWith ::
221−{-# INLINE demuxToHashMap #-}
181+ (Monad m, Ord k, Num b)
222−demuxToHashMap :: (Monad m, Hashable k) =>
182+ => (a -> (k, b))
223− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
183+ -> Map k (Fold m b b)
224−demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g)
184+ -> SerialT m a
225−
185+ -> m (Map k b, b)
226−{-# INLINE demuxToMapIO #-}
186+demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.lmap snd FL.sum))
227−demuxToMapIO :: (MonadIO m, Ord k) =>
187+
228− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)
188+{-# INLINE classifyWith #-}
229−demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
189+classifyWith ::
230−
190+ (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)
231−{-# INLINE demuxToHashMapIO #-}
191+classifyWith f = S.fold (FL.classifyWith f FL.sum)
232−demuxToHashMapIO :: (MonadIO m, Hashable k) =>
233− (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)
234−demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g)
235−
236−{-# INLINE toMap #-}
237−toMap ::
238− (Monad m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
239−toMap f = Stream.fold (FL.toContainer f FL.sum)
240−
241−{-# INLINE toIntMap #-}
242−toIntMap ::
243− (Monad m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
244−toIntMap f = Stream.fold (FL.toContainer f FL.sum)
245−
246−{-# INLINE toMapIO #-}
247−toMapIO ::
248− (MonadIO m, Ord k, Num a) => (a -> k) -> Stream m a -> m (Map k a)
249−toMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
250−
251−{-# INLINE toIntMapIO #-}
252−toIntMapIO ::
253− (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a)
254−toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum)
255−
256−{-# INLINE toHashMapIO #-}
257−toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) =>
258− (a -> k) -> Stream m a -> m (HashMap k a)
259−toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum)
260
192
261-------------------------------------------------------------------------------
193-------------------------------------------------------------------------------
262-- unzip
194-- unzip
263-------------------------------------------------------------------------------
195-------------------------------------------------------------------------------
264
196
265{-# INLINE unzip #-}
197{-# INLINE unzip #-}
266−unzip :: Monad m => Stream m Int -> m (Int, Int)
198+unzip :: Monad m => SerialT m Int -> m (Int, Int)
267−unzip = Stream.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
199+unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)
268
200
269{-# INLINE unzipWithFstM #-}
201{-# INLINE unzipWithFstM #-}
270−unzipWithFstM :: Monad m => Stream m Int -> m (Int, Int)
202+unzipWithFstM :: Monad m => SerialT m Int -> m (Int, Int)
271unzipWithFstM = do
203unzipWithFstM = do
272− let f a = return (a + 1, a)
204+ let f = \a -> return (a + 1, a)
273− Stream.fold (FL.unzipWithFstM f FL.sum FL.length)
205+ IP.fold (FL.unzipWithFstM f FL.sum FL.length)
274
206
275{-# INLINE unzipWithMinM #-}
207{-# INLINE unzipWithMinM #-}
276−unzipWithMinM :: Monad m => Stream m Int -> m (Int, Int)
208+unzipWithMinM :: Monad m => SerialT m Int -> m (Int, Int)
277unzipWithMinM = do
209unzipWithMinM = do
278− let f a = return (a + 1, a)
210+ let f = \a -> return (a + 1, a)
279− Stream.fold (FL.unzipWithMinM f FL.sum FL.length)
211+ IP.fold (FL.unzipWithMinM f FL.sum FL.length)
280−
281−-------------------------------------------------------------------------------
282−-- Nested
283−-------------------------------------------------------------------------------
284−
285−{-# INLINE unfoldMany #-}
286−unfoldMany :: Int -> Benchmarkable
287−unfoldMany val =
288− nfIO
289− $ Stream.fold (FL.unfoldMany Unfold.replicateM FL.drain)
290− $ Stream.fromPure (val, randomRIO (1, 1 :: Int))
291
212
292-------------------------------------------------------------------------------
213-------------------------------------------------------------------------------
293-- Benchmarks
214-- Benchmarks
@@ -296,113 +217,100 @@ unfoldMany val =
296moduleName :: String
217moduleName :: String
297moduleName = "Data.Fold"
218moduleName = "Data.Fold"
298
219
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−
307o_1_space_serial_elimination :: Int -> [Benchmark]
220o_1_space_serial_elimination :: Int -> [Benchmark]
308o_1_space_serial_elimination value =
221o_1_space_serial_elimination value =
309 [ bgroup "elimination"
222 [ bgroup "elimination"
310− [ benchIOSink value "drain" (Stream.fold FL.drain)
223+ [ benchIOSink value "drain" (S.fold FL.drain)
311− , benchIOSink value "drainBy" (Stream.fold (FL.drainBy return))
224+ , benchIOSink value "drainBy" (S.fold (FL.drainBy return))
312− , benchIOSink value "drainN" (Stream.fold (FL.drainN value))
225+ , benchIOSink value "drainN" (S.fold (FL.drainN value))
313− , benchIOSink value "last" (Stream.fold FL.last)
226+ , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)
314− , benchIOSink value "length" (Stream.fold FL.length)
315− , benchIOSink value "top" (Stream.fold $ FL.top 10)
227+ , benchIOSink value "last" (S.fold FL.last)
316− , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)
228+ , benchIOSink value "length" (S.fold FL.length)
317− , benchIOSink value "sum" (Stream.fold FL.sum)
229+ , benchIOSink value "sum" (S.fold FL.sum)
318− , benchIOSink value "sum (foldMap)" (Stream.fold (FL.foldMap Sum))
230+ , benchIOSink value "sum (foldMap)" (S.fold (FL.foldMap Sum))
319− , benchIOSink value "product" (Stream.fold FL.product)
231+ , benchIOSink value "product" (S.fold FL.product)
320− , benchIOSink value "maximumBy" (Stream.fold (FL.maximumBy compare))
232+ , benchIOSink value "maximumBy" (S.fold (FL.maximumBy compare))
321− , benchIOSink value "maximum" (Stream.fold FL.maximum)
233+ , benchIOSink value "maximum" (S.fold FL.maximum)
322− , benchIOSink value "minimumBy" (Stream.fold (FL.minimumBy compare))
234+ , benchIOSink value "minimumBy" (S.fold (FL.minimumBy compare))
323− , benchIOSink value "minimum" (Stream.fold FL.minimum)
235+ , benchIOSink value "minimum" (S.fold FL.minimum)
324 , benchIOSink
236 , benchIOSink
325 value
237 value
326 "mean"
238 "mean"
327− (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))
239+ (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))
328 , benchIOSink
240 , benchIOSink
329 value
241 value
330 "variance"
242 "variance"
331− (Stream.fold FL.variance . fmap (fromIntegral :: Int -> Double))
243+ (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))
332 , benchIOSink
244 , benchIOSink
333 value
245 value
334 "stdDev"
246 "stdDev"
335− (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))
247+ (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))
336 , benchIOSink
248 , benchIOSink
337 value
249 value
338 "mconcat"
250 "mconcat"
339− (Stream.fold FL.mconcat . fmap (Last . Just))
251+ (S.fold FL.mconcat . S.map (Last . Just))
340 , benchIOSink
252 , benchIOSink
341 value
253 value
342 "foldMap"
254 "foldMap"
343− (Stream.fold (FL.foldMap (Last . Just)))
255+ (S.fold (FL.foldMap (Last . Just)))
344 , benchIOSink
256 , benchIOSink
345 value
257 value
346 "foldMapM"
258 "foldMapM"
347− (Stream.fold (FL.foldMapM (return . Last . Just)))
259+ (S.fold (FL.foldMapM (return . Last . Just)))
348− , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))
260+ , benchIOSink value "index" (S.fold (FL.index (value + 1)))
349− , benchIOSink value "head" (Stream.fold FL.head)
261+ , benchIOSink value "head" (S.fold FL.head)
350− , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))
262+ , benchIOSink value "find" (S.fold (FL.find (== (value + 1))))
351 , benchIOSink
263 , benchIOSink
352 value
264 value
353 "lookup"
265 "lookup"
354− (Stream.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
266+ (S.fold (FL.lmap (\a -> (a, a)) (FL.lookup (value + 1))))
355 , benchIOSink
267 , benchIOSink
356 value
268 value
357 "findIndex"
269 "findIndex"
358− (Stream.fold (FL.findIndex (== (value + 1))))
270+ (S.fold (FL.findIndex (== (value + 1))))
359 , benchIOSink
271 , benchIOSink
360 value
272 value
361 "elemIndex"
273 "elemIndex"
362− (Stream.fold (FL.elemIndex (value + 1)))
274+ (S.fold (FL.elemIndex (value + 1)))
363− , benchIOSink value "null" (Stream.fold FL.null)
275+ , benchIOSink value "null" (S.fold FL.null)
364− , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))
276+ , benchIOSink value "elem" (S.fold (FL.elem (value + 1)))
365− , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))
277+ , benchIOSink value "notElem" (S.fold (FL.notElem (value + 1)))
366 , benchIOSink value "all" $ all value
278 , benchIOSink value "all" $ all value
367 , benchIOSink value "any" $ any value
279 , benchIOSink value "any" $ any value
368 , benchIOSink value "take" $ take value
280 , benchIOSink value "take" $ take value
369 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
281 , benchIOSink value "takeEndBy_" $ takeEndBy_ value
370− , benchIOSink value "and" (Stream.fold FL.and . fmap (<= (value + 1)))
282+ , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))
371− , benchIOSink value "or" (Stream.fold FL.or . fmap (> (value + 1)))
283+ , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))
372 ]
284 ]
373 ]
285 ]
374
286
375o_1_space_serial_transformation :: Int -> [Benchmark]
287o_1_space_serial_transformation :: Int -> [Benchmark]
376o_1_space_serial_transformation value =
288o_1_space_serial_transformation value =
377 [ bgroup "transformation"
289 [ bgroup "transformation"
378− [ benchIOSink value "map" (Stream.fold (FL.lmap (+ 1) FL.drain))
290+ [ benchIOSink value "map" (S.fold (FL.lmap (+ 1) FL.drain))
379 , let f x = if even x then Just x else Nothing
291 , let f x = if even x then Just x else Nothing
380 fld = FL.mapMaybe f FL.drain
292 fld = FL.mapMaybe f FL.drain
381− in benchIOSink value "mapMaybe" (Stream.fold fld)
293+ in benchIOSink value "mapMaybe" (S.fold fld)
382 , benchIOSink
294 , benchIOSink
383 value
295 value
384 "rsequence"
296 "rsequence"
385− (Stream.fold (FL.rmapM id (return <$> FL.drain)))
297+ (S.fold (FL.rmapM id (return <$> FL.drain)))
386− , benchIOSink value "rmapM" (Stream.fold (FL.rmapM return FL.drain))
298+ , benchIOSink value "rmapM" (S.fold (FL.rmapM return FL.drain))
387 , benchIOSink
299 , benchIOSink
388 value
300 value
389 "pipe-mapM"
301 "pipe-mapM"
390− (Stream.fold
302+ (S.fold
391 (FL.transform
303 (FL.transform
392 (Pipe.mapM (\x -> return $ x + 1))
304 (Pipe.mapM (\x -> return $ x + 1))
393 FL.drain))
305 FL.drain))
394 , benchIOSink
306 , benchIOSink
395 value
307 value
396 "fold-scan"
308 "fold-scan"
397− (Stream.fold $ FL.scan FL.sum FL.drain)
309+ (S.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
310 , benchIOSink
403 value
311 value
404 "fold-postscan"
312 "fold-postscan"
405− (Stream.fold $ FL.postscan FL.sum FL.drain)
313+ (S.fold $ FL.postscan FL.sum FL.drain)
406 ]
314 ]
407 ]
315 ]
408
316
@@ -410,15 +318,10 @@ o_1_space_serial_composition :: Int -> [Benchmark]
410o_1_space_serial_composition value =
318o_1_space_serial_composition value =
411 [ bgroup
319 [ bgroup
412 "composition"
320 "composition"
413− [ benchIOSink value "filter even" $ filter value
414− , benchIOSink value "scanMaybe even" $ scanMaybe value
415− , benchIOSink value "scanMaybe even, odd" $ scanMaybe2 value
416− , benchIOSink value "foldBreak (recursive)" foldBreak
417− , benchIOSink value "splitWith (all, any)" $ splitAllAny value
321+ [ benchIOSink value "serialWith (all, any)" $ splitAllAny value
418− , benchIOSink value "split_ (all, any)" $ split_ value
322+ , benchIOSink value "serial_ (all, any)" $ serial_ value
419 , benchIOSink value "tee (all, any)" $ teeAllAny value
323 , benchIOSink value "tee (all, any)" $ teeAllAny value
420 , benchIOSink value "many drain (take 1)" many
324 , benchIOSink value "many drain (take 1)" many
421− , bench "unfoldMany" $ unfoldMany value
422 , benchIOSink value "shortest (sum, length)" shortest
325 , benchIOSink value "shortest (sum, length)" shortest
423 , benchIOSink value "longest (sum, length)" longest
326 , benchIOSink value "longest (sum, length)" longest
424 , benchIOSink value "tee (sum, length)" teeSumLength
327 , benchIOSink value "tee (sum, length)" teeSumLength
@@ -431,12 +334,23 @@ o_1_space_serial_composition value =
431 , benchIOSink value "unzip (sum, length)" unzip
334 , benchIOSink value "unzip (sum, length)" unzip
432 , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
335 , benchIOSink value "unzipWithFstM (sum, length)" unzipWithFstM
433 , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
336 , benchIOSink value "unzipWithMinM (sum, length)" unzipWithMinM
337+ , benchIOSink value "demuxDefaultWith [sum, length] sum"
338+ $ demuxDefaultWith fn mp
339+ , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp
340+ , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)
434 ]
341 ]
435 ]
342 ]
436
343
344+ where
345+
346+ -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.
347+ fn x = (x `mod` 3, x)
348+
349+ mp = Map.fromList [(0, FL.sum), (1, FL.length)]
350+
437o_n_space_serial :: Int -> [Benchmark]
351o_n_space_serial :: Int -> [Benchmark]
438o_n_space_serial value =
352o_n_space_serial value =
439− [ benchIOSink value "sequence_/100" $ Stream.fold (sequence_ (value `div` 100))
353+ [ benchIOSink value "sequence_/100" $ S.fold (sequence_ (value `div` 100))
440 ]
354 ]
441
355
442o_n_heap_serial :: Int -> [Benchmark]
356o_n_heap_serial :: Int -> [Benchmark]
@@ -445,71 +359,23 @@ o_n_heap_serial value =
445 -- Left folds for building a structure are inherently non-streaming
359 -- Left folds for building a structure are inherently non-streaming
446 -- as the structure cannot be lazily consumed until fully built.
360 -- as the structure cannot be lazily consumed until fully built.
447 [
361 [
448− benchIOSink value "toList" (Stream.fold FL.toList)
362+ benchIOSink value "toList" (S.fold FL.toList)
449− , benchIOSink value "toListRev" (Stream.fold FL.toListRev)
363+ , benchIOSink value "toListRev" (S.fold FL.toListRev)
450 , benchIOSink value "toStream"
364 , benchIOSink value "toStream"
451− (Stream.fold FL.toStream
365+ (S.fold FL.toStream
452− :: Stream IO a -> IO (Stream Identity a))
366+ :: SerialT IO a -> IO (SerialT Identity a))
453 , benchIOSink value "toStreamRev"
367 , benchIOSink value "toStreamRev"
454− (Stream.fold FL.toStreamRev
368+ (S.fold FL.toStreamRev
455− :: Stream IO a -> IO (Stream Identity a))
369+ :: SerialT IO a -> IO (SerialT Identity a))
456− , benchIOSink value "nub" (Stream.fold FL.nub)
457− ]
458− , bgroup "key-value"
459− [
460− benchIOSink value "demuxToMap (64 buckets) [sum, length]"
461− $ demuxToMap (getKey 64) (getFold . getKey 64)
462− , benchIOSink value "demuxToIntMap (64 buckets) [sum, length]"
463− $ demuxToIntMap (getKey 64) (getFold . getKey 64)
464− , benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"
465− $ demuxToHashMap (getKey 64) (getFold . getKey 64)
466− , benchIOSink value "demuxToMapIO (64 buckets) [sum, length]"
467− $ demuxToMapIO (getKey 64) (getFold . getKey 64)
468− , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"
469− $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)
470−
471− -- classify: immutable
472− , benchIOSink value "toMap (64 buckets) sum"
473− $ toMap (getKey 64)
474− , benchIOSink value "toIntMap (64 buckets) sum"
475− $ toIntMap (getKey 64)
476−
477− -- classify: mutable cells
478− , benchIOSink value "toMapIO (single bucket) sum"
479− $ toMapIO (getKey 1)
480− , benchIOSink value "toMapIO (64 buckets) sum"
481− $ toMapIO (getKey 64)
482− , benchIOSink value "toMapIO (max buckets) sum"
483− $ toMapIO (getKey value)
484− , benchIOSink value "toIntMapIO (64 buckets) sum"
485− $ toIntMapIO (getKey 64)
486− , benchIOSink value "toHashMapIO (single bucket) sum"
487− $ toHashMapIO (getKey 1)
488− , benchIOSink value "toHashMapIO (64 buckets) sum"
489− $ toHashMapIO (getKey 64)
490− , benchIOSink value "toHashMapIO (max buckets) sum"
491− $ toHashMapIO (getKey value)
492 ]
370 ]
493 ]
371 ]
494
372
495− where
496−
497− getKey buckets = (`mod` buckets)
498−
499− getFold k =
500− return $ case k of
501− 0 -> FL.sum
502− 1 -> FL.length
503− _ -> FL.length
504−
505-------------------------------------------------------------------------------
373-------------------------------------------------------------------------------
506-- Driver
374-- Driver
507-------------------------------------------------------------------------------
375-------------------------------------------------------------------------------
508
376
509main :: IO ()
377main :: IO ()
510−main = do
511−#ifndef FUSION_CHECK
512− runWithCLIOpts defaultStreamSize allBenchmarks
378+main = runWithCLIOpts defaultStreamSize allBenchmarks
513
379
514 where
380 where
515
381
@@ -522,20 +388,3 @@ main = do
522 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
388 , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
523 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
389 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
524 ]
390 ]
525−#else
526− -- Enable FUSION_CHECK macro at the beginning of the file
527− -- Enable one benchmark below, and run the benchmark
528− -- Check the .dump-simpl output
529− let value = 100000
530− let input = source value 1
531− let getKey buckets = (`mod` buckets)
532− let getFold k =
533− return $ case k of
534− 0 -> FL.sum
535− 1 -> FL.length
536− _ -> FL.length
537−
538− -- demuxToMap (getKey 64) (getFold . getKey 64) input
539− toIntMapIO (getKey 64) input
540− return ()
541−#endif
benchmark/Streamly/Benchmark/Data/Fold/Window.hsdeleted−191
@@ -1,191 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−module Main (main) where
4−
5−import Control.DeepSeq (NFData)
6−import Streamly.Data.Fold (Fold)
7−import Streamly.Internal.Data.Stream (Stream)
8−import System.Random (randomRIO)
9−
10−import qualified Streamly.Data.Fold as Fold
11−import qualified Streamly.Internal.Data.Fold as Window
12−import qualified Streamly.Internal.Data.Ring as Ring
13−import qualified Streamly.Internal.Data.Stream as Stream
14−
15−import Streamly.Benchmark.Common
16−import Test.Tasty.Bench
17−
18−{-# INLINE source #-}
19−source :: (Monad m, Num a, Stream.Enumerable a) =>
20− Int -> a -> Stream m a
21−source len from =
22− Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)
23−
24−{-# INLINE sourceDescending #-}
25−sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>
26− Int -> a -> Stream m a
27−sourceDescending len from =
28− Stream.enumerateFromThenTo
29− (from + fromIntegral len)
30− (from + fromIntegral (len - 1))
31− from
32−
33−{-# INLINE sourceDescendingInt #-}
34−sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int
35−sourceDescendingInt = sourceDescending
36−
37−{-# INLINE benchWith #-}
38−benchWith :: (Num a, NFData b) =>
39− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
40−benchWith src len name f =
41− bench name
42− $ nfIO
43− $ randomRIO (1, 1 :: Int) >>= Stream.fold f . src len . fromIntegral
44−
45−{-# INLINE benchWithFold #-}
46−benchWithFold :: NFData a => Int -> String -> Fold IO Double a -> Benchmark
47−benchWithFold = benchWith source
48−
49−{-# INLINE benchWithFoldInt #-}
50−benchWithFoldInt :: Int -> String -> Fold IO Int Int -> Benchmark
51−benchWithFoldInt = benchWith source
52−
53−{-# INLINE benchScanWith #-}
54−benchScanWith :: Num a =>
55− (Int -> a -> Stream IO a) -> Int -> String -> Fold IO a b -> Benchmark
56−benchScanWith src len name f =
57− bench name
58− $ nfIO
59− $ randomRIO (1, 1 :: Int)
60− >>= Stream.fold Fold.drain
61− . Stream.postscan f
62− . src len
63− . fromIntegral
64−
65−{-# INLINE benchWithPostscan #-}
66−benchWithPostscan :: Int -> String -> Fold IO Double a -> Benchmark
67−benchWithPostscan = benchScanWith source
68−
69−o_1_space_folds :: Int -> [Benchmark]
70−o_1_space_folds numElements =
71− [ bgroup "fold"
72− [ benchWithFold numElements "minimum (window size 100)"
73− (Window.windowMinimum 100)
74− , benchWithFold numElements "minimum (window size 1000)"
75− (Window.windowMinimum 1000)
76− , benchWith sourceDescendingInt numElements
77− "minimum descending (window size 1000)"
78− (Window.windowMinimum 1000)
79−
80− , benchWithFold numElements "maximum (window size 100)"
81− (Window.windowMaximum 100)
82− , benchWithFold numElements "maximum (window size 1000)"
83− (Window.windowMaximum 1000)
84− , benchWith sourceDescendingInt numElements
85− "maximum descending (window size 1000)"
86− (Window.windowMaximum 1000)
87−
88− , benchWithFold numElements "range (window size 100)"
89− (Window.windowRange 100)
90− , benchWithFold numElements "range (window size 1000)"
91− (Window.windowRange 1000)
92− , benchWith sourceDescendingInt numElements
93− "range descending (window size 1000)"
94− (Window.windowRange 1000)
95−
96− , benchWithFoldInt numElements "sumInt (window size 100)"
97− (Ring.slidingWindow 100 Window.windowSumInt)
98− , benchWithFoldInt numElements "sum for Int (window size 100)"
99− (Ring.slidingWindow 100 Window.windowSum)
100− , benchWithFold numElements "sum (window size 100)"
101− (Ring.slidingWindow 100 Window.windowSum)
102− , benchWithFold numElements "sum (window size 1000)"
103− (Ring.slidingWindow 1000 Window.windowSum)
104− , benchWithFold numElements "sum (entire stream)"
105− (Window.cumulative Window.windowSum)
106− , benchWithFold numElements "sum (Data.Fold)"
107− Fold.sum
108−
109− , benchWithFold numElements "mean (window size 100)"
110− (Ring.slidingWindow 100 Window.windowMean)
111− , benchWithFold numElements "mean (window size 1000)"
112− (Ring.slidingWindow 1000 Window.windowMean)
113− , benchWithFold numElements "mean (entire stream)"
114− (Window.cumulative Window.windowMean)
115− , benchWithFold numElements "mean (Data.Fold)"
116− Fold.mean
117−
118− , benchWithFold numElements "powerSum 2 (window size 100)"
119− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
120− , benchWithFold numElements "powerSum 2 (entire stream)"
121− (Window.cumulative (Window.windowPowerSum 2))
122−
123− ]
124− ]
125−
126−o_1_space_scans :: Int -> [Benchmark]
127−o_1_space_scans numElements =
128− [ bgroup "scan"
129− [ benchWithPostscan numElements "minimum (window size 10)"
130− (Window.windowMinimum 10)
131− -- Below window size 30 the linear search based impl performs better
132− -- than the dequeue based implementation.
133− , benchWithPostscan numElements "minimum (window size 30)"
134− (Window.windowMinimum 30)
135− , benchWithPostscan numElements "minimum (window size 1000)"
136− (Window.windowMinimum 1000)
137− , benchScanWith sourceDescendingInt numElements
138− "minimum descending (window size 1000)"
139− (Window.windowMinimum 1000)
140−
141− , benchWithPostscan numElements "maximum (window size 10)"
142− (Window.windowMaximum 10)
143− , benchWithPostscan numElements "maximum (window size 30)"
144− (Window.windowMaximum 30)
145− , benchWithPostscan numElements "maximum (window size 1000)"
146− (Window.windowMaximum 1000)
147− , benchScanWith sourceDescendingInt numElements
148− "maximum descending (window size 1000)"
149− (Window.windowMaximum 1000)
150−
151− , benchWithPostscan numElements "range (window size 10)"
152− (Window.windowRange 10)
153− , benchWithPostscan numElements "range (window size 30)"
154− (Window.windowRange 30)
155− , benchWithPostscan numElements "range (window size 1000)"
156− (Window.windowRange 1000)
157− , benchScanWith sourceDescendingInt numElements
158− "range descending (window size 1000)"
159− (Window.windowRange 1000)
160−
161− , benchWithPostscan numElements "sum (window size 100)"
162− (Ring.slidingWindow 100 Window.windowSum)
163− , benchWithPostscan numElements "sum (window size 1000)"
164− (Ring.slidingWindow 1000 Window.windowSum)
165−
166− , benchWithPostscan numElements "mean (window size 100)"
167− (Ring.slidingWindow 100 Window.windowMean)
168− , benchWithPostscan numElements "mean (window size 1000)"
169− (Ring.slidingWindow 1000 Window.windowMean)
170−
171− , benchWithPostscan numElements "powerSum 2 (window size 100)"
172− (Ring.slidingWindow 100 (Window.windowPowerSum 2))
173− , benchWithPostscan numElements "powerSum 2 (window size 1000)"
174− (Ring.slidingWindow 1000 (Window.windowPowerSum 2))
175− ]
176− ]
177−
178−moduleName :: String
179−moduleName = "Data.Fold.Window"
180−
181−main :: IO ()
182−main = runWithCLIOpts defaultStreamSize allBenchmarks
183−
184− where
185−
186− allBenchmarks value =
187− [ bgroup (o_1_space_prefix moduleName) $ concat
188− [ o_1_space_folds value
189− , o_1_space_scans value
190− ]
191− ]
benchmark/Streamly/Benchmark/Data/MutArray.hsdeleted−300
@@ -1,300 +0,0 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−{-# OPTIONS_GHC -Wno-orphans #-}
3−
4−-- |
5−-- Module : Streamly.Benchmark.Data.Array.Unboxed.Mut
6−-- Copyright : (c) 2021 Composewell Technologies
7−-- License : BSD-3-Clause
8−-- Maintainer : streamly@composewell.com
9−
10−{-# LANGUAGE CPP #-}
11−{-# LANGUAGE FlexibleContexts #-}
12−{-# LANGUAGE ScopedTypeVariables #-}
13−
14−#ifdef __HADDOCK_VERSION__
15−#undef INSPECTION
16−#endif
17−
18−#ifdef INSPECTION
19−{-# LANGUAGE TemplateHaskell #-}
20−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21−#endif
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad.IO.Class (MonadIO)
25−import Data.Functor ((<&>))
26−import System.Random (randomRIO)
27−import Prelude
28− ( IO
29− , Int
30− , Integral(..)
31− , Maybe(..)
32− , Monad(..)
33− , Num(..)
34− , Ord(..)
35− , String
36− , ($)
37− , (.)
38− , (||)
39− , concat
40− , const
41− , fmap
42− , id
43− , undefined
44− )
45−import Streamly.Internal.Data.MutArray (MutArray)
46−
47−import qualified Streamly.Internal.Data.Array as Array
48−import qualified Streamly.Internal.Data.MutArray as MArray
49−import qualified Streamly.Internal.Data.Fold as Fold
50−import qualified Streamly.Internal.Data.Stream as Stream
51−
52−import Test.Tasty.Bench
53−import Streamly.Benchmark.Common hiding (benchPureSrc)
54−
55−type Stream = MutArray
56−
57−instance NFData (MutArray a) where
58− {-# INLINE rnf #-}
59− rnf _ = ()
60−
61−-------------------------------------------------------------------------------
62−-- Benchmark helpers
63−-------------------------------------------------------------------------------
64−
65−{-# INLINE benchIO #-}
66−benchIO :: NFData b => String -> (Int -> IO a) -> (a -> b) -> Benchmark
67−benchIO name src f = bench name $ nfIO $
68− (randomRIO (1,1) >>= src) <&> f
69−
70−{-# INLINE benchPureSink #-}
71−benchPureSink :: NFData b => Int -> String -> (Stream Int -> b) -> Benchmark
72−benchPureSink value name = benchIO name (sourceIntFromTo value)
73−
74−{-# INLINE benchIO' #-}
75−benchIO' :: NFData b => String -> (Int -> IO a) -> (a -> IO b) -> Benchmark
76−benchIO' name src f = bench name $ nfIO $
77− randomRIO (1,1) >>= src >>= f
78−
79−{-# INLINE benchIOSink #-}
80−benchIOSink :: NFData b => Int -> String -> (Stream Int -> IO b) -> Benchmark
81−benchIOSink value name = benchIO' name (sourceIntFromTo value)
82−
83−-- Drain a source that generates an array in the IO monad
84−{-# INLINE benchIOSrc #-}
85−benchIOSrc :: String -> (Int -> IO (Stream a)) -> Benchmark
86−benchIOSrc name src = benchIO name src id
87−
88−drain :: Monad m => Stream.Stream m a -> m ()
89−drain = Stream.fold Fold.drain
90−
91−-------------------------------------------------------------------------------
92−-- Bench Ops
93−-------------------------------------------------------------------------------
94−
95−{-# INLINE sourceUnfoldr #-}
96−sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)
97−sourceUnfoldr value n =
98− Stream.fold (MArray.writeN value) $ Stream.unfoldr step n
99−
100− where
101−
102− step cnt =
103− if cnt > n + value
104− then Nothing
105− else Just (cnt, cnt + 1)
106−
107−{-# INLINE sourceIntFromTo #-}
108−sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)
109−sourceIntFromTo value n =
110− Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)
111−
112−{-# INLINE sourceFromList #-}
113−sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)
114−sourceFromList value n =
115− Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]
116−
117−{-# INLINE sourceIntFromToFromList #-}
118−sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)
119−sourceIntFromToFromList value n = MArray.fromListN value [n..n + value]
120−
121−{-# INLINE sourceIntFromToFromStream #-}
122−sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)
123−sourceIntFromToFromStream value n =
124− Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)
125−
126−{-# INLINE sourceUnfoldrM #-}
127−sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int
128−sourceUnfoldrM value n = Stream.unfoldrM step n
129− where
130− step cnt =
131− if cnt > n + value
132− then return Nothing
133− else return (Just (cnt, cnt + 1))
134−
135−-------------------------------------------------------------------------------
136−-- Transformation
137−-------------------------------------------------------------------------------
138−
139−{-# INLINE composeN #-}
140−composeN :: Monad m
141− => Int -> (Stream Int -> m (Stream Int)) -> Stream Int -> m (Stream Int)
142−composeN n f x =
143− case n of
144− 1 -> f x
145− 2 -> f x >>= f
146− 3 -> f x >>= f >>= f
147− 4 -> f x >>= f >>= f >>= f
148− _ -> undefined
149−
150−{-# INLINE scanl' #-}
151−scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
152−scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)
153−
154−{-# INLINE scanl1' #-}
155−scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
156−scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+)
157−
158−{-# INLINE map #-}
159−map :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)
160−map value n = composeN n $ onArray value $ fmap (+ 1)
161−
162−{-# INLINE onArray #-}
163−onArray
164− :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)
165− -> Stream Int
166− -> m (Stream Int)
167−onArray value f arr =
168− Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr
169−
170−-------------------------------------------------------------------------------
171−-- Elimination
172−-------------------------------------------------------------------------------
173−
174−{-# INLINE unfoldReadDrain #-}
175−unfoldReadDrain :: MonadIO m => Stream Int -> m ()
176−unfoldReadDrain = drain . Stream.unfold MArray.reader
177−
178−{-# INLINE unfoldReadRevDrain #-}
179−unfoldReadRevDrain :: MonadIO m => Stream Int -> m ()
180−unfoldReadRevDrain = drain . Stream.unfold MArray.readerRev
181−
182−{-# INLINE toStreamDRevDrain #-}
183−toStreamDRevDrain :: MonadIO m => Stream Int -> m ()
184−toStreamDRevDrain = drain . MArray.readRev
185−
186−{-# INLINE toStreamDDrain #-}
187−toStreamDDrain :: MonadIO m => Stream Int -> m ()
188−toStreamDDrain = drain . MArray.read
189−
190−{-# INLINE unfoldFold #-}
191−unfoldFold :: MonadIO m => Stream Int -> m Int
192−unfoldFold = Stream.fold (Fold.foldl' (+) 0) . Stream.unfold MArray.reader
193−
194−-------------------------------------------------------------------------------
195−-- Bench groups
196−-------------------------------------------------------------------------------
197−
198−o_1_space_generation :: Int -> [Benchmark]
199−o_1_space_generation value =
200− [ bgroup
201− "generation"
202− [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)
203− , benchIOSrc
204− "fromList . intFromTo"
205− (sourceIntFromToFromList value)
206− , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)
207− , benchIOSrc "writeN . fromList" (sourceFromList value)
208− , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)
209− ]
210− ]
211−
212−o_1_space_elimination :: Int -> [Benchmark]
213−o_1_space_elimination value =
214− [ bgroup "elimination"
215− [ benchPureSink value "id" id
216− , benchIOSink value "foldl'" unfoldFold
217− , benchIOSink value "read" unfoldReadDrain
218− , benchIOSink value "readRev" unfoldReadRevDrain
219− , benchIOSink value "toStream" toStreamDDrain
220− , benchIOSink value "toStreamRev" toStreamDRevDrain
221− ]
222− ]
223−
224−o_n_heap_serial :: Int -> [Benchmark]
225−o_n_heap_serial value =
226− [ bgroup "elimination"
227− [
228− -- Converting the stream to an array
229− benchFold "writeN" (Stream.fold (MArray.writeN value))
230− (sourceUnfoldrM value)
231− ]
232− ]
233−
234−o_1_space_transformation :: Int -> [Benchmark]
235−o_1_space_transformation value =
236− [ bgroup "transformation"
237− [ benchIOSink value "scanl'" (scanl' value 1)
238− , benchIOSink value "scanl1'" (scanl1' value 1)
239− , benchIOSink value "map" (map value 1)
240− ]
241− ]
242−
243−o_1_space_transformationX4 :: Int -> [Benchmark]
244−o_1_space_transformationX4 value =
245− [ bgroup "transformationX4"
246− [ benchIOSink value "scanl'" (scanl' value 4)
247− , benchIOSink value "scanl1'" (scanl1' value 4)
248− , benchIOSink value "map" (map value 4)
249− ]
250− ]
251−
252−o_1_space_serial_marray ::
253− Int -> (MutArray Int, Array.Array Int) -> [Benchmark]
254−o_1_space_serial_marray value ~(array, indices) =
255− [ benchIO' "partitionBy (< 0)" (const (return array))
256− $ MArray.partitionBy (< 0)
257− , benchIO' "partitionBy (> 0)" (const (return array))
258− $ MArray.partitionBy (> 0)
259− , benchIO' "partitionBy (< value/2)" (const (return array))
260− $ MArray.partitionBy (< (value `div` 2))
261− , benchIO' "partitionBy (> value/2)" (const (return array))
262− $ MArray.partitionBy (> (value `div` 2))
263− , benchIO' "strip (< value/2 || > value/2)" (const (return array))
264− $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)
265− , benchIO' "strip (> 0)" (const (return array))
266− $ MArray.strip (> 0)
267− , benchIO' "modifyIndices (+ 1)" (const (return indices))
268− $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))
269− . Stream.unfold Array.reader
270− ]
271−
272−-------------------------------------------------------------------------------
273−-- Driver
274−-------------------------------------------------------------------------------
275−
276−moduleName :: String
277−moduleName = "Data.MutArray"
278−
279−main :: IO ()
280−main = do
281− runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
282−
283− where
284−
285− alloc value = do
286− marr <- MArray.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
287− indices <- Array.fromStream (sourceUnfoldrM value 0 :: Stream.Stream IO Int)
288− return (marr, indices)
289−
290− allBenchmarks array value =
291− [ bgroup (o_1_space_prefix moduleName)
292− $ concat
293− [ o_1_space_serial_marray value array
294− , o_1_space_generation value
295− , o_1_space_elimination value
296− , o_1_space_transformation value
297− , o_1_space_transformationX4 value
298− ]
299− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
300− ]
benchmark/Streamly/Benchmark/Data/Parser.hs+193−642
@@ -1,10 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3−#undef FUSION_CHECK
4−#ifdef FUSION_CHECK
5−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
6−#endif
7−
8-- |
1-- |
9-- Module : Streamly.Benchmark.Data.Parser
2-- Module : Streamly.Benchmark.Data.Parser
10-- Copyright : (c) 2020 Composewell Technologies
3-- Copyright : (c) 2020 Composewell Technologies
@@ -14,42 +7,43 @@
14
7
15{-# LANGUAGE CPP #-}
8{-# LANGUAGE CPP #-}
16{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
17−{-# LANGUAGE ScopedTypeVariables #-}
18−{-# OPTIONS_GHC -Wno-orphans #-}
19
10
20module Main
11module Main
21 (
12 (
22 main
13 main
23 ) where
14 ) where
24
15
25−import Control.Applicative ((<|>))
26import Control.DeepSeq (NFData(..))
16import Control.DeepSeq (NFData(..))
27−import Data.Function ((&))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
28import Data.Functor (($>))
19import Data.Functor (($>))
20+import Data.Maybe (fromMaybe)
29import Data.Monoid (Sum(..))
21import Data.Monoid (Sum(..))
30import GHC.Magic (inline)
22import GHC.Magic (inline)
23+#if __GLASGOW_HASKELL__ >= 802
31import GHC.Magic (noinline)
24import GHC.Magic (noinline)
25+#else
26+#define noinline
27+#endif
32import System.IO (Handle)
28import System.IO (Handle)
33import System.Random (randomRIO)
29import System.Random (randomRIO)
34−import Streamly.Internal.Data.Fold (Fold(..))
35−import Streamly.Internal.Data.Parser
36− (ParseError(..), Parser(..), Initial(..), Step(..))
37−import Streamly.Internal.Data.Stream (Stream)
38−import Prelude hiding
30+import Prelude
39− (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span)
31+ hiding (any, all, take, sequence, sequence_, sequenceA, takeWhile)
40
32
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
43import qualified Data.Traversable as TR
33import qualified Data.Traversable as TR
34+import qualified Data.Foldable as F
35+import qualified Control.Applicative as AP
44import qualified Streamly.FileSystem.Handle as Handle
36import qualified Streamly.FileSystem.Handle as Handle
45−import qualified Streamly.Internal.Data.Array as Array
37+import qualified Streamly.Prelude as S
38+import qualified Streamly.Internal.Data.Array.Foreign as Array
46−import qualified Streamly.Internal.Data.Fold as Fold
39+import qualified Streamly.Internal.Data.Fold as FL
47import qualified Streamly.Internal.Data.Parser as PR
40import qualified Streamly.Internal.Data.Parser as PR
48−import qualified Streamly.Data.Stream as Stream
41+import qualified Streamly.Internal.Data.Stream.IsStream as IP
49import qualified Streamly.Internal.Data.Producer as Producer
42import qualified Streamly.Internal.Data.Producer as Producer
50−import qualified Streamly.Internal.Data.Stream as Stream
43+import qualified Streamly.Internal.Data.Producer.Source as Source
51
44
52−import Test.Tasty.Bench hiding (env)
45+import Gauge hiding (env)
46+import Streamly.Prelude (SerialT)
53import Streamly.Benchmark.Common
47import Streamly.Benchmark.Common
54import Streamly.Benchmark.Common.Handle
48import Streamly.Benchmark.Common.Handle
55
49
@@ -60,59 +54,19 @@ import Streamly.Benchmark.Common.Handle
60-- XXX these can be moved to the common module
54-- XXX these can be moved to the common module
61
55
62{-# INLINE sourceUnfoldrM #-}
56{-# INLINE sourceUnfoldrM #-}
63−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
57+sourceUnfoldrM :: (S.IsStream t, S.MonadAsync m) => Int -> Int -> t m Int
64−sourceUnfoldrM value n = Stream.unfoldrM step n
58+sourceUnfoldrM value n = S.unfoldrM step n
65 where
59 where
66 step cnt =
60 step cnt =
67 if cnt > n + value
61 if cnt > n + value
68 then return Nothing
62 then return Nothing
69 else return (Just (cnt, cnt + 1))
63 else return (Just (cnt, cnt + 1))
70
64
71−-- | Generates something like this: { { \{ \{ } }. The stream consists of
72−-- three parts, the first part is contains a sequence of `{`. The second part
73−-- contains a sequence pf escaped values `\{`. The third part contains a
74−-- sequence of `}`.
75−{-# INLINE sourceEscapedFrames #-}
76−sourceEscapedFrames ::
77− Monad m
78− => Int
79− -> Int
80− -> Stream m Char
81−sourceEscapedFrames value n = Stream.unfoldrM step n
82− where
83−
84− bs = '\\'
85− cbOpen = '{'
86− cbClose = '}'
87− value1 = value `div` 4
88−
89− step cnt
90− | cnt > 4 * value1 = return Nothing
91− | cnt <= value1 = return $ Just (cbOpen, cnt + 1)
92− | cnt > 3 * value1 = return $ Just (cbClose, cnt + 1)
93− | otherwise =
94− return
95− $ Just
96− $ if (cnt - value1) `mod` 2 == 1
97− then (bs, cnt + 1)
98− else (cbOpen, cnt + 1)
99−
100−{-# INLINE benchIOSrc #-}
101−benchIOSrc
102− :: NFData b
103− => (Int -> Int -> Stream IO a)
104− -> Int
105− -> String
106− -> (Stream IO a -> IO b)
107− -> Benchmark
108−benchIOSrc src value name f =
109− bench name $ nfIO $ randomRIO (1,1) >>= f . src value
110−
111-- | Takes a fold method, and uses it with a default source.
65-- | Takes a fold method, and uses it with a default source.
112{-# INLINE benchIOSink #-}
66{-# INLINE benchIOSink #-}
113benchIOSink
67benchIOSink
114− :: NFData b
68+ :: (S.IsStream t, NFData b)
115− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
69+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
116benchIOSink value name f =
70benchIOSink value name f =
117 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
71 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
118
72
@@ -120,452 +74,199 @@ benchIOSink value name f =
120-- Parsers
74-- Parsers
121-------------------------------------------------------------------------------
75-------------------------------------------------------------------------------
122
76
77+{-# INLINE next #-}
78+next :: MonadCatch m => Int -> SerialT m Int -> m (Maybe Int)
79+next value = IP.parse p
80+ where
81+ p = do
82+ m <- PR.next
83+ case m of
84+ Just i -> if i >= value then pure m else p
85+ Nothing -> pure Nothing
86+
123{-# INLINE takeBetween #-}
87{-# INLINE takeBetween #-}
124−takeBetween :: Monad m => Int -> Stream m a -> m (Either ParseError ())
88+takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()
125−takeBetween value = Stream.parse (PR.takeBetween 0 value Fold.drain)
89+takeBetween value = IP.parse (PR.takeBetween 0 value FL.drain)
126
90
127{-# INLINE takeEQ #-}
91{-# INLINE takeEQ #-}
128−takeEQ :: Monad m => Int -> Stream m a -> m (Either ParseError ())
92+takeEQ :: MonadCatch m => Int -> SerialT m a -> m ()
129−takeEQ value = Stream.parse (PR.takeEQ value Fold.drain)
93+takeEQ value = IP.parse (PR.takeEQ value FL.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
94
135−{-# INLINE dropWhile #-}
95+{-# INLINE drainWhile #-}
136−dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
96+drainWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
137−dropWhile value = Stream.parse (PR.dropWhile (<= value))
97+drainWhile value = IP.parse (PR.drainWhile (<= value))
138
98
139−{-# INLINE takeStartBy #-}
99+{-# INLINE sliceBeginWith #-}
140−takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
100+sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
141−takeStartBy value stream = do
101+sliceBeginWith value stream = do
102+ stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream
142− let stream2 = value `Stream.cons` stream
103+ let stream2 = value `S.cons` stream1
143− Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2
104+ IP.parse (PR.sliceBeginWith (== value) FL.drain) stream2
144−
145−takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ())
146−takeFramedByEsc_ _ = Stream.parse parser
147−
148− where
149−
150− isEsc = (== '\\')
151− isBegin = (== '{')
152− isEnd = (== '}')
153−
154− parser = PR.takeFramedByEsc_ isEsc isBegin isEnd Fold.drain
155−
156−{-# INLINE listEqBy #-}
157−listEqBy :: Int -> Stream IO Int -> IO (Either ParseError [Int])
158−listEqBy len = Stream.parse (PR.listEqBy (==) [1 .. len])
159−
160−{-# INLINE streamEqBy #-}
161−streamEqBy :: Int -> Stream IO Int -> IO (Either ParseError ())
162−streamEqBy len = Stream.parse (PR.streamEqBy (==) (Stream.enumerateFromTo 1 len))
163
105
164{-# INLINE takeWhile #-}
106{-# INLINE takeWhile #-}
165−takeWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
107+takeWhile :: MonadCatch m => Int -> SerialT m Int -> m ()
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))
108+takeWhile value = IP.parse (PR.takeWhile (<= value) FL.drain)
171
109
172{-# INLINE takeP #-}
110{-# INLINE takeP #-}
173−takeP :: Monad m => Int -> Stream m a -> m (Either ParseError ())
111+takeP :: MonadCatch m => Int -> SerialT m a -> m ()
174−takeP value = Stream.parse (PR.takeP value (PR.fromFold Fold.drain))
112+takeP value = IP.parse (PR.takeP value (PR.fromFold FL.drain))
175
113
176{-# INLINE groupBy #-}
114{-# INLINE groupBy #-}
177−groupBy :: Monad m => Stream m Int -> m (Either ParseError ())
115+groupBy :: MonadCatch m => SerialT m Int -> m ()
178−groupBy = Stream.parse (PR.groupBy (<=) Fold.drain)
116+groupBy = IP.parse (PR.groupBy (<=) FL.drain)
179
117
180{-# INLINE groupByRolling #-}
118{-# INLINE groupByRolling #-}
181−groupByRolling :: Monad m => Stream m Int -> m (Either ParseError ())
119+groupByRolling :: MonadCatch m => SerialT m Int -> m ()
182−groupByRolling = Stream.parse (PR.groupByRolling (<=) Fold.drain)
120+groupByRolling = IP.parse (PR.groupByRolling (<=) FL.drain)
183
121
184{-# INLINE wordBy #-}
122{-# INLINE wordBy #-}
185−wordBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
123+wordBy :: MonadCatch m => Int -> SerialT m Int -> m ()
186−wordBy value = Stream.parse (PR.wordBy (>= value) Fold.drain)
124+wordBy value = IP.parse (PR.wordBy (>= value) FL.drain)
187−
188−{-# INLINE sepByWords #-}
189−sepByWords :: Monad m => Stream m Int -> m (Either ParseError ())
190−sepByWords = Stream.parse (wrds even Fold.drain)
191− where
192− wrds p = PR.sepBy (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
193−
194−{-# INLINE sepByAllWords #-}
195−sepByAllWords :: Monad m => Stream m Int -> m (Either ParseError ())
196−sepByAllWords = Stream.parse (wrds even Fold.drain)
197− where
198− wrds p = PR.sepByAll (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
199−
200−-- Returning a list to compare with the sepBy1 in ParserK
201−{-# INLINE sepBy1 #-}
202−sepBy1 :: Monad m => Stream m Int -> m (Either ParseError [Int])
203−sepBy1 xs = do
204− Stream.parse (PR.sepBy1 (PR.satisfy odd) (PR.satisfy even) Fold.toList) xs
205−
206−{-# INLINE sepByWords1 #-}
207−sepByWords1 :: Monad m => Stream m Int -> m (Either ParseError ())
208−sepByWords1 = Stream.parse (wrds even Fold.drain)
209− where
210− wrds p = PR.sepBy1 (PR.takeWhile (not . p) Fold.drain) (PR.dropWhile p)
211−
212−{-# INLINE deintercalate #-}
213−deintercalate :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
214−deintercalate _ = Stream.parse (partition even)
215−
216− where
217−
218− partition p =
219− PR.deintercalate
220− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
221−
222−{-# INLINE deintercalate1 #-}
223−deintercalate1 :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
224−deintercalate1 _ = Stream.parse (partition even)
225−
226− where
227−
228− partition p =
229− PR.deintercalate1
230− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
231−
232−{-# INLINE deintercalateAll #-}
233−deintercalateAll :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
234−deintercalateAll _ = Stream.parse (partition even)
235−
236− where
237−
238− partition p =
239− PR.deintercalateAll
240− (PR.takeWhile (not . p) Fold.sum) (PR.takeWhile p Fold.sum) Fold.drain
241
125
242{-# INLINE manyWordByEven #-}
126{-# INLINE manyWordByEven #-}
243−manyWordByEven :: Monad m => Stream m Int -> m (Either ParseError ())
127+manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
244−manyWordByEven = Stream.parse (PR.many (PR.wordBy even Fold.drain) Fold.drain)
128+manyWordByEven = IP.parse (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
245
129
246{-# INLINE many #-}
130{-# INLINE many #-}
247−many :: Monad m => Stream m Int -> m (Either ParseError Int)
131+many :: MonadCatch m => SerialT m Int -> m Int
248−many = Stream.parse (PR.many (PR.satisfy (> 0)) Fold.length)
132+many = IP.parse (PR.many (PR.satisfy (> 0)) FL.length)
249
133
250{-# INLINE manyAlt #-}
134{-# INLINE manyAlt #-}
251−manyAlt :: Monad m => Stream m Int -> m Int
135+manyAlt :: MonadCatch m => SerialT m Int -> m Int
252manyAlt xs = do
136manyAlt xs = do
253− x <- Stream.parse (AP.many (PR.satisfy (> 0))) xs
137+ x <- IP.parse (AP.many (PR.satisfy (> 0))) xs
254 return $ Prelude.length x
138 return $ Prelude.length x
255
139
256{-# INLINE some #-}
140{-# INLINE some #-}
257−some :: Monad m => Stream m Int -> m (Either ParseError Int)
141+some :: MonadCatch m => SerialT m Int -> m Int
258−some = Stream.parse (PR.some (PR.satisfy (> 0)) Fold.length)
142+some = IP.parse (PR.some (PR.satisfy (> 0)) FL.length)
259
143
260{-# INLINE someAlt #-}
144{-# INLINE someAlt #-}
261−someAlt :: Monad m => Stream m Int -> m Int
145+someAlt :: MonadCatch m => SerialT m Int -> m Int
262someAlt xs = do
146someAlt xs = do
263− x <- Stream.parse (AP.some (PR.satisfy (> 0))) xs
147+ x <- IP.parse (AP.some (PR.satisfy (> 0))) xs
264 return $ Prelude.length x
148 return $ Prelude.length x
265
149
266{-# INLINE manyTill #-}
150{-# INLINE manyTill #-}
267−manyTill :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
151+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
268manyTill value =
152manyTill value =
269− Stream.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) Fold.length)
153+ IP.parse (PR.manyTill (PR.satisfy (> 0)) (PR.satisfy (== value)) FL.length)
270
154
271−{-# INLINE splitAp2 #-}
155+{-# INLINE splitAp #-}
272−splitAp2 :: Monad m
156+splitAp :: MonadCatch m
273− => Int -> Stream m Int -> m (Either ParseError ((), ()))
157+ => Int -> SerialT m Int -> m ((), ())
274−splitAp2 value =
158+splitAp value =
275− Stream.parse
159+ IP.parse
276 ((,)
160 ((,)
277− <$> PR.dropWhile (<= (value `div` 2))
161+ <$> PR.drainWhile (<= (value `div` 2))
278− <*> PR.dropWhile (<= value)
162+ <*> PR.drainWhile (<= value)
279− )
280−
281−{-# INLINE splitAp4 #-}
282−splitAp4 :: Monad m
283− => Int -> Stream m Int -> m (Either ParseError ())
284−splitAp4 value =
285− Stream.parse
286− ( (\() () () () -> ())
287− <$> PR.dropWhile (<= (value * 1 `div` 4))
288− <*> PR.dropWhile (<= (value * 2 `div` 4))
289− <*> PR.dropWhile (<= (value * 3 `div` 4))
290− <*> PR.dropWhile (<= value)
291− )
292−
293−{-# INLINE splitAp8 #-}
294−splitAp8 :: Monad m
295− => Int -> Stream m Int -> m (Either ParseError ())
296−splitAp8 value =
297− Stream.parse
298− ( (\() () () () () () () () -> ())
299− <$> PR.dropWhile (<= (value * 1 `div` 8))
300− <*> PR.dropWhile (<= (value * 2 `div` 8))
301− <*> PR.dropWhile (<= (value * 3 `div` 8))
302− <*> PR.dropWhile (<= (value * 4 `div` 8))
303− <*> PR.dropWhile (<= (value * 5 `div` 8))
304− <*> PR.dropWhile (<= (value * 6 `div` 8))
305− <*> PR.dropWhile (<= (value * 7 `div` 8))
306− <*> PR.dropWhile (<= value)
307 )
163 )
308
164
309{-# INLINE splitApBefore #-}
165{-# INLINE splitApBefore #-}
310−splitApBefore :: Monad m
166+splitApBefore :: MonadCatch m
311− => Int -> Stream m Int -> m (Either ParseError ())
167+ => Int -> SerialT m Int -> m ()
312splitApBefore value =
168splitApBefore value =
313− Stream.parse
169+ IP.parse
314− ( PR.dropWhile (<= (value `div` 2))
170+ ( PR.drainWhile (<= (value `div` 2))
315− *> PR.dropWhile (<= value)
171+ *> PR.drainWhile (<= value)
316 )
172 )
317
173
318{-# INLINE splitApAfter #-}
174{-# INLINE splitApAfter #-}
319−splitApAfter :: Monad m
175+splitApAfter :: MonadCatch m
320− => Int -> Stream m Int -> m (Either ParseError ())
176+ => Int -> SerialT m Int -> m ()
321splitApAfter value =
177splitApAfter value =
322− Stream.parse
178+ IP.parse
323− ( PR.dropWhile (<= (value `div` 2))
179+ ( PR.drainWhile (<= (value `div` 2))
324− <* PR.dropWhile (<= value)
180+ <* PR.drainWhile (<= value)
325 )
181 )
326
182
327−{-# INLINE splitWith2 #-}
183+{-# INLINE serialWith #-}
328−splitWith2 :: Monad m
184+serialWith :: MonadCatch m
329− => Int -> Stream m Int -> m (Either ParseError ((), ()))
185+ => Int -> SerialT m Int -> m ((), ())
330−splitWith2 value =
186+serialWith value =
331− Stream.parse
187+ IP.parse
332− (PR.splitWith (,)
188+ (PR.serialWith (,)
333− (PR.dropWhile (<= (value `div` 2)))
189+ (PR.drainWhile (<= (value `div` 2)))
334− (PR.dropWhile (<= value))
190+ (PR.drainWhile (<= value))
335 )
191 )
336
192
337{-# INLINE split_ #-}
193{-# INLINE split_ #-}
338−split_ :: Monad m
194+split_ :: MonadCatch m
339− => Int -> Stream m Int -> m (Either ParseError ())
195+ => Int -> SerialT m Int -> m ()
340split_ value =
196split_ value =
341− Stream.parse
197+ IP.parse
342 (PR.split_
198 (PR.split_
343− (PR.dropWhile (<= (value `div` 2)))
199+ (PR.drainWhile (<= (value `div` 2)))
344− (PR.dropWhile (<= value))
200+ (PR.drainWhile (<= value))
345 )
201 )
346
202
347−-- XXX dropWhile with applicative does not fuse
203+{-# INLINE sliceSepByP #-}
348−-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"
204+sliceSepByP :: MonadCatch m
349−{-# INLINE takeWhileFail #-}
205+ => Int -> SerialT m Int -> m()
350−takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
206+sliceSepByP value = IP.parse (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
351−takeWhileFail predicate (Fold fstep finitial _ ffinal) =
352− Parser step initial extract
353−
354− where
355−
356− initial = do
357− res <- finitial
358− return $ case res of
359− Fold.Partial s -> IPartial s
360− Fold.Done b -> IDone b
361−
362− step s a =
363− if predicate a
364− then do
365− fres <- fstep s a
366− return
367− $ case fres of
368− Fold.Partial s1 -> Partial 0 s1
369− Fold.Done b -> Done 0 b
370− else return $ Error "fail"
371−
372− extract s = fmap (Done 0) (ffinal s)
373−
374−{-# INLINE alt2 #-}
375−alt2 :: Monad m
376− => Int -> Stream m Int -> m (Either ParseError ())
377−alt2 value =
378− Stream.parse
379− (PR.alt
380− (takeWhileFail (<= (value `div` 2)) Fold.drain)
381− (PR.dropWhile (<= value))
382− )
383−
384−{-# INLINE alt4 #-}
385−alt4 :: Monad m
386− => Int -> Stream m Int -> m (Either ParseError ())
387−alt4 value =
388− Stream.parse
389− ( takeWhileFail (<= (value * 1 `div` 4)) Fold.drain
390− <|> takeWhileFail (<= (value * 2 `div` 4)) Fold.drain
391− <|> takeWhileFail (<= (value * 3 `div` 4)) Fold.drain
392− <|> PR.dropWhile (<= value)
393− )
394−
395−{-# INLINE alt8 #-}
396−alt8 :: Monad m
397− => Int -> Stream m Int -> m (Either ParseError ())
398−alt8 value =
399− Stream.parse
400− ( takeWhileFail (<= (value * 1 `div` 8)) Fold.drain
401− <|> takeWhileFail (<= (value * 2 `div` 8)) Fold.drain
402− <|> takeWhileFail (<= (value * 3 `div` 8)) Fold.drain
403− <|> takeWhileFail (<= (value * 4 `div` 8)) Fold.drain
404− <|> takeWhileFail (<= (value * 5 `div` 8)) Fold.drain
405− <|> takeWhileFail (<= (value * 6 `div` 8)) Fold.drain
406− <|> takeWhileFail (<= (value * 7 `div` 8)) Fold.drain
407− <|> PR.dropWhile (<= value)
408− )
409−
410−{-# INLINE alt16 #-}
411−alt16 :: Monad m
412− => Int -> Stream m Int -> m (Either ParseError ())
413−alt16 value =
414− Stream.parse
415− ( takeWhileFail (<= (value * 1 `div` 16)) Fold.drain
416− <|> takeWhileFail (<= (value * 2 `div` 16)) Fold.drain
417− <|> takeWhileFail (<= (value * 3 `div` 16)) Fold.drain
418− <|> takeWhileFail (<= (value * 4 `div` 16)) Fold.drain
419− <|> takeWhileFail (<= (value * 5 `div` 16)) Fold.drain
420− <|> takeWhileFail (<= (value * 6 `div` 16)) Fold.drain
421− <|> takeWhileFail (<= (value * 8 `div` 16)) Fold.drain
422− <|> takeWhileFail (<= (value * 9 `div` 16)) Fold.drain
423− <|> takeWhileFail (<= (value * 10 `div` 16)) Fold.drain
424− <|> takeWhileFail (<= (value * 11 `div` 16)) Fold.drain
425− <|> takeWhileFail (<= (value * 12 `div` 16)) Fold.drain
426− <|> takeWhileFail (<= (value * 13 `div` 16)) Fold.drain
427− <|> takeWhileFail (<= (value * 14 `div` 16)) Fold.drain
428− <|> takeWhileFail (<= (value * 15 `div` 16)) Fold.drain
429− <|> PR.dropWhile (<= value)
430− )
431
207
432−{-# INLINE altSmall #-}
433−altSmall :: Monad m
434− => Int -> Stream m Int -> m ()
435−altSmall value =
436− Stream.fold Fold.drain .
437− Stream.parseMany
438− (PR.alt
439− (PR.satisfy (>= value) *> PR.die "alt")
440− (PR.satisfy (<= value))
441− )
442−
443−{-# INLINE monad #-}
444−monad :: Monad m
445− => Int -> Stream m Int -> m (Either ParseError ())
446−monad value =
447− Stream.parse
448− $ do
449− PR.dropWhile (<= (value `div` 2))
450− PR.dropWhile (<= value)
451−
452−{-# INLINE monad4 #-}
453−monad4 :: Monad m
454− => Int -> Stream m Int -> m (Either ParseError ())
455−monad4 value =
456− Stream.parse $ do
457− PR.dropWhile (<= (value `div` 4))
458− PR.dropWhile (<= (value `div` 2))
459− PR.dropWhile (<= (value * 3 `div` 4))
460− PR.dropWhile (<= value)
461−
462−{-# INLINE monad8 #-}
463−monad8 :: Monad m
464− => Int -> Stream m Int -> m (Either ParseError ())
465−monad8 value =
466− Stream.parse $ do
467− PR.dropWhile (<= (value * 1 `div` 8))
468− PR.dropWhile (<= (value * 2 `div` 8))
469− PR.dropWhile (<= (value * 3 `div` 8))
470− PR.dropWhile (<= (value * 4 `div` 8))
471− PR.dropWhile (<= (value * 5 `div` 8))
472− PR.dropWhile (<= (value * 6 `div` 8))
473− PR.dropWhile (<= (value * 7 `div` 8))
474− PR.dropWhile (<= value)
475−
476−{-# INLINE monad16 #-}
477−monad16 :: Monad m
478− => Int -> Stream m Int -> m (Either ParseError ())
479−monad16 value =
480− Stream.parse $ do
481− PR.dropWhile (<= (value * 1 `div` 16))
482− PR.dropWhile (<= (value * 2 `div` 16))
483− PR.dropWhile (<= (value * 3 `div` 16))
484− PR.dropWhile (<= (value * 4 `div` 16))
485− PR.dropWhile (<= (value * 5 `div` 16))
486− PR.dropWhile (<= (value * 6 `div` 16))
487− PR.dropWhile (<= (value * 7 `div` 16))
488− PR.dropWhile (<= (value * 8 `div` 16))
489− PR.dropWhile (<= (value * 9 `div` 16))
490− PR.dropWhile (<= (value * 10 `div` 16))
491− PR.dropWhile (<= (value * 11 `div` 16))
492− PR.dropWhile (<= (value * 12 `div` 16))
493− PR.dropWhile (<= (value * 13 `div` 16))
494− PR.dropWhile (<= (value * 14 `div` 16))
495− PR.dropWhile (<= (value * 15 `div` 16))
496− PR.dropWhile (<= value)
497−
498−{-# INLINE takeEndBy_ #-}
499−takeEndBy_ :: Monad m
500− => Int -> Stream m Int -> m (Either ParseError ())
501−takeEndBy_ value = Stream.parse (PR.takeEndBy_ (>= value) (PR.fromFold Fold.drain))
502−
503−{-
504{-# INLINE teeAllAny #-}
208{-# INLINE teeAllAny #-}
505−teeAllAny :: Monad m
209+teeAllAny :: MonadCatch m
506− => Int -> Stream m Int -> m ((), ())
210+ => Int -> SerialT m Int -> m ((), ())
507teeAllAny value =
211teeAllAny value =
508− Stream.parse
212+ IP.parse
509 (PR.teeWith (,)
213 (PR.teeWith (,)
510− (PR.dropWhile (<= value))
214+ (PR.drainWhile (<= value))
511− (PR.dropWhile (<= value))
215+ (PR.drainWhile (<= value))
512 )
216 )
513
217
514{-# INLINE teeFstAllAny #-}
218{-# INLINE teeFstAllAny #-}
515−teeFstAllAny :: Monad m
219+teeFstAllAny :: MonadCatch m
516− => Int -> Stream m Int -> m ((), ())
220+ => Int -> SerialT m Int -> m ((), ())
517teeFstAllAny value =
221teeFstAllAny value =
518− Stream.parse
222+ IP.parse
519 (PR.teeWithFst (,)
223 (PR.teeWithFst (,)
520− (PR.dropWhile (<= value))
224+ (PR.drainWhile (<= value))
521− (PR.dropWhile (<= value))
225+ (PR.drainWhile (<= value))
522 )
226 )
523
227
524{-# INLINE shortestAllAny #-}
228{-# INLINE shortestAllAny #-}
525−shortestAllAny :: Monad m
229+shortestAllAny :: MonadCatch m
526− => Int -> Stream m Int -> m (Either ParseError ())
230+ => Int -> SerialT m Int -> m ()
527shortestAllAny value =
231shortestAllAny value =
528− Stream.parse
232+ IP.parse
529 (PR.shortest
233 (PR.shortest
530− (PR.dropWhile (<= value))
234+ (PR.drainWhile (<= value))
531− (PR.dropWhile (<= value))
235+ (PR.drainWhile (<= value))
532 )
236 )
533
237
534{-# INLINE longestAllAny #-}
238{-# INLINE longestAllAny #-}
535−longestAllAny :: Monad m
239+longestAllAny :: MonadCatch m
536− => Int -> Stream m Int -> m (Either ParseError ())
240+ => Int -> SerialT m Int -> m ()
537longestAllAny value =
241longestAllAny value =
538− Stream.parse
242+ IP.parse
539 (PR.longest
243 (PR.longest
540− (PR.dropWhile (<= value))
244+ (PR.drainWhile (<= value))
541− (PR.dropWhile (<= value))
245+ (PR.drainWhile (<= value))
542 )
246 )
543−-}
247+
248+parseManyChunksOfSum :: Int -> Handle -> IO Int
249+parseManyChunksOfSum n inh =
250+ S.length
251+ $ IP.parseMany
252+ (PR.fromFold $ FL.take n FL.sum)
253+ (S.unfold Handle.read inh)
544
254
545-------------------------------------------------------------------------------
255-------------------------------------------------------------------------------
546−-- Spanning
256+-- Parsing with unfolds
547-------------------------------------------------------------------------------
257-------------------------------------------------------------------------------
548
258
549−{-# INLINE span #-}
259+{-# INLINE parseManyUnfoldArrays #-}
550−span :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
260+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
551−span value = Stream.parse (PR.span (<= (value `div` 2)) Fold.drain Fold.drain)
261+parseManyUnfoldArrays count arrays = do
552−
262+ let src = Source.source (Just (Producer.OuterLoop arrays))
553−{-# INLINE spanBy #-}
554−spanBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
555−spanBy value =
556− Stream.parse (PR.spanBy (\_ i -> i <= (value `div` 2)) Fold.drain Fold.drain)
557−
558−{-# INLINE spanByRolling #-}
559−spanByRolling :: Monad m => Int -> Stream m Int -> m (Either ParseError ((), ()))
560−spanByRolling value =
561− Stream.parse (PR.spanByRolling (\_ i -> i <= value `div` 2) Fold.drain Fold.drain)
562−
563−parseManyChunksOfSum :: Int -> Handle -> IO Int
564−parseManyChunksOfSum n inh =
565− Stream.fold Fold.length
566− $ Stream.parseMany
567− (PR.fromFold $ Fold.take n Fold.sum)
263+ let parser = PR.fromFold (FL.take count FL.drain)
568− (Stream.unfold Handle.reader inh)
264+ let readSrc =
265+ Source.producer
266+ $ Producer.concat Producer.fromList Array.producer
267+ let streamParser =
268+ Producer.simplify (Source.parseMany parser readSrc)
269+ S.drain $ S.unfold streamParser src
569
270
570-------------------------------------------------------------------------------
271-------------------------------------------------------------------------------
571-- Parsers in which -fspec-constr-recursive=16 is problematic
272-- Parsers in which -fspec-constr-recursive=16 is problematic
@@ -576,129 +277,63 @@ parseManyChunksOfSum n inh =
576-- not have to rely on it.
277-- not have to rely on it.
577--
278--
578{-# INLINE lookAhead #-}
279{-# INLINE lookAhead #-}
579−lookAhead :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
280+lookAhead :: MonadCatch m => Int -> SerialT m Int -> m ()
580lookAhead value =
281lookAhead value =
581− Stream.parse (PR.lookAhead (PR.takeWhile (<= value) Fold.drain) $> ())
282+ IP.parse (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
582−
583−-- XXX The timing of this increased 3x after the stepify extract changes.
584−{-# INLINE sequenceA_ #-}
585−sequenceA_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
586−sequenceA_ value =
587− Stream.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
588
283
589−-- quadratic complexity
590{-# INLINE sequenceA #-}
284{-# INLINE sequenceA #-}
591−sequenceA :: Monad m => Int -> Stream m Int -> m Int
285+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
592sequenceA value xs = do
286sequenceA value xs = do
593− x <- Stream.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
287+ x <- IP.parse (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
594 return $ length x
288 return $ length x
595
289
596−-- quadratic complexity
290+{-# INLINE sequenceA_ #-}
291+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
292+sequenceA_ value =
293+ IP.parse (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
294+
597{-# INLINE sequence #-}
295{-# INLINE sequence #-}
598−sequence :: Monad m => Int -> Stream m Int -> m Int
296+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
599sequence value xs = do
297sequence value xs = do
600− x <- Stream.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
298+ x <- IP.parse (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
601 return $ length x
299 return $ length x
602
300
603{-# INLINE sequence_ #-}
301{-# INLINE sequence_ #-}
604−sequence_ :: Monad m => Int -> Stream m Int -> m (Either ParseError ())
302+sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
605−sequence_ value xs =
303+sequence_ value =
606− Stream.parse (foldr f (return ()) (replicate value (PR.takeBetween 0 1 Fold.drain))) xs
304+ IP.parse (F.sequence_ $ replicate value (PR.satisfy (> 0)))
607
305
608− where
609−
610− {-# INLINE f #-}
611− f m k = m >>= (\_ -> k)
612−
613−-- choice using the "Alternative" instance with direct style parser type has
614−-- quadratic performance complexity.
615−--
616{-# INLINE choiceAsum #-}
306{-# INLINE choiceAsum #-}
617−choiceAsum :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
307+choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
618choiceAsum value =
308choiceAsum value =
619− Stream.parse (F.asum (replicate value (PR.satisfy (< 0)))
309+ IP.parse (asum (replicate value (PR.satisfy (< 0)))
620 AP.<|> PR.satisfy (> 0))
310 AP.<|> PR.satisfy (> 0))
621
311
622−{-
623{-# INLINE choice #-}
312{-# INLINE choice #-}
624−choice :: Monad m => Int -> Stream m Int -> m (Either ParseError Int)
313+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
625choice value =
314choice value =
626− Stream.parse
315+ IP.parse
627 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
316 (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
628−-}
629−
630−-------------------------------------------------------------------------------
631−-- Parsing with unfolds
632−-------------------------------------------------------------------------------
633−
634−{-# INLINE parseManyUnfoldArrays #-}
635−parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
636−parseManyUnfoldArrays count arrays = do
637− let src = Producer.source (Just (Producer.OuterLoop arrays))
638− let parser = PR.fromFold (Fold.take count Fold.drain)
639− let readSrc =
640− Producer.producer
641− $ Producer.concat Producer.fromList Array.producer
642− let streamParser =
643− Producer.simplify (Producer.parseMany parser readSrc)
644− Stream.fold Fold.drain $ Stream.unfold streamParser src
645
317
646-------------------------------------------------------------------------------
318-------------------------------------------------------------------------------
647-- Stream transformation
319-- Stream transformation
648-------------------------------------------------------------------------------
320-------------------------------------------------------------------------------
649
321
650{-# INLINE parseMany #-}
322{-# INLINE parseMany #-}
651−parseMany :: Monad m => Int -> Stream m Int -> m ()
323+parseMany :: MonadCatch m => Int -> SerialT m Int -> m ()
652parseMany n =
324parseMany n =
653− Stream.fold Fold.drain
325+ S.drain
654− . fmap getSum
326+ . S.map getSum
655− . Stream.catRights . Stream.parseMany (PR.fromFold $ Fold.take n Fold.mconcat)
327+ . IP.parseMany (PR.fromFold $ FL.take n FL.mconcat)
656− . fmap Sum
328+ . S.map Sum
657−
658−{-# INLINE parseManyGroupBy #-}
659−parseManyGroupBy :: Monad m => (Int -> Int -> Bool) -> Stream m Int -> m ()
660−parseManyGroupBy cmp =
661− Stream.fold Fold.drain . Stream.parseMany (PR.groupBy cmp Fold.drain)
662−
663−{-# INLINE parseManyGroupsRolling #-}
664−parseManyGroupsRolling :: Monad m => Bool -> Stream m Int -> m ()
665−parseManyGroupsRolling b =
666− Stream.fold Fold.drain
667− . Stream.parseMany (PR.groupByRolling (\_ _ -> b) Fold.drain)
668−
669−{-# INLINE parseManyGroupsRollingEither #-}
670−parseManyGroupsRollingEither :: Monad m =>
671− (Int -> Int -> Bool) -> Int -> m ()
672−parseManyGroupsRollingEither cmp value = do
673− sourceUnfoldrM value 1
674− & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)
675− & Stream.fold Fold.drain
676−
677−{-# INLINE parseManyGroupsRollingEitherAlt #-}
678−parseManyGroupsRollingEitherAlt :: Monad m =>
679− (Int -> Int -> Bool) -> Int -> m ()
680−parseManyGroupsRollingEitherAlt cmp value = do
681− sourceUnfoldrM value 1
682− -- Make the input unsorted.
683− & fmap (\x -> if even x then x + 2 else x)
684− & Stream.parseMany (PR.groupByRollingEither cmp Fold.drain Fold.drain)
685− & Stream.fold Fold.drain
686
329
687{-# INLINE parseIterate #-}
330{-# INLINE parseIterate #-}
688−parseIterate :: Monad m => Int -> Stream m Int -> m ()
331+parseIterate :: MonadCatch m => Int -> SerialT m Int -> m ()
689parseIterate n =
332parseIterate n =
690− Stream.fold Fold.drain
333+ S.drain
691− . fmap getSum
334+ . S.map getSum
692− . Stream.catRights
693− . Stream.parseIterate
694− (PR.fromFold . Fold.take n . Fold.sconcat)
335+ . IP.parseIterate (PR.fromFold . FL.take n . FL.sconcat) (Sum 0)
695− (Sum 0)
336+ . 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
702
337
703-------------------------------------------------------------------------------
338-------------------------------------------------------------------------------
704-- Benchmarks
339-- Benchmarks
@@ -707,95 +342,42 @@ concatSequence =
707moduleName :: String
342moduleName :: String
708moduleName = "Data.Parser"
343moduleName = "Data.Parser"
709
344
710−instance NFData ParseError where
711− {-# INLINE rnf #-}
712− rnf (ParseError x) = rnf x
713−
714o_1_space_serial :: Int -> [Benchmark]
345o_1_space_serial :: Int -> [Benchmark]
715o_1_space_serial value =
346o_1_space_serial value =
347+ [ benchIOSink value "next" $ next value
716− [ benchIOSink value "takeBetween" $ takeBetween value
348+ , benchIOSink value "takeBetween" $ takeBetween value
349+ , benchIOSink value "takeEQ" $ takeEQ value
717 , benchIOSink value "takeWhile" $ takeWhile value
350 , benchIOSink value "takeWhile" $ takeWhile value
718− , benchIOSink value "takeWhileP" $ takeWhileP value
719 , benchIOSink value "takeP" $ takeP value
351 , benchIOSink value "takeP" $ takeP value
720− , benchIOSink value "dropWhile" $ dropWhile value
352+ , benchIOSink value "drainWhile" $ drainWhile value
721− , benchIOSink value "takeStartBy" $ takeStartBy value
722− , benchIOSink value "takeEndBy_" $ takeEndBy_ value
353+ , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
723 , benchIOSink value "groupBy" $ groupBy
354 , benchIOSink value "groupBy" $ groupBy
724 , benchIOSink value "groupByRolling" $ groupByRolling
355 , benchIOSink value "groupByRolling" $ groupByRolling
725 , benchIOSink value "wordBy" $ wordBy value
356 , benchIOSink value "wordBy" $ wordBy value
726− , benchIOSink value "sepBy (words)" sepByWords
357+ , benchIOSink value "splitAp" $ splitAp value
727− , benchIOSink value "sepByAll (words)" sepByAllWords
728− , benchIOSink value "sepBy1 (words)" sepByWords1
729− , benchIOSink value "deintercalate" $ deintercalate value
730− , benchIOSink value "deintercalate1" $ deintercalate1 value
731− , benchIOSink value "deintercalateAll" $ deintercalateAll value
732− -- Applicative and Monad
733− , benchIOSink value "splitAp2" $ splitAp2 value
734− , benchIOSink value "splitAp4" $ splitAp4 value
735− , benchIOSink value "splitAp8" $ splitAp8 value
736 , benchIOSink value "splitApBefore" $ splitApBefore value
358 , benchIOSink value "splitApBefore" $ splitApBefore value
737 , benchIOSink value "splitApAfter" $ splitApAfter value
359 , benchIOSink value "splitApAfter" $ splitApAfter value
738− , benchIOSink value "splitWith2" $ splitWith2 value
360+ , benchIOSink value "serialWith" $ serialWith value
739− , benchIOSink value "span" $ span value
740− , benchIOSink value "spanBy" $ spanBy value
741− , benchIOSink value "spanByRolling" $ spanByRolling value
742− , benchIOSink value "monad2" $ monad value
743− , benchIOSink value "monad4" $ monad4 value
744− , benchIOSink value "monad8" $ monad8 value
745− -- Alternative
746− , benchIOSink value "alt2parseMany" $ altSmall value
747− , benchIOSink value "alt2" $ alt2 value
748− , benchIOSink value "alt4" $ alt4 value
749− , benchIOSink value "alt8" $ alt8 value
750− , benchIOSink value "alt16" $ alt16 value
361+ , benchIOSink value "sliceSepByP" $ sliceSepByP value
751 , benchIOSink value "many" many
362 , benchIOSink value "many" many
752 , benchIOSink value "many (wordBy even)" $ manyWordByEven
363 , benchIOSink value "many (wordBy even)" $ manyWordByEven
753 , benchIOSink value "some" some
364 , benchIOSink value "some" some
754 , benchIOSink value "manyTill" $ manyTill value
365 , benchIOSink value "manyTill" $ manyTill value
755− , benchIOSink value "parseMany" $ parseMany value
756− , benchIOSink value "parseMany (take 1)" (parseMany 1)
757− , benchIOSink value "parseMany (take all)" (parseMany value)
758− , benchIOSink value "parseMany (groupBy (<))" (parseManyGroupBy (<))
759− , benchIOSink value "parseMany (groupBy (==))" (parseManyGroupBy (==))
760− , benchIOSink value "parseMany groupRollingBy (bound groups)"
761− $ parseManyGroupsRolling False
762− , benchIOSink value "parseMany groupRollingBy (1 group)"
763− $ parseManyGroupsRolling True
764− , bench "parseMany groupRollingByEither (Left)"
765− $ nfIO $ parseManyGroupsRollingEitherLeft
766− , bench "parseMany groupRollingByEither (Right)"
767− $ nfIO $ parseManyGroupsRollingEitherRight
768− , bench "parseMany groupRollingByEither (Alternating)"
769− $ nfIO $ parseManyGroupsRollingEitherAlt1
770− , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
771− , benchIOSink value "parseIterate (take all)" (parseIterate value)
772− , benchIOSink value "concatSequence" concatSequence
773− {-
774 , benchIOSink value "tee" $ teeAllAny value
366 , benchIOSink value "tee" $ teeAllAny value
775 , benchIOSink value "teeFst" $ teeFstAllAny value
367 , benchIOSink value "teeFst" $ teeFstAllAny value
776 , benchIOSink value "shortest" $ shortestAllAny value
368 , benchIOSink value "shortest" $ shortestAllAny value
777 , benchIOSink value "longest" $ longestAllAny value
369 , benchIOSink value "longest" $ longestAllAny value
778− -}
370+ , benchIOSink value "parseMany (take 1)" (parseMany 1)
779− , benchIOSink value "streamEqBy" (streamEqBy value)
371+ , benchIOSink value "parseMany (take all)" (parseMany value)
372+ , benchIOSink value "parseIterate (take 1)" (parseIterate 1)
373+ , benchIOSink value "parseIterate (take all)" (parseIterate value)
780 ]
374 ]
781
375
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−
794o_1_space_filesystem :: BenchEnv -> [Benchmark]
376o_1_space_filesystem :: BenchEnv -> [Benchmark]
795o_1_space_filesystem env =
377o_1_space_filesystem env =
796− [ mkBench ("S.parseMany (Fold.take " ++ show (bigSize env) ++ " Fold.sum)") env
378+ [ mkBench ("S.parseMany (FL.take " ++ show (bigSize env) ++ " FL.sum)") env
797 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
379 $ \inh _ -> noinline parseManyChunksOfSum (bigSize env) inh
798− , mkBench "S.parseMany (Fold.take 1 Fold.sum)" env
380+ , mkBench "S.parseMany (FL.take 1 FL.sum)" env
799 $ \inh _ -> inline parseManyChunksOfSum 1 inh
381 $ \inh _ -> inline parseManyChunksOfSum 1 inh
800 ]
382 ]
801
383
@@ -810,38 +392,26 @@ o_1_space_serial_unfold bound arrays =
810o_n_heap_serial :: Int -> [Benchmark]
392o_n_heap_serial :: Int -> [Benchmark]
811o_n_heap_serial value =
393o_n_heap_serial value =
812 [
394 [
813− benchIOSink value "takeEQ" $ takeEQ value
814− , benchIOSink value "takeGE" $ takeGE value
815−
816 -- lookahead benchmark holds the entire input till end
395 -- lookahead benchmark holds the entire input till end
817− , benchIOSink value "lookAhead" $ lookAhead value
396+ benchIOSink value "lookAhead" $ lookAhead value
818
397
819− -- o-n-heap because of backtracking
398+ -- accumulates the results in a list
820− , benchIOSrc sourceEscapedFrames value "takeFramedByEsc_"
399+ , benchIOSink value "sequence" $ sequence value
821− $ takeFramedByEsc_ value
400+ , benchIOSink value "sequenceA" $ sequenceA value
822
401
402+ -- XXX why should this take O(n) heap, it discards the results?
403+ , benchIOSink value "sequence_" $ sequence_ value
404+ , benchIOSink value "sequenceA_" $ sequenceA_ value
823 -- non-linear time complexity (parserD)
405 -- non-linear time complexity (parserD)
824 , benchIOSink value "split_" $ split_ value
406 , benchIOSink value "split_" $ split_ value
825− -- XXX Takes lot of space when run on a long stream, why?
407+ -- XXX why O(n) heap?
826− , benchIOSink value "monad16" $ monad16 value
408+ , benchIOSink value "choice (asum)" $ choiceAsum value
409+ , benchIOSink value "choice" $ choice value
827
410
828 -- These show non-linear time complexity.
411 -- These show non-linear time complexity.
829 -- They accumulate the results in a list.
412 -- They accumulate the results in a list.
830− , benchIOSink value "sepBy1" sepBy1
831 , benchIOSink value "manyAlt" manyAlt
413 , benchIOSink value "manyAlt" manyAlt
832 , benchIOSink value "someAlt" someAlt
414 , benchIOSink value "someAlt" someAlt
833− , benchIOSink value "listEqBy" (listEqBy value)
834− ]
835−
836−-- accumulate results in a list in IO
837−o_n_space_serial :: Int -> [Benchmark]
838−o_n_space_serial value =
839− [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
840− , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
841− , benchIOSink value "sequence/100" $ sequence (value `div` 100)
842− , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
843− , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
844− -- , benchIOSink value "choice/100" $ choice (value `div` 100)
845 ]
415 ]
846
416
847-------------------------------------------------------------------------------
417-------------------------------------------------------------------------------
@@ -850,13 +420,12 @@ o_n_space_serial value =
850
420
851main :: IO ()
421main :: IO ()
852main = do
422main = do
853−#ifndef FUSION_CHECK
854 env <- mkHandleBenchEnv
423 env <- mkHandleBenchEnv
855 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
424 runWithCLIOptsEnv defaultStreamSize alloc (allBenchmarks env)
856
425
857 where
426 where
858
427
859− alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0
428+ alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
860
429
861 allBenchmarks env arrays value =
430 allBenchmarks env arrays value =
862 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
431 [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
@@ -866,22 +435,4 @@ main = do
866 , bgroup (o_1_space_prefix moduleName)
435 , bgroup (o_1_space_prefix moduleName)
867 (o_1_space_serial_unfold value arrays)
436 (o_1_space_serial_unfold value arrays)
868 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
437 , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
869− , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
870 ]
438 ]
871−#else
872− -- Enable FUSION_CHECK macro at the beginning of the file
873− -- Enable one benchmark below, and run the benchmark
874− -- Check the .dump-simpl output
875− let value = 100000
876− -- let input = sourceUnfoldrM value 1
877− -- manyTill value input
878− -- deintercalate value input
879− -- deintercalate1 value input
880− -- deintercalateAll value input
881− -- sepByWords input
882− -- sepByAllWords input
883− -- sepBy1 input
884− -- sepByWords1 input
885− takeFramedByEsc_ value (sourceEscapedFrames value 1)
886− return ()
887−#endif
benchmark/Streamly/Benchmark/Data/Parser/ParserD.hsnew file+417
@@ -0,0 +1,417 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ParserD
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# OPTIONS_GHC -fspec-constr-recursive=4 #-}
11+
12+module Main
13+ (
14+ main
15+ ) where
16+
17+import Control.DeepSeq (NFData(..))
18+import Control.Monad.Catch (MonadCatch, MonadThrow)
19+import Data.Foldable (asum)
20+import Data.Functor (($>))
21+import Data.Maybe (fromMaybe)
22+import System.Random (randomRIO)
23+import Prelude hiding (any, all, take, sequence, sequenceA, sequence_, takeWhile, span)
24+
25+import qualified Data.Traversable as TR
26+import qualified Data.Foldable as F
27+import qualified Control.Applicative as AP
28+import qualified Streamly.Prelude as S
29+import qualified Streamly.Internal.Data.Array.Foreign as Array
30+import qualified Streamly.Internal.Data.Fold as FL
31+import qualified Streamly.Internal.Data.Parser.ParserD as PR
32+import qualified Streamly.Internal.Data.Producer as Producer
33+import qualified Streamly.Internal.Data.Producer.Source as Source
34+import qualified Streamly.Internal.Data.Stream.IsStream as IP
35+
36+import Gauge
37+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
38+import Streamly.Benchmark.Common
39+
40+-------------------------------------------------------------------------------
41+-- Utilities
42+-------------------------------------------------------------------------------
43+
44+-- XXX these can be moved to the common module
45+
46+{-# INLINE sourceUnfoldrM #-}
47+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
48+sourceUnfoldrM value n = S.unfoldrM step n
49+ where
50+ step cnt =
51+ if cnt > n + value
52+ then return Nothing
53+ else return (Just (cnt, cnt + 1))
54+
55+-- | Takes a fold method, and uses it with a default source.
56+{-# INLINE benchIOSink #-}
57+benchIOSink
58+ :: (IsStream t, NFData b)
59+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
60+benchIOSink value name f =
61+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
62+
63+-- Make the input unsorted.
64+{-# INLINE benchIOSinkRandom #-}
65+benchIOSinkRandom
66+ :: (IsStream t, NFData b)
67+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
68+benchIOSinkRandom value name f =
69+ bench name $ nfIO $ randomRIO (1,1)
70+ >>= f
71+ . S.map (\x -> if even x then x + 2 else x)
72+ . sourceUnfoldrM value
73+
74+-------------------------------------------------------------------------------
75+-- Parsers
76+-------------------------------------------------------------------------------
77+
78+{-# INLINE drainWhile #-}
79+drainWhile :: MonadThrow m => (a -> Bool) -> PR.Parser m a ()
80+drainWhile p = PR.takeWhile p FL.drain
81+
82+{-# INLINE sliceBeginWith #-}
83+sliceBeginWith :: MonadCatch m => Int -> SerialT m Int -> m ()
84+sliceBeginWith value stream = do
85+ stream1 <- return . fromMaybe (S.fromPure (value + 1)) =<< S.tail stream
86+ let stream2 = value `S.cons` stream1
87+ IP.parseD (PR.sliceBeginWith (== value) FL.drain) stream2
88+
89+{-# INLINE takeWhile #-}
90+takeWhile :: MonadThrow m => Int -> SerialT m Int -> m ()
91+takeWhile value = IP.parseD (drainWhile (<= value))
92+
93+{-# INLINE takeP #-}
94+takeP :: MonadThrow m => Int -> SerialT m a -> m ()
95+takeP value = IP.parseD (PR.takeP value (PR.fromFold FL.drain))
96+
97+{-# INLINE takeBetween #-}
98+takeBetween :: MonadCatch m => Int -> SerialT m a -> m ()
99+takeBetween value = IP.parseD (PR.takeBetween 0 value FL.drain)
100+
101+{-# INLINE groupBy #-}
102+groupBy :: MonadThrow m => SerialT m Int -> m ()
103+groupBy = IP.parseD (PR.groupBy (<=) FL.drain)
104+
105+{-# INLINE groupByRolling #-}
106+groupByRolling :: MonadThrow m => SerialT m Int -> m ()
107+groupByRolling = IP.parseD (PR.groupByRolling (<=) FL.drain)
108+
109+{-# INLINE wordBy #-}
110+wordBy :: MonadThrow m => Int -> SerialT m Int -> m ()
111+wordBy value = IP.parseD (PR.wordBy (>= value) FL.drain)
112+
113+{-# INLINE manyWordByEven #-}
114+manyWordByEven :: MonadCatch m => SerialT m Int -> m ()
115+manyWordByEven =
116+ IP.parseD (PR.many (PR.wordBy (Prelude.even) FL.drain) FL.drain)
117+
118+{-# INLINE many #-}
119+many :: MonadCatch m => SerialT m Int -> m Int
120+many = IP.parseD (PR.many (PR.satisfy (> 0)) FL.length)
121+
122+{-# INLINE manyAlt #-}
123+manyAlt :: MonadCatch m => SerialT m Int -> m Int
124+manyAlt xs = do
125+ x <- IP.parseD (AP.many (PR.satisfy (> 0))) xs
126+ return $ Prelude.length x
127+
128+{-# INLINE some #-}
129+some :: MonadCatch m => SerialT m Int -> m Int
130+some = IP.parseD (PR.some (PR.satisfy (> 0)) FL.length)
131+
132+{-# INLINE someAlt #-}
133+someAlt :: MonadCatch m => SerialT m Int -> m Int
134+someAlt xs = do
135+ x <- IP.parseD (AP.some (PR.satisfy (> 0))) xs
136+ return $ Prelude.length x
137+
138+{-#INLINE sliceSepByP #-}
139+sliceSepByP :: MonadCatch m => Int -> SerialT m Int -> m ()
140+sliceSepByP value = IP.parseD (PR.sliceSepByP (>= value) (PR.fromFold FL.drain))
141+
142+{-# INLINE manyTill #-}
143+manyTill :: MonadCatch m => Int -> SerialT m Int -> m Int
144+manyTill value =
145+ let p = PR.satisfy (> 0)
146+ pcond = PR.satisfy (== value)
147+ in IP.parseD (PR.manyTill FL.length p pcond)
148+
149+{-# INLINE serialWith #-}
150+serialWith :: MonadThrow m
151+ => Int -> SerialT m Int -> m ((), ())
152+serialWith value =
153+ IP.parseD
154+ ((,)
155+ <$> drainWhile (<= (value `div` 2))
156+ <*> drainWhile (<= value)
157+ )
158+
159+{-# INLINE teeAllAny #-}
160+teeAllAny :: MonadThrow m
161+ => Int -> SerialT m Int -> m ((), ())
162+teeAllAny value =
163+ IP.parseD
164+ (PR.teeWith (,)
165+ (drainWhile (<= value))
166+ (drainWhile (<= value))
167+ )
168+
169+{-# INLINE teeFstAllAny #-}
170+teeFstAllAny :: MonadThrow m
171+ => Int -> SerialT m Int -> m ((), ())
172+teeFstAllAny value =
173+ IP.parseD
174+ (PR.teeWithFst (,)
175+ (drainWhile (<= value))
176+ (drainWhile (<= value))
177+ )
178+
179+{-# INLINE shortestAllAny #-}
180+shortestAllAny :: MonadThrow m
181+ => Int -> SerialT m Int -> m ()
182+shortestAllAny value =
183+ IP.parseD
184+ (PR.shortest
185+ (drainWhile (<= value))
186+ (drainWhile (<= value))
187+ )
188+
189+{-# INLINE longestAllAny #-}
190+longestAllAny :: MonadCatch m
191+ => Int -> SerialT m Int -> m ()
192+longestAllAny value =
193+ IP.parseD
194+ (PR.longest
195+ (drainWhile (<= value))
196+ (drainWhile (<= value))
197+ )
198+
199+-------------------------------------------------------------------------------
200+-- Spanning
201+-------------------------------------------------------------------------------
202+
203+{-# INLINE span #-}
204+span :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
205+span value = IP.parseD (PR.span (<= (value `div` 2)) FL.drain FL.drain)
206+
207+{-# INLINE spanBy #-}
208+spanBy :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
209+spanBy value =
210+ IP.parseD (PR.spanBy (\_ i -> i <= (value `div` 2)) FL.drain FL.drain)
211+
212+{-# INLINE spanByRolling #-}
213+spanByRolling :: MonadThrow m => Int -> SerialT m Int -> m ((), ())
214+spanByRolling value =
215+ IP.parseD (PR.spanByRolling (\_ i -> i <= value `div` 2) FL.drain FL.drain)
216+
217+-------------------------------------------------------------------------------
218+-- Nested
219+-------------------------------------------------------------------------------
220+
221+{-# INLINE parseMany #-}
222+parseMany :: MonadThrow m => Int -> SerialT m Int -> m ()
223+parseMany value = IP.drain . IP.parseManyD (drainWhile (<= value + 1))
224+
225+{-# INLINE parseManyGroups #-}
226+parseManyGroups :: MonadThrow m => Bool -> SerialT m Int -> m ()
227+parseManyGroups b = IP.drain . IP.parseManyD (PR.groupBy (\_ _ -> b) FL.drain)
228+
229+{-# INLINE parseManyGroupsRolling #-}
230+parseManyGroupsRolling :: MonadThrow m => Bool -> SerialT m Int -> m ()
231+parseManyGroupsRolling b =
232+ IP.drain . IP.parseManyD (PR.groupByRolling (\_ _ -> b) FL.drain)
233+
234+{-# INLINE parseManyGroupsRollingEither #-}
235+parseManyGroupsRollingEither :: (MonadThrow m, MonadCatch m) =>
236+ (Int -> Int -> Bool) -> SerialT m Int -> m ()
237+parseManyGroupsRollingEither cmp =
238+ IP.drain
239+ . IP.parseManyD (PR.groupByRollingEither cmp FL.drain FL.drain)
240+
241+-------------------------------------------------------------------------------
242+-- Parsing with unfolds
243+-------------------------------------------------------------------------------
244+
245+{-# INLINE parseManyUnfoldArrays #-}
246+parseManyUnfoldArrays :: Int -> [Array.Array Int] -> IO ()
247+parseManyUnfoldArrays count arrays = do
248+ let src = Source.source (Just (Producer.OuterLoop arrays))
249+ let parser = PR.fromFold (FL.take count FL.drain)
250+ let readSrc =
251+ Source.producer
252+ $ Producer.concat Producer.fromList Array.producer
253+ let streamParser =
254+ Producer.simplify (Source.parseManyD parser readSrc)
255+ S.drain $ S.unfold streamParser src
256+
257+-------------------------------------------------------------------------------
258+-- Parsers in which -fspec-constr-recursive=16 is problematic
259+-------------------------------------------------------------------------------
260+
261+-- XXX -fspec-constr-recursive=16 makes GHC go beserk when compiling these.
262+-- We need to fix GHC so that we can have better control over that option or do
263+-- not have to rely on it.
264+--
265+{-# INLINE lookAhead #-}
266+lookAhead :: MonadThrow m => Int -> SerialT m Int -> m ()
267+lookAhead value =
268+ IP.parseD (PR.lookAhead (PR.takeWhile (<= value) FL.drain) $> ())
269+
270+{-# INLINE sequenceA_ #-}
271+sequenceA_ :: MonadThrow m => Int -> SerialT m Int -> m ()
272+sequenceA_ value =
273+ IP.parseD (F.sequenceA_ $ replicate value (PR.satisfy (> 0)))
274+
275+-- quadratic complexity
276+{-# INLINE sequenceA #-}
277+sequenceA :: MonadThrow m => Int -> SerialT m Int -> m Int
278+sequenceA value xs = do
279+ x <- IP.parseD (TR.sequenceA (replicate value (PR.satisfy (> 0)))) xs
280+ return $ length x
281+
282+-- quadratic complexity
283+{-# INLINE sequence #-}
284+sequence :: MonadThrow m => Int -> SerialT m Int -> m Int
285+sequence value xs = do
286+ x <- IP.parseD (TR.sequence (replicate value (PR.satisfy (> 0)))) xs
287+ return $ length x
288+
289+{-# INLINE sequence_ #-}
290+sequence_ :: MonadCatch m => Int -> SerialT m Int -> m ()
291+sequence_ value xs =
292+ IP.parseD (foldr f (return ()) (replicate value (PR.takeBetween 0 1 FL.drain))) xs
293+
294+ where
295+
296+ {-# INLINE f #-}
297+ f m k = m >>= (\_ -> k)
298+
299+-- choice using the "Alternative" instance with direct style parser type has
300+-- quadratic performance complexity.
301+--
302+{-# INLINE choiceAsum #-}
303+choiceAsum :: MonadCatch m => Int -> SerialT m Int -> m Int
304+choiceAsum value =
305+ IP.parseD (asum (replicate value (PR.satisfy (< 0)))
306+ AP.<|> PR.satisfy (> 0))
307+
308+{-# INLINE choice #-}
309+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
310+choice value =
311+ IP.parseD
312+ (PR.choice (replicate value (PR.satisfy (< 0))) AP.<|> PR.satisfy (> 0))
313+
314+-------------------------------------------------------------------------------
315+-- Benchmarks
316+-------------------------------------------------------------------------------
317+
318+moduleName :: String
319+moduleName = "Data.Parser.ParserD"
320+
321+o_1_space_serial :: Int -> [Benchmark]
322+o_1_space_serial value =
323+ [ benchIOSink value "takeWhile" $ takeWhile value
324+ , benchIOSink value "takeP" $ takeP value
325+ , benchIOSink value "takeBetween" $ takeBetween value
326+ , benchIOSink value "sliceBeginWith" $ sliceBeginWith value
327+ , benchIOSink value "groupBy" $ groupBy
328+ , benchIOSink value "groupByRolling" $ groupByRolling
329+ , benchIOSink value "wordBy" $ wordBy value
330+ , benchIOSink value "serialWith" $ serialWith value
331+ , benchIOSink value "many" many
332+ , benchIOSink value "many (wordBy even)" $ manyWordByEven
333+ , benchIOSink value "some" some
334+ , benchIOSink value "sliceSepByP" $ sliceSepByP value
335+ , benchIOSink value "manyTill" $ manyTill value
336+ , benchIOSink value "tee (all,any)" $ teeAllAny value
337+ , benchIOSink value "teeFst (all,any)" $ teeFstAllAny value
338+ , benchIOSink value "shortest (all,any)" $ shortestAllAny value
339+ , benchIOSink value "longest (all,any)" $ longestAllAny value
340+ ]
341+
342+o_1_space_serial_spanning :: Int -> [Benchmark]
343+o_1_space_serial_spanning value =
344+ [ benchIOSink value "span" $ span value
345+ , benchIOSink value "spanBy" $ spanBy value
346+ , benchIOSink value "spanByRolling" $ spanByRolling value
347+ ]
348+
349+o_1_space_serial_nested :: Int -> [Benchmark]
350+o_1_space_serial_nested value =
351+ [ benchIOSink value "parseMany" $ parseMany value
352+ , benchIOSink value "parseMany groupBy (bound groups)"
353+ $ parseManyGroups False
354+ , benchIOSink value "parseMany groupRollingBy (bound groups)"
355+ $ parseManyGroupsRolling False
356+ , benchIOSink value "parseMany groupBy (1 group)" $ parseManyGroups True
357+ , benchIOSink value "parseMany groupRollingBy (1 group)"
358+ $ parseManyGroupsRolling True
359+ , benchIOSink value "parseMany groupRollingByEither (Left)"
360+ $ parseManyGroupsRollingEither (<)
361+ , benchIOSink value "parseMany groupRollingByEither (Right)"
362+ $ parseManyGroupsRollingEither (>)
363+ , benchIOSinkRandom value "parseMany groupRollingByEither (Alternating)"
364+ $ parseManyGroupsRollingEither (>)
365+ ]
366+
367+o_1_space_serial_unfold :: Int -> [Array.Array Int] -> [Benchmark]
368+o_1_space_serial_unfold bound arrays =
369+ [ bench "parseMany/Unfold/1000 arrays/1 parse"
370+ $ nfIO $ parseManyUnfoldArrays bound arrays
371+ , bench "parseMany/Unfold/1000 arrays/100000 parses"
372+ $ nfIO $ parseManyUnfoldArrays 1 arrays
373+ ]
374+
375+o_n_heap_serial :: Int -> [Benchmark]
376+o_n_heap_serial value =
377+ [
378+ -- lookahead benchmark holds the entire input till end
379+ benchIOSink value "lookAhead" $ lookAhead value
380+
381+ -- These show non-linear time complexity
382+ -- They accumulate the results in a list.
383+ , benchIOSink value "manyAlt" manyAlt
384+ , benchIOSink value "someAlt" someAlt
385+ ]
386+
387+-- accumulate results in a list in IO
388+o_n_space_serial :: Int -> [Benchmark]
389+o_n_space_serial value =
390+ [ benchIOSink value "sequenceA/100" $ sequenceA (value `div` 100)
391+ , benchIOSink value "sequenceA_/100" $ sequenceA_ (value `div` 100)
392+ , benchIOSink value "sequence/100" $ sequence (value `div` 100)
393+ , benchIOSink value "sequence_/100" $ sequence_ (value `div` 100)
394+ , benchIOSink value "choice (asum)/100" $ choiceAsum (value `div` 100)
395+ , benchIOSink value "choice/100" $ choice (value `div` 100)
396+ ]
397+
398+-------------------------------------------------------------------------------
399+-- Driver
400+-------------------------------------------------------------------------------
401+
402+main :: IO ()
403+main = runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
404+
405+ where
406+
407+ alloc value = IP.toList $ IP.arraysOf 100 $ sourceUnfoldrM value 0
408+
409+ allBenchmarks arraysSmall value =
410+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
411+ , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_spanning value)
412+ , bgroup (o_1_space_prefix moduleName) (o_1_space_serial_nested value)
413+ , bgroup (o_1_space_prefix moduleName)
414+ (o_1_space_serial_unfold value arraysSmall)
415+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
416+ , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)
417+ ]
benchmark/Streamly/Benchmark/Data/Parser/ParserK.hsnew file+163
@@ -0,0 +1,163 @@
1+-- |
2+-- Module : Streamly.Benchmark.Data.ParserK
3+-- Copyright : (c) 2020 Composewell Technologies
4+--
5+-- License : BSD-3-Clause
6+-- Maintainer : streamly@composewell.com
7+
8+{-# LANGUAGE CPP #-}
9+{-# LANGUAGE FlexibleContexts #-}
10+
11+module Main
12+ (
13+ main
14+ ) where
15+
16+import Control.DeepSeq (NFData(..))
17+import Control.Monad.Catch (MonadCatch)
18+import Data.Foldable (asum)
19+import System.Random (randomRIO)
20+import Prelude hiding (any, all, take, sequence, sequenceA, takeWhile)
21+
22+import qualified Control.Applicative as AP
23+import qualified Data.Foldable as F
24+import qualified Data.Traversable as TR
25+import qualified Streamly.Prelude as S
26+import qualified Streamly.Internal.Data.Fold as FL
27+import qualified Streamly.Internal.Data.Parser.ParserK.Type as PR
28+import qualified Streamly.Internal.Data.Parser.ParserD as PRD
29+import qualified Streamly.Internal.Data.Stream.IsStream as IP
30+
31+import Gauge
32+import Streamly.Prelude (SerialT, MonadAsync, IsStream)
33+import Streamly.Benchmark.Common
34+
35+-------------------------------------------------------------------------------
36+-- Utilities
37+-------------------------------------------------------------------------------
38+
39+-- XXX these can be moved to the common module
40+
41+{-# INLINE sourceUnfoldrM #-}
42+sourceUnfoldrM :: (IsStream t, MonadAsync m) => Int -> Int -> t m Int
43+sourceUnfoldrM value n = S.unfoldrM step n
44+ where
45+ step cnt =
46+ if cnt > n + value
47+ then return Nothing
48+ else return (Just (cnt, cnt + 1))
49+
50+-- | Takes a fold method, and uses it with a default source.
51+{-# INLINE benchIOSink #-}
52+benchIOSink
53+ :: (IsStream t, NFData b)
54+ => Int -> String -> (t IO Int -> IO b) -> Benchmark
55+benchIOSink value name f =
56+ bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
57+
58+-------------------------------------------------------------------------------
59+-- Parsers
60+-------------------------------------------------------------------------------
61+
62+#ifdef FROM_PARSERK
63+#define PARSE_OP (IP.parseD . PR.fromParserK)
64+#else
65+#define PARSE_OP IP.parseK
66+#endif
67+
68+{-# INLINE satisfy #-}
69+satisfy :: MonadCatch m => (a -> Bool) -> PR.Parser m a a
70+satisfy = PR.toParserK . PRD.satisfy
71+
72+{-# INLINE takeWhile #-}
73+takeWhile :: MonadCatch m => (a -> Bool) -> PR.Parser m a ()
74+takeWhile p = PR.toParserK $ PRD.takeWhile p FL.drain
75+
76+{-# INLINE takeWhileK #-}
77+takeWhileK :: MonadCatch m => Int -> SerialT m Int -> m ()
78+takeWhileK value = PARSE_OP (takeWhile (<= value))
79+
80+{-# INLINE splitApp #-}
81+splitApp :: MonadCatch m
82+ => Int -> SerialT m Int -> m ((), ())
83+splitApp value =
84+ PARSE_OP ((,) <$> takeWhile (<= (value `div` 2)) <*> takeWhile (<= value))
85+
86+{-# INLINE sequenceA #-}
87+sequenceA :: MonadCatch m => Int -> SerialT m Int -> m Int
88+sequenceA value xs = do
89+ let parser = satisfy (> 0)
90+ list = Prelude.replicate value parser
91+ x <- PARSE_OP (TR.sequenceA list) xs
92+ return $ Prelude.length x
93+
94+{-# INLINE sequenceA_ #-}
95+sequenceA_ :: MonadCatch m => Int -> SerialT m Int -> m ()
96+sequenceA_ value xs = do
97+ let parser = satisfy (> 0)
98+ list = Prelude.replicate value parser
99+ PARSE_OP (F.sequenceA_ list) xs
100+
101+{-# INLINE sequence #-}
102+sequence :: MonadCatch m => Int -> SerialT m Int -> m Int
103+sequence value xs = do
104+ let parser = satisfy (> 0)
105+ list = Prelude.replicate value parser
106+ x <- PARSE_OP (TR.sequence list) xs
107+ return $ Prelude.length x
108+
109+{-# INLINE manyAlt #-}
110+manyAlt :: MonadCatch m => SerialT m Int -> m Int
111+manyAlt xs = do
112+ x <- PARSE_OP (AP.many (satisfy (> 0))) xs
113+ return $ Prelude.length x
114+
115+{-# INLINE someAlt #-}
116+someAlt :: MonadCatch m => SerialT m Int -> m Int
117+someAlt xs = do
118+ x <- PARSE_OP (AP.some (satisfy (> 0))) xs
119+ return $ Prelude.length x
120+
121+{-# INLINE choice #-}
122+choice :: MonadCatch m => Int -> SerialT m Int -> m Int
123+choice value =
124+ PARSE_OP (asum (replicate value (satisfy (< 0)))
125+ AP.<|> satisfy (> 0))
126+
127+-------------------------------------------------------------------------------
128+-- Benchmarks
129+-------------------------------------------------------------------------------
130+
131+moduleName :: String
132+moduleName = "Data.Parser.ParserK"
133+
134+o_1_space_serial :: Int -> [Benchmark]
135+o_1_space_serial value =
136+ [ benchIOSink value "takeWhile" $ takeWhileK value
137+ , benchIOSink value "splitApp" $ splitApp value
138+ ]
139+
140+-- O(n) heap beacuse of accumulation of the list in strict IO monad?
141+o_n_heap_serial :: Int -> [Benchmark]
142+o_n_heap_serial value =
143+ [ benchIOSink value "sequenceA" $ sequenceA value
144+ , benchIOSink value "sequenceA_" $ sequenceA_ value
145+ , benchIOSink value "sequence" $ sequence value
146+ , benchIOSink value "manyAlt" manyAlt
147+ , benchIOSink value "someAlt" someAlt
148+ , benchIOSink value "choice" $ choice value
149+ ]
150+
151+-------------------------------------------------------------------------------
152+-- Driver
153+-------------------------------------------------------------------------------
154+
155+main :: IO ()
156+main = runWithCLIOpts defaultStreamSize allBenchmarks
157+
158+ where
159+
160+ allBenchmarks value =
161+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
162+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
163+ ]
benchmark/Streamly/Benchmark/Data/ParserK.hsdeleted−437
@@ -1,437 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.ParserK
3−-- Copyright : (c) 2020 Composewell Technologies
4−--
5−-- License : BSD-3-Clause
6−-- Maintainer : streamly@composewell.com
7−
8−-- BENCH_CHUNKED -> adaptC
9−-- BENCH_CHUNKED_GENERIC -> adaptCG
10−-- BENCH_SINGULAR -> adapt
11−
12−{-# LANGUAGE CPP #-}
13−{-# LANGUAGE FlexibleContexts #-}
14−{-# OPTIONS_GHC -Wno-orphans #-}
15−
16−module Main
17− (
18− main
19− ) where
20−
21−import Control.Applicative ((<|>))
22−import Control.DeepSeq (NFData(..))
23−import Control.Monad.IO.Class (MonadIO)
24−import Data.Foldable (asum)
25−#ifdef BENCH_CHUNKED
26−import Streamly.Data.Array (Array, Unbox)
27−#endif
28−#ifdef BENCH_CHUNKED_GENERIC
29−import Streamly.Data.Array.Generic (Array)
30−import qualified Streamly.Internal.Data.Array.Generic as GenArr (chunksOf)
31−#endif
32−import Streamly.Internal.Data.Fold (Fold(..))
33−import Streamly.Data.StreamK (StreamK)
34−import Streamly.Internal.Data.Parser
35− (ParseError(..), Parser(..), Initial(..), Step(..))
36−import Streamly.Internal.Data.Stream (Stream)
37−import System.Random (randomRIO)
38−import Prelude hiding
39− (any, all, take, sequence, sequence_, sequenceA, takeWhile)
40−
41−import qualified Control.Applicative as AP
42−import qualified Data.Foldable as F
43−import qualified Data.Traversable as TR
44−import qualified Streamly.Data.Stream as Stream
45−import qualified Streamly.Data.Fold as FL
46−import qualified Streamly.Internal.Data.Fold as Fold
47−import qualified Streamly.Data.Parser as PRD
48−import qualified Streamly.Internal.Data.ParserK as PR
49−import qualified Streamly.Internal.Data.StreamK as StreamK
50−
51−import Test.Tasty.Bench
52−import Streamly.Benchmark.Common
53−
54−-------------------------------------------------------------------------------
55−-- CPP Helpers
56−-------------------------------------------------------------------------------
57−
58−#ifdef BENCH_CHUNKED
59−
60−#define PARSE_OP StreamK.parseChunks
61−#define FROM_PARSER adaptC
62−#define INPUT (Array a)
63−#define PARSE_ELEM (Array Int)
64−#define CONSTRAINT_IO (MonadIO m, Unbox a)
65−#define CONSTRAINT (Monad m, Unbox a)
66−#define MODULE_NAME "Data.ParserK.Chunked"
67−
68−#endif
69−
70−#ifdef BENCH_CHUNKED_GENERIC
71−
72−#define PARSE_OP StreamK.parseChunksGeneric
73−#define FROM_PARSER adaptCG
74−#define INPUT (Array a)
75−#define PARSE_ELEM (Array Int)
76−#define CONSTRAINT_IO (MonadIO m)
77−#define CONSTRAINT (Monad m)
78−#define MODULE_NAME "Data.ParserK.Chunked.Generic"
79−
80−#endif
81−
82−#ifdef BENCH_SINGULAR
83−
84−#define PARSE_OP StreamK.parse
85−#define FROM_PARSER adapt
86−#define INPUT a
87−#define PARSE_ELEM Int
88−#define CONSTRAINT_IO (MonadIO m)
89−#define CONSTRAINT (Monad m)
90−#define MODULE_NAME "Data.ParserK"
91−
92−#endif
93−
94−-------------------------------------------------------------------------------
95−-- Utilities
96−-------------------------------------------------------------------------------
97−
98−-- XXX these can be moved to the common module
99−
100−{-# INLINE sourceUnfoldrM #-}
101−sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int
102−sourceUnfoldrM value n = Stream.unfoldrM step n
103− where
104− step cnt =
105− if cnt > n + value
106− then return Nothing
107− else return (Just (cnt, cnt + 1))
108−
109−-- | Takes a fold method, and uses it with a default source.
110−{-# INLINE benchIOSink #-}
111−benchIOSink
112− :: NFData b
113− => Int -> String -> (StreamK IO PARSE_ELEM -> IO b) -> Benchmark
114−benchIOSink value name f =
115− bench name $ nfIO $ randomRIO (1,1)
116− >>= f
117− . StreamK.fromStream
118−#ifdef BENCH_CHUNKED
119− . Stream.chunksOf 4000
120−#endif
121−#ifdef BENCH_CHUNKED_GENERIC
122− . GenArr.chunksOf 4000
123−#endif
124− . sourceUnfoldrM value
125−
126−-------------------------------------------------------------------------------
127−-- Parsers
128−-------------------------------------------------------------------------------
129−
130−{-# INLINE one #-}
131−one :: MonadIO m =>
132− Int -> StreamK m PARSE_ELEM -> m (Either ParseError (Maybe Int))
133−one value = PARSE_OP p
134−
135− where
136−
137− p = do
138− m <- PR.FROM_PARSER (PRD.fromFold FL.one)
139− case m of
140− Just i -> if i >= value then pure m else p
141− Nothing -> pure Nothing
142−
143−{-# INLINE satisfy #-}
144−satisfy :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m a
145−satisfy = PR.FROM_PARSER . PRD.satisfy
146−
147−{-# INLINE takeWhile #-}
148−takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()
149−takeWhile p = PR.FROM_PARSER $ PRD.takeWhile p FL.drain
150−
151−{-# INLINE takeWhileK #-}
152−takeWhileK :: MonadIO m =>
153− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
154−takeWhileK value = PARSE_OP (takeWhile (<= value))
155−
156−{-# INLINE splitAp2 #-}
157−splitAp2 :: MonadIO m
158− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ((), ()))
159−splitAp2 value =
160− PARSE_OP
161− ((,)
162− <$> takeWhile (<= (value `div` 2))
163− <*> takeWhile (<= value)
164− )
165−
166−{-# INLINE splitAp8 #-}
167−splitAp8 :: MonadIO m
168− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
169−splitAp8 value =
170− PARSE_OP
171− ( (\() () () () () () () () -> ())
172− <$> takeWhile (<= ( value `div` 8))
173− <*> takeWhile (<= ((value * 2) `div` 8))
174− <*> takeWhile (<= ((value * 3) `div` 8))
175− <*> takeWhile (<= ((value * 4) `div` 8))
176− <*> takeWhile (<= ((value * 5) `div` 8))
177− <*> takeWhile (<= ((value * 6) `div` 8))
178− <*> takeWhile (<= ((value * 7) `div` 8))
179− <*> takeWhile (<= value)
180− )
181−
182−{-# INLINE sequenceA #-}
183−sequenceA :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int
184−sequenceA value xs = do
185− let parser = satisfy (> 0)
186− list = Prelude.replicate value parser
187− x <- PARSE_OP (TR.sequenceA list) xs
188− return $ Prelude.length x
189−
190−{-# INLINE sequenceA_ #-}
191−sequenceA_ :: MonadIO m =>
192− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
193−sequenceA_ value xs = do
194− let parser = satisfy (> 0)
195− list = Prelude.replicate value parser
196− PARSE_OP (F.sequenceA_ list) xs
197−
198−{-# INLINE sequence #-}
199−sequence :: MonadIO m => Int -> StreamK m PARSE_ELEM -> m Int
200−sequence value xs = do
201− let parser = satisfy (> 0)
202− list = Prelude.replicate value parser
203− x <- PARSE_OP (TR.sequence list) xs
204− return $ Prelude.length x
205−
206−{-# INLINE sequence_ #-}
207−sequence_ :: MonadIO m =>
208− Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
209−sequence_ value =
210− let parser = satisfy (> 0)
211− list = Prelude.replicate value parser
212− in PARSE_OP (F.sequence_ list)
213−
214−{-# INLINE takeWhileFailD #-}
215−takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
216−takeWhileFailD predicate (Fold fstep finitial _ ffinal) =
217− Parser step initial extract
218−
219− where
220−
221− initial = do
222− res <- finitial
223− return $ case res of
224− Fold.Partial s -> IPartial s
225− Fold.Done b -> IDone b
226−
227− step s a =
228− if predicate a
229− then do
230− fres <- fstep s a
231− return
232− $ case fres of
233− Fold.Partial s1 -> Partial 0 s1
234− Fold.Done b -> Done 0 b
235− else return $ Error "fail"
236−
237− extract s = fmap (Done 0) (ffinal s)
238−
239−{-# INLINE takeWhileFail #-}
240−takeWhileFail :: CONSTRAINT =>
241− (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b
242−takeWhileFail p f = PR.FROM_PARSER (takeWhileFailD p f)
243−
244−{-# INLINE alt2 #-}
245−alt2 :: MonadIO m
246− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
247−alt2 value =
248− PARSE_OP
249− ( takeWhileFail (<= (value `div` 2)) Fold.drain
250− <|> takeWhile (<= value)
251− )
252−
253−{-# INLINE alt8 #-}
254−alt8 :: MonadIO m
255− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
256−alt8 value =
257− PARSE_OP
258− ( takeWhileFail (<= ( value `div` 8)) Fold.drain
259− <|> takeWhileFail (<= ((value * 2) `div` 8)) Fold.drain
260− <|> takeWhileFail (<= ((value * 3) `div` 8)) Fold.drain
261− <|> takeWhileFail (<= ((value * 4) `div` 8)) Fold.drain
262− <|> takeWhileFail (<= ((value * 5) `div` 8)) Fold.drain
263− <|> takeWhileFail (<= ((value * 6) `div` 8)) Fold.drain
264− <|> takeWhileFail (<= ((value * 7) `div` 8)) Fold.drain
265− <|> takeWhile (<= value)
266− )
267−
268−{-# INLINE alt16 #-}
269−alt16 :: MonadIO m
270− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
271−alt16 value =
272− PARSE_OP
273− ( takeWhileFail (<= ( value `div` 16)) Fold.drain
274− <|> takeWhileFail (<= ((value * 2) `div` 16)) Fold.drain
275− <|> takeWhileFail (<= ((value * 3) `div` 16)) Fold.drain
276− <|> takeWhileFail (<= ((value * 4) `div` 16)) Fold.drain
277− <|> takeWhileFail (<= ((value * 5) `div` 16)) Fold.drain
278− <|> takeWhileFail (<= ((value * 6) `div` 16)) Fold.drain
279− <|> takeWhileFail (<= ((value * 7) `div` 16)) Fold.drain
280− <|> takeWhileFail (<= ((value * 8) `div` 16)) Fold.drain
281− <|> takeWhileFail (<= ((value * 9) `div` 16)) Fold.drain
282− <|> takeWhileFail (<= ((value * 10) `div` 16)) Fold.drain
283− <|> takeWhileFail (<= ((value * 11) `div` 16)) Fold.drain
284− <|> takeWhileFail (<= ((value * 12) `div` 16)) Fold.drain
285− <|> takeWhileFail (<= ((value * 13) `div` 16)) Fold.drain
286− <|> takeWhileFail (<= ((value * 14) `div` 16)) Fold.drain
287− <|> takeWhileFail (<= ((value * 15) `div` 16)) Fold.drain
288− <|> takeWhile (<= value)
289− )
290−
291−{-# INLINE manyAlt #-}
292−manyAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int
293−manyAlt xs = do
294− x <- PARSE_OP (AP.many (satisfy (> 0))) xs
295− return $ Prelude.length x
296−
297−{-# INLINE someAlt #-}
298−someAlt :: MonadIO m => StreamK m PARSE_ELEM -> m Int
299−someAlt xs = do
300− x <- PARSE_OP (AP.some (satisfy (> 0))) xs
301− return $ Prelude.length x
302−
303−{-# INLINE choice #-}
304−choice :: MonadIO m =>
305− Int -> StreamK m PARSE_ELEM -> m (Either ParseError Int)
306−choice value =
307− PARSE_OP (asum (replicate value (satisfy (< 0)))
308− AP.<|> satisfy (> 0))
309−
310−{-# INLINE monad2 #-}
311−monad2 :: MonadIO m
312− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
313−monad2 value =
314− PARSE_OP $ do
315− takeWhile (<= (value `div` 2))
316− takeWhile (<= value)
317−
318−{-# INLINE monad4 #-}
319−monad4 :: MonadIO m
320− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
321−monad4 value =
322− PARSE_OP $ do
323− takeWhile (<= ( value `div` 4))
324− takeWhile (<= ((value * 2) `div` 4))
325− takeWhile (<= ((value * 3) `div` 4))
326− takeWhile (<= value)
327−
328−{-# INLINE monad8 #-}
329−monad8 :: MonadIO m
330− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
331−monad8 value =
332− PARSE_OP $ do
333− takeWhile (<= ( value `div` 8))
334− takeWhile (<= ((value * 2) `div` 8))
335− takeWhile (<= ((value * 3) `div` 8))
336− takeWhile (<= ((value * 4) `div` 8))
337− takeWhile (<= ((value * 5) `div` 8))
338− takeWhile (<= ((value * 6) `div` 8))
339− takeWhile (<= ((value * 7) `div` 8))
340− takeWhile (<= value)
341−
342−{-# INLINE monad16 #-}
343−monad16 :: MonadIO m
344− => Int -> StreamK m PARSE_ELEM -> m (Either ParseError ())
345−monad16 value =
346− PARSE_OP $ do
347− takeWhile (<= ( value `div` 16))
348− takeWhile (<= ((value * 2) `div` 16))
349− takeWhile (<= ((value * 3) `div` 16))
350− takeWhile (<= ((value * 4) `div` 16))
351− takeWhile (<= ((value * 5) `div` 16))
352− takeWhile (<= ((value * 6) `div` 16))
353− takeWhile (<= ((value * 7) `div` 16))
354− takeWhile (<= ((value * 8) `div` 16))
355− takeWhile (<= ((value * 9) `div` 16))
356− takeWhile (<= ((value * 10) `div` 16))
357− takeWhile (<= ((value * 11) `div` 16))
358− takeWhile (<= ((value * 12) `div` 16))
359− takeWhile (<= ((value * 13) `div` 16))
360− takeWhile (<= ((value * 14) `div` 16))
361− takeWhile (<= ((value * 15) `div` 16))
362− takeWhile (<= value)
363−
364−-------------------------------------------------------------------------------
365−-- Benchmarks
366−-------------------------------------------------------------------------------
367−
368−moduleName :: String
369−moduleName = MODULE_NAME
370−
371−instance NFData ParseError where
372− {-# INLINE rnf #-}
373− rnf (ParseError x) = rnf x
374−
375−o_1_space_serial :: Int -> [Benchmark]
376−o_1_space_serial value =
377− [ benchIOSink value "drain" (Stream.fold Fold.drain . StreamK.toStream)
378− , benchIOSink value "takeWhile" $ takeWhileK value
379− , benchIOSink value "splitAp2" $ splitAp2 value
380− , benchIOSink value "splitAp8" $ splitAp8 value
381− , benchIOSink value "alt2" $ alt2 value
382− , benchIOSink value "alt8" $ alt8 value
383− , benchIOSink value "alt16" $ alt16 value
384− , benchIOSink value "monad2" $ monad2 value
385− , benchIOSink value "monad4" $ monad4 value
386− , benchIOSink value "monad8" $ monad8 value
387− , benchIOSink value "monad16" $ monad16 value
388− ]
389−
390−{-# INLINE sepBy1 #-}
391−sepBy1 :: MonadIO m => StreamK m PARSE_ELEM -> m Int
392−sepBy1 xs = do
393− x <- PARSE_OP (parser (satisfy odd) (satisfy even)) xs
394− return $ Prelude.length x
395−
396− where
397−
398− parser p sep = do
399− x <- p
400− fmap (x :) $ AP.many (sep >> p)
401−
402−-- O(n) heap beacuse of accumulation of the list in strict IO monad?
403−o_n_heap_serial :: Int -> [Benchmark]
404−o_n_heap_serial value =
405− [
406− -- accumulates the results in a list
407− -- XXX why should this take O(n) heap, it discards the results?
408− benchIOSink value "sequence_" $ sequence_ value
409− , benchIOSink value "sequenceA_" $ sequenceA_ value
410− , benchIOSink value "sequence" $ sequence value
411− , benchIOSink value "sequenceA" $ sequenceA value
412− , benchIOSink value "manyAlt" manyAlt
413− , benchIOSink value "sepBy1" sepBy1
414− , benchIOSink value "someAlt" someAlt
415− , benchIOSink value "choice" $ choice value
416− ]
417−
418−-- O(n) heap beacuse of accumulation of the list in strict IO monad?
419−o_1_space_recursive :: Int -> [Benchmark]
420−o_1_space_recursive value =
421− [ benchIOSink value "one (recursive)" $ one value
422− ]
423−
424−-------------------------------------------------------------------------------
425−-- Driver
426−-------------------------------------------------------------------------------
427−
428−main :: IO ()
429−main = runWithCLIOpts defaultStreamSize allBenchmarks
430−
431− where
432−
433− allBenchmarks value =
434− [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
435− , bgroup (o_1_space_prefix moduleName) (o_1_space_recursive value)
436− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
437− ]
benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hsdeleted−69
@@ -1,69 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Ring.Unboxed
3−-- Copyright : (c) 2022 Composewell
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE RankNTypes #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−
11−module Main (main) where
12−
13−import Control.Monad (void)
14−import GHC.Ptr (Ptr(..))
15−import qualified Streamly.Internal.Data.Array as Array
16−import qualified Streamly.Internal.Data.Ring as Ring
17−import qualified Data.Foldable as P
18−
19−import Test.Tasty.Bench
20−import Streamly.Benchmark.Common
21−
22−import Prelude as P
23−
24−-------------------------------------------------------------------------------
25−-- Benchmark ops
26−-------------------------------------------------------------------------------
27−
28−unsafeEqArrayN :: (Int, Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool
29−unsafeEqArrayN (value, arr, (ring, rh)) = Ring.unsafeEqArrayN ring rh arr value
30−
31−unsafeEqArray :: (Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool
32−unsafeEqArray (arr, (ring, rh)) = Ring.unsafeEqArray ring rh arr
33−
34−-------------------------------------------------------------------------------
35−-- Benchmark groups
36−-------------------------------------------------------------------------------
37−
38−o_1_space_serial ::
39− Int -> Array.Array Int -> (Ring.Ring Int, Ptr Int) -> [Benchmark]
40−o_1_space_serial value arr (ring, rh) =
41− [ bench "unsafeEqArrayN" $ nf unsafeEqArrayN (value, arr, (ring, rh))
42− , bench "unsafeEqArray" $ nf unsafeEqArray (arr, (ring, rh))
43− ]
44−
45−-------------------------------------------------------------------------------
46−-- Main
47−-------------------------------------------------------------------------------
48−
49−moduleName :: String
50−moduleName = "Data.Ring.Unboxed"
51−
52−main :: IO ()
53−main = do
54− runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks
55−
56− where
57−
58− alloc value = do
59− let input = [1 .. value] :: [Int]
60− let arr = Array.fromList input
61− (ring, rh) <- Ring.new value
62− void $ P.foldlM (Ring.unsafeInsert ring) rh input
63− return (arr, (ring, rh))
64−
65− allBenchmarks (arr, (ring, rh)) value =
66− [ bgroup
67− (o_1_space_prefix moduleName)
68− (o_1_space_serial value arr (ring, rh))
69− ]
benchmark/Streamly/Benchmark/Data/Serialize.hsdeleted−591
@@ -1,591 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−{- HLINT ignore -}
3−
4−#undef FUSION_CHECK
5−#ifdef FUSION_CHECK
6−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
7−#endif
8−
9−-- |
10−-- Module : Streamly.Benchmark.Data.Serialize
11−-- Copyright : (c) 2023 Composewell
12−-- License : BSD-3-Clause
13−-- Maintainer : streamly@composewell.com
14−
15−module Main (main) where
16−
17−-------------------------------------------------------------------------------
18−-- Imports
19−-------------------------------------------------------------------------------
20−
21−import Control.DeepSeq (NFData(..), deepseq)
22−import Control.Monad (when, void)
23−import GHC.Generics (Generic)
24−import System.Random (randomRIO)
25−#ifndef USE_UNBOX
26−import Test.QuickCheck (Arbitrary, arbitrary)
27−#endif
28−
29−import Streamly.Internal.Data.MutByteArray
30−import qualified Streamly.Internal.Data.MutByteArray as MBA
31−#ifdef USE_UNBOX
32−import Data.Proxy (Proxy(..))
33−#else
34−import Control.DeepSeq (force)
35−import Test.QuickCheck (oneof, generate)
36−#endif
37−
38−import Test.Tasty.Bench
39−import Streamly.Benchmark.Common
40−
41−#ifndef USE_UNBOX
42−import Streamly.Benchmark.Data.Serialize.RecCompatible
43−import Streamly.Benchmark.Data.Serialize.RecNonCompatible
44−#endif
45−
46−#ifdef USE_UNBOX
47−#define SERIALIZE_CLASS Unbox
48−#define DERIVE_CLASS(typ) $(deriveUnbox [d|instance Unbox typ|])
49−#define SERIALIZE_OP pokeAt
50−#define DESERIALIZE_OP peekAt
51−#else
52−#define SERIALIZE_CLASS Serialize
53−#define DERIVE_CLASS(typ) $(deriveSerialize [d|instance Serialize typ|])
54−#define SERIALIZE_OP serializeAt
55−#define DESERIALIZE_OP deserializeAt
56−#endif
57−
58−-------------------------------------------------------------------------------
59−-- Types
60−-------------------------------------------------------------------------------
61−
62−data Unit = Unit
63− deriving (Generic, Show, Eq)
64−
65−#ifndef USE_TH
66−instance SERIALIZE_CLASS Unit
67−#else
68−DERIVE_CLASS(Unit)
69−#endif
70−
71−instance NFData Unit where
72− {-# INLINE rnf #-}
73− rnf _ = ()
74−
75−data Sum2
76− = Sum21
77− | Sum22
78− deriving (Generic, Show, Eq)
79−
80−#ifndef USE_TH
81−instance SERIALIZE_CLASS Sum2
82−#else
83−DERIVE_CLASS(Sum2)
84−#endif
85−
86−instance NFData Sum2 where
87− {-# INLINE rnf #-}
88− rnf _ = ()
89−
90−data Sum25
91− = Sum251
92− | Sum252
93− | Sum253
94− | Sum254
95− | Sum255
96− | Sum256
97− | Sum257
98− | Sum258
99− | Sum259
100− | Sum2510
101− | Sum2511
102− | Sum2512
103− | Sum2513
104− | Sum2514
105− | Sum2515
106− | Sum2516
107− | Sum2517
108− | Sum2518
109− | Sum2519
110− | Sum2520
111− | Sum2521
112− | Sum2522
113− | Sum2523
114− | Sum2524
115− | Sum2525
116− deriving (Generic, Show, Eq)
117−
118−#ifndef USE_TH
119−instance SERIALIZE_CLASS Sum25
120−#else
121−DERIVE_CLASS(Sum25)
122−#endif
123−
124−instance NFData Sum25 where
125− {-# INLINE rnf #-}
126− rnf _ = ()
127−
128−data Product25
129− = Product25
130− Int
131− Int
132− Int
133− Int
134− Int
135− Int
136− Int
137− Int
138− Int
139− Int
140− Int
141− Int
142− Int
143− Int
144− Int
145− Int
146− Int
147− Int
148− Int
149− Int
150− Int
151− Int
152− Int
153− Int
154− Int
155− deriving (Generic, Show)
156−
157−#ifndef USE_TH
158−instance SERIALIZE_CLASS Product25
159−#else
160−DERIVE_CLASS(Product25)
161−#endif
162−
163−instance NFData Product25 where
164− {-# INLINE rnf #-}
165− rnf
166− (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)
167− = a1
168− `seq` a2
169− `seq` a3
170− `seq` a4
171− `seq` a5
172− `seq` a6
173− `seq` a7
174− `seq` a8
175− `seq` a9
176− `seq` a10
177− `seq` a11
178− `seq` a12
179− `seq` a13
180− `seq` a14
181− `seq` a15
182− `seq` a16
183− `seq` a17
184− `seq` a18
185− `seq` a19
186− `seq` a20
187− `seq` a21
188− `seq` a22
189− `seq` a23
190− `seq` a24
191− `seq` a25
192− `seq` ()
193−
194−-- XXX derived Eq instance is not inlined
195−instance Eq Product25 where
196− {-# INLINE (==) #-}
197− (==)
198− (Product25 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25)
199− (Product25 b1 b2 b3 b4 b5 b6 b7 b8 b9 b10 b11 b12 b13 b14 b15 b16 b17 b18 b19 b20 b21 b22 b23 b24 b25)
200− = a1 == b1
201− && a2 == b2
202− && a3 == b3
203− && a4 == b4
204− && a5 == b5
205− && a6 == b6
206− && a7 == b7
207− && a8 == b8
208− && a9 == b9
209− && a10 == b10
210− && a11 == b11
211− && a12 == b12
212− && a13 == b13
213− && a14 == b14
214− && a15 == b15
215− && a16 == b16
216− && a17 == b17
217− && a18 == b18
218− && a19 == b19
219− && a20 == b20
220− && a21 == b21
221− && a22 == b22
222− && a23 == b23
223− && a24 == b24
224− && a25 == b25
225−
226−-------------------------------------------------------------------------------
227−-- Simple non-recursive ADT
228−-------------------------------------------------------------------------------
229−
230−{-
231−data CustomDT1
232− = CDT1C1
233− | CDT1C2 Int
234− | CDT1C3 Int Int
235− deriving (Generic, Show, Eq)
236−
237−#ifndef USE_TH
238−instance SERIALIZE_CLASS CustomDT1
239−#else
240−DERIVE_CLASS(CustomDT1)
241−#endif
242−
243−instance NFData CustomDT1 where
244− {-# INLINE rnf #-}
245− rnf CDT1C1 = ()
246− rnf (CDT1C2 i) = i `seq` ()
247− rnf (CDT1C3 i1 i2) = i1 `seq` i2 `seq` ()
248−-}
249−
250−-------------------------------------------------------------------------------
251−-- Recursive ADT
252−-------------------------------------------------------------------------------
253−
254−#ifndef USE_UNBOX
255−data BinTree a
256− = Tree (BinTree a) (BinTree a)
257− | Leaf a
258− deriving (Show, Read, Eq, Generic)
259−
260−#ifndef USE_TH
261−instance Serialize (BinTree a)
262−#else
263−$(deriveSerialize [d|instance Serialize a => Serialize (BinTree a)|])
264−#endif
265−
266−instance NFData a => NFData (BinTree a) where
267− {-# INLINE rnf #-}
268− rnf (Leaf a) = rnf a `seq` ()
269− rnf (Tree l r) = rnf l `seq` rnf r
270−
271−-- XXX This may not terminate, or could become really large.
272−instance Arbitrary a => Arbitrary (BinTree a) where
273− arbitrary = oneof [Leaf <$> arbitrary, Tree <$> arbitrary <*> arbitrary]
274−
275−mkBinTree :: (Arbitrary a) => Int -> IO (BinTree a)
276−mkBinTree = go (generate arbitrary)
277−
278− where
279−
280− go r 0 = Leaf <$> r
281− go r n = Tree <$> go r (n - 1) <*> go r (n - 1)
282−
283−#endif
284−
285−-------------------------------------------------------------------------------
286−-- Size helpers
287−-------------------------------------------------------------------------------
288−
289−{-# INLINE getSize #-}
290−getSize :: forall a. SERIALIZE_CLASS a => a -> Int
291−#ifdef USE_UNBOX
292−getSize _ = sizeOf (Proxy :: Proxy a)
293−#else
294−getSize = addSizeTo 0
295−#endif
296−
297−-------------------------------------------------------------------------------
298−-- Common helpers
299−-------------------------------------------------------------------------------
300−
301−{- HLINT ignore "Eta reduce" -}
302−-- Parts of "f" that are dependent on val will not be optimized out.
303−{-# INLINE loop #-}
304−loop :: Int -> (a -> IO b) -> a -> IO ()
305−loop count f val = go count val
306− where
307−
308− go n x = when (n > 0) $ f x >> go (n-1) x
309−
310−-- The first arg of "f" is the environment which is not threaded around in the
311−-- loop.
312−{-# INLINE loopWith #-}
313−loopWith :: Int -> (e -> a -> IO b) -> e -> a -> IO ()
314−loopWith count f e val = go count val
315− where
316−
317− go n x = when (n > 0) $ f e x >> go (n-1) x
318−
319−benchSink :: NFData b => String -> Int -> (Int -> IO b) -> Benchmark
320−benchSink name times f = bench name (nfIO (randomRIO (times, times) >>= f))
321−
322−-------------------------------------------------------------------------------
323−-- Serialization Helpers
324−-------------------------------------------------------------------------------
325−
326−{-
327−{-# INLINE pokeWithSize #-}
328−pokeWithSize :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()
329−pokeWithSize arr val = do
330− let n = getSize val
331− n `seq` SERIALIZE_OP 0 arr val >> return ()
332−
333−{-# INLINE pokeTimesWithSize #-}
334−pokeTimesWithSize :: SERIALIZE_CLASS a => a -> Int -> IO ()
335−pokeTimesWithSize val times = do
336− let n = getSize val
337− arr <- MBA.new n
338− loopWith times pokeWithSize arr val
339−-}
340−
341−{-# INLINE poke #-}
342−poke :: SERIALIZE_CLASS a => MutByteArray -> a -> IO ()
343−poke arr val = void (SERIALIZE_OP 0 arr val)
344−
345−{-# INLINE pokeTimes #-}
346−pokeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
347−pokeTimes val times = do
348− let n = getSize val
349− arr <- MBA.new n
350− loopWith times poke arr val
351−
352−{-# INLINE encode #-}
353−encode :: SERIALIZE_CLASS a => a -> IO ()
354−encode val = do
355− let n = getSize val
356− arr <- MBA.new n
357− void (SERIALIZE_OP 0 arr val)
358−
359−{-# INLINE encodeTimes #-}
360−encodeTimes :: SERIALIZE_CLASS a => a -> Int -> IO ()
361−encodeTimes val times = loop times encode val
362−
363−{-# INLINE peek #-}
364−peek :: forall a. (NFData a, SERIALIZE_CLASS a) =>
365− (a, Int) -> MutByteArray -> IO ()
366−#ifdef USE_UNBOX
367−peek (_val, _) arr = do
368− (val1 :: a) <- DESERIALIZE_OP 0 arr
369−#else
370−peek (_val, n) arr = do
371− (_, val1 :: a) <- DESERIALIZE_OP 0 arr n
372−#endif
373− -- If the datatype is not deeply strict or deepseq is not used then use
374− -- Equality.
375− -- Ensure that we are actually constructing the type and using it. This
376− -- is important, otherwise the structure is created and discarded, the
377− -- cost of creation of the structure is not accounted. Otherwise we may
378− -- just read the values and discard them. The comparison adds to the
379− -- cost though. We could use deepseq but then we need to write
380− -- instances of NFData and ensure that they are correct and perform
381− -- well. Equality check also ensures correctness.
382− {-
383− if (val1 /= val)
384− then error "peek: no match"
385− else return ()
386− -}
387− val1 `deepseq` return ()
388−
389−{-# INLINE peekTimes #-}
390−peekTimes :: (NFData a, SERIALIZE_CLASS a) => Int -> a -> Int -> IO ()
391−peekTimes n val times = do
392− arr <- MBA.new n
393− _ <- SERIALIZE_OP 0 arr val
394− loopWith times peek (val, n) arr
395−
396−{-# INLINE trip #-}
397−trip :: forall a. (NFData a, SERIALIZE_CLASS a) => a -> IO ()
398−trip val = do
399− let n = getSize val
400− arr <- MBA.new n
401− _ <- SERIALIZE_OP 0 arr val
402−#ifdef USE_UNBOX
403− (val1 :: a) <- DESERIALIZE_OP 0 arr
404−#else
405− (_, val1 :: a) <- DESERIALIZE_OP 0 arr n
406−#endif
407− -- Do not remove this or use deepseq, see the comments in peek.
408− {-
409− if (val1 /= val)
410− then error "roundtrip: no match"
411− else return ()
412− -}
413− -- Note: deepseq is not needed if the datatype is strict
414− val1 `deepseq` return ()
415−
416−{-# INLINE roundtrip #-}
417−roundtrip :: (NFData a, SERIALIZE_CLASS a) => a -> Int -> IO ()
418−roundtrip val times = loop times trip val
419−
420−-------------------------------------------------------------------------------
421−-- Benchmarks
422−-------------------------------------------------------------------------------
423−
424−{-# INLINE benchConst #-}
425−benchConst ::
426− String
427− -> (forall a. (NFData a, SERIALIZE_CLASS a) =>
428− Int -> a -> Int -> IO ())
429− -> Int
430− -> Benchmark
431−benchConst gname f times =
432− bgroup gname
433− [ let !n = getSize Unit
434− in benchSink "Unit" times (f n Unit)
435− {-
436− , let !n = getSize CDT1C1
437− in benchSink "C1" times (f n CDT1C1)
438− , let val = CDT1C2 5
439− !n = getSize val
440− in benchSink "C2" (times `div` 2) (f n val)
441− , let val = CDT1C3 5 2
442− !n = getSize val
443− in benchSink "C3" (times `div` 3) (f n val)
444− -}
445− , let !n = getSize Sum21
446− in benchSink "Sum2" times (f n Sum21)
447− , let !n = getSize Sum2525
448− in benchSink "Sum25" times (f n Sum2525)
449− , let val = Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25
450− !n = getSize val
451− in benchSink "Product25" (times `div` 26) (f n val)
452− ]
453−
454−#ifndef USE_UNBOX
455−{-# INLINE benchVar #-}
456−benchVar ::
457− String
458− -> (forall a. (NFData a, SERIALIZE_CLASS a) =>
459− Int -> a -> Int -> IO ())
460− -> BinTree Int
461− -> [Int]
462− -> Int
463− -> Benchmark
464−benchVar gname f tInt lInt times =
465− bgroup gname
466− [ let !n = getSize tInt
467− in benchSink "bintree-int" times (f n tInt)
468− , let !n = getSize lInt
469− in benchSink "list-int" times (f n lInt)
470− ]
471−
472−{-
473−{-# INLINE benchGeneric #-}
474−benchGeneric
475− :: (NFData b, Serialize b)
476− => String
477− -> String
478− -> (forall a. (NFData a, Serialize a) =>
479− Int -> a -> Int -> IO ())
480− -> b
481− -> Int
482− -> Benchmark
483−benchGeneric gname valId f val times =
484− bgroup gname
485− [ let !n = getSize val
486− in benchSink valId times (f n val)
487− ]
488−-}
489−
490−{-# INLINE benchLargeRec #-}
491−benchLargeRec ::
492− String
493− -> (forall a. (NFData a, Serialize a) =>
494− Int -> a -> Int -> IO ())
495− -> RecNonCompatible
496− -> RecCompatible
497− -> Int
498− -> Benchmark
499−benchLargeRec gname f recL recR times =
500− bgroup gname
501− [ let !n = getSize recL
502− in benchSink "RecNonCompatible" times (f n recL)
503− , let !n = getSize recR
504− in benchSink "RecCompatible" times (f n recR)
505− ]
506−#endif
507−
508−-- Times is scaled by the number of constructors to normalize
509−#ifdef USE_UNBOX
510−allBenchmarks :: Int -> [Benchmark]
511−allBenchmarks times =
512−#else
513−allBenchmarks ::
514− BinTree Int -> [Int] -> RecNonCompatible -> RecCompatible -> Int -> [Benchmark]
515−allBenchmarks tInt lInt recL recR times =
516−#endif
517− [ bgroup "sizeOf"
518− [
519−#ifndef USE_UNBOX
520− bench "bintree-int" $ nf getSize tInt
521− , bench "list-int" $ nf getSize lInt
522−#endif
523− ]
524− , benchConst "poke" (const pokeTimes) times
525− -- , benchConst "pokeWithSize" (const pokeTimesWithSize) times
526− , benchConst "encode" (const encodeTimes) times
527− , benchConst "peek" peekTimes times
528− , benchConst "roundtrip" (const roundtrip) times
529−#ifndef USE_UNBOX
530− , benchVar "poke" (const pokeTimes) tInt lInt 1
531− -- , benchVar "pokeWithSize" (const pokeTimesWithSize) tInt lInt 1
532− , benchVar "encode" (const encodeTimes) tInt lInt 1
533− , benchVar "peek" peekTimes tInt lInt 1
534− , benchVar "roundtrip" (const roundtrip) tInt lInt 1
535− , benchLargeRec "poke" (const pokeTimes) recL recR times
536− , benchLargeRec "encode" (const encodeTimes) recL recR times
537− , benchLargeRec "peek" peekTimes recL recR times
538− , benchLargeRec "roundtrip" (const roundtrip) recL recR times
539−#endif
540− ]
541−
542−-------------------------------------------------------------------------------
543−-- Driver
544−-------------------------------------------------------------------------------
545−
546−main :: IO ()
547−main = do
548−#ifndef USE_UNBOX
549− -- Approximately 100000 constructors
550− -- Assuming Leaf nodes constitute two constructors (Leaf, Int) and internal
551− -- nodes 1 level = log_2 (100001/3) + 1 = 16
552− !(tInt :: BinTree Int) <- force <$> mkBinTree 16
553−
554− let !recL = valRecNonCompatible
555− let !recR = valRecCompatible
556−
557− -- Approximately 100000 constructors, assuming two constructors (Cons, Int)
558− -- per element.
559− let lInt = [1..50000 :: Int]
560− let !len = length lInt -- evaluate the list
561−#endif
562−#ifndef FUSION_CHECK
563−#ifdef USE_UNBOX
564− runWithCLIOpts defaultStreamSize allBenchmarks
565−#else
566− len
567− `seq` runWithCLIOpts
568− defaultStreamSize
569− (allBenchmarks tInt lInt recL recR)
570−#endif
571−#else
572− -- Enable FUSION_CHECK macro at the beginning of the file
573− -- Enable one benchmark below, and run the benchmark
574− -- Check the .dump-simpl output
575− let value = 100000
576− -- print $ getSize (CDT1C3 4 2)
577− -- print $ getSize tInt
578− -- print $ getSize lInt
579−
580− -- pokeTimes tInt 1
581−
582− -- peekTimes ((CDT1C2 (5 :: Int)) :: CustomDT1) value
583− -- peekTimes (Sum2525) value
584− -- peekTimes (Product25 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25) value
585− -- peekTimes tInt 1
586− let !n = getSize lInt
587− peekTimes n lInt 1
588−
589− -- roundtrip ((CDT1C2 (5 :: Int)) :: CustomDT1) value
590− return ()
591−#endif
benchmark/Streamly/Benchmark/Data/Serialize/RecCompatible.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.RecCompatible
4− ( RecCompatible(..)
5− , valRecCompatible
6− ) where
7−
8−--------------------------------------------------------------------------------
9−-- Imports
10−--------------------------------------------------------------------------------
11−
12−import Streamly.Internal.Data.MutByteArray (Serialize)
13−import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
14−
15−import qualified Streamly.Internal.Data.MutByteArray as Serialize
16−
17−--------------------------------------------------------------------------------
18−-- Code
19−--------------------------------------------------------------------------------
20−
21−$(genLargeRecord "RecCompatible" 50)
22−$(Serialize.deriveSerializeWith
23− (Serialize.encodeRecordFields True)
24− [d|instance Serialize RecCompatible|])
benchmark/Streamly/Benchmark/Data/Serialize/RecNonCompatible.hsdeleted−21
@@ -1,21 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.RecNonCompatible
4− ( RecNonCompatible(..)
5− , valRecNonCompatible
6− ) where
7−
8−--------------------------------------------------------------------------------
9−-- Imports
10−--------------------------------------------------------------------------------
11−
12−import Streamly.Benchmark.Data.Serialize.TH (genLargeRecord)
13−
14−import qualified Streamly.Internal.Data.MutByteArray as Serialize
15−
16−--------------------------------------------------------------------------------
17−-- Code
18−--------------------------------------------------------------------------------
19−
20−$(genLargeRecord "RecNonCompatible" 50)
21−$(Serialize.deriveSerialize [d|instance Serialize.Serialize RecNonCompatible|])
benchmark/Streamly/Benchmark/Data/Serialize/TH.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE TemplateHaskell #-}
2−
3−module Streamly.Benchmark.Data.Serialize.TH (genLargeRecord) where
4−
5−--------------------------------------------------------------------------------
6−-- Imports
7−--------------------------------------------------------------------------------
8−
9−import Language.Haskell.TH
10−
11−import Streamly.Internal.Data.MutByteArray (makeI)
12−import Control.DeepSeq (NFData(..))
13−
14−--------------------------------------------------------------------------------
15−-- Large Record
16−--------------------------------------------------------------------------------
17−
18−genLargeRecord :: String -> Int -> Q [Dec]
19−genLargeRecord tyName numFields =
20− sequence
21− [ dataD
22− (pure [])
23− (mkName tyName)
24− []
25− Nothing
26− [mkCon tyName]
27− [derivClause Nothing [conT ''Eq, conT ''Show]]
28− , mkValueSigDec
29− , mkValueDec
30− , nfDataInstance tyName
31− ]
32−
33− where
34−
35− fieldTypeChoices = [conT ''()]
36− chooseCycle i xs = xs !! (i `mod` length xs)
37− nfDataInstance nm =
38− instanceD
39− (pure [])
40− (appT (conT ''NFData) (conT (mkName nm)))
41− [ funD
42− 'rnf
43− [ clause
44− [ conP
45− (mkName nm)
46− (varP . makeI <$> [0 .. (numFields - 1)])
47− ]
48− (normalB
49− (foldl
50− (\b a -> [|rnf $(b) `seq` rnf $(a)|])
51− [|()|]
52− (varE . makeI <$> [0 .. (numFields - 1)])))
53− []
54− ]
55− ]
56− valueName = mkName $ "val" ++ tyName
57− mkValueSigDec = sigD valueName [t|$(conT (mkName tyName))|]
58− mkValueDec =
59− funD
60− valueName
61− [ clause
62− []
63− (normalB
64− (foldl
65− (\b a -> [|$(b) $(a)|])
66− (conE (mkName tyName))
67− (conE '() <$ [0 .. (numFields - 1)])))
68− []
69− ]
70− mkCon nm = recC (mkName nm) (mkField <$> [0 .. (numFields - 1)])
71− mkField i =
72− varBangType
73− (mkName ("field" ++ show i))
74− (bangType
75− (bang noSourceUnpackedness noSourceStrictness)
76− (chooseCycle i fieldTypeChoices))
benchmark/Streamly/Benchmark/Data/Stream.hsdeleted−114
@@ -1,114 +0,0 @@
1−-- |
2−-- Module : Data.Stream
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE RankNTypes #-}
11−
12−#undef FUSION_CHECK
13−#ifdef FUSION_CHECK
14−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
15−#endif
16−
17−module Main (main) where
18−
19−import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
20−
21−import qualified Stream.Eliminate as Elimination
22−#ifndef USE_STREAMLY_CORE
23−import qualified Stream.Exceptions as Exceptions
24−#endif
25−import qualified Stream.Expand as NestedStream
26−import qualified Stream.Generate as Generation
27−import qualified Stream.Lift as Lift
28−import qualified Stream.Reduce as NestedFold
29−#ifdef USE_PRELUDE
30−import qualified Stream.Split as Split
31−#endif
32−import qualified Stream.Transform as Transformation
33−
34−import Streamly.Benchmark.Common
35−
36−#ifdef FUSION_CHECK
37−import Data.Function ((&))
38−import Streamly.Data.Stream (Stream)
39−import qualified Streamly.Internal.Data.Stream as Stream
40−import qualified Streamly.Internal.Data.Fold as Fold
41−import qualified Data.Foldable as Foldable
42−import Stream.Common
43−#endif
44−
45−moduleName :: String
46−#ifdef USE_STREAMK
47−moduleName = "Data.Stream.StreamDK"
48−#else
49−moduleName = "Data.Stream"
50−#endif
51−
52−-------------------------------------------------------------------------------
53−-- Main
54−-------------------------------------------------------------------------------
55−
56−-- In addition to gauge options, the number of elements in the stream can be
57−-- passed using the --stream-size option.
58−--
59−main :: IO ()
60−main = do
61−#ifndef FUSION_CHECK
62− env <- mkHandleBenchEnv
63− runWithCLIOpts defaultStreamSize (allBenchmarks env)
64−
65− where
66−
67− allBenchmarks env size = Prelude.concat
68− [ Generation.benchmarks moduleName size
69− , Elimination.benchmarks moduleName size
70−#ifndef USE_STREAMLY_CORE
71− , Exceptions.benchmarks moduleName env size
72−#endif
73−#ifdef USE_PRELUDE
74− , Split.benchmarks moduleName env
75−#endif
76− , Transformation.benchmarks moduleName size
77− , NestedFold.benchmarks moduleName size
78− , Lift.benchmarks moduleName size
79− , NestedStream.benchmarks moduleName size
80− ]
81−#else
82− -- Enable FUSION_CHECK macro at the beginning of the file
83− -- Enable one benchmark below, and run the benchmark
84− -- Check the .dump-simpl output
85− let value = 100000
86− let input = sourceUnfoldrM value 1
87−
88− -- Stream.foldr (:) [] input >>= print . Prelude.length
89− -- Stream.fold (Fold.foldr' (:) []) input >>= print . Prelude.length
90−
91− -- Stream.toList input >>= print . Prelude.length
92− -- Stream.fold Fold.toList input >>= print . Prelude.length
93−
94− -- We can automatically assert that these generate identical core
95−
96− -- Stream.drain input >>= print
97− -- Stream.fold Fold.drain input >>= print
98−
99− -- Stream.last input >>= print
100− -- Stream.fold Fold.latest input >>= print
101−
102− -- Stream.length input >>= print
103− -- Stream.fold Fold.length input >>= print
104−
105− -- Stream.maximum input >>= print
106− -- Stream.fold Fold.maximum input >>= print
107−
108− -- Stream.head input >>= print
109− -- Stream.fold Fold.one input >>= print
110−
111− -- composeN 4 (Stream.scanl' (+) 0) input
112− composeN 4 (Stream.scan (Fold.foldl' (+) 0)) input
113− return ()
114−#endif
benchmark/Streamly/Benchmark/Data/Stream/Common.hsdeleted−518
@@ -1,518 +0,0 @@
1−{-# LANGUAGE ConstraintKinds #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE ScopedTypeVariables #-}
5−
6−-- |
7−-- Module : Stream.Common
8−-- Copyright : (c) 2018 Composewell Technologies
9−-- License : BSD-3-Clause
10−-- Maintainer : streamly@composewell.com
11−
12−#ifdef USE_PRELUDE
13−{-# OPTIONS_GHC -Wno-deprecations #-}
14−#endif
15−
16−module Stream.Common
17− ( MonadAsync
18−
19− , fromStream
20− , toStream
21−
22− -- Generation
23− , fromListM
24− , fromFoldableM
25−
26− , append
27− , append2
28−
29− -- Elimination
30− , drain
31− , foldl'
32− , scanl'
33−
34− -- Benchmark stream generation
35− , sourceUnfoldr
36− , sourceUnfoldrM
37− , sourceUnfoldrAction
38− , sourceConcatMapId
39− , sourceFromFoldable
40−
41− -- Benchmark stream elimination
42− , benchIOSink
43− , benchIOSrc
44− , benchIO
45−
46− -- Benchmarking functions
47−#ifdef USE_STREAMK
48− , concatStreamsWith
49− , mergeMapWith
50−#endif
51− , apDiscardFst
52− , apDiscardSnd
53− , apLiftA2
54− , toNullAp
55− , monadThen
56− , toNullM
57− , toNullM3
58− , filterAllOutM
59− , filterAllInM
60− , filterSome
61− , breakAfterSome
62− , toListM
63− , toListSome
64− , composeN
65− , mapN
66− , mapM
67− , transformMapM
68− , transformComposeMapM
69− , transformTeeMapM
70− , transformZipMapM
71− )
72−where
73−
74−#if !MIN_VERSION_base(4,18,0)
75−import Control.Applicative (liftA2)
76−#endif
77−import Control.DeepSeq (NFData)
78−import Control.Exception (try)
79−import GHC.Exception (ErrorCall)
80−import System.Random (randomRIO)
81−
82−import qualified Streamly.Internal.Data.Fold as Fold
83−import qualified Streamly.Internal.Data.Pipe as Pipe
84−
85−#ifdef USE_PRELUDE
86−import Streamly.Prelude (foldl', scanl')
87−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
88−import qualified Streamly.Prelude as Stream
89−import qualified Streamly.Prelude as StreamK
90−import Streamly.Benchmark.Prelude
91− ( composeN, sourceConcatMapId, benchIOSink
92− , concatStreamsWith
93− )
94−#else
95−import Streamly.Internal.Data.Stream (Stream)
96−import qualified Streamly.Internal.Data.Stream as D
97−#ifdef USE_STREAMK
98−import Streamly.Internal.Data.StreamK (StreamK)
99−import qualified Streamly.Internal.Data.Stream as Stream
100−import qualified Streamly.Internal.Data.StreamK as StreamK
101−#else
102−import qualified Streamly.Internal.Data.Stream as Stream
103−import qualified Streamly.Internal.Data.Stream as StreamK
104−#endif
105−#endif
106−
107−import Test.Tasty.Bench
108−import Prelude hiding (Foldable(..), mapM, replicate)
109−
110−#ifdef USE_STREAMK
111−toStream :: Applicative m => StreamK m a -> Stream m a
112−toStream = StreamK.toStream
113−
114−fromStream :: Monad m => Stream m a -> StreamK m a
115−fromStream = StreamK.fromStream
116−#else
117−fromStream :: a -> a
118−fromStream = id
119−
120−toStream :: a -> a
121−toStream = id
122−#endif
123−
124−#ifdef USE_PRELUDE
125−type Stream = Stream.SerialT
126−type MonadAsync m = Stream.MonadAsync m
127−mkCross = id
128−unCross = id
129−#else
130−type MonadAsync = Monad
131−
132−#ifdef USE_STREAMK
133−mkCross :: StreamK m a -> StreamK.CrossStreamK m a
134−mkCross = StreamK.mkCross
135−
136−unCross :: StreamK.CrossStreamK m a -> StreamK m a
137−unCross = StreamK.unCross
138−#else
139−mkCross :: Stream m a -> Stream.CrossStream m a
140−mkCross = Stream.mkCross
141−
142−unCross :: Stream.CrossStream m a -> Stream m a
143−unCross = Stream.unCross
144−#endif
145−#endif
146−
147−#ifdef USE_PRELUDE
148−{-# INLINE append #-}
149−append :: Monad m => Stream m a -> Stream m a -> Stream m a
150−append = Stream.serial
151−#else
152−#ifdef USE_STREAMK
153−append :: StreamK m a -> StreamK m a -> StreamK m a
154−append = StreamK.append
155−#else
156−append :: Monad m => Stream m a -> Stream m a -> Stream m a
157−append = Stream.append
158−#endif
159−#endif
160−
161−{-# INLINE append2 #-}
162−append2 :: Monad m => Stream m a -> Stream m a -> Stream m a
163−#ifdef USE_PRELUDE
164−append2 = Stream.append
165−#else
166−append2 = D.append
167−#endif
168−
169−{-# INLINE drain #-}
170−drain :: Monad m => Stream m a -> m ()
171−{-# INLINE toList #-}
172−toList :: Monad m => Stream m a -> m [a]
173−#ifdef USE_PRELUDE
174−drain = Stream.drain
175−toList = Stream.toList
176−#else
177−drain = Stream.fold Fold.drain
178−toList = Stream.fold Fold.toList
179−#endif
180−
181−{-# INLINE fromListM #-}
182−fromListM :: MonadAsync m => [m a] -> Stream m a
183−#ifdef USE_PRELUDE
184−fromListM = Stream.fromListM
185−#else
186−fromListM = Stream.sequence . Stream.fromList
187−#endif
188−
189−{-# INLINE fromFoldableM #-}
190−fromFoldableM :: MonadAsync m => [m a] -> Stream m a
191−#ifdef USE_PRELUDE
192−fromFoldableM = Stream.fromFoldableM
193−#else
194−fromFoldableM = Stream.sequence . toStream . StreamK.fromFoldable
195−#endif
196−
197−{-# INLINE sourceUnfoldrM #-}
198−sourceUnfoldrM :: MonadAsync m => Int -> Int -> Stream m Int
199−sourceUnfoldrM count start = Stream.unfoldrM step start
200−
201− where
202−
203− step cnt =
204− if cnt > start + count
205− then return Nothing
206− else return (Just (cnt, cnt + 1))
207−
208−{-# INLINE sourceUnfoldr #-}
209−sourceUnfoldr :: Monad m => Int -> Int -> Stream m Int
210−sourceUnfoldr count start = Stream.unfoldr step start
211−
212− where
213−
214− step cnt =
215− if cnt > start + count
216− then Nothing
217− else Just (cnt, cnt + 1)
218−
219−{-# INLINE sourceUnfoldrAction #-}
220−sourceUnfoldrAction :: (Monad m1, Monad m) => Int -> Int -> Stream m (m1 Int)
221−sourceUnfoldrAction value n = Stream.unfoldr step n
222−
223− where
224−
225− step cnt =
226− if cnt > n + value
227− then Nothing
228− else Just (return cnt, cnt + 1)
229−
230−{-# INLINE sourceFromFoldable #-}
231−sourceFromFoldable :: Monad m => Int -> Int -> Stream m Int
232−sourceFromFoldable value n = toStream $ StreamK.fromFoldable [n..n+value]
233−
234−#ifndef USE_PRELUDE
235−{-# INLINE benchIOSink #-}
236−benchIOSink
237− :: (NFData b)
238− => Int -> String -> (Stream IO Int -> IO b) -> Benchmark
239−benchIOSink value name f =
240− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value
241−#endif
242−
243−-- | Takes a source, and uses it with a default drain/fold method.
244−{-# INLINE benchIOSrc #-}
245−benchIOSrc
246− :: String
247− -> (Int -> Stream IO a)
248− -> Benchmark
249−benchIOSrc name f =
250− bench name $ nfIO $ randomRIO (1,1) >>= drain . f
251−
252−{-# NOINLINE benchIO #-}
253−benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark
254−benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
255−
256−#ifndef USE_PRELUDE
257−#ifdef USE_STREAMK
258−{-# INLINE concatStreamsWith #-}
259−concatStreamsWith
260− :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)
261− -> Int
262− -> Int
263− -> Int
264− -> IO ()
265−concatStreamsWith op outer inner n =
266− drain $ toStream $ StreamK.concatMapWith op
267− (fromStream . sourceUnfoldrM inner)
268− (fromStream $ sourceUnfoldrM outer n)
269−
270−{-# INLINE mergeMapWith #-}
271−mergeMapWith
272− :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)
273− -> Int
274− -> Int
275− -> Int
276− -> IO ()
277−mergeMapWith op outer inner n =
278− drain $ toStream $ StreamK.mergeMapWith op
279− (fromStream . sourceUnfoldrM inner)
280− (fromStream $ sourceUnfoldrM outer n)
281−#endif
282−
283−{-# INLINE sourceConcatMapId #-}
284−sourceConcatMapId :: (Monad m)
285− => Int -> Int -> Stream m (Stream m Int)
286−sourceConcatMapId value n =
287− Stream.fromList $ fmap (D.fromEffect . return) [n..n+value]
288−#endif
289−
290−{-# INLINE apDiscardFst #-}
291−apDiscardFst :: MonadAsync m =>
292− Int -> Int -> m ()
293−apDiscardFst linearCount start = drain $ toStream $ unCross $
294− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
295− *> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
296−
297− where
298−
299− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
300−
301−{-# INLINE apDiscardSnd #-}
302−apDiscardSnd :: MonadAsync m => Int -> Int -> m ()
303−apDiscardSnd linearCount start = drain $ toStream $ unCross $
304− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
305− <* mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
306−
307− where
308−
309− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
310−
311−{-# INLINE apLiftA2 #-}
312−apLiftA2 :: MonadAsync m => Int -> Int -> m ()
313−apLiftA2 linearCount start = drain $ toStream $ unCross $
314− liftA2 (+) (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))
315− (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))
316−
317− where
318−
319− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
320−
321−{-# INLINE toNullAp #-}
322−toNullAp :: MonadAsync m => Int -> Int -> m ()
323−toNullAp linearCount start = drain $ toStream $ unCross $
324− (+) <$> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
325− <*> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
326−
327− where
328−
329− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
330−
331−{-# INLINE monadThen #-}
332−monadThen :: MonadAsync m => Int -> Int -> m ()
333−monadThen linearCount start = drain $ toStream $ unCross $ do
334− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) >>
335− mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
336−
337− where
338−
339− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
340−
341−{-# INLINE toNullM #-}
342−toNullM :: MonadAsync m => Int -> Int -> m ()
343−toNullM linearCount start = drain $ toStream $ unCross $ do
344− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
345− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
346− return $ x + y
347−
348− where
349−
350− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
351−
352−{-# INLINE toNullM3 #-}
353−toNullM3 :: MonadAsync m => Int -> Int -> m ()
354−toNullM3 linearCount start = drain $ toStream $ unCross $ do
355− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
356− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
357− z <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)
358− return $ x + y + z
359− where
360− nestedCount3 = round (fromIntegral linearCount**(1/3::Double))
361−
362−{-# INLINE filterAllOutM #-}
363−filterAllOutM :: MonadAsync m => Int -> Int -> m ()
364−filterAllOutM linearCount start = drain $ toStream $ unCross $ do
365− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
366− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
367− let s = x + y
368− if s < 0
369− then return s
370− else mkCross StreamK.nil
371− where
372− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
373−
374−{-# INLINE filterAllInM #-}
375−filterAllInM :: MonadAsync m => Int -> Int -> m ()
376−filterAllInM linearCount start = drain $ toStream $ unCross $ do
377− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
378− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
379− let s = x + y
380− if s > 0
381− then return s
382− else mkCross StreamK.nil
383− where
384− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
385−
386−{-# INLINE filterSome #-}
387−filterSome :: MonadAsync m => Int -> Int -> m ()
388−filterSome linearCount start = drain $ toStream $ unCross $ do
389− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
390− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
391− let s = x + y
392− if s > 1100000
393− then return s
394− else mkCross StreamK.nil
395− where
396− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
397−
398−{-# INLINE breakAfterSome #-}
399−breakAfterSome :: Int -> Int -> IO ()
400−breakAfterSome linearCount start = do
401− (_ :: Either ErrorCall ()) <- try $ drain $ toStream $ unCross $ do
402− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
403− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
404− let s = x + y
405− if s > 1100000
406− then error "break"
407− else return s
408− return ()
409− where
410− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
411−
412−{-# INLINE toListM #-}
413−toListM :: MonadAsync m => Int -> Int -> m [Int]
414−toListM linearCount start = toList $ toStream $ unCross $ do
415− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
416− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
417− return $ x + y
418− where
419− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
420−
421−-- Taking a specified number of elements is very expensive in logict so we have
422−-- a test to measure the same.
423−{-# INLINE toListSome #-}
424−toListSome :: MonadAsync m => Int -> Int -> m [Int]
425−toListSome linearCount start =
426− toList $ Stream.take 10000 $ toStream $ unCross $ do
427− x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
428− y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)
429− return $ x + y
430− where
431− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
432−
433−#ifndef USE_PRELUDE
434−{-# INLINE composeN #-}
435−composeN ::
436− (Monad m)
437− => Int
438− -> (Stream m Int -> Stream m Int)
439− -> Stream m Int
440− -> m ()
441−composeN n f =
442− case n of
443− 1 -> drain . f
444− 2 -> drain . f . f
445− 3 -> drain . f . f . f
446− 4 -> drain . f . f . f . f
447− _ -> undefined
448−#endif
449−
450−{-# INLINE mapN #-}
451−mapN ::
452− Monad m
453− => Int
454− -> Stream m Int
455− -> m ()
456−mapN n = composeN n $ fmap (+ 1)
457−
458−{-# INLINE mapM #-}
459−mapM ::
460− MonadAsync m
461− => Int
462− -> Stream m Int
463− -> m ()
464−mapM n = composeN n $ Stream.mapM return
465−
466−#ifndef USE_PRELUDE
467−foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b
468−foldl' f z = Stream.fold (Fold.foldl' f z)
469−
470−scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b
471−scanl' f z = Stream.scan (Fold.foldl' f z)
472−#endif
473−
474−{-# INLINE transformMapM #-}
475−transformMapM ::
476− (Monad m)
477− => Int
478− -> Stream m Int
479− -> m ()
480−transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)
481−
482−{-# INLINE transformComposeMapM #-}
483−transformComposeMapM ::
484− (Monad m)
485− => Int
486− -> Stream m Int
487− -> m ()
488−transformComposeMapM n =
489− composeN n $
490− Stream.transform
491− (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`
492− Pipe.mapM (\x -> return (x + 2)))
493−
494−{-# INLINE transformTeeMapM #-}
495−transformTeeMapM ::
496− (Monad m)
497− => Int
498− -> Stream m Int
499− -> m ()
500−transformTeeMapM n =
501− composeN n $
502− Stream.transform
503− (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`
504− Pipe.mapM (\x -> return (x + 2)))
505−
506−{-# INLINE transformZipMapM #-}
507−transformZipMapM ::
508− (Monad m)
509− => Int
510− -> Stream m Int
511− -> m ()
512−transformZipMapM n =
513− composeN n $
514− Stream.transform
515− (Pipe.zipWith
516− (+)
517− (Pipe.mapM (\x -> return (x + 1)))
518− (Pipe.mapM (\x -> return (x + 2))))
benchmark/Streamly/Benchmark/Data/Stream/Concurrent.hsdeleted−20
@@ -1,20 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−moduleName :: String
13−moduleName = "Data.Stream.Concurrent"
14−
15−-------------------------------------------------------------------------------
16−-- Main
17−-------------------------------------------------------------------------------
18−
19−main :: IO ()
20−main = runWithCLIOpts defaultStreamSize (allBenchmarks moduleName False id)
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hsdeleted−208
@@ -1,208 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−module Stream.ConcurrentCommon
10− ( allBenchmarks
11− )
12−where
13−
14−import Stream.Common
15− (composeN, benchIO, benchIOSink, benchIOSrc, sourceUnfoldrM)
16−import Streamly.Data.Stream (Stream)
17−import Streamly.Internal.Data.Stream.Prelude (MonadAsync, Config)
18−
19−import qualified Data.List as List
20−import qualified Streamly.Data.Fold as Fold
21−import qualified Streamly.Data.Stream as Stream
22−import qualified Streamly.Internal.Data.Stream.Prelude as Async
23−
24−import Test.Tasty.Bench
25−import Prelude hiding (mapM)
26−import Streamly.Benchmark.Common
27−
28−-- XXX Write inspection tests to make sure no dictionaries are being passed
29−-- around to find specialization issues. Could be really bad for perf.
30−
31−-------------------------------------------------------------------------------
32−-- Mapping
33−-------------------------------------------------------------------------------
34−
35−{-# INLINE mapM #-}
36−mapM ::
37− MonadAsync m
38− => (Config -> Config)
39− -> Int
40− -> Stream m Int
41− -> m ()
42−mapM f n = composeN n $ Async.parMapM f return
43−
44−o_1_space_mapping :: Int -> (Config -> Config) -> [Benchmark]
45−o_1_space_mapping value f =
46− [ bgroup "mapping"
47− [ benchIOSink value "mapM" $ mapM f 1
48− ]
49− ]
50−
51−-------------------------------------------------------------------------------
52−-- Size conserving transformations (reordering, buffering, etc.)
53−-------------------------------------------------------------------------------
54−
55−o_n_heap_buffering :: Int -> (Config -> Config) -> [Benchmark]
56−o_n_heap_buffering value f =
57− [ bgroup "buffered"
58− [ benchIOSink value "mkAsync"
59− (Stream.fold Fold.drain . Async.parEval f)
60− ]
61− ]
62−
63−-------------------------------------------------------------------------------
64−-- Joining
65−-------------------------------------------------------------------------------
66−
67−{-# INLINE async2 #-}
68−async2 :: (Config -> Config) -> Int -> Int -> IO ()
69−async2 f count n =
70− Stream.fold Fold.drain
71− $ Async.parTwo f
72− (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
73−
74−{-# INLINE concatAsync2 #-}
75−concatAsync2 :: (Config -> Config) -> Int -> Int -> IO ()
76−concatAsync2 f count n =
77− Stream.fold Fold.drain
78− $ Async.parConcat f
79− $ Stream.fromList
80− [sourceUnfoldrM count n, sourceUnfoldrM count (n + 1)]
81−
82−o_1_space_joining :: Int -> (Config -> Config) -> [Benchmark]
83−o_1_space_joining value f =
84− [ bgroup "joining"
85− [ benchIOSrc1 "async (2 of n/2)" (async2 f (value `div` 2))
86− , benchIOSrc1 "concat async (2 of n/2)" (concatAsync2 f (value `div` 2))
87− ]
88− ]
89−
90−-------------------------------------------------------------------------------
91−-- Concat
92−-------------------------------------------------------------------------------
93−
94−{-# INLINE sourceFoldMapWith #-}
95−sourceFoldMapWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
96−sourceFoldMapWith f value n =
97− Async.parConcatMap f Stream.fromPure $ Stream.fromList [n..n+value]
98−
99−{-# INLINE sourceFoldMapWithStream #-}
100−sourceFoldMapWithStream :: (Config -> Config) -> Int -> Int -> Stream IO Int
101−sourceFoldMapWithStream f value n =
102− Async.parConcatMap f Stream.fromPure
103− $ Stream.enumerateFromTo n (n + value)
104−
105−{-# INLINE concatFoldableWith #-}
106−concatFoldableWith :: (Config -> Config) -> Int -> Int -> Stream IO Int
107−concatFoldableWith f value n =
108− let step x =
109− if x <= n + value
110− then Just (Stream.fromPure x, x + 1)
111− else Nothing
112− list = List.unfoldr step n
113− in Async.parConcat f (Stream.fromList list)
114−
115−o_1_space_concatFoldable :: Int -> (Config -> Config) -> [Benchmark]
116−o_1_space_concatFoldable value f =
117− [ bgroup "concat-foldable"
118− [ benchIOSrc "foldMapWith (<>) (List)"
119− (sourceFoldMapWith f value)
120− , benchIOSrc "foldMapWith (<>) (Stream)"
121− (sourceFoldMapWithStream f value)
122− , benchIOSrc "S.concatFoldableWith (<>) (List)"
123− (concatFoldableWith f value)
124− ]
125− ]
126−
127−{-# INLINE concatMapStreamsWith #-}
128−concatMapStreamsWith
129− :: (Config -> Config)
130− -> Int
131− -> Int
132− -> Int
133− -> IO ()
134−concatMapStreamsWith f outer inner n =
135− Stream.fold Fold.drain
136− $ Async.parConcatMap f (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
137−
138−{-# INLINE concatFmapStreamsWith #-}
139−concatFmapStreamsWith
140− :: (Config -> Config)
141− -> Int
142− -> Int
143− -> Int
144− -> IO ()
145−concatFmapStreamsWith f outer inner n =
146− Stream.fold Fold.drain
147− $ Async.parConcat f
148− $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n)
149−
150−o_1_space_concatMap :: Int -> (Config -> Config) -> [Benchmark]
151−o_1_space_concatMap value f =
152− value2 `seq`
153− [ bgroup "concat"
154− [ benchIO "parConcatMap (n of 1)"
155− (concatMapStreamsWith f value 1)
156− , benchIO "parConcatMap (sqrt x of sqrt x)"
157− (concatMapStreamsWith f value2 value2)
158− , benchIO "parConcatMap (1 of n)"
159− (concatMapStreamsWith f 1 value)
160− , benchIO "concat . fmap (n of 1)"
161− (concatFmapStreamsWith f value 1)
162− ]
163− ]
164−
165− where
166−
167− value2 = round $ sqrt (fromIntegral value :: Double)
168−
169−-------------------------------------------------------------------------------
170−-- Monadic outer product
171−-------------------------------------------------------------------------------
172−
173−{-# INLINE toNullAp #-}
174−toNullAp :: (Config -> Config) -> Int -> Int -> IO ()
175−toNullAp f linearCount start =
176− Stream.fold Fold.drain
177− $ Async.parApply f
178− (fmap (+) (sourceUnfoldrM nestedCount2 start))
179− (sourceUnfoldrM nestedCount2 start)
180−
181− where
182−
183− nestedCount2 = round (fromIntegral linearCount**(1/2::Double))
184−
185−o_1_space_outerProduct :: Int -> (Config -> Config) -> [Benchmark]
186−o_1_space_outerProduct value f =
187− [ bgroup "monad-outer-product"
188− [ benchIO "toNullAp" $ toNullAp f value
189− ]
190− ]
191−
192−-------------------------------------------------------------------------------
193−-- Benchmark sets
194−-------------------------------------------------------------------------------
195−
196−allBenchmarks :: String -> Bool -> (Config -> Config) -> Int -> [Benchmark]
197−allBenchmarks moduleName wide modifier value =
198− [ bgroup (o_1_space_prefix moduleName) $ concat
199− [ o_1_space_mapping value modifier
200− , o_1_space_concatFoldable value modifier
201− , o_1_space_concatMap value modifier
202− , o_1_space_joining value modifier
203− ] ++ if wide then [] else o_1_space_outerProduct value modifier
204− , bgroup (o_n_heap_prefix moduleName) $ concat
205− [ if wide then o_1_space_outerProduct value modifier else []
206− , o_n_heap_buffering value modifier
207− ]
208− ]
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentEager.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentEager"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName True (Async.eager True))
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentInterleaved.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2022 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentInterleaved"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName True (Async.interleaved True))
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentOrdered.hsdeleted−25
@@ -1,25 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−-- |
3−-- Module : Main
4−-- Copyright : (c) 2018 Composewell Technologies
5−--
6−-- License : BSD3
7−-- Maintainer : streamly@composewell.com
8−
9−import Stream.ConcurrentCommon (allBenchmarks)
10−import Streamly.Benchmark.Common (runWithCLIOpts, defaultStreamSize)
11−
12−import qualified Streamly.Internal.Data.Stream.Prelude as Async
13−
14−moduleName :: String
15−moduleName = "Data.Stream.ConcurrentOrdered"
16−
17−-------------------------------------------------------------------------------
18−-- Main
19−-------------------------------------------------------------------------------
20−
21−main :: IO ()
22−main =
23− runWithCLIOpts
24− defaultStreamSize
25− (allBenchmarks moduleName False (Async.ordered True))
benchmark/Streamly/Benchmark/Data/Stream/Generate.hsdeleted−278
@@ -1,278 +0,0 @@
1−-- |
2−-- Module : Stream.Generate
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE FlexibleInstances #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE RankNTypes #-}
12−
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−module Stream.Generate (benchmarks) where
19−
20−import Control.DeepSeq (NFData(..))
21−import Data.Functor.Identity (Identity(..))
22−
23−import qualified GHC.Exts as GHC
24−import qualified Streamly.Internal.Data.Fold as Fold
25−
26−#ifdef USE_PRELUDE
27−import Streamly.Prelude (MonadAsync)
28−import Stream.Common hiding (MonadAsync)
29−import Streamly.Benchmark.Prelude (sourceFromFoldableM, absTimes)
30−import qualified Streamly.Prelude as S
31−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32−#else
33−import Stream.Common
34−import Streamly.Internal.Data.Stream (Stream)
35−import qualified Streamly.Internal.Data.Stream as Stream
36−#ifdef USE_STREAMK
37−import System.IO.Unsafe (unsafeInterleaveIO)
38−import qualified Streamly.Internal.Data.StreamK as StreamK
39−import qualified Stream.Common as Common
40−#endif
41−#endif
42−
43−import Test.Tasty.Bench
44−import Streamly.Benchmark.Common
45−import qualified Prelude
46−
47−import Prelude hiding (repeat, replicate, iterate)
48−
49−-------------------------------------------------------------------------------
50−-- Generation
51−-------------------------------------------------------------------------------
52−
53−#ifdef USE_PRELUDE
54−type Stream = Stream.SerialT
55−toStreamD = Stream.toStream
56−#else
57−toStreamD :: a -> a
58−toStreamD = id
59−#endif
60−
61−-------------------------------------------------------------------------------
62−-- fromList
63−-------------------------------------------------------------------------------
64−
65−{-# INLINE sourceFromList #-}
66−sourceFromList :: Monad m => Int -> Int -> Stream m Int
67−sourceFromList value n = Stream.fromList [n..n+value]
68−
69−{-# INLINE sourceFromListM #-}
70−sourceFromListM :: MonadAsync m => Int -> Int -> Stream m Int
71−sourceFromListM value n = fromListM (fmap return [n..n+value])
72−
73−{-# INLINE sourceIsList #-}
74−sourceIsList :: Int -> Int -> Stream Identity Int
75−sourceIsList value n = GHC.fromList [n..n+value]
76−
77−{-# INLINE sourceIsString #-}
78−sourceIsString :: Int -> Int -> Stream Identity Char
79−sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
80−
81−{-# INLINE readInstance #-}
82−readInstance :: String -> Stream Identity Int
83−readInstance str =
84− let r = reads str
85− in case r of
86− [(x,"")] -> x
87− _ -> error "readInstance: no parse"
88−
89−-- For comparisons
90−{-# INLINE readInstanceList #-}
91−readInstanceList :: String -> [Int]
92−readInstanceList str =
93− let r = reads str
94− in case r of
95− [(x,"")] -> x
96− _ -> error "readInstance: no parse"
97−
98−{-# INLINE repeat #-}
99−repeat :: Monad m => Int -> Int -> Stream m Int
100−repeat count = Stream.take count . Stream.repeat
101−
102−{-# INLINE replicate #-}
103−replicate :: Monad m => Int -> Int -> Stream m Int
104−replicate = Stream.replicate
105−
106−-------------------------------------------------------------------------------
107−-- enumerate
108−-------------------------------------------------------------------------------
109−
110−{-# INLINE sourceIntFromTo #-}
111−sourceIntFromTo :: Monad m => Int -> Int -> Stream m Int
112−sourceIntFromTo value n = Stream.enumerateFromTo n (n + value)
113−
114−{-# INLINE sourceIntFromThenTo #-}
115−sourceIntFromThenTo :: Monad m => Int -> Int -> Stream m Int
116−sourceIntFromThenTo value n = Stream.enumerateFromThenTo n (n + 1) (n + value)
117−
118−{-# INLINE sourceFracFromTo #-}
119−sourceFracFromTo :: Monad m => Int -> Int -> Stream m Double
120−sourceFracFromTo value n =
121− Stream.enumerateFromTo (fromIntegral n) (fromIntegral (n + value))
122−
123−{-# INLINE sourceFracFromThenTo #-}
124−sourceFracFromThenTo :: Monad m => Int -> Int -> Stream m Double
125−sourceFracFromThenTo value n = Stream.enumerateFromThenTo (fromIntegral n)
126− (fromIntegral n + 1.0001) (fromIntegral (n + value))
127−
128−{-# INLINE sourceIntegerFromStep #-}
129−sourceIntegerFromStep :: Monad m => Int -> Int -> Stream m Integer
130−sourceIntegerFromStep value n =
131− Stream.take value $ Stream.enumerateFromThen (fromIntegral n) (fromIntegral n + 1)
132−
133−{-# INLINE enumerateFrom #-}
134−enumerateFrom :: Monad m => Int -> Int -> Stream m Int
135−enumerateFrom count = Stream.take count . Stream.enumerateFrom
136−
137−{-# INLINE enumerateFromTo #-}
138−enumerateFromTo :: Monad m => Int -> Int -> Stream m Int
139−enumerateFromTo = sourceIntFromTo
140−
141−{-# INLINE enumerateFromThen #-}
142−enumerateFromThen :: Monad m => Int -> Int -> Stream m Int
143−enumerateFromThen count inp = Stream.take count $ Stream.enumerateFromThen inp (inp + 1)
144−
145−{-# INLINE enumerateFromThenTo #-}
146−enumerateFromThenTo :: Monad m => Int -> Int -> Stream m Int
147−enumerateFromThenTo = sourceIntFromThenTo
148−
149−-- n ~ 1
150−{-# INLINE enumerate #-}
151−enumerate :: Monad m => Int -> Int -> Stream m Int
152−enumerate count n = Stream.take (count + n) Stream.enumerate
153−
154−-- n ~ 1
155−{-# INLINE enumerateTo #-}
156−enumerateTo :: Monad m => Int -> Int -> Stream m Int
157−enumerateTo count n = Stream.enumerateTo (minBound + count + n)
158−
159−{-# INLINE iterate #-}
160−iterate :: Monad m => Int -> Int -> Stream m Int
161−iterate count = Stream.take count . Stream.iterate (+1)
162−
163−{-# INLINE iterateM #-}
164−iterateM :: MonadAsync m => Int -> Int -> Stream m Int
165−iterateM count = Stream.take count . Stream.iterateM (return . (+1)) . return
166−
167−{-# INLINE repeatM #-}
168−repeatM :: MonadAsync m => Int -> Int -> Stream m Int
169−repeatM count = Stream.take count . Stream.repeatM . return
170−
171−{-# INLINE replicateM #-}
172−replicateM :: MonadAsync m => Int -> Int -> Stream m Int
173−replicateM count = Stream.replicateM count . return
174−
175−#ifdef USE_PRELUDE
176−{-# INLINE fromIndices #-}
177−fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
178−fromIndices value n = S.take value $ S.fromIndices (+ n)
179−
180−{-# INLINE fromIndicesM #-}
181−fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
182−fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
183−#endif
184−
185−#ifdef USE_STREAMK
186−{-# INLINE mfixUnfold #-}
187−mfixUnfold :: Int -> Int -> Stream IO (Int, Int)
188−mfixUnfold count start = toStream $ StreamK.mfix f
189− where
190− f action = StreamK.unCross $ do
191− let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act
192− x <- StreamK.mkCross (fromStream $ Common.fromListM [incr 1 action, incr 2 action])
193− y <- StreamK.mkCross (fromStream $ Common.sourceUnfoldr count start)
194− return (x, y)
195−#endif
196−
197−o_1_space_generation :: Int -> [Benchmark]
198−o_1_space_generation value =
199− [ bgroup "generation"
200− [ benchIOSrc "unfoldr" (sourceUnfoldr value)
201− , benchIOSrc "unfoldrM" (sourceUnfoldrM value)
202− , benchIOSrc "repeat" (repeat value)
203− , benchIOSrc "replicate" (replicate value)
204− , benchIOSrc "iterate" (iterate value)
205− , benchIOSrc "iterateM" (iterateM value)
206− , benchIOSrc "intFromTo" (sourceIntFromTo value)
207− , benchIOSrc "intFromThenTo" (sourceIntFromThenTo value)
208− , benchIOSrc "integerFromStep" (sourceIntegerFromStep value)
209− , benchIOSrc "fracFromThenTo" (sourceFracFromThenTo value)
210− , benchIOSrc "fracFromTo" (sourceFracFromTo value)
211− , benchIOSrc "fromList" (sourceFromList value)
212− , benchIOSrc "fromListM" (sourceFromListM value)
213− , benchPureSrc "IsList.fromList" (toStreamD . sourceIsList value)
214− , benchPureSrc "IsString.fromString" (toStreamD . sourceIsString value)
215− , benchIOSrc "enumerateFrom" (enumerateFrom value)
216− , benchIOSrc "enumerateFromTo" (enumerateFromTo value)
217− , benchIOSrc "enumerateFromThen" (enumerateFromThen value)
218− , benchIOSrc "enumerateFromThenTo" (enumerateFromThenTo value)
219− , benchIOSrc "enumerate" (enumerate value)
220− , benchIOSrc "enumerateTo" (enumerateTo value)
221− , benchIOSrc "repeatM" (repeatM value)
222− , benchIOSrc "replicateM" (replicateM value)
223−#ifdef USE_PRELUDE
224− , benchIOSrc "fromIndices" (fromIndices value)
225− , benchIOSrc "fromIndicesM" (fromIndicesM value)
226−#endif
227−
228− -- These essentially test cons and consM
229−#ifdef USE_STREAMK
230− , benchIOSrc "fromFoldable" (sourceFromFoldable value)
231− -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)
232−#else
233− -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)
234−#endif
235−
236−#ifdef USE_PRELUDE
237− , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)
238− , benchIOSrc "absTimes" $ absTimes value
239−#endif
240−#ifdef USE_STREAMK
241− , Common.benchIOSrc "mfix_10" (mfixUnfold 10)
242− , Common.benchIOSrc "mfix_100" (mfixUnfold 100)
243− , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000)
244−#endif
245− ]
246− ]
247−
248−#ifndef USE_PRELUDE
249−instance NFData a => NFData (Stream Identity a) where
250− {-# INLINE rnf #-}
251− rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs
252−#endif
253−
254−o_n_heap_generation :: Int -> [Benchmark]
255−o_n_heap_generation value =
256− [ bgroup "buffered"
257− -- Buffers the output of show/read.
258− -- XXX can the outputs be streaming? Can we have special read/show
259− -- style type classes, readM/showM supporting streaming effects?
260− [ bench "readsPrec pure streams" $
261− nf readInstance (mkString value)
262− , bench "readsPrec Haskell lists" $
263− nf readInstanceList (mkListString value)
264− ]
265− ]
266−
267−-------------------------------------------------------------------------------
268−-- Main
269−-------------------------------------------------------------------------------
270−
271−-- In addition to gauge options, the number of elements in the stream can be
272−-- passed using the --stream-size option.
273−--
274−benchmarks :: String -> Int -> [Benchmark]
275−benchmarks moduleName size =
276− [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
277− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
278− ]
benchmark/Streamly/Benchmark/Data/Stream/Lift.hsdeleted−146
@@ -1,146 +0,0 @@
1−-- |
2−-- Module : Stream.Lift
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE RankNTypes #-}
11−
12−#ifdef USE_PRELUDE
13−{-# OPTIONS_GHC -Wno-deprecations #-}
14−#endif
15−
16−module Stream.Lift (benchmarks) where
17−
18−import Control.DeepSeq (NFData(..))
19−import Control.Monad.State.Strict (StateT, get, put)
20−import Data.Functor.Identity (Identity)
21−import Stream.Common (sourceUnfoldr, sourceUnfoldrM, benchIOSrc)
22−import System.Random (randomRIO)
23−
24−import qualified Stream.Common as Common
25−import qualified Streamly.Internal.Data.Fold as Fold
26−
27−#ifdef USE_PRELUDE
28−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
29−#else
30−import Streamly.Internal.Data.Stream (Stream)
31−import qualified Streamly.Internal.Data.Stream as Stream
32−#ifdef USE_STREAMK
33−import Stream.Common (benchIO, drain)
34−import Streamly.Internal.Data.StreamK (StreamK)
35−import qualified Streamly.Internal.Data.StreamK as StreamK
36−import qualified Control.Monad.State.Strict as State
37−#endif
38−#endif
39−
40−import Test.Tasty.Bench
41−import Streamly.Benchmark.Common
42−import Prelude hiding (reverse, tail)
43−
44−#ifdef USE_PRELUDE
45−type Stream = Stream.SerialT
46−#endif
47−
48−-------------------------------------------------------------------------------
49−-- Monad transformation (hoisting etc.)
50−-------------------------------------------------------------------------------
51−
52−{-# INLINE sourceUnfoldrState #-}
53−sourceUnfoldrState :: Common.MonadAsync m =>
54− Int -> Int -> Stream (StateT Int m) Int
55−sourceUnfoldrState value n = Stream.unfoldrM step n
56− where
57− step cnt =
58− if cnt > n + value
59− then return Nothing
60− else do
61− s <- get
62− put (s + 1)
63− return (Just (s, cnt + 1))
64−
65−{-# INLINE evalStateT #-}
66−evalStateT :: Common.MonadAsync m => Int -> Int -> Stream m Int
67−evalStateT value n =
68− Stream.evalStateT (return 0) (sourceUnfoldrState value n)
69−
70−{-# INLINE withState #-}
71−withState :: Common.MonadAsync m => Int -> Int -> Stream m Int
72−withState value n =
73− Stream.evalStateT
74− (return (0 :: Int)) (Stream.liftInner (sourceUnfoldrM value n))
75−
76−{-# INLINE benchHoistSink #-}
77−benchHoistSink
78− :: (NFData b)
79− => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
80−benchHoistSink value name f =
81− bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
82−
83−o_1_space_hoisting :: Int -> [Benchmark]
84−o_1_space_hoisting value =
85− [ bgroup "hoisting"
86− [ benchIOSrc "evalState" (evalStateT value)
87− , benchIOSrc "withState" (withState value)
88−#ifndef USE_PRELUDE
89− , benchHoistSink value "generalizeInner"
90− ((\xs -> Stream.fold Fold.length xs :: IO Int)
91− . Stream.generalizeInner)
92−#endif
93− ]
94− ]
95−
96−#ifdef USE_STREAMK
97−{-# INLINE iterateStateIO #-}
98−iterateStateIO ::
99− Monad m
100− => Int
101− -> StateT Int m Int
102−iterateStateIO n = do
103− x <- get
104− if x > n
105− then do
106− put (x - 1)
107− iterateStateIO n
108− else return x
109−
110−-- XXX This is basically testing the perf of concatEffect, change it to just
111−-- use concatEffect and move it along with other concatMap benchmarks.
112−{-# INLINE iterateStateT #-}
113−iterateStateT :: Int -> StreamK (StateT Int IO) Int
114−iterateStateT n = StreamK.concatEffect $ do
115− x <- get
116− if x > n
117− then do
118− put (x - 1)
119− return $ iterateStateT n
120− else return $ StreamK.fromPure x
121−
122−o_n_heap_transformer :: Int -> [Benchmark]
123−o_n_heap_transformer value =
124− [ bgroup "transformer"
125− [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
126− State.evalStateT (iterateStateIO n) value
127− , benchIO "Stream (StateT Int IO) (n times)" $ \n ->
128− State.evalStateT (drain $ Common.toStream (iterateStateT n)) value
129− ]
130− ]
131−#endif
132−
133−-------------------------------------------------------------------------------
134−-- Main
135−-------------------------------------------------------------------------------
136−
137−-- In addition to gauge options, the number of elements in the stream can be
138−-- passed using the --stream-size option.
139−--
140−benchmarks :: String -> Int -> [Benchmark]
141−benchmarks moduleName size =
142− [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
143−#ifdef USE_STREAMK
144− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
145−#endif
146− ]
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hsdeleted−588
@@ -1,588 +0,0 @@
1−-- |
2−-- Module : Stream.Reduce
3−-- Copyright : (c) 2018 Composewell Technologies
4−-- License : BSD-3-Clause
5−-- Maintainer : streamly@composewell.com
6−
7−{-# LANGUAGE CPP #-}
8−{-# LANGUAGE FlexibleContexts #-}
9−{-# LANGUAGE ScopedTypeVariables #-}
10−{-# LANGUAGE DeriveAnyClass #-}
11−{-# LANGUAGE DeriveGeneric #-}
12−{-# LANGUAGE RankNTypes #-}
13−
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18−module Stream.Reduce (benchmarks) where
19−
20−import Control.DeepSeq (NFData(..))
21−import Control.Monad.IO.Class (MonadIO(..))
22−import Data.Monoid (Sum(..))
23−import GHC.Generics (Generic)
24−
25−import qualified Streamly.Internal.Data.Refold.Type as Refold
26−import qualified Streamly.Internal.Data.Fold as FL
27−import qualified Stream.Common as Common
28−
29−#ifndef USE_STREAMLY_CORE
30−import Data.HashMap.Strict (HashMap)
31−import Data.Proxy (Proxy(..))
32−import Streamly.Internal.Data.IsMap.HashMap ()
33−#endif
34−
35−#ifdef USE_PRELUDE
36−import Control.Monad (when)
37−import qualified Streamly.Internal.Data.Stream.IsStream as S
38−import qualified Streamly.Prelude as S
39−import Streamly.Prelude (fromSerial)
40−import Streamly.Benchmark.Prelude hiding
41− ( benchIO, benchIOSrc, sourceUnfoldrM, apDiscardFst, apDiscardSnd, apLiftA2
42− , toNullAp, monadThen, toNullM, toNullM3, filterAllInM, filterAllOutM
43− , filterSome, breakAfterSome, toListM, toListSome, transformMapM
44− , transformComposeMapM, transformTeeMapM, transformZipMapM)
45−#else
46−
47−import Streamly.Internal.Data.Stream (Stream)
48−import qualified Streamly.Internal.Data.Stream as S
49−#ifndef USE_STREAMLY_CORE
50−import qualified Streamly.Data.Stream.Prelude as S
51−import qualified Streamly.Internal.Data.Stream.Prelude as S
52−#endif
53−
54−#ifdef USE_STREAMK
55−import Streamly.Internal.Data.StreamK (StreamK)
56−import qualified Streamly.Internal.Data.Parser as PR
57−import qualified Streamly.Internal.Data.StreamK as K
58−#else
59−import qualified Streamly.Internal.Data.Stream as K
60−#endif
61−
62−#endif
63−
64−import Test.Tasty.Bench
65−import Streamly.Benchmark.Common
66−import Stream.Common
67−import Prelude hiding (reverse, tail)
68−
69−#ifdef USE_PRELUDE
70−type Stream = S.SerialT
71−#endif
72−
73−-- Apply transformation g count times on a stream of length len
74−#ifdef USE_STREAMK
75−{-# INLINE iterateSource #-}
76−iterateSource ::
77− MonadAsync m
78− => (StreamK m Int -> StreamK m Int)
79− -> Int
80− -> Int
81− -> Int
82− -> StreamK m Int
83−iterateSource g count len n = f count (fromStream $ sourceUnfoldrM len n)
84−
85− where
86−
87− f (0 :: Int) stream = stream
88− f i stream = f (i - 1) (g stream)
89−#else
90−{-# INLINE iterateSource #-}
91−iterateSource ::
92− MonadAsync m
93− => (Stream m Int -> Stream m Int)
94− -> Int
95− -> Int
96− -> Int
97− -> Stream m Int
98−iterateSource g count len n = f count (sourceUnfoldrM len n)
99−
100− where
101−
102− f (0 :: Int) stream = stream
103− f i stream = f (i - 1) (g stream)
104−#endif
105−
106−-------------------------------------------------------------------------------
107−-- Grouping transformations
108−-------------------------------------------------------------------------------
109−
110−{-# INLINE groups #-}
111−groups :: MonadIO m => Stream m Int -> m ()
112−groups =
113−#ifdef USE_PRELUDE
114− Common.drain . S.groups FL.drain
115−#else
116− Common.drain . S.groupsWhile (==) FL.drain
117−#endif
118−
119−{-# INLINE groupsWhileLT #-}
120−groupsWhileLT :: MonadIO m => Stream m Int -> m ()
121−groupsWhileLT =
122−#ifdef USE_PRELUDE
123− Common.drain . S.groupsBy (>) FL.drain
124−#else
125− Common.drain . S.groupsWhile (<) FL.drain
126−#endif
127−
128−{-# INLINE groupsWhileEq #-}
129−groupsWhileEq :: MonadIO m => Stream m Int -> m ()
130−groupsWhileEq =
131−#ifdef USE_PRELUDE
132− Common.drain . S.groupsBy (==) FL.drain
133−#else
134− Common.drain . S.groupsWhile (==) FL.drain
135−#endif
136−
137−
138−{-# INLINE groupsByRollingLT #-}
139−groupsByRollingLT :: MonadIO m => Stream m Int -> m ()
140−groupsByRollingLT =
141−#ifdef USE_PRELUDE
142− Common.drain . S.groupsByRolling (<) FL.drain
143−#else
144− Common.drain . S.groupsRollingBy (<) FL.drain
145−#endif
146−
147−{-# INLINE groupsByRollingEq #-}
148−groupsByRollingEq :: MonadIO m => Stream m Int -> m ()
149−groupsByRollingEq =
150−#ifdef USE_PRELUDE
151− Common.drain . S.groupsByRolling (==) FL.drain
152−#else
153− Common.drain . S.groupsRollingBy (==) FL.drain
154−#endif
155−
156−{-# INLINE foldMany #-}
157−foldMany :: Monad m => Stream m Int -> m ()
158−foldMany =
159− Common.drain
160− . fmap getSum
161− . S.foldMany (FL.take 2 FL.mconcat)
162− . fmap Sum
163−
164−{-# INLINE foldManyPost #-}
165−foldManyPost :: Monad m => Stream m Int -> m ()
166−foldManyPost =
167− Common.drain
168− . fmap getSum
169− . S.foldManyPost (FL.take 2 FL.mconcat)
170− . fmap Sum
171−
172−{-# INLINE refoldMany #-}
173−refoldMany :: Monad m => Stream m Int -> m ()
174−refoldMany =
175− Common.drain
176− . fmap getSum
177− . S.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
178− . fmap Sum
179−
180−{-# INLINE foldIterateM #-}
181−foldIterateM :: Monad m => Stream m Int -> m ()
182−foldIterateM =
183− Common.drain
184− . fmap getSum
185− . S.foldIterateM
186− (return . FL.take 2 . FL.sconcat) (return (Sum 0))
187− . fmap Sum
188−
189−{-# INLINE refoldIterateM #-}
190−refoldIterateM :: Monad m => Stream m Int -> m ()
191−refoldIterateM =
192− Common.drain
193− . fmap getSum
194− . S.refoldIterateM
195− (Refold.take 2 Refold.sconcat) (return (Sum 0))
196− . fmap Sum
197−
198−#ifdef USE_STREAMK
199−{-# INLINE parseBreak #-}
200−parseBreak :: Monad m => StreamK m Int -> m ()
201−parseBreak s = do
202− r <- K.parseDBreak PR.one s
203− case r of
204− (Left _, _) -> return ()
205− (Right _, s1) -> parseBreak s1
206−#endif
207−
208−o_1_space_grouping :: Int -> [Benchmark]
209−o_1_space_grouping value =
210− -- Buffering operations using heap proportional to group/window sizes.
211− [ bgroup "grouping"
212− [
213− benchIOSink value "groups" groups
214− , benchIOSink value "groupsWhileLT" groupsWhileLT
215− , benchIOSink value "groupsWhileEq" groupsWhileEq
216− , benchIOSink value "groupsByRollingLT" groupsByRollingLT
217− , benchIOSink value "groupsByRollingEq" groupsByRollingEq
218− ,
219−
220− -- XXX parseMany/parseIterate benchmarks are in the Parser/ParserD
221− -- modules we can bring those here. chunksOf benchmarks are in
222− -- Parser/ParserD/Array.Stream/FileSystem.Handle.
223− benchIOSink value "foldMany" foldMany
224− , benchIOSink value "foldManyPost" foldManyPost
225− , benchIOSink value "refoldMany" refoldMany
226− , benchIOSink value "foldIterateM" foldIterateM
227− , benchIOSink value "refoldIterateM" refoldIterateM
228−#ifdef USE_STREAMK
229− , benchIOSink value "parseBreak (recursive)" (parseBreak . fromStream)
230−#endif
231−
232−#ifndef USE_STREAMLY_CORE
233− , benchIOSink value "classifySessionsOf (10000 buckets)"
234− (classifySessionsOf (getKey 10000))
235− , benchIOSink value "classifySessionsOf (64 buckets)"
236− (classifySessionsOf (getKey 64))
237− , benchIOSink value "classifySessionsOfHash (10000 buckets)"
238− (classifySessionsOfHash (getKey 10000))
239− , benchIOSink value "classifySessionsOfHash (64 buckets)"
240− (classifySessionsOfHash (getKey 64))
241−#endif
242− ]
243− ]
244−
245−#ifndef USE_STREAMLY_CORE
246− where
247−
248− getKey :: Int -> Int -> Int
249− getKey n = (`mod` n)
250−#endif
251−
252−-------------------------------------------------------------------------------
253−-- Size conserving transformations (reordering, buffering, etc.)
254−-------------------------------------------------------------------------------
255−
256−#ifndef USE_PRELUDE
257−{-# INLINE reverse #-}
258−reverse :: MonadIO m => Int -> Stream m Int -> m ()
259−reverse n = composeN n (toStream . K.reverse . fromStream)
260−
261−{-# INLINE reverse' #-}
262−reverse' :: MonadIO m => Int -> Stream m Int -> m ()
263−reverse' n = composeN n S.reverseUnbox
264−#endif
265−
266−o_n_heap_buffering :: Int -> [Benchmark]
267−o_n_heap_buffering value =
268− [ bgroup "buffered"
269− [
270−#ifndef USE_PRELUDE
271− -- Reversing a stream
272− benchIOSink value "reverse" (reverse 1)
273− , benchIOSink value "reverse'" (reverse' 1)
274−#else
275− benchIOSink value "mkAsync" (mkAsync fromSerial)
276−#endif
277− ]
278− ]
279−
280−-------------------------------------------------------------------------------
281−-- Grouping/Splitting
282−-------------------------------------------------------------------------------
283−
284−#ifndef USE_STREAMLY_CORE
285−{-# INLINE classifySessionsOf #-}
286−classifySessionsOf :: S.MonadAsync m => (Int -> Int) -> Stream m Int -> m ()
287−classifySessionsOf getKey =
288− Common.drain
289− . S.classifySessionsOf
290− (const (return False)) 3 (FL.take 10 FL.sum)
291− . S.timestamped
292− . fmap (\x -> (getKey x, x))
293−
294−{-# INLINE classifySessionsOfHash #-}
295−classifySessionsOfHash :: S.MonadAsync m =>
296− (Int -> Int) -> Stream m Int -> m ()
297−classifySessionsOfHash getKey =
298− Common.drain
299− . S.classifySessionsByGeneric
300− (Proxy :: Proxy (HashMap k))
301− 1 False (const (return False)) 3 (FL.take 10 FL.sum)
302− . S.timestamped
303− . fmap (\x -> (getKey x, x))
304−#endif
305−
306−-------------------------------------------------------------------------------
307−-- Mixed Transformation
308−-------------------------------------------------------------------------------
309−
310−{-# INLINE scanMap #-}
311−scanMap :: MonadIO m => Int -> Stream m Int -> m ()
312−scanMap n = composeN n $ fmap (subtract 1) . Common.scanl' (+) 0
313−
314−{-# INLINE dropMap #-}
315−dropMap :: MonadIO m => Int -> Stream m Int -> m ()
316−dropMap n = composeN n $ fmap (subtract 1) . S.drop 1
317−
318−{-# INLINE dropScan #-}
319−dropScan :: MonadIO m => Int -> Stream m Int -> m ()
320−dropScan n = composeN n $ Common.scanl' (+) 0 . S.drop 1
321−
322−{-# INLINE takeDrop #-}
323−takeDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
324−takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
325−
326−{-# INLINE takeScan #-}
327−takeScan :: MonadIO m => Int -> Int -> Stream m Int -> m ()
328−takeScan value n = composeN n $ Common.scanl' (+) 0 . S.take (value + 1)
329−
330−{-# INLINE takeMap #-}
331−takeMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
332−takeMap value n = composeN n $ fmap (subtract 1) . S.take (value + 1)
333−
334−{-# INLINE filterDrop #-}
335−filterDrop :: MonadIO m => Int -> Int -> Stream m Int -> m ()
336−filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
337−
338−{-# INLINE filterTake #-}
339−filterTake :: MonadIO m => Int -> Int -> Stream m Int -> m ()
340−filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
341−
342−{-# INLINE filterScan #-}
343−filterScan :: MonadIO m => Int -> Stream m Int -> m ()
344−filterScan n = composeN n $ Common.scanl' (+) 0 . S.filter (<= maxBound)
345−
346−#ifdef USE_PRELUDE
347−{-# INLINE filterScanl1 #-}
348−filterScanl1 :: MonadIO m => Int -> Stream m Int -> m ()
349−filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
350−#endif
351−
352−{-# INLINE filterMap #-}
353−filterMap :: MonadIO m => Int -> Int -> Stream m Int -> m ()
354−filterMap value n = composeN n $ fmap (subtract 1) . S.filter (<= (value + 1))
355−
356−-------------------------------------------------------------------------------
357−-- Scan and fold
358−-------------------------------------------------------------------------------
359−
360−data Pair a b =
361− Pair !a !b
362− deriving (Generic, NFData)
363−
364−{-# INLINE sumProductFold #-}
365−sumProductFold :: Monad m => Stream m Int -> m (Pair Int Int)
366−sumProductFold =
367− Common.foldl' (\(Pair s p) x -> Pair (s + x) (p * x)) (Pair 0 1)
368−
369−{-# INLINE sumProductScan #-}
370−sumProductScan :: Monad m => Stream m Int -> m (Pair Int Int)
371−sumProductScan =
372− Common.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
373− Common.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
374−
375−{-# INLINE foldl'ReduceMap #-}
376−foldl'ReduceMap :: Monad m => Stream m Int -> m Int
377−foldl'ReduceMap = fmap (+ 1) . Common.foldl' (+) 0
378−
379−o_1_space_transformations_mixed :: Int -> [Benchmark]
380−o_1_space_transformations_mixed value =
381− -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
382− -- library. If scan/fold followed by a map is efficient enough we may not
383− -- need monolithic implementations of these.
384− [ bgroup "mixed"
385− [ benchIOSink value "scanl-map" (scanMap 1)
386− , benchIOSink value "foldl-map" foldl'ReduceMap
387− , benchIOSink value "sum-product-fold" sumProductFold
388− , benchIOSink value "sum-product-scan" sumProductScan
389− ]
390− ]
391−
392−o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
393−o_1_space_transformations_mixedX4 value =
394− [ bgroup "mixedX4"
395− [ benchIOSink value "scan-map" (scanMap 4)
396− , benchIOSink value "drop-map" (dropMap 4)
397− , benchIOSink value "drop-scan" (dropScan 4)
398− , benchIOSink value "take-drop" (takeDrop value 4)
399− , benchIOSink value "take-scan" (takeScan value 4)
400− , benchIOSink value "take-map" (takeMap value 4)
401− , benchIOSink value "filter-drop" (filterDrop value 4)
402− , benchIOSink value "filter-take" (filterTake value 4)
403− , benchIOSink value "filter-scan" (filterScan 4)
404−#ifdef USE_PRELUDE
405− , benchIOSink value "filter-scanl1" (filterScanl1 4)
406−#endif
407− , benchIOSink value "filter-map" (filterMap value 4)
408− ]
409− ]
410−
411−-------------------------------------------------------------------------------
412−-- Iterating a transformation over and over again
413−-------------------------------------------------------------------------------
414−
415−#ifdef USE_STREAMK
416−{-
417−-- this is quadratic
418−{-# INLINE iterateScan #-}
419−iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int
420−iterateScan count len = toStream . iterateSource (K.scanl' (+) 0) count len
421−-}
422−
423−{-# INLINE iterateMapM #-}
424−iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int
425−iterateMapM count len = toStream . iterateSource (K.mapM return) count len
426−
427−{-# INLINE iterateFilterEven #-}
428−iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int
429−iterateFilterEven count len =
430− toStream . iterateSource (K.filter even) count len
431−
432−{-# INLINE iterateTakeAll #-}
433−iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
434−iterateTakeAll value count len =
435− toStream . iterateSource (K.take (value + 1)) count len
436−
437−{-# INLINE iterateDropOne #-}
438−iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int
439−iterateDropOne count len = toStream . iterateSource (K.drop 1) count len
440−
441−{-# INLINE iterateDropWhileTrue #-}
442−iterateDropWhileTrue :: MonadAsync m
443− => Int -> Int -> Int -> Int -> Stream m Int
444−iterateDropWhileTrue value count len =
445− toStream . iterateSource (K.dropWhile (<= (value + 1))) count len
446−
447−{-# INLINE iterateDropWhileFalse #-}
448−iterateDropWhileFalse :: MonadAsync m
449− => Int -> Int -> Int -> Int -> Stream m Int
450−iterateDropWhileFalse value count len =
451− toStream . iterateSource (K.dropWhile (> (value + 1))) count len
452−
453−#else
454−
455−-- this is quadratic
456−{-# INLINE iterateScan #-}
457−iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int
458−iterateScan = iterateSource (Common.scanl' (+) 0)
459−
460−#ifdef USE_PRELUDE
461−-- this is quadratic
462−{-# INLINE iterateScanl1 #-}
463−iterateScanl1 :: MonadAsync m => Int -> Int -> Int -> Stream m Int
464−iterateScanl1 = iterateSource (S.scanl1' (+))
465−#endif
466−
467−{-# INLINE iterateMapM #-}
468−iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int
469−iterateMapM = iterateSource (S.mapM return)
470−
471−{-# INLINE iterateFilterEven #-}
472−iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int
473−iterateFilterEven = iterateSource (S.filter even)
474−
475−{-# INLINE iterateTakeAll #-}
476−iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
477−iterateTakeAll value = iterateSource (S.take (value + 1))
478−
479−{-# INLINE iterateDropOne #-}
480−iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int
481−iterateDropOne = iterateSource (S.drop 1)
482−
483−{-# INLINE iterateDropWhileTrue #-}
484−iterateDropWhileTrue :: MonadAsync m
485− => Int -> Int -> Int -> Int -> Stream m Int
486−iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
487−#endif
488−
489−#ifdef USE_PRELUDE
490−{-# INLINE tail #-}
491−tail :: Monad m => Stream m a -> m ()
492−tail s = S.tail s >>= mapM_ tail
493−
494−{-# INLINE nullHeadTail #-}
495−nullHeadTail :: Monad m => Stream m Int -> m ()
496−nullHeadTail s = do
497− r <- S.null s
498− when (not r) $ do
499− _ <- S.head s
500− S.tail s >>= mapM_ nullHeadTail
501−#endif
502−
503−-- Head recursive operations.
504−o_n_stack_iterated :: Int -> [Benchmark]
505−o_n_stack_iterated value = by10 `seq` by100 `seq`
506− [ bgroup "iterated"
507− [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10
508−#ifndef USE_STREAMK
509− , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $
510− iterateScan by100 100
511−#endif
512−#ifdef USE_PRELUDE
513− , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
514−#endif
515− , benchIOSrc "filterEven (n/10 x 10)" $
516− iterateFilterEven by10 10
517− , benchIOSrc "takeAll (n/10 x 10)" $
518− iterateTakeAll value by10 10
519− , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10
520−#ifdef USE_STREAMK
521− , benchIOSrc "dropWhileFalse (n/10 x 10)" $
522− iterateDropWhileFalse value by10 10
523−#endif
524− , benchIOSrc "dropWhileTrue (n/10 x 10)" $
525− iterateDropWhileTrue value by10 10
526−#ifdef USE_PRELUDE
527− , benchIOSink value "tail" tail
528− , benchIOSink value "nullHeadTail" nullHeadTail
529−#endif
530− ]
531− ]
532−
533− where
534−
535− by10 = value `div` 10
536− by100 = value `div` 100
537−
538−-------------------------------------------------------------------------------
539−-- Pipes
540−-------------------------------------------------------------------------------
541−
542−o_1_space_pipes :: Int -> [Benchmark]
543−o_1_space_pipes value =
544− [ bgroup "pipes"
545− [ benchIOSink value "mapM" (transformMapM 1)
546− , benchIOSink value "compose" (transformComposeMapM 1)
547− , benchIOSink value "tee" (transformTeeMapM 1)
548−#ifdef DEVBUILD
549− -- XXX this take 1 GB memory to compile
550− , benchIOSink value "zip" (transformZipMapM 1)
551−#endif
552− ]
553− ]
554−
555−o_1_space_pipesX4 :: Int -> [Benchmark]
556−o_1_space_pipesX4 value =
557− [ bgroup "pipesX4"
558− [ benchIOSink value "mapM" (transformMapM 4)
559− , benchIOSink value "compose" (transformComposeMapM 4)
560− , benchIOSink value "tee" (transformTeeMapM 4)
561−#ifdef DEVBUILD
562− -- XXX this take 1 GB memory to compile
563− , benchIOSink value "zip" (transformZipMapM 4)
564−#endif
565− ]
566− ]
567−
568−-------------------------------------------------------------------------------
569−-- Main
570−-------------------------------------------------------------------------------
571−
572−-- In addition to gauge options, the number of elements in the stream can be
573−-- passed using the --stream-size option.
574−--
575−benchmarks :: String -> Int -> [Benchmark]
576−benchmarks moduleName size =
577− [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
578− [ o_1_space_grouping size
579− , o_1_space_transformations_mixed size
580− , o_1_space_transformations_mixedX4 size
581−
582− -- pipes
583− , o_1_space_pipes size
584− , o_1_space_pipesX4 size
585− ]
586− , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
587− , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size)
588− ]
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs+5−46
@@ -8,8 +8,6 @@
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 #-}
13
11
14#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
15#undef INSPECTION
13#undef INSPECTION
@@ -22,19 +20,15 @@
22
20
23module Main (main) where
21module Main (main) where
24
22
25−#if !MIN_VERSION_base(4,18,0)
26−import Control.Applicative (liftA2)
27−#endif
28import Control.Monad (when)
23import Control.Monad (when)
29import Data.Maybe (isJust)
24import Data.Maybe (isJust)
30−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
25+import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
31import System.Random (randomRIO)
26import System.Random (randomRIO)
32import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
27import Prelude hiding (tail, mapM_, foldl, last, map, mapM, concatMap, zip)
33
28
34import qualified Prelude as P
29import qualified Prelude as P
35−import qualified Streamly.Internal.Data.Stream as S
30+import qualified Streamly.Internal.Data.Stream.StreamD as S
36import qualified Streamly.Internal.Data.Unfold as UF
31import qualified Streamly.Internal.Data.Unfold as UF
37−import qualified Streamly.Internal.Data.Fold as FL
38
32
39import Streamly.Benchmark.Common
33import Streamly.Benchmark.Common
40
34
@@ -131,12 +125,6 @@ uncons s = do
131 Nothing -> return ()
125 Nothing -> return ()
132 Just (_, t) -> uncons t
126 Just (_, t) -> uncons t
133
127
134−{-# INLINE foldBreak #-}
135−foldBreak :: Monad m => Stream m Int -> m ()
136−foldBreak s = do
137− (r, s1) <- S.foldBreak (FL.take 1 FL.length) s
138− when (r /= 0) $ foldBreak s1
139−
140{-# INLINE tail #-}
128{-# INLINE tail #-}
141tail :: Monad m => Stream m a -> m ()
129tail :: Monad m => Stream m a -> m ()
142tail s = S.tail s >>= P.mapM_ tail
130tail s = S.tail s >>= P.mapM_ tail
@@ -326,34 +314,6 @@ filterMap n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)
326-- Nested Composition
314-- Nested Composition
327-------------------------------------------------------------------------------
315-------------------------------------------------------------------------------
328
316
329−instance Monad f => Applicative (S.Stream f) where
330− {-# INLINE pure #-}
331− pure = S.fromPure
332−
333− {-# INLINE (<*>) #-}
334− (<*>) = S.crossApply
335−
336− {-# INLINE liftA2 #-}
337− liftA2 f x = (<*>) (fmap f x)
338−
339− {-# INLINE (*>) #-}
340− (*>) = S.crossApplySnd
341−
342− {-# INLINE (<*) #-}
343− (<*) = S.crossApplyFst
344−
345−-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,
346−-- the monad instance does not seem to be significantly faster.
347−instance Monad m => Monad (S.Stream m) where
348− {-# INLINE return #-}
349− return = pure
350−
351− {-# INLINE (>>=) #-}
352− (>>=) = flip S.concatMap
353−
354− {-# INLINE (>>) #-}
355− (>>) = (*>)
356−
357{-# INLINE toNullApNested #-}
317{-# INLINE toNullApNested #-}
358toNullApNested :: Monad m => Stream m Int -> m ()
318toNullApNested :: Monad m => Stream m Int -> m ()
359toNullApNested s = runStream $ do
319toNullApNested s = runStream $ do
@@ -449,8 +409,8 @@ unfoldManyRepl :: Int -> Int -> Int -> IO ()
449unfoldManyRepl outer inner n =
409unfoldManyRepl outer inner n =
450 S.drain
410 S.drain
451 $ S.unfoldMany
411 $ S.unfoldMany
452− UF.replicateM
412+ (UF.lmap return (UF.replicateM inner))
453− (S.map ((inner,) . return) (sourceUnfoldrMN outer n))
413+ (sourceUnfoldrMN outer n)
454
414
455#ifdef INSPECTION
415#ifdef INSPECTION
456inspect $ hasNoTypeClasses 'unfoldManyRepl
416inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -463,7 +423,7 @@ inspect $ 'unfoldManyRepl `hasNoType` ''SPEC
463-------------------------------------------------------------------------------
423-------------------------------------------------------------------------------
464
424
465moduleName :: String
425moduleName :: String
466−moduleName = "Data.StreamD"
426+moduleName = "Data.Stream.StreamD"
467
427
468o_1_space :: [Benchmark]
428o_1_space :: [Benchmark]
469o_1_space =
429o_1_space =
@@ -479,7 +439,6 @@ o_1_space =
479 [ benchFold "toNull" toNull sourceUnfoldrM
439 [ benchFold "toNull" toNull sourceUnfoldrM
480 , benchFold "mapM_" mapM_ sourceUnfoldrM
440 , benchFold "mapM_" mapM_ sourceUnfoldrM
481 , benchFold "uncons" uncons sourceUnfoldrM
441 , benchFold "uncons" uncons sourceUnfoldrM
482− , benchFold "foldBreak" foldBreak sourceUnfoldrM
483 , benchFold "foldl'" foldl sourceUnfoldrM
442 , benchFold "foldl'" foldl sourceUnfoldrM
484 , benchFold "last" last sourceUnfoldrM
443 , benchFold "last" last sourceUnfoldrM
485 ]
444 ]
benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs → benchmark/Streamly/Benchmark/Data/Stream/StreamDK.hsrenamed+4−6
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Streamly.Benchmark.Data.Stream.StreamDK
2-- Module : Streamly.Benchmark.Data.Stream.StreamDK
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -18,12 +16,12 @@ import Prelude hiding ()
18-- import qualified Prelude as P
16-- import qualified Prelude as P
19-- import qualified Data.List as List
17-- import qualified Data.List as List
20
18
21−import qualified Streamly.Internal.Data.StreamK.Alt as S
19+import qualified Streamly.Internal.Data.Stream.StreamDK as S
22−-- import qualified Streamly.Internal.Data.Stream.Common as SP
20+-- import qualified Streamly.Internal.Data.Stream.Prelude as SP
23-- import qualified Streamly.Internal.Data.SVar as S
21-- import qualified Streamly.Internal.Data.SVar as S
24
22
25import Streamly.Benchmark.Common
23import Streamly.Benchmark.Common
26−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
24+import Gauge (bgroup, Benchmark, defaultMain)
27
25
28value :: Int
26value :: Int
29value = 100000
27value = 100000
@@ -452,4 +450,4 @@ o_1_space =
452 ]
450 ]
453
451
454main :: IO ()
452main :: IO ()
455−main = defaultMain [o_1_space]
453+main = defaultMain $ concat [o_1_space]
benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs+33−61
@@ -8,7 +8,6 @@
8{-# LANGUAGE CPP #-}
8{-# LANGUAGE CPP #-}
9{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleContexts #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12
11
13#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
14#undef INSPECTION
13#undef INSPECTION
@@ -21,23 +20,22 @@
21
20
22module Main (main) where
21module Main (main) where
23
22
24−#if !MIN_VERSION_base(4,18,0)
25−import Control.Applicative (liftA2)
26−#endif
27import Control.Monad (when)
23import Control.Monad (when)
28import Data.Maybe (isJust)
24import Data.Maybe (isJust)
29import System.Random (randomRIO)
25import System.Random (randomRIO)
30import Prelude hiding
26import Prelude hiding
31− ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate
27+ ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
32 , repeat, replicate
28 , repeat, replicate
33 )
29 )
34
30
35import qualified Prelude as P
31import qualified Prelude as P
36import qualified Data.List as List
32import qualified Data.List as List
37
33
38−import qualified Streamly.Internal.Data.StreamK as S
34+import qualified Streamly.Internal.Control.Concurrent as S
35+import qualified Streamly.Internal.Data.Stream.StreamK.Type as S
36+import qualified Streamly.Internal.Data.Stream.StreamK as S
39
37
40−import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)
38+import Gauge (bench, nfIO, bgroup, Benchmark, defaultMain)
41
39
42import Streamly.Benchmark.Common
40import Streamly.Benchmark.Common
43
41
@@ -117,7 +115,7 @@ Benchmarks that need to be added
117-- Stream generation and elimination
115-- Stream generation and elimination
118-------------------------------------------------------------------------------
116-------------------------------------------------------------------------------
119
117
120−type Stream m a = S.StreamK m a
118+type Stream m a = S.Stream m a
121
119
122{-# INLINE unfoldr #-}
120{-# INLINE unfoldr #-}
123unfoldr :: Int -> Int -> Stream m Int
121unfoldr :: Int -> Int -> Stream m Int
@@ -129,7 +127,7 @@ unfoldr streamLen n = S.unfoldr step n
129 else Just (cnt, cnt + 1)
127 else Just (cnt, cnt + 1)
130
128
131{-# INLINE unfoldrM #-}
129{-# INLINE unfoldrM #-}
132−unfoldrM :: Monad m => Int -> Int -> Stream m Int
130+unfoldrM :: S.MonadAsync m => Int -> Int -> Stream m Int
133unfoldrM streamLen n = S.unfoldrMWith S.consM step n
131unfoldrM streamLen n = S.unfoldrMWith S.consM step n
134 where
132 where
135 step cnt =
133 step cnt =
@@ -142,7 +140,7 @@ repeat :: Int -> Int -> Stream m Int
142repeat streamLen = S.take streamLen . S.repeat
140repeat streamLen = S.take streamLen . S.repeat
143
141
144{-# INLINE repeatM #-}
142{-# INLINE repeatM #-}
145−repeatM :: Monad m => Int -> Int -> Stream m Int
143+repeatM :: S.MonadAsync m => Int -> Int -> Stream m Int
146repeatM streamLen = S.take streamLen . S.repeatM . return
144repeatM streamLen = S.take streamLen . S.repeatM . return
147
145
148{-# INLINE replicate #-}
146{-# INLINE replicate #-}
@@ -150,7 +148,7 @@ replicate :: Int -> Int -> Stream m Int
150replicate = S.replicate
148replicate = S.replicate
151
149
152{-# INLINE replicateM #-}
150{-# INLINE replicateM #-}
153−replicateM :: Monad m => Int -> Int -> Stream m Int
151+replicateM :: S.MonadAsync m => Int -> Int -> Stream m Int
154replicateM streamLen = S.replicateMWith S.consM streamLen . return
152replicateM streamLen = S.replicateMWith S.consM streamLen . return
155
153
156{-# INLINE iterate #-}
154{-# INLINE iterate #-}
@@ -158,7 +156,7 @@ iterate :: Int -> Int -> Stream m Int
158iterate streamLen = S.take streamLen . S.iterate (+1)
156iterate streamLen = S.take streamLen . S.iterate (+1)
159
157
160{-# INLINE iterateM #-}
158{-# INLINE iterateM #-}
161−iterateM :: Monad m => Int -> Int -> Stream m Int
159+iterateM :: S.MonadAsync m => Int -> Int -> Stream m Int
162iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
160iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return
163
161
164{-# INLINE fromFoldable #-}
162{-# INLINE fromFoldable #-}
@@ -166,27 +164,26 @@ fromFoldable :: Int -> Int -> Stream m Int
166fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
164fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
167
165
168{-# INLINE fromFoldableM #-}
166{-# INLINE fromFoldableM #-}
169−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
167+fromFoldableM :: S.MonadAsync m => Int -> Int -> Stream m Int
170fromFoldableM streamLen n =
168fromFoldableM streamLen n =
171− List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
169+ Prelude.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])
172
170
173{-# INLINABLE concatMapFoldableWith #-}
171{-# INLINABLE concatMapFoldableWith #-}
174−concatMapFoldableWith :: P.Foldable f
172+concatMapFoldableWith :: Foldable f
175 => (Stream m b -> Stream m b -> Stream m b)
173 => (Stream m b -> Stream m b -> Stream m b)
176 -> (a -> Stream m b)
174 -> (a -> Stream m b)
177 -> f a
175 -> f a
178 -> Stream m b
176 -> Stream m b
179−concatMapFoldableWith f g = P.foldr (f . g) S.nil
177+concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
180
178
181{-# INLINE concatMapFoldableSerial #-}
179{-# INLINE concatMapFoldableSerial #-}
182concatMapFoldableSerial :: Int -> Int -> Stream m Int
180concatMapFoldableSerial :: Int -> Int -> Stream m Int
183−concatMapFoldableSerial streamLen n =
184− concatMapFoldableWith S.append S.fromPure [n..n+streamLen]
181+concatMapFoldableSerial streamLen n = concatMapFoldableWith S.serial S.fromPure [n..n+streamLen]
185
182
186{-# INLINE concatMapFoldableSerialM #-}
183{-# INLINE concatMapFoldableSerialM #-}
187concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
184concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
188concatMapFoldableSerialM streamLen n =
185concatMapFoldableSerialM streamLen n =
189− concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]
186+ concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
190
187
191-------------------------------------------------------------------------------
188-------------------------------------------------------------------------------
192-- Elimination
189-- Elimination
@@ -271,11 +268,11 @@ fmapK :: Monad m => Int -> Stream m Int -> m ()
271fmapK n = composeN n $ P.fmap (+ 1)
268fmapK n = composeN n $ P.fmap (+ 1)
272
269
273{-# INLINE mapM #-}
270{-# INLINE mapM #-}
274−mapM :: Monad m => Int -> Stream m Int -> m ()
271+mapM :: S.MonadAsync m => Int -> Stream m Int -> m ()
275mapM n = composeN n $ S.mapMWith S.consM return
272mapM n = composeN n $ S.mapMWith S.consM return
276
273
277{-# INLINE mapMSerial #-}
274{-# INLINE mapMSerial #-}
278−mapMSerial :: Monad m => Int -> Stream m Int -> m ()
275+mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
279mapMSerial n = composeN n $ S.mapMSerial return
276mapMSerial n = composeN n $ S.mapMSerial return
280
277
281{-# INLINE filterEven #-}
278{-# INLINE filterEven #-}
@@ -327,7 +324,7 @@ foldlS :: Monad m => Int -> Stream m Int -> m ()
327foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
324foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
328
325
329{-# INLINE intersperse #-}
326{-# INLINE intersperse #-}
330−intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()
327+intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
331intersperse streamLen n = composeN n $ S.intersperse streamLen
328intersperse streamLen n = composeN n $ S.intersperse streamLen
332
329
333-------------------------------------------------------------------------------
330-------------------------------------------------------------------------------
@@ -336,7 +333,8 @@ intersperse streamLen n = composeN n $ S.intersperse streamLen
336
333
337{-# INLINE iterateSource #-}
334{-# INLINE iterateSource #-}
338iterateSource
335iterateSource
336+ :: S.MonadAsync m
339− :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
337+ => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
340iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
338iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
341 where
339 where
342 f (0 :: Int) m = g m
340 f (0 :: Int) m = g m
@@ -344,37 +342,37 @@ iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
344
342
345-- this is quadratic
343-- this is quadratic
346{-# INLINE iterateScan #-}
344{-# INLINE iterateScan #-}
347−iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int
345+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
348iterateScan iterStreamLen maxIters =
346iterateScan iterStreamLen maxIters =
349 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
347 iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
350
348
351-- this is quadratic
349-- this is quadratic
352{-# INLINE iterateDropWhileFalse #-}
350{-# INLINE iterateDropWhileFalse #-}
353−iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
351+iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
354iterateDropWhileFalse streamLen iterStreamLen maxIters =
352iterateDropWhileFalse streamLen iterStreamLen maxIters =
355 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
353 iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
356
354
357{-# INLINE iterateMapM #-}
355{-# INLINE iterateMapM #-}
358−iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int
356+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
359iterateMapM iterStreamLen =
357iterateMapM iterStreamLen =
360 iterateSource iterStreamLen (S.mapMWith S.consM return)
358 iterateSource iterStreamLen (S.mapMWith S.consM return)
361
359
362{-# INLINE iterateFilterEven #-}
360{-# INLINE iterateFilterEven #-}
363−iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int
361+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
364iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
362iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
365
363
366{-# INLINE iterateTakeAll #-}
364{-# INLINE iterateTakeAll #-}
367−iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int
365+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
368iterateTakeAll streamLen iterStreamLen =
366iterateTakeAll streamLen iterStreamLen =
369 iterateSource iterStreamLen (S.take streamLen)
367 iterateSource iterStreamLen (S.take streamLen)
370
368
371{-# INLINE iterateDropOne #-}
369{-# INLINE iterateDropOne #-}
372−iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int
370+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
373iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
371iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
374
372
375{-# INLINE iterateDropWhileTrue #-}
373{-# INLINE iterateDropWhileTrue #-}
376−iterateDropWhileTrue ::
374+iterateDropWhileTrue :: S.MonadAsync m =>
377− Monad m => Int -> Int -> Int -> Int -> Stream m Int
375+ Int -> Int -> Int -> Int -> Stream m Int
378iterateDropWhileTrue streamLen iterStreamLen =
376iterateDropWhileTrue streamLen iterStreamLen =
379 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
377 iterateSource iterStreamLen (S.dropWhile (<= streamLen))
380
378
@@ -392,7 +390,7 @@ zipWithM src = drain $ S.zipWithM (curry return) src src
392
390
393{-# INLINE sortByK #-}
391{-# INLINE sortByK #-}
394sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
392sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
395−sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure
393+sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
396
394
397{-# INLINE sortBy #-}
395{-# INLINE sortBy #-}
398sortBy :: Monad m => Stream m Int -> m ()
396sortBy :: Monad m => Stream m Int -> m ()
@@ -494,7 +492,7 @@ sourceConcatMapId val n =
494{-# INLINE concatMapBySerial #-}
492{-# INLINE concatMapBySerial #-}
495concatMapBySerial :: Int -> Int -> Int -> IO ()
493concatMapBySerial :: Int -> Int -> Int -> IO ()
496concatMapBySerial outer inner n =
494concatMapBySerial outer inner n =
497− S.drain $ S.concatMapWith S.append
495+ S.drain $ S.concatMapWith S.serial
498 (unfoldrM inner)
496 (unfoldrM inner)
499 (unfoldrM outer n)
497 (unfoldrM outer n)
500
498
@@ -502,32 +500,6 @@ concatMapBySerial outer inner n =
502-- Nested Composition
500-- Nested Composition
503-------------------------------------------------------------------------------
501-------------------------------------------------------------------------------
504
502
505−instance Monad m => Applicative (S.StreamK m) where
506− {-# INLINE pure #-}
507− pure = S.fromPure
508−
509− {-# INLINE (<*>) #-}
510− (<*>) = S.crossApply
511−
512− {-# INLINE liftA2 #-}
513− liftA2 f x = (<*>) (fmap f x)
514−
515− {-# INLINE (*>) #-}
516− (*>) = S.crossApplySnd
517−
518− {-# INLINE (<*) #-}
519− (<*) = S.crossApplyFst
520−
521−-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
522−-- the monad instance of StreamD is slower than StreamK after foldr/build
523−-- fusion.
524−instance Monad m => Monad (S.StreamK m) where
525− {-# INLINE return #-}
526− return = pure
527−
528− {-# INLINE (>>=) #-}
529− (>>=) = flip S.concatMap
530−
531{-# INLINE drainApplicative #-}
503{-# INLINE drainApplicative #-}
532drainApplicative :: Monad m => Stream m Int -> m ()
504drainApplicative :: Monad m => Stream m Int -> m ()
533drainApplicative s = drain $ do
505drainApplicative s = drain $ do
@@ -634,7 +606,7 @@ filterAllInNestedList str = do
634-------------------------------------------------------------------------------
606-------------------------------------------------------------------------------
635
607
636moduleName :: String
608moduleName :: String
637−moduleName = "Data.StreamK"
609+moduleName = "Data.Stream.StreamK"
638
610
639o_1_space_generation :: Int -> Benchmark
611o_1_space_generation :: Int -> Benchmark
640o_1_space_generation streamLen =
612o_1_space_generation streamLen =
@@ -731,7 +703,7 @@ o_1_space_concat streamLen =
731 -- This is for comparison with concatMapFoldableWith
703 -- This is for comparison with concatMapFoldableWith
732 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
704 , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
733 (S.drain
705 (S.drain
734− . S.concatMapWith S.append id
706+ . S.concatMapWith S.serial id
735 . sourceConcatMapId streamLen)
707 . sourceConcatMapId streamLen)
736
708
737 , benchIOSrc1 "concatMapBy serial (n of 1)"
709 , benchIOSrc1 "concatMapBy serial (n of 1)"
benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hsdeleted−938
@@ -1,938 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.StreamK
3−-- Copyright : (c) 2018 Composewell Technologies
4−--
5−-- License : BSD3
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#ifdef __HADDOCK_VERSION__
14−#undef INSPECTION
15−#endif
16−
17−#ifdef INSPECTION
18−{-# LANGUAGE TemplateHaskell #-}
19−{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
20−#endif
21−
22−module Main (main) where
23−
24−-- import Control.Applicative (liftA2)
25−-- import Control.Monad (when)
26−-- import Data.Maybe (isJust)
27−-- import System.Random (randomRIO)
28−import Prelude hiding
29− ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate
30− , repeat, replicate
31− )
32−
33−import qualified Prelude as P
34−-- import qualified Data.List as List
35−
36−import qualified Streamly.Internal.Data.StreamK as S
37−import qualified Streamly.Internal.Data.Stream as D
38−import qualified Streamly.Internal.Data.Fold as Fold
39−
40−import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)
41−
42−import Streamly.Benchmark.Common
43−
44−#ifdef INSPECTION
45−import Test.Inspection
46−#endif
47−
48−-------------------------------------------------------------------------------
49−-- Stream generation and elimination
50−-------------------------------------------------------------------------------
51−
52−type Stream m a = S.Stream m a
53−
54−{-# INLINE unfoldrD #-}
55−unfoldrD :: Monad m => Int -> Int -> Stream m Int
56−unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)
57− where
58− step cnt =
59− if cnt > n + streamLen
60− then Nothing
61− else Just (cnt, cnt + 1)
62−
63−{-# INLINE unfoldrMD #-}
64−unfoldrMD :: Monad m => Int -> Int -> Stream m Int
65−unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)
66− where
67− step cnt =
68− if cnt > n + streamLen
69− then return Nothing
70− else return (Just (cnt, cnt + 1))
71−
72−{-
73−{-# INLINE unfoldrK #-}
74−unfoldrK :: Int -> Int -> Stream m Int
75−unfoldrK streamLen n = S.unfoldr step n
76− where
77− step cnt =
78− if cnt > n + streamLen
79− then Nothing
80− else Just (cnt, cnt + 1)
81−-}
82−
83−{-# INLINE unfoldrMK #-}
84−unfoldrMK :: Monad m => Int -> Int -> Stream m Int
85−unfoldrMK streamLen n = S.unfoldrMWith S.consM step n
86− where
87− step cnt =
88− if cnt > n + streamLen
89− then return Nothing
90− else return (Just (cnt, cnt + 1))
91−
92−{-# INLINE repeat #-}
93−repeat :: Monad m => Int -> Int -> Stream m Int
94−repeat streamLen = S.take streamLen . D.toStreamK . D.repeat
95−
96−{-# INLINE repeatM #-}
97−repeatM :: Monad m => Int -> Int -> Stream m Int
98−repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return
99−
100−{-# INLINE replicate #-}
101−replicate :: Monad m => Int -> Int -> Stream m Int
102−replicate x y = D.toStreamK $ D.replicate x y
103−
104−{-# INLINE replicateM #-}
105−replicateM :: Monad m => Int -> Int -> Stream m Int
106−replicateM streamLen = D.toStreamK . D.replicateM streamLen . return
107−
108−{-# INLINE iterate #-}
109−iterate :: Monad m => Int -> Int -> Stream m Int
110−iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)
111−
112−{-# INLINE iterateM #-}
113−iterateM :: Monad m => Int -> Int -> Stream m Int
114−iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return
115−
116−{-# INLINE fromFoldable #-}
117−fromFoldable :: Int -> Int -> Stream m Int
118−fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]
119−
120−{-# INLINE fromFoldableM #-}
121−fromFoldableM :: Monad m => Int -> Int -> Stream m Int
122−fromFoldableM streamLen n =
123− Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]
124−
125−{-
126−{-# INLINABLE concatMapFoldableWith #-}
127−concatMapFoldableWith :: Foldable f
128− => (Stream m b -> Stream m b -> Stream m b)
129− -> (a -> Stream m b)
130− -> f a
131− -> Stream m b
132−concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil
133−-}
134−
135−{-# INLINE concatMapFoldableSerial #-}
136−concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int
137−concatMapFoldableSerial streamLen n =
138− D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]
139−
140−{-# INLINE concatMapFoldableSerialM #-}
141−concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int
142−concatMapFoldableSerialM streamLen n =
143− -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]
144− D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]
145−
146−-------------------------------------------------------------------------------
147−-- Elimination
148−-------------------------------------------------------------------------------
149−
150−{-# INLINE drainD #-}
151−drainD :: Monad m => Stream m a -> m ()
152−drainD = D.drain . D.fromStreamK
153−
154−{-# INLINE drain #-}
155−drain :: Monad m => Stream m a -> m ()
156−drain = S.drain
157−
158−{-# INLINE mapM_ #-}
159−mapM_ :: Monad m => Stream m a -> m ()
160−mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s
161−
162−{-
163−{-# INLINE uncons #-}
164−uncons :: Monad m => Stream m Int -> m ()
165−uncons s = do
166− r <- D.uncons $ D.fromStreamK s
167− case r of
168− Nothing -> return ()
169− Just (_, t) -> uncons (D.toStreamK t)
170−
171−{-# INLINE init #-}
172−init :: Monad m => Stream m a -> m ()
173−init s = do
174− t <- S.init s
175− P.mapM_ S.drain t
176−
177−{-# INLINE tail #-}
178−tail :: Monad m => Stream m a -> m ()
179−tail s = S.tail s >>= P.mapM_ tail
180−
181−{-# INLINE nullTail #-}
182−nullTail :: Monad m => Stream m Int -> m ()
183−nullTail s = do
184− r <- S.null s
185− when (not r) $ S.tail s >>= P.mapM_ nullTail
186−
187−{-# INLINE headTail #-}
188−headTail :: Monad m => Stream m Int -> m ()
189−headTail s = do
190− h <- S.head s
191− when (isJust h) $ S.tail s >>= P.mapM_ headTail
192−-}
193−
194−{-# INLINE toList #-}
195−toList :: Monad m => Stream m Int -> m [Int]
196−toList = D.fold Fold.toList . D.fromStreamK
197−
198−{-# INLINE foldl' #-}
199−foldl' :: Monad m => Stream m Int -> m Int
200−foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK
201−
202−{-# INLINE last #-}
203−last :: Monad m => Stream m Int -> m (Maybe Int)
204−last = D.fold Fold.latest . D.fromStreamK
205−
206−-------------------------------------------------------------------------------
207−-- Transformation
208−-------------------------------------------------------------------------------
209−
210−{-# INLINE composeN #-}
211−composeN
212− :: Monad m
213− => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()
214−composeN n f =
215− case n of
216− 1 -> drain . f
217− 2 -> drain . f . f
218− 3 -> drain . f . f . f
219− 4 -> drain . f . f . f . f
220− _ -> undefined
221−
222−{-# INLINE scanl' #-}
223−scanl' :: Monad m => Int -> Stream m Int -> m ()
224−scanl' n =
225− composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)
226−
227−{-# INLINE map #-}
228−map :: Monad m => Int -> Stream m Int -> m ()
229−map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)
230−
231−{-
232−{-# INLINE fmapK #-}
233−fmapK :: Monad m => Int -> Stream m Int -> m ()
234−fmapK n = composeN n $ P.fmap (+ 1)
235−-}
236−
237−{-# INLINE mapM #-}
238−mapM :: Monad m => Int -> Stream m Int -> m ()
239−mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)
240−
241−{-
242−{-# INLINE mapMSerial #-}
243−mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()
244−mapMSerial n = composeN n $ S.mapMSerial return
245−-}
246−
247−{-# INLINE filterEven #-}
248−filterEven :: Monad m => Int -> Stream m Int -> m ()
249−filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)
250−
251−{-
252−{-# INLINE filterAllOut #-}
253−filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()
254−filterAllOut streamLen n = composeN n $ S.filter (> streamLen)
255−
256−{-# INLINE filterAllIn #-}
257−filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()
258−filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)
259−
260−{-# INLINE _takeOne #-}
261−_takeOne :: Monad m => Int -> Stream m Int -> m ()
262−_takeOne n = composeN n $ S.take 1
263−
264−{-# INLINE takeAll #-}
265−takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()
266−takeAll streamLen n = composeN n $ S.take streamLen
267−
268−{-# INLINE takeWhileTrue #-}
269−takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
270−takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)
271−
272−{-# INLINE dropOne #-}
273−dropOne :: Monad m => Int -> Stream m Int -> m ()
274−dropOne n = composeN n $ S.drop 1
275−
276−{-# INLINE dropAll #-}
277−dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()
278−dropAll streamLen n = composeN n $ S.drop streamLen
279−
280−{-# INLINE dropWhileTrue #-}
281−dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()
282−dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)
283−
284−{-# INLINE dropWhileFalse #-}
285−dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()
286−dropWhileFalse n = composeN n $ S.dropWhile (<= 1)
287−-}
288−
289−{-
290−{-# INLINE foldrS #-}
291−foldrS :: Monad m => Int -> Stream m Int -> m ()
292−foldrS n = composeN n $ S.foldrS S.cons S.nil
293−
294−{-# INLINE foldlS #-}
295−foldlS :: Monad m => Int -> Stream m Int -> m ()
296−foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil
297−-}
298−
299−{-
300−{-# INLINE intersperse #-}
301−intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()
302−intersperse streamLen n = composeN n $ S.intersperse streamLen
303−-}
304−
305−-------------------------------------------------------------------------------
306−-- Iteration
307−-------------------------------------------------------------------------------
308−
309−{-
310−{-# INLINE iterateSource #-}
311−iterateSource
312− :: S.MonadAsync m
313− => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int
314−iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)
315− where
316− f (0 :: Int) m = g m
317− f x m = g (f (x P.- 1) m)
318−
319−-- this is quadratic
320−{-# INLINE iterateScan #-}
321−iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
322−iterateScan iterStreamLen maxIters =
323− iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)
324−
325−-- this is quadratic
326−{-# INLINE iterateDropWhileFalse #-}
327−iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
328−iterateDropWhileFalse streamLen iterStreamLen maxIters =
329− iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)
330−
331−{-# INLINE iterateMapM #-}
332−iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
333−iterateMapM iterStreamLen =
334− iterateSource iterStreamLen (S.mapMWith S.consM return)
335−
336−{-# INLINE iterateFilterEven #-}
337−iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
338−iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)
339−
340−{-# INLINE iterateTakeAll #-}
341−iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int
342−iterateTakeAll streamLen iterStreamLen =
343− iterateSource iterStreamLen (S.take streamLen)
344−
345−{-# INLINE iterateDropOne #-}
346−iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int
347−iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)
348−
349−{-# INLINE iterateDropWhileTrue #-}
350−iterateDropWhileTrue :: S.MonadAsync m =>
351− Int -> Int -> Int -> Int -> Stream m Int
352−iterateDropWhileTrue streamLen iterStreamLen =
353− iterateSource iterStreamLen (S.dropWhile (<= streamLen))
354−-}
355−
356−-------------------------------------------------------------------------------
357−-- Zipping
358−-------------------------------------------------------------------------------
359−
360−{-
361−{-# INLINE zipWith #-}
362−zipWith :: Monad m => Stream m Int -> m ()
363−zipWith src = drain $ S.zipWith (,) src src
364−
365−{-# INLINE zipWithM #-}
366−zipWithM :: Monad m => Stream m Int -> m ()
367−zipWithM src = drain $ S.zipWithM (curry return) src src
368−
369−{-# INLINE sortByK #-}
370−sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a
371−sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure
372−
373−{-# INLINE sortBy #-}
374−sortBy :: Monad m => Stream m Int -> m ()
375−sortBy = drain . sortByK compare
376−
377−-------------------------------------------------------------------------------
378−-- Mixed Composition
379−-------------------------------------------------------------------------------
380−
381−{-# INLINE scanMap #-}
382−scanMap :: Monad m => Int -> Stream m Int -> m ()
383−scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
384−
385−{-# INLINE dropMap #-}
386−dropMap :: Monad m => Int -> Stream m Int -> m ()
387−dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
388−
389−{-# INLINE dropScan #-}
390−dropScan :: Monad m => Int -> Stream m Int -> m ()
391−dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
392−
393−{-# INLINE takeDrop #-}
394−takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
395−takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen
396−
397−{-# INLINE takeScan #-}
398−takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()
399−takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen
400−
401−{-# INLINE takeMap #-}
402−takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()
403−takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen
404−
405−{-# INLINE filterDrop #-}
406−filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()
407−filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)
408−
409−{-# INLINE filterTake #-}
410−filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()
411−filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)
412−
413−{-# INLINE filterScan #-}
414−filterScan :: Monad m => Int -> Stream m Int -> m ()
415−filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
416−
417−{-# INLINE filterMap #-}
418−filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()
419−filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)
420−-}
421−
422−-------------------------------------------------------------------------------
423−-- ConcatMap
424−-------------------------------------------------------------------------------
425−
426−-- concatMap unfoldrM/unfoldrM
427−
428−{-# INLINE concatMap #-}
429−concatMap :: Int -> Int -> Int -> IO ()
430−concatMap outer inner n =
431− S.drain $ D.toStreamK $ D.concatMap
432− (\_ -> D.fromStreamK $ unfoldrMK inner n)
433− (D.fromStreamK $ unfoldrMK outer n)
434−
435−#ifdef INSPECTION
436−inspect $ hasNoTypeClasses 'concatMap
437−#endif
438−
439−-- concatMap unfoldr/unfoldr
440−
441−{-
442−{-# INLINE concatMapPure #-}
443−concatMapPure :: Int -> Int -> Int -> IO ()
444−concatMapPure outer inner n =
445− S.drain $ S.concatMap
446− (\_ -> unfoldr inner n)
447− (unfoldr outer n)
448−
449−#ifdef INSPECTION
450−inspect $ hasNoTypeClasses 'concatMapPure
451−#endif
452−
453−-- concatMap replicate/unfoldrM
454−
455−{-# INLINE concatMapRepl #-}
456−concatMapRepl :: Int -> Int -> Int -> IO ()
457−concatMapRepl outer inner n =
458− S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)
459−
460−#ifdef INSPECTION
461−inspect $ hasNoTypeClasses 'concatMapRepl
462−#endif
463−
464−-- concatMapWith
465−
466−{-# INLINE sourceConcatMapId #-}
467−sourceConcatMapId :: Monad m
468− => Int -> Int -> Stream m (Stream m Int)
469−sourceConcatMapId val n =
470− S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]
471−
472−{-# INLINE concatMapBySerial #-}
473−concatMapBySerial :: Int -> Int -> Int -> IO ()
474−concatMapBySerial outer inner n =
475− S.drain $ S.concatMapWith S.serial
476− (unfoldrM inner)
477− (unfoldrM outer n)
478−-}
479−
480−{-
481−-------------------------------------------------------------------------------
482−-- Nested Composition
483−-------------------------------------------------------------------------------
484−
485−instance Monad m => Applicative (S.Stream m) where
486− {-# INLINE pure #-}
487− pure = S.fromPure
488−
489− {-# INLINE (<*>) #-}
490− (<*>) = S.crossApply
491−
492− {-# INLINE liftA2 #-}
493− liftA2 f x = (<*>) (fmap f x)
494−
495− {-# INLINE (*>) #-}
496− (*>) = S.crossApplySnd
497−
498− {-# INLINE (<*) #-}
499− (<*) = S.crossApplyFst
500−
501−-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,
502−-- the monad instance of StreamD is slower than StreamK after foldr/build
503−-- fusion.
504−instance Monad m => Monad (S.Stream m) where
505− {-# INLINE return #-}
506− return = pure
507−
508− {-# INLINE (>>=) #-}
509− (>>=) = flip S.concatMap
510−
511−{-# INLINE drainApplicative #-}
512−drainApplicative :: Monad m => Stream m Int -> m ()
513−drainApplicative s = drain $ do
514− (+) <$> s <*> s
515−
516−{-# INLINE drainMonad #-}
517−drainMonad :: Monad m => Stream m Int -> m ()
518−drainMonad s = drain $ do
519− x <- s
520− y <- s
521− return $ x + y
522−
523−{-# INLINE drainMonad3 #-}
524−drainMonad3 :: Monad m => Stream m Int -> m ()
525−drainMonad3 s = drain $ do
526− x <- s
527− y <- s
528− z <- s
529− return $ x + y + z
530−
531−{-# INLINE filterAllOutMonad #-}
532−filterAllOutMonad
533− :: Monad m
534− => Stream m Int -> m ()
535−filterAllOutMonad str = drain $ do
536− x <- str
537− y <- str
538− let s = x + y
539− if s < 0
540− then return s
541− else S.nil
542−
543−{-# INLINE filterAllInMonad #-}
544−filterAllInMonad
545− :: Monad m
546− => Stream m Int -> m ()
547−filterAllInMonad str = drain $ do
548− x <- str
549− y <- str
550− let s = x + y
551− if s > 0
552− then return s
553− else S.nil
554−
555−-------------------------------------------------------------------------------
556−-- Nested Composition Pure lists
557−-------------------------------------------------------------------------------
558−
559−-- There are several list benchmarks here for comparison with lists. It is easy
560−-- and convenient to see the comparisons when they are here, otherwise we'll
561−-- have to add a separate module for list benchmarks with the same names and
562−-- then add a comparison in bench.sh.
563−
564−{-# INLINE unfoldrList #-}
565−unfoldrList :: Int -> Int -> [Int]
566−unfoldrList maxval n = List.unfoldr step n
567− where
568− step cnt =
569− if cnt > n + maxval
570− then Nothing
571− else Just (cnt, cnt + 1)
572−
573−{-# INLINE toNullApNestedList #-}
574−toNullApNestedList :: [Int] -> [Int]
575−toNullApNestedList s = (+) <$> s <*> s
576−
577−{-# INLINE toNullNestedList #-}
578−toNullNestedList :: [Int] -> [Int]
579−toNullNestedList s = do
580− x <- s
581− y <- s
582− return $ x + y
583−
584−{-# INLINE toNullNestedList3 #-}
585−toNullNestedList3 :: [Int] -> [Int]
586−toNullNestedList3 s = do
587− x <- s
588− y <- s
589− z <- s
590− return $ x + y + z
591−
592−{-# INLINE filterAllOutNestedList #-}
593−filterAllOutNestedList :: [Int] -> [Int]
594−filterAllOutNestedList str = do
595− x <- str
596− y <- str
597− let s = x + y
598− if s < 0
599− then return s
600− else []
601−
602−{-# INLINE filterAllInNestedList #-}
603−filterAllInNestedList :: [Int] -> [Int]
604−filterAllInNestedList str = do
605− x <- str
606− y <- str
607− let s = x + y
608− if s > 0
609− then return s
610− else []
611− -}
612−
613−-------------------------------------------------------------------------------
614−-- Benchmarks
615−-------------------------------------------------------------------------------
616−
617−moduleName :: String
618−moduleName = "Data.Stream.ToStreamK"
619−
620−-- Generation of StreamK using StreamD generation functions and eleminating
621−-- using StreamK drain.
622−o_1_space_generation :: Int -> Benchmark
623−o_1_space_generation streamLen =
624− bgroup "generation"
625− [ benchFold "unfoldr" drain (unfoldrD streamLen)
626− , benchFold "unfoldrM" drain (unfoldrMD streamLen)
627− , benchFold "repeat" drain (repeat streamLen)
628− , benchFold "repeatM" drain (repeatM streamLen)
629− , benchFold "replicate" drain (replicate streamLen)
630− , benchFold "replicateM" drain (replicateM streamLen)
631− , benchFold "iterate" drain (iterate streamLen)
632− , benchFold "iterateM" drain (iterateM streamLen)
633−
634− , benchFold "fromFoldable" drain (fromFoldable streamLen)
635− , benchFold "fromFoldableM" drain (fromFoldableM streamLen)
636−
637− -- appends
638− , benchFold "concatMapFoldableWith" drain (concatMapFoldableSerial streamLen)
639− , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)
640− ]
641−
642−-- Generating using StreamK and eliminating using StreamD folds.
643−o_1_space_elimination :: Int -> Benchmark
644−o_1_space_elimination streamLen =
645− bgroup "elimination"
646− [ benchFold "toNull" drainD (unfoldrMK streamLen)
647− , benchFold "mapM_" mapM_ (unfoldrMK streamLen)
648− -- , benchFold "uncons" uncons (unfoldrMK streamLen)
649− -- , benchFold "init" init (unfoldrM streamLen)
650− , benchFold "foldl'" foldl' (unfoldrMK streamLen)
651− , benchFold "last" last (unfoldrMK streamLen)
652− ]
653−
654−{-
655−o_1_space_nested :: Int -> Benchmark
656−o_1_space_nested streamLen =
657− bgroup "nested"
658− [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)
659− , benchFold "drainMonad" drainMonad (unfoldrM streamLen2)
660− , benchFold "drainMonad3" drainMonad3 (unfoldrM streamLen3)
661− , benchFold "filterAllInMonad" filterAllInMonad (unfoldrM streamLen2)
662− , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)
663− , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)
664− , benchFold "drainMonad (pure)" drainMonad (unfoldr streamLen2)
665− , benchFold "drainMonad3 (pure)" drainMonad3 (unfoldr streamLen3)
666− , benchFold "filterAllInMonad (pure)" filterAllInMonad (unfoldr streamLen2)
667− , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)
668− ]
669− where
670− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
671− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
672−-}
673−
674−-- Generate using StreamK and transform using StreamD transformation functions
675−-- and then drain using StreamK.
676−o_1_space_transformation :: Int -> Benchmark
677−o_1_space_transformation streamLen =
678− bgroup "transformation"
679− [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)
680− benchFold "scanl'" (scanl' 1) (unfoldrMK streamLen)
681− , benchFold "map" (map 1) (unfoldrMK streamLen)
682− -- , benchFold "fmap" (fmapK 1) (unfoldrM streamLen)
683− , benchFold "mapM" (mapM 1) (unfoldrMK streamLen)
684− -- , benchFold "mapMSerial" (mapMSerial 1) (unfoldrM streamLen)
685− ]
686−
687−o_1_space_transformationX4 :: Int -> Benchmark
688−o_1_space_transformationX4 streamLen =
689− bgroup "transformationX4"
690− [ benchFold "scanl'" (scanl' 4) (unfoldrMK streamLen)
691− , benchFold "map" (map 4) (unfoldrMK streamLen)
692− -- , benchFold "fmap" (fmapK 4) (unfoldrMK streamLen)
693− , benchFold "mapM" (mapM 4) (unfoldrMK streamLen)
694− -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)
695− -- XXX this is horribly slow
696− -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)
697− ]
698−
699−-- Generate using K, fold using K, concat using D.concatMap
700−o_1_space_concat :: Int -> Benchmark
701−o_1_space_concat streamLen =
702− bgroup "concat"
703− [ {- benchIOSrc1 "concatMapPure (n of 1)"
704− (concatMapPure streamLen 1)
705− , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"
706− (concatMapPure streamLen2 streamLen2)
707− , benchIOSrc1 "concatMapPure (1 of n)"
708− (concatMapPure 1 streamLen)
709− -}
710−
711− benchIOSrc1 "concatMap (n of 1)"
712− (concatMap streamLen 1)
713− , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
714− (concatMap streamLen2 streamLen2)
715− , benchIOSrc1 "concatMap (1 of n)"
716− (concatMap 1 streamLen)
717−
718−{-
719− , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
720− (concatMapRepl streamLen2 streamLen2)
721−
722− -- This is for comparison with concatMapFoldableWith
723− , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"
724− (S.drain
725− . S.concatMapWith S.serial id
726− . sourceConcatMapId streamLen)
727−
728− , benchIOSrc1 "concatMapBy serial (n of 1)"
729− (concatMapBySerial streamLen 1)
730− , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"
731− (concatMapBySerial streamLen2 streamLen2)
732− , benchIOSrc1 "concatMapBy serial (1 of n)"
733− (concatMapBySerial 1 streamLen)
734− , benchFold "sortBy" sortBy (unfoldrM streamLen)
735− -}
736− ]
737− where
738− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
739−
740−o_1_space_filtering :: Int -> Benchmark
741−o_1_space_filtering streamLen =
742− bgroup "filtering"
743− [ benchFold "filter-even" (filterEven 1) (unfoldrMK streamLen)
744− {-
745− , benchFold "filter-all-out" (filterAllOut streamLen 1) (unfoldrM streamLen)
746− , benchFold "filter-all-in" (filterAllIn streamLen 1) (unfoldrM streamLen)
747− , benchFold "take-all" (takeAll streamLen 1) (unfoldrM streamLen)
748− , benchFold "takeWhile-true" (takeWhileTrue streamLen 1) (unfoldrM streamLen)
749− , benchFold "drop-one" (dropOne 1) (unfoldrM streamLen)
750− , benchFold "drop-all" (dropAll streamLen 1) (unfoldrM streamLen)
751− , benchFold "dropWhile-true" (dropWhileTrue streamLen 1) (unfoldrM streamLen)
752− , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)
753− -}
754− ]
755−
756−o_1_space_filteringX4 :: Int -> Benchmark
757−o_1_space_filteringX4 streamLen =
758− bgroup "filteringX4"
759− [ benchFold "filter-even" (filterEven 4) (unfoldrMK streamLen)
760− {-
761− , benchFold "filter-all-out" (filterAllOut streamLen 4) (unfoldrM streamLen)
762− , benchFold "filter-all-in" (filterAllIn streamLen 4) (unfoldrM streamLen)
763− , benchFold "take-all" (takeAll streamLen 4) (unfoldrM streamLen)
764− , benchFold "takeWhile-true" (takeWhileTrue streamLen 4) (unfoldrM streamLen)
765− , benchFold "drop-one" (dropOne 4) (unfoldrM streamLen)
766− , benchFold "drop-all" (dropAll streamLen 4) (unfoldrM streamLen)
767− , benchFold "dropWhile-true" (dropWhileTrue streamLen 4) (unfoldrM streamLen)
768− , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)
769− -}
770− ]
771−
772−{-
773−o_1_space_zipping :: Int -> Benchmark
774−o_1_space_zipping streamLen =
775− bgroup "zipping"
776− [ benchFold "zipWith" zipWith (unfoldrM streamLen)
777− , benchFold "zipWithM" zipWithM (unfoldrM streamLen)
778− ]
779−
780−o_1_space_mixed :: Int -> Benchmark
781−o_1_space_mixed streamLen =
782− bgroup "mixed"
783− [ benchFold "scan-map" (scanMap 1) (unfoldrM streamLen)
784− , benchFold "drop-map" (dropMap 1) (unfoldrM streamLen)
785− , benchFold "drop-scan" (dropScan 1) (unfoldrM streamLen)
786− , benchFold "take-drop" (takeDrop streamLen 1) (unfoldrM streamLen)
787− , benchFold "take-scan" (takeScan streamLen 1) (unfoldrM streamLen)
788− , benchFold "take-map" (takeMap streamLen 1) (unfoldrM streamLen)
789− , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)
790− , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)
791− , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)
792− , benchFold "filter-map" (filterMap streamLen 1) (unfoldrM streamLen)
793− ]
794−
795−o_1_space_mixedX2 :: Int -> Benchmark
796−o_1_space_mixedX2 streamLen =
797− bgroup "mixedX2"
798− [ benchFold "scan-map" (scanMap 2) (unfoldrM streamLen)
799− , benchFold "drop-map" (dropMap 2) (unfoldrM streamLen)
800− , benchFold "drop-scan" (dropScan 2) (unfoldrM streamLen)
801− , benchFold "take-drop" (takeDrop streamLen 2) (unfoldrM streamLen)
802− , benchFold "take-scan" (takeScan streamLen 2) (unfoldrM streamLen)
803− , benchFold "take-map" (takeMap streamLen 2) (unfoldrM streamLen)
804− , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)
805− , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)
806− , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)
807− , benchFold "filter-map" (filterMap streamLen 2) (unfoldrM streamLen)
808− ]
809−
810−o_1_space_mixedX4 :: Int -> Benchmark
811−o_1_space_mixedX4 streamLen =
812− bgroup "mixedX4"
813− [ benchFold "scan-map" (scanMap 4) (unfoldrM streamLen)
814− , benchFold "drop-map" (dropMap 4) (unfoldrM streamLen)
815− , benchFold "drop-scan" (dropScan 4) (unfoldrM streamLen)
816− , benchFold "take-drop" (takeDrop streamLen 4) (unfoldrM streamLen)
817− , benchFold "take-scan" (takeScan streamLen 4) (unfoldrM streamLen)
818− , benchFold "take-map" (takeMap streamLen 4) (unfoldrM streamLen)
819− , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)
820− , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)
821− , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)
822− , benchFold "filter-map" (filterMap streamLen 4) (unfoldrM streamLen)
823− ]
824− -}
825−
826−{-
827−o_1_space_list :: Int -> Benchmark
828−o_1_space_list streamLen =
829− bgroup "list"
830− [ bgroup "elimination"
831− [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)
832− ]
833− , bgroup "nested"
834− [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)
835− , benchList "toNull" toNullNestedList (unfoldrList streamLen2)
836− , benchList "toNull3" toNullNestedList3 (unfoldrList streamLen3)
837− , benchList "filterAllIn" filterAllInNestedList (unfoldrList streamLen2)
838− , benchList "filterAllOut" filterAllOutNestedList (unfoldrList streamLen2)
839− ]
840− ]
841− where
842−
843− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
844− streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop
845−-}
846−
847−o_1_space :: Int -> Benchmark
848−o_1_space streamLen =
849− bgroup (o_1_space_prefix moduleName)
850− [ o_1_space_generation streamLen
851− , o_1_space_elimination streamLen
852− -- , o_1_space_nested streamLen
853− , o_1_space_transformation streamLen
854− , o_1_space_transformationX4 streamLen
855− , o_1_space_concat streamLen
856− , o_1_space_filtering streamLen
857− , o_1_space_filteringX4 streamLen
858− -- , o_1_space_zipping streamLen
859− -- , o_1_space_mixed streamLen
860− -- , o_1_space_mixedX2 streamLen
861− -- , o_1_space_mixedX4 streamLen
862− -- , o_1_space_list streamLen
863− ]
864−
865−{-
866−o_n_heap :: Int -> Benchmark
867−o_n_heap streamLen =
868− bgroup (o_n_heap_prefix moduleName)
869− [ bgroup "transformation"
870− [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)
871− ]
872− ]
873−
874−{-# INLINE benchK #-}
875−benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark
876−benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f
877−
878−o_n_stack :: Int -> Int -> Int -> Benchmark
879−o_n_stack streamLen iterStreamLen maxIters =
880− bgroup (o_n_stack_prefix moduleName)
881− [ bgroup "elimination"
882− [ benchFold "tail" tail (unfoldrM streamLen)
883− , benchFold "nullTail" nullTail (unfoldrM streamLen)
884− , benchFold "headTail" headTail (unfoldrM streamLen)
885− ]
886− , bgroup "transformation"
887− [
888− -- XXX why do these need so much stack
889− benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)
890− , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)
891− ]
892− , bgroup "transformationX4"
893− [
894− benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)
895− ]
896− , bgroup "iterated"
897− [ benchK "mapM" (iterateMapM iterStreamLen maxIters)
898− , benchK "scan(1/10)" (iterateScan iterStreamLen maxIters)
899− , benchK "filterEven" (iterateFilterEven iterStreamLen maxIters)
900− , benchK "takeAll" (iterateTakeAll streamLen iterStreamLen maxIters)
901− , benchK "dropOne" (iterateDropOne iterStreamLen maxIters)
902− , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)
903− , benchK "dropWhileTrue" (iterateDropWhileTrue streamLen iterStreamLen maxIters)
904− ]
905− ]
906− where
907− streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop
908− streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop
909−-}
910−
911−o_n_space :: Int -> Benchmark
912−o_n_space streamLen =
913− bgroup (o_n_space_prefix moduleName)
914− [ bgroup "elimination"
915− [ benchFold "toList" toList (unfoldrMK streamLen)
916− ]
917− ]
918−
919−{-
920−{-# INLINE benchList #-}
921−benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark
922−benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f
923−-}
924−
925−main :: IO ()
926−main =
927− defaultMain
928− [ o_1_space streamLen
929− -- , o_n_stack streamLen iterStreamLen maxIters
930− -- , o_n_heap streamLen
931− , o_n_space streamLen
932− ]
933−
934− where
935−
936− streamLen = 100000
937− -- maxIters = 10000
938− -- iterStreamLen = 10
benchmark/Streamly/Benchmark/Data/Unfold.hs+60−89
@@ -21,8 +21,6 @@ module Main (main) where
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)
26import Streamly.Internal.Data.Unfold (Unfold)
24import Streamly.Internal.Data.Unfold (Unfold)
27import System.IO (Handle, hClose)
25import System.IO (Handle, hClose)
28import System.Random (randomRIO)
26import System.Random (randomRIO)
@@ -31,18 +29,17 @@ import qualified Prelude
31import qualified Streamly.FileSystem.Handle as FH
29import qualified Streamly.FileSystem.Handle as FH
32import qualified Streamly.Internal.Data.Fold as FL
30import qualified Streamly.Internal.Data.Fold as FL
33import qualified Streamly.Internal.Data.Unfold as UF
31import qualified Streamly.Internal.Data.Unfold as UF
34−import qualified Streamly.Internal.Data.Unfold.Prelude as UF
32+import qualified Streamly.Internal.Data.Stream.IsStream as S
35−import qualified Streamly.Internal.Data.Stream as S
36−import qualified Streamly.Internal.Data.Stream as D
33+import qualified Streamly.Internal.Data.Stream.StreamD as D
37−import qualified Streamly.Internal.Data.StreamK as K
34+import qualified Streamly.Internal.Data.Stream.StreamK as K
35+import qualified Streamly.Prelude as SP
38
36
39−import Test.Tasty.Bench hiding (env)
37+import Gauge hiding (env)
40−import Prelude hiding (take, filter, zipWith, map, mapM, takeWhile)
38+import Prelude hiding (concat, take, filter, zipWith, map, mapM, takeWhile)
41import Streamly.Benchmark.Common
39import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common.Handle
40import Streamly.Benchmark.Common.Handle
43
41
44#ifdef INSPECTION
42#ifdef INSPECTION
45−import Control.Monad.Catch (MonadCatch)
46import Test.Inspection
43import Test.Inspection
47#endif
44#endif
48
45
@@ -57,7 +54,7 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f
57-- generate numbers up to the argument value
54-- generate numbers up to the argument value
58{-# INLINE source #-}
55{-# INLINE source #-}
59source :: Monad m => Int -> Unfold m Int Int
56source :: Monad m => Int -> Unfold m Int Int
60−source n = UF.second n UF.enumerateFromToIntegral
57+source n = UF.supplySecond n UF.enumerateFromToIntegral
61
58
62-------------------------------------------------------------------------------
59-------------------------------------------------------------------------------
63-- Benchmark helpers
60-- Benchmark helpers
@@ -76,7 +73,7 @@ drainTransformation unf f seed = drainGeneration (f unf) seed
76drainTransformationDefault ::
73drainTransformationDefault ::
77 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
74 Monad m => Int -> (Unfold m Int Int -> Unfold m c d) -> c -> m ()
78drainTransformationDefault to =
75drainTransformationDefault to =
79− drainTransformation (UF.second to UF.enumerateFromToIntegral)
76+ drainTransformation (UF.supplySecond to UF.enumerateFromToIntegral)
80
77
81{-# INLINE drainProduct #-}
78{-# INLINE drainProduct #-}
82drainProduct ::
79drainProduct ::
@@ -99,7 +96,7 @@ drainProductDefault to = drainProduct src src
99
96
100 where
97 where
101
98
102− src = UF.second to UF.enumerateFromToIntegral
99+ src = UF.supplySecond to UF.enumerateFromToIntegral
103
100
104-------------------------------------------------------------------------------
101-------------------------------------------------------------------------------
105-- Operations on input
102-- Operations on input
@@ -115,26 +112,26 @@ lmapM :: Monad m => Int -> Int -> m ()
115lmapM size start =
112lmapM size start =
116 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
113 drainTransformationDefault (size + start) (UF.lmapM (return . (+) 1)) start
117
114
118−{-# INLINE both #-}
115+{-# INLINE supply #-}
119−both :: Monad m => Int -> Int -> m ()
116+supply :: Monad m => Int -> Int -> m ()
120−both size start =
117+supply size start =
121− drainTransformationDefault (size + start) (UF.both start) undefined
118+ drainTransformationDefault (size + start) (UF.supply start) undefined
122
119
123
120
124−{-# INLINE first #-}
121+{-# INLINE supplyFirst #-}
125−first :: Monad m => Int -> Int -> m ()
122+supplyFirst :: Monad m => Int -> Int -> m ()
126−first size start =
123+supplyFirst size start =
127 drainTransformation
124 drainTransformation
128 (UF.take size UF.enumerateFromThenIntegral)
125 (UF.take size UF.enumerateFromThenIntegral)
129− (UF.first start)
126+ (UF.supplyFirst start)
130 1
127 1
131
128
132−{-# INLINE second #-}
129+{-# INLINE supplySecond #-}
133−second :: Monad m => Int -> Int -> m ()
130+supplySecond :: Monad m => Int -> Int -> m ()
134−second size start =
131+supplySecond size start =
135 drainTransformation
132 drainTransformation
136 (UF.take size UF.enumerateFromThenIntegral)
133 (UF.take size UF.enumerateFromThenIntegral)
137− (UF.second 1)
134+ (UF.supplySecond 1)
138 start
135 start
139
136
140{-# INLINE discardFirst #-}
137{-# INLINE discardFirst #-}
@@ -162,7 +159,7 @@ swap size start =
162{-# INLINE fromStream #-}
159{-# INLINE fromStream #-}
163fromStream :: Int -> Int -> IO ()
160fromStream :: Int -> Int -> IO ()
164fromStream size start =
161fromStream size start =
165− drainGeneration UF.fromStream (S.replicate size start :: S.Stream IO Int)
162+ drainGeneration UF.fromStream (S.replicate size start :: S.SerialT IO Int)
166
163
167-- XXX INVESTIGATE: Although the performance of this should be equivalant to
164-- XXX INVESTIGATE: Although the performance of this should be equivalant to
168-- fromStream, this is considerably worse. More than 4x worse.
165-- fromStream, this is considerably worse. More than 4x worse.
@@ -232,7 +229,7 @@ _fromProducer = undefined
232
229
233{-# INLINE replicateM #-}
230{-# INLINE replicateM #-}
234replicateM :: Monad m => Int -> Int -> m ()
231replicateM :: Monad m => Int -> Int -> m ()
235−replicateM size start = drainGeneration UF.replicateM (size, return start)
232+replicateM size start = drainGeneration (UF.replicateM size) (return start)
236
233
237{-# INLINE repeatM #-}
234{-# INLINE repeatM #-}
238repeatM :: Monad m => Int -> Int -> m ()
235repeatM :: Monad m => Int -> Int -> m ()
@@ -257,7 +254,7 @@ enumerateFromThenIntegral size start =
257enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
254enumerateFromToIntegral :: Monad m => Int -> Int -> m ()
258enumerateFromToIntegral size start =
255enumerateFromToIntegral size start =
259 drainGeneration
256 drainGeneration
260− ( UF.second
257+ ( UF.supplySecond
261 (size + start)
258 (size + start)
262 UF.enumerateFromToIntegral
259 UF.enumerateFromToIntegral
263 ) start
260 ) start
@@ -281,7 +278,7 @@ enumerateFromToFractional :: Monad m => Int -> Int -> m ()
281enumerateFromToFractional size start =
278enumerateFromToFractional size start =
282 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
279 let intToDouble x = (fromInteger (fromIntegral x)) :: Double
283 in drainGeneration
280 in drainGeneration
284− ( UF.second
281+ ( UF.supplySecond
285 (intToDouble $ start + size)
282 (intToDouble $ start + size)
286 UF.enumerateFromToFractional
283 UF.enumerateFromToFractional
287 )
284 )
@@ -291,11 +288,6 @@ enumerateFromToFractional size start =
291-- Stream transformation
288-- Stream transformation
292-------------------------------------------------------------------------------
289-------------------------------------------------------------------------------
293
290
294−{-# INLINE postscan #-}
295−postscan :: Monad m => Int -> Int -> m ()
296−postscan size start =
297− drainTransformationDefault (size + start) (UF.postscan FL.sum) start
298−
299{-# INLINE map #-}
291{-# INLINE map #-}
300map :: Monad m => Int -> Int -> m ()
292map :: Monad m => Int -> Int -> m ()
301map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
293map size start = drainTransformationDefault (size + start) (UF.map (+1)) start
@@ -305,12 +297,12 @@ mapM :: Monad m => Int -> Int -> m ()
305mapM size start =
297mapM size start =
306 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
298 drainTransformationDefault (size + start) (UF.mapM (return . (+) 1)) start
307
299
308−{-# INLINE mapM2 #-}
300+{-# INLINE mapMWithInput #-}
309−mapM2 :: Monad m => Int -> Int -> m ()
301+mapMWithInput :: Monad m => Int -> Int -> m ()
310−mapM2 size start =
302+mapMWithInput size start =
311 drainTransformationDefault
303 drainTransformationDefault
312 size
304 size
313− (UF.mapM2 (\a b -> return $ a + b))
305+ (UF.mapMWithInput (\a b -> return $ a + b))
314 start
306 start
315
307
316-------------------------------------------------------------------------------
308-------------------------------------------------------------------------------
@@ -418,16 +410,13 @@ teeZipWith size start =
418-- Applicative
410-- Applicative
419-------------------------------------------------------------------------------
411-------------------------------------------------------------------------------
420
412
421−nthRoot :: Double -> Int -> Int
422−nthRoot n value = round (fromIntegral value**(1/n))
423−
424{-# INLINE toNullAp #-}
413{-# INLINE toNullAp #-}
425toNullAp :: Monad m => Int -> Int -> m ()
414toNullAp :: Monad m => Int -> Int -> m ()
426toNullAp value start =
415toNullAp value start =
427 let end = start + nthRoot 2 value
416 let end = start + nthRoot 2 value
428 s = source end
417 s = source end
429 -- in UF.fold ((+) <$> s <*> s) FL.drain start
418 -- in UF.fold ((+) <$> s <*> s) FL.drain start
430− in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start
419+ in UF.fold FL.drain ((+) `fmap` s `UF.apply` s) start
431
420
432{-# INLINE _apDiscardFst #-}
421{-# INLINE _apDiscardFst #-}
433_apDiscardFst :: Int -> Int -> m ()
422_apDiscardFst :: Int -> Int -> m ()
@@ -441,6 +430,9 @@ _apDiscardSnd = undefined
441-- Monad
430-- Monad
442-------------------------------------------------------------------------------
431-------------------------------------------------------------------------------
443
432
433+nthRoot :: Double -> Int -> Int
434+nthRoot n value = round (fromIntegral value**(1/n))
435+
444{-# INLINE concatMapM #-}
436{-# INLINE concatMapM #-}
445concatMapM :: Monad m => Int -> Int -> m ()
437concatMapM :: Monad m => Int -> Int -> m ()
446concatMapM value start =
438concatMapM value start =
@@ -449,8 +441,8 @@ concatMapM value start =
449 where
441 where
450
442
451 val = nthRoot 2 value
443 val = nthRoot 2 value
452− unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)
444+ unfoldInGen i = return (UF.supplySecond (i + val) UF.enumerateFromToIntegral)
453− unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral
445+ unfoldOut = UF.supplySecond (start + val) UF.enumerateFromToIntegral
454
446
455{-# INLINE toNull #-}
447{-# INLINE toNull #-}
456toNull :: Monad m => Int -> Int -> m ()
448toNull :: Monad m => Int -> Int -> m ()
@@ -601,9 +593,9 @@ concatCount :: Int -> Int
601concatCount linearCount =
593concatCount linearCount =
602 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
594 round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)
603
595
604−{-# INLINE many #-}
596+{-# INLINE concat #-}
605−many :: Monad m => Int -> Int -> m ()
597+concat :: Monad m => Int -> Int -> m ()
606−many linearCount start = do
598+concat linearCount start = do
607 let end = start + concatCount linearCount
599 let end = start + concatCount linearCount
608 UF.fold FL.drain (UF.many (source end) (source end)) start
600 UF.fold FL.drain (UF.many (source end) (source end)) start
609
601
@@ -620,9 +612,9 @@ o_1_space_transformation_input size =
620 "transformation/input"
612 "transformation/input"
621 [ benchIO "lmap" $ lmap size
613 [ benchIO "lmap" $ lmap size
622 , benchIO "lmapM" $ lmapM size
614 , benchIO "lmapM" $ lmapM size
623− , benchIO "both" $ both size
615+ , benchIO "supply" $ supply size
624− , benchIO "first" $ first size
616+ , benchIO "supplyFirst" $ supplyFirst size
625− , benchIO "second" $ second size
617+ , benchIO "supplySecond" $ supplySecond size
626 , benchIO "discardFirst" $ discardFirst size
618 , benchIO "discardFirst" $ discardFirst size
627 , benchIO "discardSecond" $ discardSecond size
619 , benchIO "discardSecond" $ discardSecond size
628 , benchIO "swap" $ swap size
620 , benchIO "swap" $ swap size
@@ -668,8 +660,7 @@ o_1_space_transformation size =
668 "transformation"
660 "transformation"
669 [ benchIO "map" $ map size
661 [ benchIO "map" $ map size
670 , benchIO "mapM" $ mapM size
662 , benchIO "mapM" $ mapM size
671− , benchIO "mapM2" $ mapM2 size
663+ , benchIO "mapMWithInput" $ mapMWithInput size
672− , benchIO "postscan" $ postscan size
673 ]
664 ]
674 ]
665 ]
675
666
@@ -702,17 +693,8 @@ o_1_space_zip size =
702 ]
693 ]
703 ]
694 ]
704
695
705−lf :: Word8
706−lf = fromIntegral (ord '\n')
707−
708−-- | Split on line feed.
709−foldManySepBy :: Handle -> IO Int
710−foldManySepBy =
711− let u = UF.foldMany (FL.takeEndBy_ (== lf) FL.drain) FH.reader
712− in UF.fold FL.length u
713−
714−o_1_space_nested :: BenchEnv -> Int -> [Benchmark]
696+o_1_space_nested :: Int -> [Benchmark]
715−o_1_space_nested env size =
697+o_1_space_nested size =
716 [ bgroup
698 [ bgroup
717 "nested"
699 "nested"
718 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
700 [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size
@@ -728,9 +710,7 @@ o_1_space_nested env size =
728 , benchIO "filterAllIn" $ filterAllIn size
710 , benchIO "filterAllIn" $ filterAllIn size
729 , benchIO "filterSome" $ filterSome size
711 , benchIO "filterSome" $ filterSome size
730
712
731− , benchIO "many" $ many size
713+ , benchIO "concat" $ concat size
732− , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env
733− $ \inh _ -> foldManySepBy inh
734 ]
714 ]
735 ]
715 ]
736
716
@@ -749,11 +729,11 @@ o_n_space_nested size =
749-- | Send the file contents to /dev/null with exception handling
729-- | Send the file contents to /dev/null with exception handling
750readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
730readWriteOnExceptionUnfold :: Handle -> Handle -> IO ()
751readWriteOnExceptionUnfold inh devNull =
731readWriteOnExceptionUnfold inh devNull =
752− let readEx = UF.onException (\_ -> hClose inh) FH.reader
732+ let readEx = UF.onException (\_ -> hClose inh) FH.read
753− in S.fold (FH.write devNull) $ S.unfold readEx inh
733+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
754
734
755#ifdef INSPECTION
735#ifdef INSPECTION
756−-- inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
736+inspect $ hasNoTypeClasses 'readWriteOnExceptionUnfold
757-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
737-- inspect $ 'readWriteOnExceptionUnfold `hasNoType` ''Step
758#endif
738#endif
759
739
@@ -761,54 +741,45 @@ readWriteOnExceptionUnfold inh devNull =
761readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
741readWriteHandleExceptionUnfold :: Handle -> Handle -> IO ()
762readWriteHandleExceptionUnfold inh devNull =
742readWriteHandleExceptionUnfold inh devNull =
763 let handler (_e :: SomeException) = hClose inh >> return 10
743 let handler (_e :: SomeException) = hClose inh >> return 10
764− readEx = UF.handle (UF.functionM handler) FH.reader
744+ readEx = UF.handle (UF.functionM handler) FH.read
765− in S.fold (FH.write devNull) $ S.unfold readEx inh
745+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
766
746
767#ifdef INSPECTION
747#ifdef INSPECTION
768−-- hasNoTypeClasses started failing in GHC 9.4.4
769−-- inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
748+inspect $ hasNoTypeClasses 'readWriteHandleExceptionUnfold
770-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
749-- inspect $ 'readWriteHandleExceptionUnfold `hasNoType` ''Step
771#endif
750#endif
772
751
773-- | Send the file contents to /dev/null with exception handling
752-- | Send the file contents to /dev/null with exception handling
774readWriteFinally_Unfold :: Handle -> Handle -> IO ()
753readWriteFinally_Unfold :: Handle -> Handle -> IO ()
775readWriteFinally_Unfold inh devNull =
754readWriteFinally_Unfold inh devNull =
776− let readEx = UF.finally_ (\_ -> hClose inh) FH.reader
755+ let readEx = UF.finally_ (\_ -> hClose inh) FH.read
777− in S.fold (FH.write devNull) $ S.unfold readEx inh
756+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
778
757
779#ifdef INSPECTION
758#ifdef INSPECTION
780−#if __GLASGOW_HASKELL__ >= 906
781−inspect $ hasNoTypeClassesExcept 'readWriteFinally_Unfold [''MonadCatch]
782−#else
783inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
759inspect $ hasNoTypeClasses 'readWriteFinally_Unfold
784−#endif
785-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
760-- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step
786#endif
761#endif
787
762
788readWriteFinallyUnfold :: Handle -> Handle -> IO ()
763readWriteFinallyUnfold :: Handle -> Handle -> IO ()
789readWriteFinallyUnfold inh devNull =
764readWriteFinallyUnfold inh devNull =
790− let readEx = UF.finally (\_ -> hClose inh) FH.reader
765+ let readEx = UF.finally (\_ -> hClose inh) FH.read
791− in S.fold (FH.write devNull) $ S.unfold readEx inh
766+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
792
767
793-- | Send the file contents to /dev/null with exception handling
768-- | Send the file contents to /dev/null with exception handling
794readWriteBracket_Unfold :: Handle -> Handle -> IO ()
769readWriteBracket_Unfold :: Handle -> Handle -> IO ()
795readWriteBracket_Unfold inh devNull =
770readWriteBracket_Unfold inh devNull =
796− let readEx = UF.bracket_ return (\_ -> hClose inh) FH.reader
771+ let readEx = UF.bracket_ return (\_ -> hClose inh) FH.read
797− in S.fold (FH.write devNull) $ S.unfold readEx inh
772+ in SP.fold (FH.write devNull) $ SP.unfold readEx inh
798
773
799#ifdef INSPECTION
774#ifdef INSPECTION
800−#if __GLASGOW_HASKELL__ >= 906
801−inspect $ hasNoTypeClassesExcept 'readWriteBracket_Unfold [''MonadCatch]
802−#else
803inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
775inspect $ hasNoTypeClasses 'readWriteBracket_Unfold
804−#endif
805-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
776-- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step
806#endif
777#endif
807
778
808readWriteBracketUnfold :: Handle -> Handle -> IO ()
779readWriteBracketUnfold :: Handle -> Handle -> IO ()
809readWriteBracketUnfold inh devNull =
780readWriteBracketUnfold inh devNull =
810− let readEx = UF.bracket return (\_ -> hClose inh) FH.reader
781+ let readEx = UF.bracket return (\_ -> hClose inh) FH.read
811− in S.fold (FH.write devNull) $ S.unfold readEx inh
782+ in SP.fold (FH.write devNull) $ S.unfold readEx inh
812
783
813o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
784o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark]
814o_1_space_copy_read_exceptions env =
785o_1_space_copy_read_exceptions env =
@@ -848,7 +819,7 @@ main = do
848 , o_1_space_transformation size
819 , o_1_space_transformation size
849 , o_1_space_filtering size
820 , o_1_space_filtering size
850 , o_1_space_zip size
821 , o_1_space_zip size
851− , o_1_space_nested env size
822+ , o_1_space_nested size
852 , o_1_space_copy_read_exceptions env
823 , o_1_space_copy_read_exceptions env
853 ]
824 ]
854 , bgroup (o_n_space_prefix moduleName)
825 , bgroup (o_n_space_prefix moduleName)
benchmark/Streamly/Benchmark/FileSystem/Handle.hs+5−1
@@ -17,12 +17,16 @@
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+
20import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
24import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
21
25
22import qualified Handle.ReadWrite as RW
26import qualified Handle.ReadWrite as RW
23import qualified Handle.Read as RO
27import qualified Handle.Read as RO
24
28
25−import Test.Tasty.Bench hiding (env)
29+import Gauge hiding (env)
26import Prelude hiding (last, length)
30import Prelude hiding (last, length)
27import Streamly.Benchmark.Common
31import Streamly.Benchmark.Common
28
32
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs+62−66
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Streamly.Benchmark.FileSystem.Handle
2-- Module : Streamly.Benchmark.FileSystem.Handle
5-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
@@ -26,29 +24,32 @@ where
26
24
27import Data.Word (Word8)
25import Data.Word (Word8)
28import GHC.Magic (inline)
26import GHC.Magic (inline)
27+#if __GLASGOW_HASKELL__ >= 802
29import GHC.Magic (noinline)
28import GHC.Magic (noinline)
29+#else
30+#define noinline
31+#endif
30import System.IO (Handle)
32import System.IO (Handle)
31
33
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 as A
35+import qualified Streamly.Internal.Data.Array.Foreign as A
36+import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
36import qualified Streamly.Internal.Data.Fold as FL
37import qualified Streamly.Internal.Data.Fold as FL
37−import qualified Streamly.Internal.Data.Stream as IP
38+import qualified Streamly.Internal.Data.Stream.IsStream as IP
38import qualified Streamly.Internal.FileSystem.Handle as IFH
39import qualified Streamly.Internal.FileSystem.Handle as IFH
39import qualified Streamly.Internal.Unicode.Stream as IUS
40import qualified Streamly.Internal.Unicode.Stream as IUS
40−import qualified Streamly.Data.Stream.Prelude as S
41+import qualified Streamly.Prelude as S
41import qualified Streamly.Unicode.Stream as SS
42import qualified Streamly.Unicode.Stream as SS
42
43
43−import Test.Tasty.Bench hiding (env)
44+import Gauge hiding (env)
44import Prelude hiding (last, length)
45import Prelude hiding (last, length)
45import Streamly.Benchmark.Common.Handle
46import Streamly.Benchmark.Common.Handle
46
47
47#ifdef INSPECTION
48#ifdef INSPECTION
48−import Streamly.Internal.Data.Stream (Step(..), FoldMany)
49+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..), FoldMany)
49
50
50−import qualified Streamly.Internal.Data.MutArray as MutArray
51+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
51−import qualified Streamly.Internal.Data.Stream as D
52+import qualified Streamly.Internal.Data.Stream.StreamD as D
52import qualified Streamly.Internal.Data.Unfold as IUF
53import qualified Streamly.Internal.Data.Unfold as IUF
53
54
54import Test.Inspection
55import Test.Inspection
@@ -62,49 +63,49 @@ import Test.Inspection
62
63
63-- | Get the last byte from a file bytestream.
64-- | Get the last byte from a file bytestream.
64readLast :: Handle -> IO (Maybe Word8)
65readLast :: Handle -> IO (Maybe Word8)
65−readLast = S.fold Fold.last . S.unfold FH.reader
66+readLast = S.last . S.unfold FH.read
66
67
67#ifdef INSPECTION
68#ifdef INSPECTION
68inspect $ hasNoTypeClasses 'readLast
69inspect $ hasNoTypeClasses 'readLast
69inspect $ 'readLast `hasNoType` ''Step -- S.unfold
70inspect $ 'readLast `hasNoType` ''Step -- S.unfold
70inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
71inspect $ 'readLast `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
71−inspect $ 'readLast `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
72+inspect $ 'readLast `hasNoType` ''MA.ReadUState -- FH.read/A.read
72#endif
73#endif
73
74
74-- assert that flattenArrays constructors are not present
75-- assert that flattenArrays constructors are not present
75-- | Count the number of bytes in a file.
76-- | Count the number of bytes in a file.
76readCountBytes :: Handle -> IO Int
77readCountBytes :: Handle -> IO Int
77−readCountBytes = S.fold Fold.length . S.unfold FH.reader
78+readCountBytes = S.length . S.unfold FH.read
78
79
79#ifdef INSPECTION
80#ifdef INSPECTION
80inspect $ hasNoTypeClasses 'readCountBytes
81inspect $ hasNoTypeClasses 'readCountBytes
81inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
82inspect $ 'readCountBytes `hasNoType` ''Step -- S.unfold
82inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
83inspect $ 'readCountBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
83−inspect $ 'readCountBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
84+inspect $ 'readCountBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
84#endif
85#endif
85
86
86-- | Count the number of lines in a file.
87-- | Count the number of lines in a file.
87readCountLines :: Handle -> IO Int
88readCountLines :: Handle -> IO Int
88readCountLines =
89readCountLines =
89− S.fold Fold.length
90+ S.length
90 . IUS.lines FL.drain
91 . IUS.lines FL.drain
91 . SS.decodeLatin1
92 . SS.decodeLatin1
92− . S.unfold FH.reader
93+ . S.unfold FH.read
93
94
94#ifdef INSPECTION
95#ifdef INSPECTION
95inspect $ hasNoTypeClasses 'readCountLines
96inspect $ hasNoTypeClasses 'readCountLines
96inspect $ 'readCountLines `hasNoType` ''Step
97inspect $ 'readCountLines `hasNoType` ''Step
97inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98inspect $ 'readCountLines `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'readCountLines `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
99+inspect $ 'readCountLines `hasNoType` ''MA.ReadUState -- FH.read/A.read
99#endif
100#endif
100
101
101-- | Count the number of words in a file.
102-- | Count the number of words in a file.
102readCountWords :: Handle -> IO Int
103readCountWords :: Handle -> IO Int
103readCountWords =
104readCountWords =
104− S.fold Fold.length
105+ S.length
105 . IUS.words FL.drain
106 . IUS.words FL.drain
106 . SS.decodeLatin1
107 . SS.decodeLatin1
107− . S.unfold FH.reader
108+ . S.unfold FH.read
108
109
109#ifdef INSPECTION
110#ifdef INSPECTION
110inspect $ hasNoTypeClasses 'readCountWords
111inspect $ hasNoTypeClasses 'readCountWords
@@ -113,13 +114,13 @@ inspect $ hasNoTypeClasses 'readCountWords
113
114
114-- | Sum the bytes in a file.
115-- | Sum the bytes in a file.
115readSumBytes :: Handle -> IO Word8
116readSumBytes :: Handle -> IO Word8
116−readSumBytes = S.fold Fold.sum . S.unfold FH.reader
117+readSumBytes = S.sum . S.unfold FH.read
117
118
118#ifdef INSPECTION
119#ifdef INSPECTION
119inspect $ hasNoTypeClasses 'readSumBytes
120inspect $ hasNoTypeClasses 'readSumBytes
120inspect $ 'readSumBytes `hasNoType` ''Step
121inspect $ 'readSumBytes `hasNoType` ''Step
121inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
122inspect $ 'readSumBytes `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
122−inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
123+inspect $ 'readSumBytes `hasNoType` ''MA.ReadUState -- FH.read/A.read
123#endif
124#endif
124
125
125-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
126-- XXX When we mark this with INLINE and we have two benchmarks using S.drain
@@ -133,21 +134,21 @@ inspect $ 'readSumBytes `hasNoType` ''MutArray.ArrayUnsafe -- FH.read/A.read
133-- fusion-plugin to propagate INLINE phase information such that this problem
134-- fusion-plugin to propagate INLINE phase information such that this problem
134-- does not occur.
135-- does not occur.
135readDrain :: Handle -> IO ()
136readDrain :: Handle -> IO ()
136−readDrain inh = S.fold Fold.drain $ S.unfold FH.reader inh
137+readDrain inh = S.drain $ S.unfold FH.read inh
137
138
138-- XXX investigate why we need an INLINE in this case (GHC)
139-- XXX investigate why we need an INLINE in this case (GHC)
139{-# INLINE readDecodeLatin1 #-}
140{-# INLINE readDecodeLatin1 #-}
140readDecodeLatin1 :: Handle -> IO ()
141readDecodeLatin1 :: Handle -> IO ()
141readDecodeLatin1 inh =
142readDecodeLatin1 inh =
142− S.fold Fold.drain
143+ S.drain
143 $ SS.decodeLatin1
144 $ SS.decodeLatin1
144− $ S.unfold FH.reader inh
145+ $ S.unfold FH.read inh
145
146
146readDecodeUtf8 :: Handle -> IO ()
147readDecodeUtf8 :: Handle -> IO ()
147readDecodeUtf8 inh =
148readDecodeUtf8 inh =
148− S.fold Fold.drain
149+ S.drain
149 $ SS.decodeUtf8
150 $ SS.decodeUtf8
150− $ S.unfold FH.reader inh
151+ $ S.unfold FH.read inh
151
152
152#ifdef INSPECTION
153#ifdef INSPECTION
153inspect $ hasNoTypeClasses 'readDecodeUtf8
154inspect $ hasNoTypeClasses 'readDecodeUtf8
@@ -186,25 +187,25 @@ o_1_space_reduce_read env =
186-------------------------------------------------------------------------------
187-------------------------------------------------------------------------------
187
188
188-- | Count the number of lines in a file.
189-- | Count the number of lines in a file.
189−getChunksConcatUnfoldCountLines :: Handle -> IO Int
190+toChunksConcatUnfoldCountLines :: Handle -> IO Int
190−getChunksConcatUnfoldCountLines inh =
191+toChunksConcatUnfoldCountLines inh =
191− S.fold Fold.length
192+ S.length
192 $ IUS.lines FL.drain
193 $ IUS.lines FL.drain
193 $ SS.decodeLatin1
194 $ SS.decodeLatin1
194 -- XXX replace with toBytes
195 -- XXX replace with toBytes
195− $ S.unfoldMany A.reader (IFH.readChunks inh)
196+ $ S.unfoldMany A.read (IFH.toChunks inh)
196
197
197#ifdef INSPECTION
198#ifdef INSPECTION
198−inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines
199+inspect $ hasNoTypeClasses 'toChunksConcatUnfoldCountLines
199−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''Step
200+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''Step
200−inspect $ 'getChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
201+inspect $ 'toChunksConcatUnfoldCountLines `hasNoType` ''D.ConcatMapUState
201#endif
202#endif
202
203
203o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
204o_1_space_reduce_toBytes :: BenchEnv -> [Benchmark]
204o_1_space_reduce_toBytes env =
205o_1_space_reduce_toBytes env =
205 [ bgroup "reduce/toBytes"
206 [ bgroup "reduce/toBytes"
206 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
207 [ mkBench "US.lines . SS.decodeLatin1" env $ \inh _ ->
207− getChunksConcatUnfoldCountLines inh
208+ toChunksConcatUnfoldCountLines inh
208 ]
209 ]
209 ]
210 ]
210
211
@@ -213,51 +214,46 @@ o_1_space_reduce_toBytes env =
213-------------------------------------------------------------------------------
214-------------------------------------------------------------------------------
214
215
215chunksOfSum :: Int -> Handle -> IO Int
216chunksOfSum :: Int -> Handle -> IO Int
216−chunksOfSum n inh =
217− S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh)
217+chunksOfSum n inh = S.length $ S.chunksOf n FL.sum (S.unfold FH.read inh)
218
218
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
219foldManyPostChunksOfSum :: Int -> Handle -> IO Int
220foldManyPostChunksOfSum n inh =
220foldManyPostChunksOfSum n inh =
221− S.fold Fold.length
222− $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh)
221+ S.length $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.read inh)
223
222
224foldManyChunksOfSum :: Int -> Handle -> IO Int
223foldManyChunksOfSum :: Int -> Handle -> IO Int
225foldManyChunksOfSum n inh =
224foldManyChunksOfSum n inh =
226− S.fold Fold.length
227− $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.reader inh)
225+ S.length $ IP.foldMany (FL.take n FL.sum) (S.unfold FH.read inh)
228
226
229-- XXX investigate why we need an INLINE in this case (GHC)
227-- XXX investigate why we need an INLINE in this case (GHC)
230-- Even though allocations remain the same in both cases inlining improves time
228-- Even though allocations remain the same in both cases inlining improves time
231-- by 4x.
229-- by 4x.
232-- | Slice in chunks of size n and get the count of chunks.
230-- | Slice in chunks of size n and get the count of chunks.
233−{-# INLINE groupsOf #-}
231+{-# INLINE chunksOf #-}
234−groupsOf :: Int -> Handle -> IO Int
232+chunksOf :: Int -> Handle -> IO Int
235−groupsOf n inh =
233+chunksOf n inh =
236 -- writeNUnsafe gives 2.5x boost here over writeN.
234 -- writeNUnsafe gives 2.5x boost here over writeN.
237− S.fold Fold.length
238− $ IP.groupsOf n (A.writeNUnsafe n) (S.unfold FH.reader inh)
235+ S.length $ S.chunksOf n (AT.writeNUnsafe n) (S.unfold FH.read inh)
239
236
240#ifdef INSPECTION
237#ifdef INSPECTION
241−inspect $ hasNoTypeClasses 'groupsOf
238+inspect $ hasNoTypeClasses 'chunksOf
242−inspect $ 'groupsOf `hasNoType` ''Step
239+inspect $ 'chunksOf `hasNoType` ''Step
243−inspect $ 'groupsOf `hasNoType` ''FoldMany
240+inspect $ 'chunksOf `hasNoType` ''FoldMany
244−inspect $ 'groupsOf `hasNoType` ''MutArray.ArrayUnsafe -- AT.writeNUnsafe
241+inspect $ 'chunksOf `hasNoType` ''AT.ArrayUnsafe -- AT.writeNUnsafe
245− -- FH.read/A.read
246−inspect $ 'groupsOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
242+inspect $ 'chunksOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
243+inspect $ 'chunksOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
247#endif
244#endif
248
245
249−{-# INLINE chunksOf #-}
246+{-# INLINE arraysOf #-}
250−chunksOf :: Int -> Handle -> IO Int
247+arraysOf :: Int -> Handle -> IO Int
251−chunksOf n inh =
252− S.fold Fold.length $ Stream.chunksOf n (S.unfold FH.reader inh)
248+arraysOf n inh = S.length $ IP.arraysOf n (S.unfold FH.read inh)
253
249
254o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
250o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark]
255o_1_space_reduce_read_grouped env =
251o_1_space_reduce_read_grouped env =
256 [ bgroup "reduce/read/chunks"
252 [ bgroup "reduce/read/chunks"
257− [ mkBench ("S.groupsOf " ++ show (bigSize env) ++ " FL.sum") env $
253+ [ mkBench ("S.chunksOf " ++ show (bigSize env) ++ " FL.sum") env $
258 \inh _ ->
254 \inh _ ->
259 chunksOfSum (bigSize env) inh
255 chunksOfSum (bigSize env) inh
260− , mkBench "S.groupsOf 1 FL.sum" env $ \inh _ ->
256+ , mkBench "S.chunksOf 1 FL.sum" env $ \inh _ ->
261 chunksOfSum 1 inh
257 chunksOfSum 1 inh
262
258
263 -- XXX investigate why we need inline/noinline in these cases (GHC)
259 -- XXX investigate why we need inline/noinline in these cases (GHC)
@@ -280,20 +276,20 @@ o_1_space_reduce_read_grouped env =
280 $ \inh _ -> inline foldManyChunksOfSum 1 inh
276 $ \inh _ -> inline foldManyChunksOfSum 1 inh
281
277
282 -- folding chunks to arrays
278 -- folding chunks to arrays
283− , mkBenchSmall "S.groupsOf 1" env $ \inh _ ->
284− groupsOf 1 inh
285− , mkBench "S.groupsOf 10" env $ \inh _ ->
286− groupsOf 10 inh
287− , mkBench "S.groupsOf 1000" env $ \inh _ ->
288− groupsOf 1000 inh
289−
290− -- chunksOf may use a different impl than groupsOf
291 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
279 , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->
292 chunksOf 1 inh
280 chunksOf 1 inh
293 , mkBench "S.chunksOf 10" env $ \inh _ ->
281 , mkBench "S.chunksOf 10" env $ \inh _ ->
294 chunksOf 10 inh
282 chunksOf 10 inh
295 , mkBench "S.chunksOf 1000" env $ \inh _ ->
283 , mkBench "S.chunksOf 1000" env $ \inh _ ->
296 chunksOf 1000 inh
284 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
297 ]
293 ]
298 ]
294 ]
299
295
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs+46−45
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Streamly.Benchmark.FileSystem.Handle
2-- Module : Streamly.Benchmark.FileSystem.Handle
5-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
@@ -31,18 +29,20 @@ import Streamly.Internal.System.IO (defaultChunkSize)
31import qualified Streamly.FileSystem.Handle as FH
29import qualified Streamly.FileSystem.Handle as FH
32import qualified Streamly.Internal.Data.Unfold as IUF
30import qualified Streamly.Internal.Data.Unfold as IUF
33import qualified Streamly.Internal.FileSystem.Handle as IFH
31import qualified Streamly.Internal.FileSystem.Handle as IFH
34−import qualified Streamly.Data.Array as A
32+import qualified Streamly.Data.Array.Foreign as A
35−import qualified Streamly.Data.Stream.Prelude as S
33+import qualified Streamly.Prelude as S
36
34
37−import Test.Tasty.Bench hiding (env)
35+import Gauge hiding (env)
38import Streamly.Benchmark.Common.Handle
36import Streamly.Benchmark.Common.Handle
39
37
40#ifdef INSPECTION
38#ifdef INSPECTION
41−import Streamly.Internal.Data.Stream (Step(..))
39+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
42
40
43−import qualified Streamly.Internal.Data.Stream as D
41+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D
44import qualified Streamly.Internal.Data.Tuple.Strict as Strict
42import qualified Streamly.Internal.Data.Tuple.Strict as Strict
45−import qualified Streamly.Internal.Data.MutArray as MutArray
43+import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as MAS
44+import qualified Streamly.Internal.Data.Array.Foreign.Type as AT
45+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
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.readChunks inh
56+copyChunks inh outh = S.fold (IFH.writeChunks outh) $ IFH.toChunks 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/getChunks"
65+ [ bgroup "copy/toChunks"
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.reader inh)
79+copyStream inh outh = S.fold (FH.write outh) (S.unfold FH.read 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
85−inspect $ 'copyStream `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
86+inspect $ 'copyStream `hasNoType` ''AT.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.reader inh
106+readFromBytesNull inh devNull = IFH.putBytes devNull $ S.unfold FH.read 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` ''MutArray.SpliceState
111+inspect $ 'readFromBytesNull `hasNoType` ''MAS.SpliceState
112−inspect $ 'readFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
112+inspect $ 'readFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
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−readWithFromBytesNull :: Handle -> Handle -> IO ()
117+readWithBufferOfFromBytesNull :: Handle -> Handle -> IO ()
118−readWithFromBytesNull inh devNull =
118+readWithBufferOfFromBytesNull inh devNull =
119 IFH.putBytes devNull
119 IFH.putBytes devNull
120− $ S.unfold FH.readerWith (defaultChunkSize, inh)
120+ $ S.unfold FH.readWithBufferOf (defaultChunkSize, inh)
121
121
122#ifdef INSPECTION
122#ifdef INSPECTION
123−inspect $ hasNoTypeClasses 'readWithFromBytesNull
123+inspect $ hasNoTypeClasses 'readWithBufferOfFromBytesNull
124−inspect $ 'readWithFromBytesNull `hasNoType` ''Step
124+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''Step
125−inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.SpliceState
125+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''MAS.SpliceState
126−inspect $ 'readWithFromBytesNull `hasNoType` ''MutArray.ArrayUnsafe -- FH.fromBytes/S.chunksOf
126+inspect $ 'readWithBufferOfFromBytesNull `hasNoType` ''AT.ArrayUnsafe -- FH.fromBytes/S.arraysOf
127−inspect $ 'readWithFromBytesNull `hasNoType` ''D.FoldMany
127+inspect $ 'readWithBufferOfFromBytesNull `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,43 +135,44 @@ _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 A.reader FH.chunkReader
138+ unf = IUF.many FH.readChunks A.read
139
139
140-- | Send the chunk content to /dev/null
140-- | Send the chunk content to /dev/null
141−-- Implicitly benchmarked via 'readWithFromBytesNull'
141+-- Implicitly benchmarked via 'readWithBufferOfFromBytesNull'
142−_readChunksWith :: Handle -> Handle -> IO ()
142+_readChunksWithBufferOf :: Handle -> Handle -> IO ()
143−_readChunksWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
143+_readChunksWithBufferOf 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 A.reader FH.chunkReaderWith
148+ unf = IUF.many FH.readChunksWithBufferOf A.read
149+
149
150
150o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
151o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark]
151o_1_space_copy_fromBytes env =
152o_1_space_copy_fromBytes env =
152 [ bgroup "copy/putBytes"
153 [ bgroup "copy/putBytes"
153 [ mkBench "rawToNull" env $ \inh _ ->
154 [ mkBench "rawToNull" env $ \inh _ ->
154 readFromBytesNull inh (nullH env)
155 readFromBytesNull inh (nullH env)
155− , mkBench "FH.readWith" env $ \inh _ ->
156+ , mkBench "FH.readWithBufferOf" env $ \inh _ ->
156− readWithFromBytesNull inh (nullH env)
157+ readWithBufferOfFromBytesNull inh (nullH env)
157 ]
158 ]
158 ]
159 ]
159
160
160-- | Send the file contents ('defaultChunkSize') to /dev/null
161-- | Send the file contents ('defaultChunkSize') to /dev/null
161−writeReadWith :: Handle -> Handle -> IO ()
162+writeReadWithBufferOf :: Handle -> Handle -> IO ()
162−writeReadWith inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
163+writeReadWithBufferOf inh devNull = IUF.fold fld unf (defaultChunkSize, inh)
163
164
164 where
165 where
165
166
166− fld = FH.writeWith defaultChunkSize devNull
167+ fld = FH.writeWithBufferOf defaultChunkSize devNull
167− unf = FH.readerWith
168+ unf = FH.readWithBufferOf
168
169
169#ifdef INSPECTION
170#ifdef INSPECTION
170−inspect $ hasNoTypeClasses 'writeReadWith
171+inspect $ hasNoTypeClasses 'writeReadWithBufferOf
171−inspect $ 'writeReadWith `hasNoType` ''Step
172+inspect $ 'writeReadWithBufferOf `hasNoType` ''Step
172−inspect $ 'writeReadWith `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
173+inspect $ 'writeReadWithBufferOf `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
174+inspect $ 'writeReadWithBufferOf `hasNoType` ''MA.ReadUState -- FH.read/A.read
173−inspect $ 'writeReadWith `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
175+inspect $ 'writeReadWithBufferOf `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
174− -- FH.read/A.read
175#endif
176#endif
176
177
177-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
178-- | Send the file contents ('AT.defaultChunkSize') to /dev/null
@@ -181,14 +182,14 @@ writeRead inh devNull = IUF.fold fld unf inh
181 where
182 where
182
183
183 fld = FH.write devNull
184 fld = FH.write devNull
184− unf = FH.reader
185+ unf = FH.read
185
186
186#ifdef INSPECTION
187#ifdef INSPECTION
187inspect $ hasNoTypeClasses 'writeRead
188inspect $ hasNoTypeClasses 'writeRead
188inspect $ 'writeRead `hasNoType` ''Step
189inspect $ 'writeRead `hasNoType` ''Step
189inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
190inspect $ 'writeRead `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
191+inspect $ 'writeRead `hasNoType` ''MA.ReadUState -- FH.read/A.read
190−inspect $ 'writeRead `hasNoType` ''MutArray.ArrayUnsafe -- FH.write/writeNUnsafe
192+inspect $ 'writeRead `hasNoType` ''AT.ArrayUnsafe -- FH.write/writeNUnsafe
191− -- FH.read/A.read
192#endif
193#endif
193
194
194o_1_space_copy :: BenchEnv -> [Benchmark]
195o_1_space_copy :: BenchEnv -> [Benchmark]
@@ -196,8 +197,8 @@ o_1_space_copy env =
196 [ bgroup "copy"
197 [ bgroup "copy"
197 [ mkBench "FH.write . FH.read" env $ \inh _ ->
198 [ mkBench "FH.write . FH.read" env $ \inh _ ->
198 writeRead inh (nullH env)
199 writeRead inh (nullH env)
199− , mkBench "FH.writeWith . FH.readWith" env $ \inh _ ->
200+ , mkBench "FH.writeWithBufferOf . FH.readWithBufferOf" env $ \inh _ ->
200− writeReadWith inh (nullH env)
201+ writeReadWithBufferOf inh (nullH env)
201 ]
202 ]
202 ]
203 ]
203
204
benchmark/Streamly/Benchmark/Prelude/Adaptive.hs+6−11
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -10,7 +8,7 @@
10import Control.Concurrent (threadDelay)
8import Control.Concurrent (threadDelay)
11import Control.Monad (when)
9import Control.Monad (when)
12import Control.Monad.IO.Class (liftIO)
10import Control.Monad.IO.Class (liftIO)
13−import Test.Tasty.Bench
11+import Gauge
14import Streamly.Prelude as S
12import Streamly.Prelude as S
15import System.Random (randomRIO)
13import System.Random (randomRIO)
16
14
@@ -36,14 +34,11 @@ source range = S.replicateM value $ do
36
34
37{-# INLINE run #-}
35{-# INLINE run #-}
38run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()
36run :: IsStream t => (Int, Int) -> (Int, Int) -> (t IO Int -> SerialT IO Int) -> IO ()
39−run srange crange t = S.drain $ S.mapM action (t $ source srange)
37+run srange crange t = S.drain $ do
40−
38+ n <- t $ source srange
41− where
42−
43− action x = liftIO $ do
44− d <- randomRIO crange
39+ d <- liftIO (randomRIO crange)
45− when (d /= 0) $ threadDelay d
40+ when (d /= 0) $ liftIO $ threadDelay d
46− return x
41+ return n
47
42
48low, medium, high :: Int
43low, medium, high :: Int
49low = 10
44low = 10
benchmark/Streamly/Benchmark/Prelude/Ahead.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
15import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
16import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
17
15
18−import Test.Tasty.Bench
16+import Gauge
19
17
20moduleName :: String
18moduleName :: String
21moduleName = "Prelude.Ahead"
19moduleName = "Prelude.Ahead"
benchmark/Streamly/Benchmark/Prelude/Async.hs+3−5
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -16,7 +14,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Transform as Transform
16import Streamly.Benchmark.Common
14import Streamly.Benchmark.Common
17import Streamly.Benchmark.Prelude
15import Streamly.Benchmark.Prelude
18
16
19−import Test.Tasty.Bench
17+import Gauge
20
18
21moduleName :: String
19moduleName :: String
22moduleName = "Prelude.Async"
20moduleName = "Prelude.Async"
@@ -124,9 +122,9 @@ o_1_space_concatFoldable value =
124 (sourceFoldMapWithStream value)
122 (sourceFoldMapWithStream value)
125 , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
123 , benchIOSrc fromAsync "foldMapWithM (<>) (List)"
126 (sourceFoldMapWithM value)
124 (sourceFoldMapWithM value)
127− , benchIOSrc fromAsync "S.concatFoldableWith (<>) (List)"
125+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
128 (concatFoldableWith value)
126 (concatFoldableWith value)
129− , benchIOSrc fromAsync "S.concatForFoldableWith (<>) (List)"
127+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
130 (concatForFoldableWith value)
128 (concatForFoldableWith value)
131 , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
129 , benchIOSrc fromAsync "foldMapM (List)" (sourceFoldMapM value)
132 ]
130 ]
benchmark/Streamly/Benchmark/Prelude/Concurrent.hs+1−2
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
3{-# LANGUAGE RankNTypes #-}
2{-# LANGUAGE RankNTypes #-}
4-- |
3-- |
@@ -15,7 +14,7 @@ import Streamly.Prelude
15 , fromWAsync, parallel, fromParallel
14 , fromWAsync, parallel, fromParallel
16 )
15 )
17
16
18−import Test.Tasty.Bench
17+import Gauge
19import qualified Streamly.Prelude as S
18import qualified Streamly.Prelude as S
20
19
21-------------------------------------------------------------------------------
20-------------------------------------------------------------------------------
benchmark/Streamly/Benchmark/Prelude/Merge.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -30,13 +28,13 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Stream
30import Streamly.Benchmark.Common
28import Streamly.Benchmark.Common
31import Streamly.Benchmark.Prelude
29import Streamly.Benchmark.Prelude
32
30
33−import Test.Tasty.Bench
31+import Gauge
34
32
35#ifdef INSPECTION
33#ifdef INSPECTION
36import GHC.Types (SPEC(..))
34import GHC.Types (SPEC(..))
37import Test.Inspection
35import Test.Inspection
38
36
39−import qualified Streamly.Internal.Data.Stream as D
37+import qualified Streamly.Internal.Data.Stream.StreamD as D
40#endif
38#endif
41
39
42moduleName :: String
40moduleName :: String
benchmark/Streamly/Benchmark/Prelude/Parallel.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -22,7 +20,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream as Internal
22import Streamly.Benchmark.Common
20import Streamly.Benchmark.Common
23import Streamly.Benchmark.Prelude
21import Streamly.Benchmark.Prelude
24
22
25−import Test.Tasty.Bench
23+import Gauge
26
24
27moduleName :: String
25moduleName :: String
28moduleName = "Prelude.Parallel"
26moduleName = "Prelude.Parallel"
benchmark/Streamly/Benchmark/Prelude/Rate.hs+1−2
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2{-# LANGUAGE FlexibleContexts #-}
1{-# LANGUAGE FlexibleContexts #-}
3
2
4-- |
3-- |
@@ -14,7 +13,7 @@ import qualified Streamly.Prelude as S
14import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
15import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
16
15
17−import Test.Tasty.Bench
16+import Gauge
18
17
19moduleName :: String
18moduleName :: String
20moduleName = "Prelude.Rate"
19moduleName = "Prelude.Rate"
benchmark/Streamly/Benchmark/Prelude/Serial.hsnew file+53
@@ -0,0 +1,53 @@
1+-- |
2+-- Module : Serial
3+-- Copyright : (c) 2018 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE RankNTypes #-}
11+
12+module Main (main) where
13+
14+import Streamly.Benchmark.Common.Handle (mkHandleBenchEnv)
15+
16+import qualified Serial.Elimination as Elimination
17+import qualified Serial.Exceptions as Exceptions
18+import qualified Serial.Generation as Generation
19+import qualified Serial.NestedStream as NestedStream
20+import qualified Serial.Split as Split
21+import qualified Serial.Transformation as Transformation
22+import qualified Serial.NestedFold as NestedFold
23+import qualified Serial.Lift as Lift
24+
25+import Streamly.Benchmark.Common
26+
27+moduleName :: String
28+moduleName = "Prelude.Serial"
29+
30+-------------------------------------------------------------------------------
31+-- Main
32+-------------------------------------------------------------------------------
33+
34+-- In addition to gauge options, the number of elements in the stream can be
35+-- passed using the --stream-size option.
36+--
37+main :: IO ()
38+main = do
39+ env <- mkHandleBenchEnv
40+ runWithCLIOpts defaultStreamSize (allBenchmarks env)
41+
42+ where
43+
44+ allBenchmarks env size = Prelude.concat
45+ [ Generation.benchmarks moduleName size
46+ , Elimination.benchmarks moduleName size
47+ , Exceptions.benchmarks moduleName env size
48+ , Split.benchmarks moduleName env
49+ , Transformation.benchmarks moduleName size
50+ , NestedFold.benchmarks moduleName size
51+ , Lift.benchmarks moduleName size
52+ , NestedStream.benchmarks moduleName size
53+ ]
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Elimination.hsrenamed+121−183
@@ -1,20 +1,14 @@
1-- |
1-- |
2−-- Module : Stream.Eliminate
2+-- Module : Serial.Elimination
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 #-}
10{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
12
11
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
19#undef INSPECTION
13#undef INSPECTION
20#endif
14#endif
@@ -24,7 +18,7 @@
24{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25#endif
19#endif
26
20
27−module Stream.Eliminate (benchmarks) where
21+module Serial.Elimination (benchmarks) where
28
22
29import Control.DeepSeq (NFData(..))
23import Control.DeepSeq (NFData(..))
30import Data.Functor.Identity (Identity, runIdentity)
24import Data.Functor.Identity (Identity, runIdentity)
@@ -32,45 +26,28 @@ import System.Random (randomRIO)
32
26
33import qualified Data.Foldable as F
27import qualified Data.Foldable as F
34import qualified GHC.Exts as GHC
28import qualified GHC.Exts as GHC
35−import qualified Streamly.Internal.Data.Fold as Fold
36
29
37#ifdef INSPECTION
30#ifdef INSPECTION
38import GHC.Types (SPEC(..))
31import GHC.Types (SPEC(..))
39import Test.Inspection
32import Test.Inspection
40−import qualified Streamly.Internal.Data.Stream as D
41−#endif
42
33
43−#ifdef USE_PRELUDE
44−import Streamly.Prelude (fromSerial)
45−import Streamly.Benchmark.Prelude
46−import qualified Streamly.Internal.Data.Stream.IsStream as S
47−import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
34+import qualified Streamly.Internal.Data.Stream.StreamD as D
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
35#endif
59
36
60−import Test.Tasty.Bench
37+import qualified Streamly.Prelude as S
38+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
39+
40+import Gauge
41+import Streamly.Prelude (SerialT, IsStream, fromSerial)
61import Streamly.Benchmark.Common
42import Streamly.Benchmark.Common
43+import Streamly.Benchmark.Prelude
62import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
44import Prelude hiding (length, sum, or, and, any, all, notElem, elem, (!!),
63 lookup, repeat, minimum, maximum, product, last, mapM_, init)
45 lookup, repeat, minimum, maximum, product, last, mapM_, init)
64import qualified Prelude
46import qualified Prelude
65
47
66−#ifdef USE_PRELUDE
67−type Stream = S.SerialT
68−fromStream = id
69−
70{-# INLINE repeat #-}
48{-# INLINE repeat #-}
71repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
49repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
72repeat count = S.take count . S.repeat
50repeat count = S.take count . S.repeat
73−#endif
74
51
75-------------------------------------------------------------------------------
52-------------------------------------------------------------------------------
76-- Elimination
53-- Elimination
@@ -83,92 +60,90 @@ repeat count = S.take count . S.repeat
83{-# INLINE foldableFoldl' #-}
60{-# INLINE foldableFoldl' #-}
84foldableFoldl' :: Int -> Int -> Int
61foldableFoldl' :: Int -> Int -> Int
85foldableFoldl' value n =
62foldableFoldl' value n =
86− F.foldl' (+) 0 (sourceUnfoldr value n :: Stream Identity Int)
63+ F.foldl' (+) 0 (sourceUnfoldr value n :: S.SerialT Identity Int)
87
64
88{-# INLINE foldableFoldrElem #-}
65{-# INLINE foldableFoldrElem #-}
89foldableFoldrElem :: Int -> Int -> Bool
66foldableFoldrElem :: Int -> Int -> Bool
90foldableFoldrElem value n =
67foldableFoldrElem value n =
91 F.foldr (\x xs -> x == value || xs)
68 F.foldr (\x xs -> x == value || xs)
92 False
69 False
93− (sourceUnfoldr value n :: Stream Identity Int)
70+ (sourceUnfoldr value n :: S.SerialT Identity Int)
94
71
95{-# INLINE foldableSum #-}
72{-# INLINE foldableSum #-}
96foldableSum :: Int -> Int -> Int
73foldableSum :: Int -> Int -> Int
97foldableSum value n =
74foldableSum value n =
98− Prelude.sum (sourceUnfoldr value n :: Stream Identity Int)
75+ Prelude.sum (sourceUnfoldr value n :: S.SerialT Identity Int)
99
76
100{-# INLINE foldableProduct #-}
77{-# INLINE foldableProduct #-}
101foldableProduct :: Int -> Int -> Int
78foldableProduct :: Int -> Int -> Int
102foldableProduct value n =
79foldableProduct value n =
103− Prelude.product (sourceUnfoldr value n :: Stream Identity Int)
80+ Prelude.product (sourceUnfoldr value n :: S.SerialT Identity Int)
104
81
105{-# INLINE _foldableNull #-}
82{-# INLINE _foldableNull #-}
106_foldableNull :: Int -> Int -> Bool
83_foldableNull :: Int -> Int -> Bool
107_foldableNull value n =
84_foldableNull value n =
108− Prelude.null (sourceUnfoldr value n :: Stream Identity Int)
85+ Prelude.null (sourceUnfoldr value n :: S.SerialT Identity Int)
109
86
110{-# INLINE foldableElem #-}
87{-# INLINE foldableElem #-}
111foldableElem :: Int -> Int -> Bool
88foldableElem :: Int -> Int -> Bool
112foldableElem value n =
89foldableElem value n =
113− value `Prelude.elem` (sourceUnfoldr value n :: Stream Identity Int)
90+ value `Prelude.elem` (sourceUnfoldr value n :: S.SerialT Identity Int)
114
91
115{-# INLINE foldableNotElem #-}
92{-# INLINE foldableNotElem #-}
116foldableNotElem :: Int -> Int -> Bool
93foldableNotElem :: Int -> Int -> Bool
117foldableNotElem value n =
94foldableNotElem value n =
118− value `Prelude.notElem` (sourceUnfoldr value n :: Stream Identity Int)
95+ value `Prelude.notElem` (sourceUnfoldr value n :: S.SerialT Identity Int)
119
96
120{-# INLINE foldableFind #-}
97{-# INLINE foldableFind #-}
121foldableFind :: Int -> Int -> Maybe Int
98foldableFind :: Int -> Int -> Maybe Int
122foldableFind value n =
99foldableFind value n =
123− F.find (== (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
100+ F.find (== (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
124
101
125{-# INLINE foldableAll #-}
102{-# INLINE foldableAll #-}
126foldableAll :: Int -> Int -> Bool
103foldableAll :: Int -> Int -> Bool
127foldableAll value n =
104foldableAll value n =
128− Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
105+ Prelude.all (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
129
106
130{-# INLINE foldableAny #-}
107{-# INLINE foldableAny #-}
131foldableAny :: Int -> Int -> Bool
108foldableAny :: Int -> Int -> Bool
132foldableAny value n =
109foldableAny value n =
133− Prelude.any (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
110+ Prelude.any (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
134
111
135−{- HLINT ignore "Use all"-}
136{-# INLINE foldableAnd #-}
112{-# INLINE foldableAnd #-}
137foldableAnd :: Int -> Int -> Bool
113foldableAnd :: Int -> Int -> Bool
138foldableAnd value n =
114foldableAnd value n =
139− Prelude.and $ fmap
115+ Prelude.and $ S.map
140− (<= (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
116+ (<= (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
141
117
142−{- HLINT ignore "Use any"-}
143{-# INLINE foldableOr #-}
118{-# INLINE foldableOr #-}
144foldableOr :: Int -> Int -> Bool
119foldableOr :: Int -> Int -> Bool
145foldableOr value n =
120foldableOr value n =
146− Prelude.or $ fmap
121+ Prelude.or $ S.map
147− (> (value + 1)) (sourceUnfoldr value n :: Stream Identity Int)
122+ (> (value + 1)) (sourceUnfoldr value n :: S.SerialT Identity Int)
148
123
149{-# INLINE foldableLength #-}
124{-# INLINE foldableLength #-}
150foldableLength :: Int -> Int -> Int
125foldableLength :: Int -> Int -> Int
151foldableLength value n =
126foldableLength value n =
152− Prelude.length (sourceUnfoldr value n :: Stream Identity Int)
127+ Prelude.length (sourceUnfoldr value n :: S.SerialT Identity Int)
153
128
154{-# INLINE foldableMin #-}
129{-# INLINE foldableMin #-}
155foldableMin :: Int -> Int -> Int
130foldableMin :: Int -> Int -> Int
156foldableMin value n =
131foldableMin value n =
157− Prelude.minimum (sourceUnfoldr value n :: Stream Identity Int)
132+ Prelude.minimum (sourceUnfoldr value n :: S.SerialT Identity Int)
158
133
159{-# INLINE ordInstanceMin #-}
134{-# INLINE ordInstanceMin #-}
160−ordInstanceMin :: Stream Identity Int -> Stream Identity Int
135+ordInstanceMin :: SerialT Identity Int -> SerialT Identity Int
161ordInstanceMin src = min src src
136ordInstanceMin src = min src src
162
137
163{-# INLINE foldableMax #-}
138{-# INLINE foldableMax #-}
164foldableMax :: Int -> Int -> Int
139foldableMax :: Int -> Int -> Int
165foldableMax value n =
140foldableMax value n =
166− Prelude.maximum (sourceUnfoldr value n :: Stream Identity Int)
141+ Prelude.maximum (sourceUnfoldr value n :: S.SerialT Identity Int)
167
142
168{-# INLINE foldableMinBy #-}
143{-# INLINE foldableMinBy #-}
169foldableMinBy :: Int -> Int -> Int
144foldableMinBy :: Int -> Int -> Int
170foldableMinBy value n =
145foldableMinBy value n =
171− F.minimumBy compare (sourceUnfoldr value n :: Stream Identity Int)
146+ F.minimumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
172
147
173{-# INLINE foldableListMinBy #-}
148{-# INLINE foldableListMinBy #-}
174foldableListMinBy :: Int -> Int -> Int
149foldableListMinBy :: Int -> Int -> Int
@@ -177,30 +152,30 @@ foldableListMinBy value n = F.minimumBy compare [1..value+n]
177{-# INLINE foldableMaxBy #-}
152{-# INLINE foldableMaxBy #-}
178foldableMaxBy :: Int -> Int -> Int
153foldableMaxBy :: Int -> Int -> Int
179foldableMaxBy value n =
154foldableMaxBy value n =
180− F.maximumBy compare (sourceUnfoldr value n :: Stream Identity Int)
155+ F.maximumBy compare (sourceUnfoldr value n :: S.SerialT Identity Int)
181
156
182{-# INLINE foldableToList #-}
157{-# INLINE foldableToList #-}
183foldableToList :: Int -> Int -> [Int]
158foldableToList :: Int -> Int -> [Int]
184foldableToList value n =
159foldableToList value n =
185− F.toList (sourceUnfoldr value n :: Stream Identity Int)
160+ F.toList (sourceUnfoldr value n :: S.SerialT Identity Int)
186
161
187{-# INLINE foldableMapM_ #-}
162{-# INLINE foldableMapM_ #-}
188foldableMapM_ :: Monad m => Int -> Int -> m ()
163foldableMapM_ :: Monad m => Int -> Int -> m ()
189foldableMapM_ value n =
164foldableMapM_ value n =
190− F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: Stream Identity Int)
165+ F.mapM_ (\_ -> return ()) (sourceUnfoldr value n :: S.SerialT Identity Int)
191
166
192{-# INLINE foldableSequence_ #-}
167{-# INLINE foldableSequence_ #-}
193foldableSequence_ :: Int -> Int -> IO ()
168foldableSequence_ :: Int -> Int -> IO ()
194foldableSequence_ value n =
169foldableSequence_ value n =
195− F.sequence_ (sourceUnfoldrAction value n :: Stream Identity (IO Int))
170+ F.sequence_ (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
196
171
197{-# INLINE _foldableMsum #-}
172{-# INLINE _foldableMsum #-}
198_foldableMsum :: Int -> Int -> IO Int
173_foldableMsum :: Int -> Int -> IO Int
199_foldableMsum value n =
174_foldableMsum value n =
200− F.msum (sourceUnfoldrAction value n :: Stream Identity (IO Int))
175+ F.msum (sourceUnfoldrAction value n :: S.SerialT Identity (IO Int))
201
176
202{-# INLINE showInstance #-}
177{-# INLINE showInstance #-}
203−showInstance :: Stream Identity Int -> String
178+showInstance :: SerialT Identity Int -> String
204showInstance = show
179showInstance = show
205
180
206o_1_space_elimination_foldable :: Int -> [Benchmark]
181o_1_space_elimination_foldable :: Int -> [Benchmark]
@@ -217,9 +192,6 @@ o_1_space_elimination_foldable value =
217 , bench "minimum" $ nf (foldableMin value) 1
192 , bench "minimum" $ nf (foldableMin value) 1
218 , benchPureSink value "min (ord)" ordInstanceMin
193 , benchPureSink value "min (ord)" ordInstanceMin
219 , bench "maximum" $ nf (foldableMax value) 1
194 , bench "maximum" $ nf (foldableMax value) 1
220− , bench "minimumBy" $ nf (`foldableMinBy` 1) value
221− , bench "maximumBy" $ nf (`foldableMaxBy` 1) value
222− , bench "minimumByList" $ nf (`foldableListMinBy` 1) value
223 , bench "length . toList"
195 , bench "length . toList"
224 $ nf (Prelude.length . foldableToList value) 1
196 $ nf (Prelude.length . foldableToList value) 1
225 , bench "notElem" $ nf (foldableNotElem value) 1
197 , bench "notElem" $ nf (foldableNotElem value) 1
@@ -242,25 +214,34 @@ o_1_space_elimination_foldable value =
242 ]
214 ]
243 ]
215 ]
244
216
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+
245-------------------------------------------------------------------------------
232-------------------------------------------------------------------------------
246-- Stream folds
233-- Stream folds
247-------------------------------------------------------------------------------
234-------------------------------------------------------------------------------
248
235
249−#ifndef USE_PRELUDE
250−instance NFData a => NFData (Stream Identity a) where
251− {-# INLINE rnf #-}
252− rnf xs = runIdentity $ S.fold (Fold.foldl' (\_ x -> rnf x) ()) xs
253−#endif
254−
255{-# INLINE benchPureSink #-}
236{-# INLINE benchPureSink #-}
256benchPureSink :: NFData b
237benchPureSink :: NFData b
257− => Int -> String -> (Stream Identity Int -> b) -> Benchmark
238+ => Int -> String -> (SerialT Identity Int -> b) -> Benchmark
258benchPureSink value name = benchPure name (sourceUnfoldr value)
239benchPureSink value name = benchPure name (sourceUnfoldr value)
259
240
260{-# INLINE benchHoistSink #-}
241{-# INLINE benchHoistSink #-}
261benchHoistSink
242benchHoistSink
262− :: (NFData b)
243+ :: (IsStream t, NFData b)
263− => Int -> String -> (Stream Identity Int -> IO b) -> Benchmark
244+ => Int -> String -> (t Identity Int -> IO b) -> Benchmark
264benchHoistSink value name f =
245benchHoistSink value name f =
265 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
246 bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value
266
247
@@ -268,8 +249,8 @@ benchHoistSink value name f =
268-- we can't use it as it requires MonadAsync constraint.
249-- we can't use it as it requires MonadAsync constraint.
269{-# INLINE benchIdentitySink #-}
250{-# INLINE benchIdentitySink #-}
270benchIdentitySink
251benchIdentitySink
271− :: (NFData b)
252+ :: (IsStream t, NFData b)
272− => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark
253+ => Int -> String -> (t Identity Int -> Identity b) -> Benchmark
273benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
254benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
274
255
275-------------------------------------------------------------------------------
256-------------------------------------------------------------------------------
@@ -277,29 +258,23 @@ benchIdentitySink value name f = bench name $ nf (f . sourceUnfoldr value) 1
277-------------------------------------------------------------------------------
258-------------------------------------------------------------------------------
278
259
279{-# INLINE uncons #-}
260{-# INLINE uncons #-}
280−#ifdef USE_STREAMK
281−uncons :: Monad m => StreamK m Int -> m ()
261+uncons :: Monad m => SerialT m Int -> m ()
282−#else
283−uncons :: Monad m => Stream m Int -> m ()
284−#endif
285uncons s = do
262uncons s = do
286− r <- StreamK.uncons s
263+ r <- S.uncons s
287 case r of
264 case r of
288 Nothing -> return ()
265 Nothing -> return ()
289 Just (_, t) -> uncons t
266 Just (_, t) -> uncons t
290
267
291−#ifdef USE_PRELUDE
292{-# INLINE init #-}
268{-# INLINE init #-}
293−init :: Monad m => Stream m a -> m ()
269+init :: Monad m => SerialT m a -> m ()
294init s = S.init s >>= Prelude.mapM_ S.drain
270init s = S.init s >>= Prelude.mapM_ S.drain
295
271
296{-# INLINE mapM_ #-}
272{-# INLINE mapM_ #-}
297−mapM_ :: Monad m => Stream m Int -> m ()
273+mapM_ :: Monad m => SerialT m Int -> m ()
298mapM_ = S.mapM_ (\_ -> return ())
274mapM_ = S.mapM_ (\_ -> return ())
299−#endif
300
275
301{-# INLINE foldrMElem #-}
276{-# INLINE foldrMElem #-}
302−foldrMElem :: Monad m => Int -> Stream m Int -> m Bool
277+foldrMElem :: Monad m => Int -> SerialT m Int -> m Bool
303foldrMElem e =
278foldrMElem e =
304 S.foldrM
279 S.foldrM
305 (\x xs ->
280 (\x xs ->
@@ -308,187 +283,155 @@ foldrMElem e =
308 else xs)
283 else xs)
309 (return False)
284 (return False)
310
285
311−#ifdef USE_STREAMK
312{-# INLINE foldrToStream #-}
286{-# INLINE foldrToStream #-}
313−foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int)
287+foldrToStream :: Monad m => SerialT m Int -> m (SerialT Identity Int)
314−foldrToStream = S.foldr StreamK.cons StreamK.nil
315−#else
316−-- {-# INLINE foldrToStream #-}
317−-- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int)
318−-- foldrToStream = S.foldr S.cons S.nil
288+foldrToStream = S.foldr S.cons S.nil
319−#endif
320
289
321{-# INLINE foldrMBuild #-}
290{-# INLINE foldrMBuild #-}
322−foldrMBuild :: Monad m => Stream m Int -> m [Int]
291+foldrMBuild :: Monad m => SerialT m Int -> m [Int]
323foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
292foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return [])
324
293
325−#ifdef USE_PRELUDE
326{-# INLINE foldl'Reduce #-}
294{-# INLINE foldl'Reduce #-}
327−foldl'Reduce :: Monad m => Stream m Int -> m Int
295+foldl'Reduce :: Monad m => SerialT m Int -> m Int
328foldl'Reduce = S.foldl' (+) 0
296foldl'Reduce = S.foldl' (+) 0
329
297
330{-# INLINE foldl1'Reduce #-}
298{-# INLINE foldl1'Reduce #-}
331−foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int)
299+foldl1'Reduce :: Monad m => SerialT m Int -> m (Maybe Int)
332foldl1'Reduce = S.foldl1' (+)
300foldl1'Reduce = S.foldl1' (+)
333
301
334{-# INLINE foldlM'Reduce #-}
302{-# INLINE foldlM'Reduce #-}
335−foldlM'Reduce :: Monad m => Stream m Int -> m Int
303+foldlM'Reduce :: Monad m => SerialT m Int -> m Int
336foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
304foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0)
337
305
338{-# INLINE last #-}
306{-# INLINE last #-}
339−last :: Monad m => Stream m Int -> m (Maybe Int)
307+last :: Monad m => SerialT m Int -> m (Maybe Int)
340last = S.last
308last = S.last
341
309
342{-# INLINE _head #-}
310{-# INLINE _head #-}
343−_head :: Monad m => Stream m Int -> m (Maybe Int)
311+_head :: Monad m => SerialT m Int -> m (Maybe Int)
344_head = S.head
312_head = S.head
345
313
346{-# INLINE elem #-}
314{-# INLINE elem #-}
347−elem :: Monad m => Int -> Stream m Int -> m Bool
315+elem :: Monad m => Int -> SerialT m Int -> m Bool
348elem value = S.elem (value + 1)
316elem value = S.elem (value + 1)
349
317
350{-# INLINE notElem #-}
318{-# INLINE notElem #-}
351−notElem :: Monad m => Int -> Stream m Int -> m Bool
319+notElem :: Monad m => Int -> SerialT m Int -> m Bool
352notElem value = S.notElem (value + 1)
320notElem value = S.notElem (value + 1)
353
321
354{-# INLINE length #-}
322{-# INLINE length #-}
355−length :: Monad m => Stream m Int -> m Int
323+length :: Monad m => SerialT m Int -> m Int
356length = S.length
324length = S.length
357
325
358{-# INLINE all #-}
326{-# INLINE all #-}
359−all :: Monad m => Int -> Stream m Int -> m Bool
327+all :: Monad m => Int -> SerialT m Int -> m Bool
360all value = S.all (<= (value + 1))
328all value = S.all (<= (value + 1))
361
329
362{-# INLINE any #-}
330{-# INLINE any #-}
363−any :: Monad m => Int -> Stream m Int -> m Bool
331+any :: Monad m => Int -> SerialT m Int -> m Bool
364any value = S.any (> (value + 1))
332any value = S.any (> (value + 1))
365
333
366{-# INLINE and #-}
334{-# INLINE and #-}
367−and :: Monad m => Int -> Stream m Int -> m Bool
335+and :: Monad m => Int -> SerialT m Int -> m Bool
368and value = S.and . S.map (<= (value + 1))
336and value = S.and . S.map (<= (value + 1))
369
337
370{-# INLINE or #-}
338{-# INLINE or #-}
371−or :: Monad m => Int -> Stream m Int -> m Bool
339+or :: Monad m => Int -> SerialT m Int -> m Bool
372or value = S.or . S.map (> (value + 1))
340or value = S.or . S.map (> (value + 1))
373
341
374{-# INLINE find #-}
342{-# INLINE find #-}
375−find :: Monad m => Int -> Stream m Int -> m (Maybe Int)
343+find :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
376find value = S.find (== (value + 1))
344find value = S.find (== (value + 1))
377
345
378{-# INLINE findM #-}
346{-# INLINE findM #-}
379−findM :: Monad m => Int -> Stream m Int -> m (Maybe Int)
347+findM :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
380findM value = S.findM (\z -> return $ z == (value + 1))
348findM value = S.findM (\z -> return $ z == (value + 1))
381
349
382{-# INLINE findIndex #-}
350{-# INLINE findIndex #-}
383−findIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
351+findIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
384findIndex value = S.findIndex (== (value + 1))
352findIndex value = S.findIndex (== (value + 1))
385
353
386{-# INLINE elemIndex #-}
354{-# INLINE elemIndex #-}
387−elemIndex :: Monad m => Int -> Stream m Int -> m (Maybe Int)
355+elemIndex :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
388elemIndex value = S.elemIndex (value + 1)
356elemIndex value = S.elemIndex (value + 1)
389
357
390{-# INLINE maximum #-}
358{-# INLINE maximum #-}
391−maximum :: Monad m => Stream m Int -> m (Maybe Int)
359+maximum :: Monad m => SerialT m Int -> m (Maybe Int)
392maximum = S.maximum
360maximum = S.maximum
393
361
394{-# INLINE minimum #-}
362{-# INLINE minimum #-}
395−minimum :: Monad m => Stream m Int -> m (Maybe Int)
363+minimum :: Monad m => SerialT m Int -> m (Maybe Int)
396minimum = S.minimum
364minimum = S.minimum
397
365
398{-# INLINE sum #-}
366{-# INLINE sum #-}
399−sum :: Monad m => Stream m Int -> m Int
367+sum :: Monad m => SerialT m Int -> m Int
400sum = S.sum
368sum = S.sum
401
369
402{-# INLINE product #-}
370{-# INLINE product #-}
403−product :: Monad m => Stream m Int -> m Int
371+product :: Monad m => SerialT m Int -> m Int
404product = S.product
372product = S.product
405
373
406{-# INLINE minimumBy #-}
374{-# INLINE minimumBy #-}
407−minimumBy :: Monad m => Stream m Int -> m (Maybe Int)
375+minimumBy :: Monad m => SerialT m Int -> m (Maybe Int)
408minimumBy = S.minimumBy compare
376minimumBy = S.minimumBy compare
409
377
410{-# INLINE maximumBy #-}
378{-# INLINE maximumBy #-}
411−maximumBy :: Monad m => Stream m Int -> m (Maybe Int)
379+maximumBy :: Monad m => SerialT m Int -> m (Maybe Int)
412maximumBy = S.maximumBy compare
380maximumBy = S.maximumBy compare
413
381
414{-# INLINE the #-}
382{-# INLINE the #-}
415−the :: Monad m => Stream m Int -> m (Maybe Int)
383+the :: Monad m => SerialT m Int -> m (Maybe Int)
416the = S.the
384the = S.the
417
385
418{-# INLINE drainN #-}
386{-# INLINE drainN #-}
419−drainN :: Monad m => Int -> Stream m Int -> m ()
387+drainN :: Monad m => Int -> SerialT m Int -> m ()
420drainN = S.drainN
388drainN = S.drainN
421
389
422{-# INLINE drainWhile #-}
390{-# INLINE drainWhile #-}
423−drainWhile :: Monad m => Stream m Int -> m ()
391+drainWhile :: Monad m => SerialT m Int -> m ()
424drainWhile = S.drainWhile (const True)
392drainWhile = S.drainWhile (const True)
425
393
426{-# INLINE (!!) #-}
394{-# INLINE (!!) #-}
427−(!!) :: Monad m => Int -> Stream m Int -> m (Maybe Int)
395+(!!) :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
428−(!!) = flip (S.!!)
396+(!!) = flip (Internal.!!)
429
397
430{-# INLINE lookup #-}
398{-# INLINE lookup #-}
431−lookup :: Monad m => Int -> Stream m Int -> m (Maybe Int)
399+lookup :: Monad m => Int -> SerialT m Int -> m (Maybe Int)
432lookup val = S.lookup val . S.map (\x -> (x, x))
400lookup val = S.lookup val . S.map (\x -> (x, x))
433−#endif
434
401
435o_1_space_elimination_folds :: Int -> [Benchmark]
402o_1_space_elimination_folds :: Int -> [Benchmark]
436o_1_space_elimination_folds value =
403o_1_space_elimination_folds value =
437 [ bgroup "elimination"
404 [ bgroup "elimination"
438 -- Basic folds
405 -- Basic folds
439− [
440−#ifdef USE_PRELUDE
441− bgroup "reduce"
406+ [ bgroup "reduce"
442 [ bgroup
407 [ bgroup
443 "IO"
408 "IO"
444 [ benchIOSink value "foldl'" foldl'Reduce
409 [ benchIOSink value "foldl'" foldl'Reduce
445 , benchIOSink value "foldl1'" foldl1'Reduce
410 , benchIOSink value "foldl1'" foldl1'Reduce
446 , benchIOSink value "foldlM'" foldlM'Reduce
411 , benchIOSink value "foldlM'" foldlM'Reduce
447 ]
412 ]
448−
449 , bgroup
413 , bgroup
450 "Identity"
414 "Identity"
451 [ benchIdentitySink value "foldl'" foldl'Reduce
415 [ benchIdentitySink value "foldl'" foldl'Reduce
452 , benchIdentitySink value "foldl1'" foldl1'Reduce
416 , benchIdentitySink value "foldl1'" foldl1'Reduce
453 , benchIdentitySink value "foldlM'" foldlM'Reduce
417 , benchIdentitySink value "foldlM'" foldlM'Reduce
454 ]
418 ]
455− ] ,
419+ ]
456−#endif
457− bgroup "build"
420+ , bgroup "build"
458 [ bgroup "IO"
421 [ bgroup "IO"
459 [ benchIOSink value "foldrMElem" (foldrMElem value)
422 [ benchIOSink value "foldrMElem" (foldrMElem value)
460 ]
423 ]
461 , bgroup "Identity"
424 , bgroup "Identity"
462 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
425 [ benchIdentitySink value "foldrMElem" (foldrMElem value)
463−#ifdef USE_STREAMK
464 , benchIdentitySink value "foldrToStreamLength"
426 , benchIdentitySink value "foldrToStreamLength"
465− (S.fold Fold.length . toStream . runIdentity . foldrToStream)
466− {-
467− , benchIdentitySink 16 "foldrToStreamLength (16)"
468− (S.fold Fold.length . toStream . runIdentity . foldrToStream)
469− -}
470−#else
471− {-
472− , benchIdentitySink 16 "foldrToStreamLength (16)"
473− (S.fold Fold.length . runIdentity . foldrToStream)
427+ (S.length . runIdentity . foldrToStream)
474− -}
475−#endif
476− {-
477− , benchPureSink 16 "foldrMToListLength (16)"
478− (Prelude.length . runIdentity . foldrMBuild)
479− -}
480 , benchPureSink value "foldrMToListLength"
428 , benchPureSink value "foldrMToListLength"
481 (Prelude.length . runIdentity . foldrMBuild)
429 (Prelude.length . runIdentity . foldrMBuild)
482 ]
430 ]
483 ]
431 ]
484
432
485 -- deconstruction
433 -- deconstruction
486− , benchIOSink value "uncons" (uncons . fromStream)
434+ , benchIOSink value "uncons" uncons
487−#ifndef USE_PRELUDE
488− , benchHoistSink value "length . generalizeInner"
489− (S.fold Fold.length . S.generalizeInner)
490−#endif
491−#ifdef USE_PRELUDE
492 , benchIOSink value "init" init
435 , benchIOSink value "init" init
493
436
494 -- draining
437 -- draining
@@ -502,6 +445,8 @@ o_1_space_elimination_folds value =
502 -- , benchIOSink value "head" head
445 -- , benchIOSink value "head" head
503 , benchIOSink value "last" last
446 , benchIOSink value "last" last
504 , benchIOSink value "length" length
447 , benchIOSink value "length" length
448+ , benchHoistSink value "length . generally"
449+ (length . Internal.generally)
505 , benchIOSink value "sum" sum
450 , benchIOSink value "sum" sum
506 , benchIOSink value "product" product
451 , benchIOSink value "product" product
507 , benchIOSink value "maximumBy" maximumBy
452 , benchIOSink value "maximumBy" maximumBy
@@ -525,7 +470,6 @@ o_1_space_elimination_folds value =
525 , benchIOSink value "any" (any value)
470 , benchIOSink value "any" (any value)
526 , benchIOSink value "and" (and value)
471 , benchIOSink value "and" (and value)
527 , benchIOSink value "or" (or value)
472 , benchIOSink value "or" (or value)
528−#endif
529
473
530 -- length is used to check for foldr/build fusion
474 -- length is used to check for foldr/build fusion
531 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
475 , benchPureSink value "length . IsList.toList" (Prelude.length . GHC.toList)
@@ -536,13 +480,12 @@ o_1_space_elimination_folds value =
536-- Buffered Transformations by fold
480-- Buffered Transformations by fold
537-------------------------------------------------------------------------------
481-------------------------------------------------------------------------------
538
482
539−#ifdef USE_PRELUDE
540{-# INLINE foldl'Build #-}
483{-# INLINE foldl'Build #-}
541−foldl'Build :: Monad m => Stream m Int -> m [Int]
484+foldl'Build :: Monad m => SerialT m Int -> m [Int]
542foldl'Build = S.foldl' (flip (:)) []
485foldl'Build = S.foldl' (flip (:)) []
543
486
544{-# INLINE foldlM'Build #-}
487{-# INLINE foldlM'Build #-}
545−foldlM'Build :: Monad m => Stream m Int -> m [Int]
488+foldlM'Build :: Monad m => SerialT m Int -> m [Int]
546foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
489foldlM'Build = S.foldlM' (\xs x -> return $ x : xs) (return [])
547
490
548o_n_heap_elimination_foldl :: Int -> [Benchmark]
491o_n_heap_elimination_foldl :: Int -> [Benchmark]
@@ -556,7 +499,6 @@ o_n_heap_elimination_foldl value =
556 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
499 , benchIdentitySink value "foldlM'/build/Identity" foldlM'Build
557 ]
500 ]
558 ]
501 ]
559−#endif
560
502
561-- For comparisons
503-- For comparisons
562{-# INLINE showInstanceList #-}
504{-# INLINE showInstanceList #-}
@@ -576,7 +518,7 @@ o_n_heap_elimination_buffered value =
576 ]
518 ]
577
519
578{-# INLINE foldrMReduce #-}
520{-# INLINE foldrMReduce #-}
579−foldrMReduce :: Monad m => Stream m Int -> m Int
521+foldrMReduce :: Monad m => SerialT m Int -> m Int
580foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
522foldrMReduce = S.foldrM (\x xs -> (x +) <$> xs) (return 0)
581
523
582o_n_space_elimination_foldr :: Int -> [Benchmark]
524o_n_space_elimination_foldr :: Int -> [Benchmark]
@@ -592,14 +534,13 @@ o_n_space_elimination_foldr value =
592 ]
534 ]
593 ]
535 ]
594
536
595−#ifdef USE_PRELUDE
596o_n_heap_elimination_toList :: Int -> [Benchmark]
537o_n_heap_elimination_toList :: Int -> [Benchmark]
597o_n_heap_elimination_toList value =
538o_n_heap_elimination_toList value =
598 [ bgroup "toList"
539 [ bgroup "toList"
599 -- Converting the stream to a list or pure stream in a strict monad
540 -- Converting the stream to a list or pure stream in a strict monad
600− [ benchIOSink value "toListRev" S.toListRev
541+ [ benchIOSink value "toListRev" Internal.toListRev
601 , benchIOSink value "toStreamRev"
542 , benchIOSink value "toStreamRev"
602− (S.toStreamRev :: (Stream IO Int -> IO (Stream Identity Int)))
543+ (Internal.toStreamRev :: (SerialT IO Int -> IO (SerialT Identity Int)))
603 ]
544 ]
604 ]
545 ]
605
546
@@ -608,13 +549,10 @@ o_n_space_elimination_toList value =
608 [ bgroup "toList"
549 [ bgroup "toList"
609 -- Converting the stream to a list or pure stream in a strict monad
550 -- Converting the stream to a list or pure stream in a strict monad
610 [ benchIOSink value "toList" S.toList
551 [ benchIOSink value "toList" S.toList
611−#ifndef USE_PRELUDE
612 , benchIOSink value "toStream"
552 , benchIOSink value "toStream"
613− (S.toStream :: (Stream IO Int -> IO (Stream Identity Int)))
553+ (Internal.toStream :: (SerialT IO Int -> IO (SerialT Identity Int)))
614−#endif
615 ]
554 ]
616 ]
555 ]
617−#endif
618
556
619-------------------------------------------------------------------------------
557-------------------------------------------------------------------------------
620-- Multi-stream folds
558-- Multi-stream folds
@@ -625,7 +563,7 @@ o_n_space_elimination_toList value =
625-------------------------------------------------------------------------------
563-------------------------------------------------------------------------------
626
564
627{-# INLINE eqBy' #-}
565{-# INLINE eqBy' #-}
628−eqBy' :: (Monad m, Eq a) => Stream m a -> m Bool
566+eqBy' :: (Monad m, Eq a) => SerialT m a -> m Bool
629eqBy' src = S.eqBy (==) src src
567eqBy' src = S.eqBy (==) src src
630
568
631{-# INLINE eqByPure #-}
569{-# INLINE eqByPure #-}
@@ -639,15 +577,15 @@ inspect $ 'eqByPure `hasNoType` ''D.Step
639#endif
577#endif
640
578
641{-# INLINE eqInstance #-}
579{-# INLINE eqInstance #-}
642−eqInstance :: Stream Identity Int -> Bool
580+eqInstance :: SerialT Identity Int -> Bool
643eqInstance src = src == src
581eqInstance src = src == src
644
582
645{-# INLINE eqInstanceNotEq #-}
583{-# INLINE eqInstanceNotEq #-}
646−eqInstanceNotEq :: Stream Identity Int -> Bool
584+eqInstanceNotEq :: SerialT Identity Int -> Bool
647eqInstanceNotEq src = src /= src
585eqInstanceNotEq src = src /= src
648
586
649{-# INLINE cmpBy' #-}
587{-# INLINE cmpBy' #-}
650−cmpBy' :: (Monad m, Ord a) => Stream m a -> m Ordering
588+cmpBy' :: (Monad m, Ord a) => SerialT m a -> m Ordering
651cmpBy' src = S.cmpBy compare src src
589cmpBy' src = S.cmpBy compare src src
652
590
653{-# INLINE cmpByPure #-}
591{-# INLINE cmpByPure #-}
@@ -661,7 +599,7 @@ inspect $ 'cmpByPure `hasNoType` ''D.Step
661#endif
599#endif
662
600
663{-# INLINE ordInstance #-}
601{-# INLINE ordInstance #-}
664−ordInstance :: Stream Identity Int -> Bool
602+ordInstance :: SerialT Identity Int -> Bool
665ordInstance src = src < src
603ordInstance src = src < src
666
604
667o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
605o_1_space_elimination_multi_stream_pure :: Int -> [Benchmark]
@@ -676,15 +614,15 @@ o_1_space_elimination_multi_stream_pure value =
676 ]
614 ]
677
615
678{-# INLINE isPrefixOf #-}
616{-# INLINE isPrefixOf #-}
679−isPrefixOf :: Monad m => Stream m Int -> m Bool
617+isPrefixOf :: Monad m => SerialT m Int -> m Bool
680isPrefixOf src = S.isPrefixOf src src
618isPrefixOf src = S.isPrefixOf src src
681
619
682{-# INLINE isSubsequenceOf #-}
620{-# INLINE isSubsequenceOf #-}
683−isSubsequenceOf :: Monad m => Stream m Int -> m Bool
621+isSubsequenceOf :: Monad m => SerialT m Int -> m Bool
684isSubsequenceOf src = S.isSubsequenceOf src src
622isSubsequenceOf src = S.isSubsequenceOf src src
685
623
686{-# INLINE stripPrefix #-}
624{-# INLINE stripPrefix #-}
687−stripPrefix :: Monad m => Stream m Int -> m ()
625+stripPrefix :: Monad m => SerialT m Int -> m ()
688stripPrefix src = do
626stripPrefix src = do
689 _ <- S.stripPrefix src src
627 _ <- S.stripPrefix src src
690 return ()
628 return ()
@@ -735,14 +673,14 @@ benchmarks moduleName size =
735 , o_1_space_elimination_multi_stream_pure size
673 , o_1_space_elimination_multi_stream_pure size
736 , o_1_space_elimination_multi_stream size
674 , o_1_space_elimination_multi_stream size
737 ]
675 ]
738−
739− , bgroup (o_n_heap_prefix moduleName) $
676+ , bgroup (o_n_heap_prefix moduleName) $ concat
740− o_n_heap_elimination_buffered size
741−#ifdef USE_PRELUDE
742− ++ o_n_heap_elimination_foldl size
677+ [ o_n_heap_elimination_foldl size
743− ++ o_n_heap_elimination_toList size
678+ , o_n_heap_elimination_toList size
744− ++ o_n_space_elimination_toList size
679+ , o_n_heap_elimination_buffered size
745−#endif
680+ ]
746− , bgroup (o_n_space_prefix moduleName) $
681+ , bgroup (o_n_space_prefix moduleName) $ concat
682+ [ o_n_space_elimination_foldable size
683+ , o_n_space_elimination_toList size
747− o_n_space_elimination_foldr size
684+ , o_n_space_elimination_foldr size
685+ ]
748 ]
686 ]
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Exceptions.hsrenamed+70−124
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Stream.Exceptions
2+-- Module : Streamly.Benchmark.Prelude.Serial.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,13 +7,8 @@
7-- Portability : GHC
7-- Portability : GHC
8
8
9{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
10−{-# LANGUAGE FlexibleContexts #-}
11{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
12
11
13−#ifdef USE_PRELUDE
14−{-# OPTIONS_GHC -Wno-deprecations #-}
15−#endif
16−
17#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
18#undef INSPECTION
13#undef INSPECTION
19#endif
14#endif
@@ -23,63 +18,29 @@
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24#endif
19#endif
25
20
26−module Stream.Exceptions (benchmarks) where
21+module Serial.Exceptions (benchmarks) where
27
22
28−import Control.Exception (Exception, throwIO)
23+import Control.Exception (SomeException, Exception, throwIO)
29−import Stream.Common (drain)
24+import System.IO (Handle, hClose, hPutChar)
30
25
31import qualified Data.IORef as Ref
26import qualified Data.IORef as Ref
32import qualified Data.Map.Strict as Map
27import qualified Data.Map.Strict as Map
33
28
34−import Control.Exception (SomeException)
35−import System.IO (Handle, hClose, hPutChar)
36import qualified Streamly.FileSystem.Handle as FH
29import qualified Streamly.FileSystem.Handle as FH
37−import qualified Streamly.Internal.FileSystem.Handle as IFH
38import qualified Streamly.Internal.Data.Unfold as IUF
30import qualified Streamly.Internal.Data.Unfold as IUF
39−import qualified Streamly.Internal.Data.Unfold.Prelude as IUF
31+import qualified Streamly.Internal.FileSystem.Handle as IFH
40−
41−#ifdef USE_PRELUDE
42−import qualified Streamly.Internal.Data.Stream.IsStream as Stream
32+import qualified Streamly.Internal.Data.Stream.IsStream as IP
43−#else
44−import qualified Streamly.Internal.Data.Stream as Stream
45−import qualified Streamly.Internal.Data.Stream.Prelude as Stream
33+import qualified Streamly.Prelude as S
46−#endif
47
34
48−import Test.Tasty.Bench hiding (env)
35+import Gauge hiding (env)
49import Prelude hiding (last, length)
36import Prelude hiding (last, length)
50import Streamly.Benchmark.Common
37import Streamly.Benchmark.Common
51import Streamly.Benchmark.Common.Handle
38import Streamly.Benchmark.Common.Handle
52
39
53#ifdef INSPECTION
40#ifdef INSPECTION
54−import Control.Monad.Catch (MonadCatch)
55import Test.Inspection
41import Test.Inspection
56
42
57−import qualified Streamly.Internal.Data.Stream as D
43+import qualified Streamly.Internal.Data.Stream.StreamD as D
58−#endif
59−
60−#ifdef USE_PRELUDE
61−type Stream = Stream.SerialT
62−toStreamD = Stream.toStream
63−fromStreamD = Stream.fromStream
64−#else
65−type Stream = Stream.Stream
66−toStreamD :: a -> a
67−toStreamD = id
68−fromStreamD :: a -> a
69−fromStreamD = id
70−#endif
71−
72−afterUnsafe :: IO b -> Stream IO a -> Stream IO a
73−finallyUnsafe :: IO b -> Stream IO a -> Stream IO a
74−bracketUnsafe :: IO b -> (b -> IO c) -> (b -> Stream IO a) -> Stream IO a
75−#ifdef USE_PRELUDE
76−afterUnsafe = Stream.after_
77−finallyUnsafe = Stream.finally_
78−bracketUnsafe = Stream.bracket_
79−#else
80−afterUnsafe = Stream.afterUnsafe
81−finallyUnsafe = Stream.finallyUnsafe
82−bracketUnsafe = Stream.bracketUnsafe
83#endif
44#endif
84
45
85-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
@@ -95,41 +56,37 @@ instance Exception BenchException
95
56
96retryNoneSimple :: Int -> Int -> IO ()
57retryNoneSimple :: Int -> Int -> IO ()
97retryNoneSimple length from =
58retryNoneSimple length from =
98− drain
59+ IP.drain
99− $ Stream.retry
100− (Map.singleton BenchException1 length)
60+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil) source
101− (const Stream.nil)
102− source
103
61
104 where
62 where
105
63
106− source = Stream.enumerateFromTo from (from + length)
64+ source = S.enumerateFromTo from (from + length)
107
65
108retryNone :: Int -> Int -> IO ()
66retryNone :: Int -> Int -> IO ()
109retryNone length from = do
67retryNone length from = do
110 ref <- Ref.newIORef (0 :: Int)
68 ref <- Ref.newIORef (0 :: Int)
111− drain
69+ IP.drain
112− $ Stream.retry (Map.singleton BenchException1 length) (const Stream.nil)
70+ $ IP.retry (Map.singleton BenchException1 length) (const S.nil)
113 $ source ref
71 $ source ref
114
72
115 where
73 where
116
74
117 source ref =
75 source ref =
118− Stream.replicateM (from + length)
76+ IP.replicateM (from + length)
119 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
77 $ Ref.modifyIORef' ref (+ 1) >> Ref.readIORef ref
120
78
121retryAll :: Int -> Int -> IO ()
79retryAll :: Int -> Int -> IO ()
122retryAll length from = do
80retryAll length from = do
123 ref <- Ref.newIORef 0
81 ref <- Ref.newIORef 0
124− drain
82+ IP.drain
125− $ Stream.retry
126− (Map.singleton BenchException1 (length + from)) (const Stream.nil)
83+ $ IP.retry (Map.singleton BenchException1 (length + from)) (const S.nil)
127 $ source ref
84 $ source ref
128
85
129 where
86 where
130
87
131 source ref =
88 source ref =
132− Stream.fromEffect
89+ IP.fromEffect
133 $ do
90 $ do
134 Ref.modifyIORef' ref (+ 1)
91 Ref.modifyIORef' ref (+ 1)
135 val <- Ref.readIORef ref
92 val <- Ref.readIORef ref
@@ -139,13 +96,13 @@ retryAll length from = do
139
96
140retryUnknown :: Int -> Int -> IO ()
97retryUnknown :: Int -> Int -> IO ()
141retryUnknown length from = do
98retryUnknown length from = do
142− drain
99+ IP.drain
143− $ Stream.retry (Map.singleton BenchException1 length) (const source)
100+ $ IP.retry (Map.singleton BenchException1 length) (const source)
144− $ throwIO BenchException2 `Stream.before` Stream.nil
101+ $ throwIO BenchException2 `S.before` S.nil
145
102
146 where
103 where
147
104
148− source = Stream.enumerateFromTo from (from + length)
105+ source = S.enumerateFromTo from (from + length)
149
106
150
107
151o_1_space_serial_exceptions :: Int -> [Benchmark]
108o_1_space_serial_exceptions :: Int -> [Benchmark]
@@ -159,8 +116,6 @@ o_1_space_serial_exceptions length =
159 ]
116 ]
160 ]
117 ]
161
118
162−-- XXX Move these to FileSystem.Handle benchmarks
163−
164-------------------------------------------------------------------------------
119-------------------------------------------------------------------------------
165-- copy stream exceptions
120-- copy stream exceptions
166-------------------------------------------------------------------------------
121-------------------------------------------------------------------------------
@@ -168,8 +123,8 @@ o_1_space_serial_exceptions length =
168-- | Send the file contents to /dev/null with exception handling
123-- | Send the file contents to /dev/null with exception handling
169readWriteOnExceptionStream :: Handle -> Handle -> IO ()
124readWriteOnExceptionStream :: Handle -> Handle -> IO ()
170readWriteOnExceptionStream inh devNull =
125readWriteOnExceptionStream inh devNull =
171− let readEx = Stream.onException (hClose inh) (Stream.unfold FH.reader inh)
126+ let readEx = S.onException (hClose inh) (S.unfold FH.read inh)
172− in Stream.fold (FH.write devNull) readEx
127+ in S.fold (FH.write devNull) $ readEx
173
128
174#ifdef INSPECTION
129#ifdef INSPECTION
175inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
130inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
@@ -178,10 +133,9 @@ inspect $ hasNoTypeClasses 'readWriteOnExceptionStream
178-- | Send the file contents to /dev/null with exception handling
133-- | Send the file contents to /dev/null with exception handling
179readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
134readWriteHandleExceptionStream :: Handle -> Handle -> IO ()
180readWriteHandleExceptionStream inh devNull =
135readWriteHandleExceptionStream inh devNull =
181− let handler (_e :: SomeException) =
136+ let handler (_e :: SomeException) = S.fromEffect (hClose inh >> return 10)
182− return $ Stream.fromEffect (hClose inh >> return 10)
183− readEx = Stream.handle handler (Stream.unfold FH.reader inh)
137+ readEx = S.handle handler (S.unfold FH.read inh)
184− in Stream.fold (FH.write devNull) readEx
138+ in S.fold (FH.write devNull) $ readEx
185
139
186#ifdef INSPECTION
140#ifdef INSPECTION
187inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
141inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
@@ -190,9 +144,8 @@ inspect $ hasNoTypeClasses 'readWriteHandleExceptionStream
190-- | Send the file contents to /dev/null with exception handling
144-- | Send the file contents to /dev/null with exception handling
191readWriteFinally_Stream :: Handle -> Handle -> IO ()
145readWriteFinally_Stream :: Handle -> Handle -> IO ()
192readWriteFinally_Stream inh devNull =
146readWriteFinally_Stream inh devNull =
193− let readEx =
194− finallyUnsafe (hClose inh) (Stream.unfold FH.reader inh)
147+ let readEx = IP.finally_ (hClose inh) (S.unfold FH.read inh)
195− in Stream.fold (FH.write devNull) readEx
148+ in S.fold (FH.write devNull) readEx
196
149
197#ifdef INSPECTION
150#ifdef INSPECTION
198inspect $ hasNoTypeClasses 'readWriteFinally_Stream
151inspect $ hasNoTypeClasses 'readWriteFinally_Stream
@@ -200,15 +153,15 @@ inspect $ hasNoTypeClasses 'readWriteFinally_Stream
200
153
201readWriteFinallyStream :: Handle -> Handle -> IO ()
154readWriteFinallyStream :: Handle -> Handle -> IO ()
202readWriteFinallyStream inh devNull =
155readWriteFinallyStream inh devNull =
203− let readEx = Stream.finally (hClose inh) (Stream.unfold FH.reader inh)
156+ let readEx = S.finally (hClose inh) (S.unfold FH.read inh)
204− in Stream.fold (FH.write devNull) readEx
157+ in S.fold (FH.write devNull) readEx
205
158
206-- | Send the file contents to /dev/null with exception handling
159-- | Send the file contents to /dev/null with exception handling
207fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
160fromToBytesBracket_Stream :: Handle -> Handle -> IO ()
208fromToBytesBracket_Stream inh devNull =
161fromToBytesBracket_Stream inh devNull =
209− let readEx = bracketUnsafe (return ()) (\_ -> hClose inh)
162+ let readEx = IP.bracket_ (return ()) (\_ -> hClose inh)
210− (\_ -> fromStreamD $ IFH.read inh)
163+ (\_ -> IFH.toBytes inh)
211− in IFH.putBytes devNull (toStreamD readEx)
164+ in IFH.putBytes devNull $ readEx
212
165
213#ifdef INSPECTION
166#ifdef INSPECTION
214inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
167inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
@@ -216,16 +169,16 @@ inspect $ hasNoTypeClasses 'fromToBytesBracket_Stream
216
169
217fromToBytesBracketStream :: Handle -> Handle -> IO ()
170fromToBytesBracketStream :: Handle -> Handle -> IO ()
218fromToBytesBracketStream inh devNull =
171fromToBytesBracketStream inh devNull =
219− let readEx = Stream.bracket (return ()) (\_ -> hClose inh)
172+ let readEx = S.bracket (return ()) (\_ -> hClose inh)
220− (\_ -> fromStreamD $ IFH.read inh)
173+ (\_ -> IFH.toBytes inh)
221− in IFH.putBytes devNull (toStreamD readEx)
174+ in IFH.putBytes devNull $ readEx
222
175
223readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
176readWriteBeforeAfterStream :: Handle -> Handle -> IO ()
224readWriteBeforeAfterStream inh devNull =
177readWriteBeforeAfterStream inh devNull =
225 let readEx =
178 let readEx =
226− Stream.after (hClose inh)
179+ IP.after (hClose inh)
227− $ Stream.before (hPutChar devNull 'A') (Stream.unfold FH.reader inh)
180+ $ IP.before (hPutChar devNull 'A') (S.unfold FH.read inh)
228− in Stream.fold (FH.write devNull) readEx
181+ in S.fold (FH.write devNull) readEx
229
182
230#ifdef INSPECTION
183#ifdef INSPECTION
231inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
184inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
@@ -233,8 +186,8 @@ inspect $ 'readWriteBeforeAfterStream `hasNoType` ''D.Step
233
186
234readWriteAfterStream :: Handle -> Handle -> IO ()
187readWriteAfterStream :: Handle -> Handle -> IO ()
235readWriteAfterStream inh devNull =
188readWriteAfterStream inh devNull =
236− let readEx = Stream.after (hClose inh) (Stream.unfold FH.reader inh)
189+ let readEx = IP.after (hClose inh) (S.unfold FH.read inh)
237− in Stream.fold (FH.write devNull) readEx
190+ in S.fold (FH.write devNull) readEx
238
191
239#ifdef INSPECTION
192#ifdef INSPECTION
240inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
193inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
@@ -242,8 +195,8 @@ inspect $ 'readWriteAfterStream `hasNoType` ''D.Step
242
195
243readWriteAfter_Stream :: Handle -> Handle -> IO ()
196readWriteAfter_Stream :: Handle -> Handle -> IO ()
244readWriteAfter_Stream inh devNull =
197readWriteAfter_Stream inh devNull =
245− let readEx = afterUnsafe (hClose inh) (Stream.unfold FH.reader inh)
198+ let readEx = IP.after_ (hClose inh) (S.unfold FH.read inh)
246− in Stream.fold (FH.write devNull) readEx
199+ in S.fold (FH.write devNull) readEx
247
200
248#ifdef INSPECTION
201#ifdef INSPECTION
249inspect $ hasNoTypeClasses 'readWriteAfter_Stream
202inspect $ hasNoTypeClasses 'readWriteAfter_Stream
@@ -253,25 +206,25 @@ inspect $ 'readWriteAfter_Stream `hasNoType` ''D.Step
253o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
206o_1_space_copy_stream_exceptions :: BenchEnv -> [Benchmark]
254o_1_space_copy_stream_exceptions env =
207o_1_space_copy_stream_exceptions env =
255 [ bgroup "exceptions"
208 [ bgroup "exceptions"
256− [ mkBenchSmall "Stream.onException" env $ \inh _ ->
209+ [ mkBenchSmall "S.onException" env $ \inh _ ->
257 readWriteOnExceptionStream inh (nullH env)
210 readWriteOnExceptionStream inh (nullH env)
258− , mkBenchSmall "Stream.handle" env $ \inh _ ->
211+ , mkBenchSmall "S.handle" env $ \inh _ ->
259 readWriteHandleExceptionStream inh (nullH env)
212 readWriteHandleExceptionStream inh (nullH env)
260− , mkBenchSmall "Stream.finally_" env $ \inh _ ->
213+ , mkBenchSmall "S.finally_" env $ \inh _ ->
261 readWriteFinally_Stream inh (nullH env)
214 readWriteFinally_Stream inh (nullH env)
262− , mkBenchSmall "Stream.finally" env $ \inh _ ->
215+ , mkBenchSmall "S.finally" env $ \inh _ ->
263 readWriteFinallyStream inh (nullH env)
216 readWriteFinallyStream inh (nullH env)
264− , mkBenchSmall "Stream.after . Stream.before" env $ \inh _ ->
217+ , mkBenchSmall "S.after . S.before" env $ \inh _ ->
265 readWriteBeforeAfterStream inh (nullH env)
218 readWriteBeforeAfterStream inh (nullH env)
266− , mkBenchSmall "Stream.after" env $ \inh _ ->
219+ , mkBenchSmall "S.after" env $ \inh _ ->
267 readWriteAfterStream inh (nullH env)
220 readWriteAfterStream inh (nullH env)
268− , mkBenchSmall "Stream.after_" env $ \inh _ ->
221+ , mkBenchSmall "S.after_" env $ \inh _ ->
269 readWriteAfter_Stream inh (nullH env)
222 readWriteAfter_Stream inh (nullH env)
270 ]
223 ]
271 , bgroup "exceptions/fromToBytes"
224 , bgroup "exceptions/fromToBytes"
272− [ mkBenchSmall "Stream.bracket_" env $ \inh _ ->
225+ [ mkBenchSmall "S.bracket_" env $ \inh _ ->
273 fromToBytesBracket_Stream inh (nullH env)
226 fromToBytesBracket_Stream inh (nullH env)
274− , mkBenchSmall "Stream.bracket" env $ \inh _ ->
227+ , mkBenchSmall "S.bracket" env $ \inh _ ->
275 fromToBytesBracketStream inh (nullH env)
228 fromToBytesBracketStream inh (nullH env)
276 ]
229 ]
277 ]
230 ]
@@ -283,34 +236,26 @@ o_1_space_copy_stream_exceptions env =
283-- | Send the file contents to /dev/null with exception handling
236-- | Send the file contents to /dev/null with exception handling
284readChunksOnException :: Handle -> Handle -> IO ()
237readChunksOnException :: Handle -> Handle -> IO ()
285readChunksOnException inh devNull =
238readChunksOnException inh devNull =
286− let readEx = IUF.onException (\_ -> hClose inh) FH.chunkReader
239+ let readEx = IUF.onException (\_ -> hClose inh) FH.readChunks
287 in IUF.fold (IFH.writeChunks devNull) readEx inh
240 in IUF.fold (IFH.writeChunks devNull) readEx inh
288
241
289#ifdef INSPECTION
242#ifdef INSPECTION
290−#if __GLASGOW_HASKELL__ >= 906
291−inspect $ hasNoTypeClassesExcept 'readChunksOnException [''MonadCatch]
292−#else
293inspect $ hasNoTypeClasses 'readChunksOnException
243inspect $ hasNoTypeClasses 'readChunksOnException
294#endif
244#endif
295−#endif
296
245
297-- | Send the file contents to /dev/null with exception handling
246-- | Send the file contents to /dev/null with exception handling
298readChunksBracket_ :: Handle -> Handle -> IO ()
247readChunksBracket_ :: Handle -> Handle -> IO ()
299readChunksBracket_ inh devNull =
248readChunksBracket_ inh devNull =
300− let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.chunkReader
249+ let readEx = IUF.bracket_ return (\_ -> hClose inh) FH.readChunks
301 in IUF.fold (IFH.writeChunks devNull) readEx inh
250 in IUF.fold (IFH.writeChunks devNull) readEx inh
302
251
303#ifdef INSPECTION
252#ifdef INSPECTION
304−#if __GLASGOW_HASKELL__ >= 906
305−inspect $ hasNoTypeClassesExcept 'readChunksBracket_ [''MonadCatch]
306−#else
307inspect $ hasNoTypeClasses 'readChunksBracket_
253inspect $ hasNoTypeClasses 'readChunksBracket_
308#endif
254#endif
309−#endif
310
255
311readChunksBracket :: Handle -> Handle -> IO ()
256readChunksBracket :: Handle -> Handle -> IO ()
312readChunksBracket inh devNull =
257readChunksBracket inh devNull =
313− let readEx = IUF.bracket return (\_ -> hClose inh) FH.chunkReader
258+ let readEx = IUF.bracket return (\_ -> hClose inh) FH.readChunks
314 in IUF.fold (IFH.writeChunks devNull) readEx inh
259 in IUF.fold (IFH.writeChunks devNull) readEx inh
315
260
316o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
261o_1_space_copy_exceptions_readChunks :: BenchEnv -> [Benchmark]
@@ -332,11 +277,11 @@ o_1_space_copy_exceptions_readChunks env =
332-- | Send the file contents to /dev/null with exception handling
277-- | Send the file contents to /dev/null with exception handling
333toChunksBracket_ :: Handle -> Handle -> IO ()
278toChunksBracket_ :: Handle -> Handle -> IO ()
334toChunksBracket_ inh devNull =
279toChunksBracket_ inh devNull =
335− let readEx = bracketUnsafe
280+ let readEx = IP.bracket_
336 (return ())
281 (return ())
337 (\_ -> hClose inh)
282 (\_ -> hClose inh)
338− (\_ -> fromStreamD $ IFH.readChunks inh)
283+ (\_ -> IFH.toChunks inh)
339− in Stream.fold (IFH.writeChunks devNull) readEx
284+ in S.fold (IFH.writeChunks devNull) $ readEx
340
285
341#ifdef INSPECTION
286#ifdef INSPECTION
342inspect $ hasNoTypeClasses 'toChunksBracket_
287inspect $ hasNoTypeClasses 'toChunksBracket_
@@ -344,28 +289,29 @@ inspect $ hasNoTypeClasses 'toChunksBracket_
344
289
345toChunksBracket :: Handle -> Handle -> IO ()
290toChunksBracket :: Handle -> Handle -> IO ()
346toChunksBracket inh devNull =
291toChunksBracket inh devNull =
347− let readEx = Stream.bracket
292+ let readEx = S.bracket
348 (return ())
293 (return ())
349 (\_ -> hClose inh)
294 (\_ -> hClose inh)
350− (\_ -> fromStreamD $ IFH.readChunks inh)
295+ (\_ -> IFH.toChunks inh)
351− in Stream.fold (IFH.writeChunks devNull) readEx
296+ in S.fold (IFH.writeChunks devNull) $ readEx
352
297
353o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
298o_1_space_copy_exceptions_toChunks :: BenchEnv -> [Benchmark]
354o_1_space_copy_exceptions_toChunks env =
299o_1_space_copy_exceptions_toChunks env =
355 [ bgroup "exceptions/toChunks"
300 [ bgroup "exceptions/toChunks"
356− [ mkBench "Stream.bracket_" env $ \inH _ ->
301+ [ mkBench "S.bracket_" env $ \inH _ ->
357 toChunksBracket_ inH (nullH env)
302 toChunksBracket_ inH (nullH env)
358− , mkBench "Stream.bracket" env $ \inH _ ->
303+ , mkBench "S.bracket" env $ \inH _ ->
359 toChunksBracket inH (nullH env)
304 toChunksBracket inH (nullH env)
360 ]
305 ]
361 ]
306 ]
362
307
308+
363benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
309benchmarks :: String -> BenchEnv -> Int -> [Benchmark]
364−benchmarks moduleName _env size =
310+benchmarks moduleName env size =
365 [ bgroup (o_1_space_prefix moduleName) $ concat
311 [ bgroup (o_1_space_prefix moduleName) $ concat
366− [ o_1_space_serial_exceptions size
367− , o_1_space_copy_exceptions_readChunks _env
312+ [ o_1_space_copy_exceptions_readChunks env
368− , o_1_space_copy_exceptions_toChunks _env
313+ , o_1_space_copy_exceptions_toChunks env
369− , o_1_space_copy_stream_exceptions _env
314+ , o_1_space_copy_stream_exceptions env
315+ , o_1_space_serial_exceptions size
370 ]
316 ]
371 ]
317 ]
benchmark/Streamly/Benchmark/Prelude/Serial/Generation.hsnew file+179
@@ -0,0 +1,179 @@
1+-- |
2+-- Module : Serial.Generation
3+-- Copyright : (c) 2018 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE RankNTypes #-}
11+
12+module Serial.Generation (benchmarks) where
13+
14+import Data.Functor.Identity (Identity)
15+
16+import qualified Prelude
17+import qualified GHC.Exts as GHC
18+
19+import qualified Streamly.Prelude as S
20+
21+import Gauge
22+import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
23+import Streamly.Benchmark.Common
24+import Streamly.Benchmark.Prelude
25+import Prelude hiding (repeat, replicate, iterate)
26+
27+-------------------------------------------------------------------------------
28+-- Generation
29+-------------------------------------------------------------------------------
30+
31+-------------------------------------------------------------------------------
32+-- fromList
33+-------------------------------------------------------------------------------
34+
35+{-# INLINE sourceIsList #-}
36+sourceIsList :: Int -> Int -> SerialT Identity Int
37+sourceIsList value n = GHC.fromList [n..n+value]
38+
39+{-# INLINE sourceIsString #-}
40+sourceIsString :: Int -> Int -> SerialT Identity Char
41+sourceIsString value n = GHC.fromString (Prelude.replicate (n + value) 'a')
42+
43+{-# INLINE readInstance #-}
44+readInstance :: String -> SerialT Identity Int
45+readInstance str =
46+ let r = reads str
47+ in case r of
48+ [(x,"")] -> x
49+ _ -> error "readInstance: no parse"
50+
51+-- For comparisons
52+{-# INLINE readInstanceList #-}
53+readInstanceList :: String -> [Int]
54+readInstanceList str =
55+ let r = reads str
56+ in case r of
57+ [(x,"")] -> x
58+ _ -> error "readInstance: no parse"
59+
60+{-# INLINE repeat #-}
61+repeat :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
62+repeat count = S.take count . S.repeat
63+
64+{-# INLINE repeatM #-}
65+repeatM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
66+repeatM count = S.take count . S.repeatM . return
67+
68+{-# INLINE replicate #-}
69+replicate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
70+replicate = S.replicate
71+
72+{-# INLINE replicateM #-}
73+replicateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
74+replicateM count = S.replicateM count . return
75+
76+{-# INLINE enumerateFrom #-}
77+enumerateFrom :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
78+enumerateFrom count = S.take count . S.enumerateFrom
79+
80+{-# INLINE enumerateFromTo #-}
81+enumerateFromTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
82+enumerateFromTo = sourceIntFromTo
83+
84+{-# INLINE enumerateFromThen #-}
85+enumerateFromThen :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
86+enumerateFromThen count inp = S.take count $ S.enumerateFromThen inp (inp + 1)
87+
88+{-# INLINE enumerateFromThenTo #-}
89+enumerateFromThenTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
90+enumerateFromThenTo = sourceIntFromThenTo
91+
92+-- n ~ 1
93+{-# INLINE enumerate #-}
94+enumerate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
95+enumerate count n = S.take (count + n) S.enumerate
96+
97+-- n ~ 1
98+{-# INLINE enumerateTo #-}
99+enumerateTo :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
100+enumerateTo count n = S.enumerateTo (minBound + count + n)
101+
102+{-# INLINE iterate #-}
103+iterate :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
104+iterate count = S.take count . S.iterate (+1)
105+
106+{-# INLINE iterateM #-}
107+iterateM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
108+iterateM count = S.take count . S.iterateM (return . (+1)) . return
109+
110+{-# INLINE fromIndices #-}
111+fromIndices :: (Monad m, S.IsStream t) => Int -> Int -> t m Int
112+fromIndices value n = S.take value $ S.fromIndices (+ n)
113+
114+{-# INLINE fromIndicesM #-}
115+fromIndicesM :: (MonadAsync m, S.IsStream t) => Int -> Int -> t m Int
116+fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n))
117+
118+o_1_space_generation :: Int -> [Benchmark]
119+o_1_space_generation value =
120+ [ bgroup "generation"
121+ [ benchIOSrc fromSerial "unfoldr" (sourceUnfoldr value)
122+ , benchIOSrc fromSerial "unfoldrM" (sourceUnfoldrM value)
123+ , benchIOSrc fromSerial "repeat" (repeat value)
124+ , benchIOSrc fromSerial "repeatM" (repeatM value)
125+ , benchIOSrc fromSerial "replicate" (replicate value)
126+ , benchIOSrc fromSerial "replicateM" (replicateM value)
127+ , benchIOSrc fromSerial "iterate" (iterate value)
128+ , benchIOSrc fromSerial "iterateM" (iterateM value)
129+ , benchIOSrc fromSerial "fromIndices" (fromIndices value)
130+ , benchIOSrc fromSerial "fromIndicesM" (fromIndicesM value)
131+ , benchIOSrc fromSerial "intFromTo" (sourceIntFromTo value)
132+ , benchIOSrc fromSerial "intFromThenTo" (sourceIntFromThenTo value)
133+ , benchIOSrc fromSerial "integerFromStep" (sourceIntegerFromStep value)
134+ , benchIOSrc fromSerial "fracFromThenTo" (sourceFracFromThenTo value)
135+ , benchIOSrc fromSerial "fracFromTo" (sourceFracFromTo value)
136+ , benchIOSrc fromSerial "fromList" (sourceFromList value)
137+ , benchPureSrc "IsList.fromList" (sourceIsList value)
138+ , benchPureSrc "IsString.fromString" (sourceIsString value)
139+ , benchIOSrc fromSerial "fromListM" (sourceFromListM value)
140+ , benchIOSrc fromSerial "enumerateFrom" (enumerateFrom value)
141+ , benchIOSrc fromSerial "enumerateFromTo" (enumerateFromTo value)
142+ , benchIOSrc fromSerial "enumerateFromThen" (enumerateFromThen value)
143+ , benchIOSrc fromSerial "enumerateFromThenTo" (enumerateFromThenTo value)
144+ , benchIOSrc fromSerial "enumerate" (enumerate value)
145+ , benchIOSrc fromSerial "enumerateTo" (enumerateTo value)
146+
147+ -- These essentially test cons and consM
148+ , benchIOSrc fromSerial "fromFoldable" (sourceFromFoldable value)
149+ , benchIOSrc fromSerial "fromFoldableM" (sourceFromFoldableM value)
150+
151+ , benchIOSrc fromSerial "absTimes" $ absTimes value
152+ ]
153+ ]
154+
155+o_n_heap_generation :: Int -> [Benchmark]
156+o_n_heap_generation value =
157+ [ bgroup "buffered"
158+ -- Buffers the output of show/read.
159+ -- XXX can the outputs be streaming? Can we have special read/show
160+ -- style type classes, readM/showM supporting streaming effects?
161+ [ bench "readsPrec pure streams" $
162+ nf readInstance (mkString value)
163+ , bench "readsPrec Haskell lists" $
164+ nf readInstanceList (mkListString value)
165+ ]
166+ ]
167+
168+-------------------------------------------------------------------------------
169+-- Main
170+-------------------------------------------------------------------------------
171+
172+-- In addition to gauge options, the number of elements in the stream can be
173+-- passed using the --stream-size option.
174+--
175+benchmarks :: String -> Int -> [Benchmark]
176+benchmarks moduleName size =
177+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_generation size)
178+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_generation size)
179+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/Lift.hsnew file+123
@@ -0,0 +1,123 @@
1+-- |
2+-- Module : Serial.Lift
3+-- Copyright : (c) 2018 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE RankNTypes #-}
11+
12+module Serial.Lift (benchmarks) where
13+
14+import Control.Monad.State.Strict (StateT, get, put, MonadState)
15+import qualified Control.Monad.State.Strict as State
16+import Control.Monad.Trans.Class (lift)
17+
18+import qualified Streamly.Prelude as S
19+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
20+
21+import Gauge
22+import Streamly.Prelude (SerialT, fromSerial)
23+import Streamly.Benchmark.Common
24+import Streamly.Benchmark.Prelude
25+import Prelude hiding (reverse, tail)
26+
27+-------------------------------------------------------------------------------
28+-- Monad transformation (hoisting etc.)
29+-------------------------------------------------------------------------------
30+
31+{-# INLINE sourceUnfoldrState #-}
32+sourceUnfoldrState :: (S.IsStream t, S.MonadAsync m)
33+ => Int -> Int -> t (StateT Int m) Int
34+sourceUnfoldrState value n = S.unfoldrM step n
35+ where
36+ step cnt =
37+ if cnt > n + value
38+ then return Nothing
39+ else do
40+ s <- get
41+ put (s + 1)
42+ return (Just (s, cnt + 1))
43+
44+{-# INLINE evalStateT #-}
45+evalStateT :: S.MonadAsync m => Int -> Int -> SerialT m Int
46+evalStateT value n =
47+ Internal.evalStateT (return 0) (sourceUnfoldrState value n)
48+
49+{-# INLINE withState #-}
50+withState :: S.MonadAsync m => Int -> Int -> SerialT m Int
51+withState value n =
52+ Internal.evalStateT
53+ (return (0 :: Int)) (Internal.liftInner (sourceUnfoldrM value n))
54+
55+o_1_space_hoisting :: Int -> [Benchmark]
56+o_1_space_hoisting value =
57+ [ bgroup "hoisting"
58+ [ benchIOSrc fromSerial "evalState" (evalStateT value)
59+ , benchIOSrc fromSerial "withState" (withState value)
60+ ]
61+ ]
62+
63+{-# INLINE iterateStateIO #-}
64+iterateStateIO ::
65+ (S.MonadAsync m)
66+ => Int
67+ -> StateT Int m Int
68+iterateStateIO n = do
69+ x <- get
70+ if x > n
71+ then do
72+ put (x - 1)
73+ iterateStateIO n
74+ else return x
75+
76+{-# INLINE iterateStateT #-}
77+iterateStateT :: Int -> SerialT (StateT Int IO) Int
78+iterateStateT n = do
79+ x <- lift get
80+ if x > n
81+ then do
82+ lift $ put (x - 1)
83+ iterateStateT n
84+ else return x
85+
86+{-# INLINE iterateState #-}
87+{-# SPECIALIZE iterateState :: Int -> SerialT (StateT Int IO) Int #-}
88+iterateState ::
89+ (S.MonadAsync m, MonadState Int m)
90+ => Int
91+ -> SerialT m Int
92+iterateState n = do
93+ x <- get
94+ if x > n
95+ then do
96+ put (x - 1)
97+ iterateState n
98+ else return x
99+
100+o_n_heap_transformer :: Int -> [Benchmark]
101+o_n_heap_transformer value =
102+ [ bgroup "transformer"
103+ [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->
104+ State.evalStateT (iterateStateIO n) value
105+ , benchIO "SerialT (StateT Int IO) (n times)" $ \n ->
106+ State.evalStateT (S.drain (iterateStateT n)) value
107+ , benchIO "MonadState Int m => SerialT m Int" $ \n ->
108+ State.evalStateT (S.drain (iterateState n)) value
109+ ]
110+ ]
111+
112+-------------------------------------------------------------------------------
113+-- Main
114+-------------------------------------------------------------------------------
115+
116+-- In addition to gauge options, the number of elements in the stream can be
117+-- passed using the --stream-size option.
118+--
119+benchmarks :: String -> Int -> [Benchmark]
120+benchmarks moduleName size =
121+ [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)
122+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)
123+ ]
benchmark/Streamly/Benchmark/Prelude/Serial/NestedFold.hsnew file+463
@@ -0,0 +1,463 @@
1+-- |
2+-- Module : Serial.NestedFold
3+-- Copyright : (c) 2018 Composewell Technologies
4+-- License : BSD-3-Clause
5+-- Maintainer : streamly@composewell.com
6+
7+{-# LANGUAGE CPP #-}
8+{-# LANGUAGE FlexibleContexts #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE DeriveAnyClass #-}
11+{-# LANGUAGE DeriveGeneric #-}
12+{-# LANGUAGE RankNTypes #-}
13+{-# LANGUAGE TupleSections #-}
14+
15+module Serial.NestedFold (benchmarks) where
16+
17+import Control.DeepSeq (NFData(..))
18+import Control.Monad (when)
19+import Control.Monad.IO.Class (MonadIO(..))
20+import Data.Monoid (Sum(..))
21+import GHC.Generics (Generic)
22+
23+import qualified Streamly.Internal.Data.Refold.Type as Refold
24+import qualified Streamly.Internal.Data.Fold as FL
25+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
26+import qualified Streamly.Prelude as S
27+
28+import Gauge
29+import Streamly.Prelude (SerialT, fromSerial)
30+import Streamly.Benchmark.Common
31+import Streamly.Benchmark.Prelude
32+import Prelude hiding (reverse, tail)
33+
34+-------------------------------------------------------------------------------
35+-- Iteration/looping utilities
36+-------------------------------------------------------------------------------
37+
38+{-# INLINE iterateN #-}
39+iterateN :: (Int -> a -> a) -> a -> Int -> a
40+iterateN g initial count = f count initial
41+
42+ where
43+
44+ f (0 :: Int) x = x
45+ f i x = f (i - 1) (g i x)
46+
47+-- Iterate a transformation over a singleton stream
48+{-# INLINE iterateSingleton #-}
49+iterateSingleton :: S.MonadAsync m
50+ => (Int -> SerialT m Int -> SerialT m Int)
51+ -> Int
52+ -> Int
53+ -> SerialT m Int
54+iterateSingleton g count n = iterateN g (return n) count
55+
56+-- XXX need to check why this is slower than the explicit recursion above, even
57+-- if the above code is written in a foldr like head recursive way. We also
58+-- need to try this with foldlM' once #150 is fixed.
59+-- However, it is perhaps best to keep the iteration benchmarks independent of
60+-- foldrM and any related fusion issues.
61+{-# INLINE _iterateSingleton #-}
62+_iterateSingleton ::
63+ S.MonadAsync m
64+ => (Int -> SerialT m Int -> SerialT m Int)
65+ -> Int
66+ -> Int
67+ -> SerialT m Int
68+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
69+
70+-- Apply transformation g count times on a stream of length len
71+{-# INLINE iterateSource #-}
72+iterateSource ::
73+ S.MonadAsync m
74+ => (SerialT m Int -> SerialT m Int)
75+ -> Int
76+ -> Int
77+ -> Int
78+ -> SerialT m Int
79+iterateSource g count len n = f count (sourceUnfoldrM len n)
80+
81+ where
82+
83+ f (0 :: Int) stream = stream
84+ f i stream = f (i - 1) (g stream)
85+
86+-------------------------------------------------------------------------------
87+-- Functor
88+-------------------------------------------------------------------------------
89+
90+o_n_space_functor :: Int -> [Benchmark]
91+o_n_space_functor value =
92+ [ bgroup "Functor"
93+ [ benchIO "(+) (n times) (baseline)" $ \i0 ->
94+ iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
95+ , benchIOSrc fromSerial "(<$) (n times)" $
96+ iterateSingleton (<$) value
97+ , benchIOSrc fromSerial "fmap (n times)" $
98+ iterateSingleton (fmap . (+)) value
99+ {-
100+ , benchIOSrc fromSerial "_(<$) (n times)" $
101+ _iterateSingleton (<$) value
102+ , benchIOSrc fromSerial "_fmap (n times)" $
103+ _iterateSingleton (fmap . (+)) value
104+ -}
105+ ]
106+ ]
107+
108+-------------------------------------------------------------------------------
109+-- Grouping transformations
110+-------------------------------------------------------------------------------
111+
112+{-# INLINE groups #-}
113+groups :: MonadIO m => SerialT m Int -> m ()
114+groups = S.drain . S.groups FL.drain
115+
116+-- XXX Change this test when the order of comparison is later changed
117+{-# INLINE groupsByGT #-}
118+groupsByGT :: MonadIO m => SerialT m Int -> m ()
119+groupsByGT = S.drain . S.groupsBy (>) FL.drain
120+
121+{-# INLINE groupsByEq #-}
122+groupsByEq :: MonadIO m => SerialT m Int -> m ()
123+groupsByEq = S.drain . S.groupsBy (==) FL.drain
124+
125+-- XXX Change this test when the order of comparison is later changed
126+{-# INLINE groupsByRollingLT #-}
127+groupsByRollingLT :: MonadIO m => SerialT m Int -> m ()
128+groupsByRollingLT =
129+ S.drain . S.groupsByRolling (<) FL.drain
130+
131+{-# INLINE groupsByRollingEq #-}
132+groupsByRollingEq :: MonadIO m => SerialT m Int -> m ()
133+groupsByRollingEq =
134+ S.drain . S.groupsByRolling (==) FL.drain
135+
136+{-# INLINE foldMany #-}
137+foldMany :: Monad m => SerialT m Int -> m ()
138+foldMany =
139+ S.drain
140+ . S.map getSum
141+ . Internal.foldMany (FL.take 2 FL.mconcat)
142+ . S.map Sum
143+
144+{-# INLINE refoldMany #-}
145+refoldMany :: Monad m => SerialT m Int -> m ()
146+refoldMany =
147+ S.drain
148+ . S.map getSum
149+ . Internal.refoldMany (Refold.take 2 Refold.sconcat) (return mempty)
150+ . S.map Sum
151+
152+{-# INLINE foldIterateM #-}
153+foldIterateM :: Monad m => SerialT m Int -> m ()
154+foldIterateM =
155+ S.drain
156+ . S.map getSum
157+ . Internal.foldIterateM
158+ (return . FL.take 2 . FL.sconcat) (return (Sum 0))
159+ . S.map Sum
160+
161+{-# INLINE refoldIterateM #-}
162+refoldIterateM :: Monad m => SerialT m Int -> m ()
163+refoldIterateM =
164+ S.drain
165+ . S.map getSum
166+ . Internal.refoldIterateM
167+ (Refold.take 2 Refold.sconcat) (return (Sum 0))
168+ . S.map Sum
169+
170+o_1_space_grouping :: Int -> [Benchmark]
171+o_1_space_grouping value =
172+ -- Buffering operations using heap proportional to group/window sizes.
173+ [ bgroup "grouping"
174+ [ benchIOSink value "groups" groups
175+ , benchIOSink value "groupsByGT" groupsByGT
176+ , benchIOSink value "groupsByEq" groupsByEq
177+ , benchIOSink value "groupsByRollingLT" groupsByRollingLT
178+ , benchIOSink value "groupsByRollingEq" groupsByRollingEq
179+ , benchIOSink value "foldMany" foldMany
180+ , benchIOSink value "refoldMany" refoldMany
181+ , benchIOSink value "foldIterateM" foldIterateM
182+ , benchIOSink value "refoldIterateM" refoldIterateM
183+ ]
184+ ]
185+
186+-------------------------------------------------------------------------------
187+-- Size conserving transformations (reordering, buffering, etc.)
188+-------------------------------------------------------------------------------
189+
190+{-# INLINE reverse #-}
191+reverse :: MonadIO m => Int -> SerialT m Int -> m ()
192+reverse n = composeN n S.reverse
193+
194+{-# INLINE reverse' #-}
195+reverse' :: MonadIO m => Int -> SerialT m Int -> m ()
196+reverse' n = composeN n Internal.reverse'
197+
198+o_n_heap_buffering :: Int -> [Benchmark]
199+o_n_heap_buffering value =
200+ [ bgroup "buffered"
201+ [
202+ -- Reversing a stream
203+ benchIOSink value "reverse" (reverse 1)
204+ , benchIOSink value "reverse'" (reverse' 1)
205+
206+ , benchIOSink value "mkAsync" (mkAsync fromSerial)
207+ ]
208+ ]
209+
210+-------------------------------------------------------------------------------
211+-- Grouping/Splitting
212+-------------------------------------------------------------------------------
213+
214+{-# INLINE classifySessionsOf #-}
215+classifySessionsOf :: (S.MonadAsync m) => SerialT m Int -> m ()
216+classifySessionsOf =
217+ S.drain
218+ . Internal.classifySessionsOf (const (return False)) 3 FL.drain
219+ . Internal.timestamped
220+ . S.concatMap (\x -> S.map (x,) (S.enumerateFromTo 1 (10 :: Int)))
221+
222+o_n_space_grouping :: Int -> [Benchmark]
223+o_n_space_grouping value =
224+ -- Buffering operations using heap proportional to group/window sizes.
225+ [ bgroup "grouping"
226+ [ benchIOSink (value `div` 10) "classifySessionsOf" classifySessionsOf
227+ ]
228+ ]
229+
230+-------------------------------------------------------------------------------
231+-- Mixed Transformation
232+-------------------------------------------------------------------------------
233+
234+{-# INLINE scanMap #-}
235+scanMap :: MonadIO m => Int -> SerialT m Int -> m ()
236+scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0
237+
238+{-# INLINE dropMap #-}
239+dropMap :: MonadIO m => Int -> SerialT m Int -> m ()
240+dropMap n = composeN n $ S.map (subtract 1) . S.drop 1
241+
242+{-# INLINE dropScan #-}
243+dropScan :: MonadIO m => Int -> SerialT m Int -> m ()
244+dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1
245+
246+{-# INLINE takeDrop #-}
247+takeDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
248+takeDrop value n = composeN n $ S.drop 1 . S.take (value + 1)
249+
250+{-# INLINE takeScan #-}
251+takeScan :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
252+takeScan value n = composeN n $ S.scanl' (+) 0 . S.take (value + 1)
253+
254+{-# INLINE takeMap #-}
255+takeMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
256+takeMap value n = composeN n $ S.map (subtract 1) . S.take (value + 1)
257+
258+{-# INLINE filterDrop #-}
259+filterDrop :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
260+filterDrop value n = composeN n $ S.drop 1 . S.filter (<= (value + 1))
261+
262+{-# INLINE filterTake #-}
263+filterTake :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
264+filterTake value n = composeN n $ S.take (value + 1) . S.filter (<= (value + 1))
265+
266+{-# INLINE filterScan #-}
267+filterScan :: MonadIO m => Int -> SerialT m Int -> m ()
268+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)
269+
270+{-# INLINE filterScanl1 #-}
271+filterScanl1 :: MonadIO m => Int -> SerialT m Int -> m ()
272+filterScanl1 n = composeN n $ S.scanl1' (+) . S.filter (<= maxBound)
273+
274+{-# INLINE filterMap #-}
275+filterMap :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
276+filterMap value n = composeN n $ S.map (subtract 1) . S.filter (<= (value + 1))
277+
278+-------------------------------------------------------------------------------
279+-- Scan and fold
280+-------------------------------------------------------------------------------
281+
282+data Pair a b =
283+ Pair !a !b
284+ deriving (Generic, NFData)
285+
286+{-# INLINE sumProductFold #-}
287+sumProductFold :: Monad m => SerialT m Int -> m (Int, Int)
288+sumProductFold = S.foldl' (\(s, p) x -> (s + x, p * x)) (0, 1)
289+
290+{-# INLINE sumProductScan #-}
291+sumProductScan :: Monad m => SerialT m Int -> m (Pair Int Int)
292+sumProductScan =
293+ S.foldl' (\(Pair _ p) (s0, x) -> Pair s0 (p * x)) (Pair 0 1) .
294+ S.scanl' (\(s, _) x -> (s + x, x)) (0, 0)
295+
296+{-# INLINE foldl'ReduceMap #-}
297+foldl'ReduceMap :: Monad m => SerialT m Int -> m Int
298+foldl'ReduceMap = fmap (+ 1) . S.foldl' (+) 0
299+
300+o_1_space_transformations_mixed :: Int -> [Benchmark]
301+o_1_space_transformations_mixed value =
302+ -- scanl-map and foldl-map are equivalent to the scan and fold in the foldl
303+ -- library. If scan/fold followed by a map is efficient enough we may not
304+ -- need monolithic implementations of these.
305+ [ bgroup "mixed"
306+ [ benchIOSink value "scanl-map" (scanMap 1)
307+ , benchIOSink value "foldl-map" foldl'ReduceMap
308+ , benchIOSink value "sum-product-fold" sumProductFold
309+ , benchIOSink value "sum-product-scan" sumProductScan
310+ ]
311+ ]
312+
313+o_1_space_transformations_mixedX4 :: Int -> [Benchmark]
314+o_1_space_transformations_mixedX4 value =
315+ [ bgroup "mixedX4"
316+ [ benchIOSink value "scan-map" (scanMap 4)
317+ , benchIOSink value "drop-map" (dropMap 4)
318+ , benchIOSink value "drop-scan" (dropScan 4)
319+ , benchIOSink value "take-drop" (takeDrop value 4)
320+ , benchIOSink value "take-scan" (takeScan value 4)
321+ , benchIOSink value "take-map" (takeMap value 4)
322+ , benchIOSink value "filter-drop" (filterDrop value 4)
323+ , benchIOSink value "filter-take" (filterTake value 4)
324+ , benchIOSink value "filter-scan" (filterScan 4)
325+ , benchIOSink value "filter-scanl1" (filterScanl1 4)
326+ , benchIOSink value "filter-map" (filterMap value 4)
327+ ]
328+ ]
329+
330+-------------------------------------------------------------------------------
331+-- Iterating a transformation over and over again
332+-------------------------------------------------------------------------------
333+
334+-- this is quadratic
335+{-# INLINE iterateScan #-}
336+iterateScan :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
337+iterateScan = iterateSource (S.scanl' (+) 0)
338+
339+-- this is quadratic
340+{-# INLINE iterateScanl1 #-}
341+iterateScanl1 :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
342+iterateScanl1 = iterateSource (S.scanl1' (+))
343+
344+{-# INLINE iterateMapM #-}
345+iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
346+iterateMapM = iterateSource (S.mapM return)
347+
348+{-# INLINE iterateFilterEven #-}
349+iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
350+iterateFilterEven = iterateSource (S.filter even)
351+
352+{-# INLINE iterateTakeAll #-}
353+iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> SerialT m Int
354+iterateTakeAll value = iterateSource (S.take (value + 1))
355+
356+{-# INLINE iterateDropOne #-}
357+iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> SerialT m Int
358+iterateDropOne = iterateSource (S.drop 1)
359+
360+{-# INLINE iterateDropWhileFalse #-}
361+iterateDropWhileFalse :: S.MonadAsync m
362+ => Int -> Int -> Int -> Int -> SerialT m Int
363+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))
364+
365+{-# INLINE iterateDropWhileTrue #-}
366+iterateDropWhileTrue :: S.MonadAsync m
367+ => Int -> Int -> Int -> Int -> SerialT m Int
368+iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))
369+
370+{-# INLINE tail #-}
371+tail :: Monad m => SerialT m a -> m ()
372+tail s = S.tail s >>= mapM_ tail
373+
374+{-# INLINE nullHeadTail #-}
375+nullHeadTail :: Monad m => SerialT m Int -> m ()
376+nullHeadTail s = do
377+ r <- S.null s
378+ when (not r) $ do
379+ _ <- S.head s
380+ S.tail s >>= mapM_ nullHeadTail
381+
382+-- Head recursive operations.
383+o_n_stack_iterated :: Int -> [Benchmark]
384+o_n_stack_iterated value = by10 `seq` by100 `seq`
385+ [ bgroup "iterated"
386+ [ benchIOSrc fromSerial "mapM (n/10 x 10)" $ iterateMapM by10 10
387+ , benchIOSrc fromSerial "scanl' (quadratic) (n/100 x 100)" $
388+ iterateScan by100 100
389+ , benchIOSrc fromSerial "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10
390+ , benchIOSrc fromSerial "filterEven (n/10 x 10)" $
391+ iterateFilterEven by10 10
392+ , benchIOSrc fromSerial "takeAll (n/10 x 10)" $
393+ iterateTakeAll value by10 10
394+ , benchIOSrc fromSerial "dropOne (n/10 x 10)" $ iterateDropOne by10 10
395+ , benchIOSrc fromSerial "dropWhileFalse (n/10 x 10)" $
396+ iterateDropWhileFalse value by10 10
397+ , benchIOSrc fromSerial "dropWhileTrue (n/10 x 10)" $
398+ iterateDropWhileTrue value by10 10
399+ , benchIOSink value "tail" tail
400+ , benchIOSink value "nullHeadTail" nullHeadTail
401+ ]
402+ ]
403+
404+ where
405+
406+ by10 = value `div` 10
407+ by100 = value `div` 100
408+
409+-------------------------------------------------------------------------------
410+-- Pipes
411+-------------------------------------------------------------------------------
412+
413+o_1_space_pipes :: Int -> [Benchmark]
414+o_1_space_pipes value =
415+ [ bgroup "pipes"
416+ [ benchIOSink value "mapM" (transformMapM fromSerial 1)
417+ , benchIOSink value "compose" (transformComposeMapM fromSerial 1)
418+ , benchIOSink value "tee" (transformTeeMapM fromSerial 1)
419+#ifdef DEVBUILD
420+ -- XXX this take 1 GB memory to compile
421+ , benchIOSink value "zip" (transformZipMapM fromSerial 1)
422+#endif
423+ ]
424+ ]
425+
426+o_1_space_pipesX4 :: Int -> [Benchmark]
427+o_1_space_pipesX4 value =
428+ [ bgroup "pipesX4"
429+ [ benchIOSink value "mapM" (transformMapM fromSerial 4)
430+ , benchIOSink value "compose" (transformComposeMapM fromSerial 4)
431+ , benchIOSink value "tee" (transformTeeMapM fromSerial 4)
432+#ifdef DEVBUILD
433+ -- XXX this take 1 GB memory to compile
434+ , benchIOSink value "zip" (transformZipMapM fromSerial 4)
435+#endif
436+ ]
437+ ]
438+
439+-------------------------------------------------------------------------------
440+-- Main
441+-------------------------------------------------------------------------------
442+
443+-- In addition to gauge options, the number of elements in the stream can be
444+-- passed using the --stream-size option.
445+--
446+benchmarks :: String -> Int -> [Benchmark]
447+benchmarks moduleName size =
448+ [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
449+ [ o_1_space_grouping size
450+ , o_1_space_transformations_mixed size
451+ , o_1_space_transformations_mixedX4 size
452+
453+ -- pipes
454+ , o_1_space_pipes size
455+ , o_1_space_pipesX4 size
456+ ]
457+ , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)
458+ , bgroup (o_n_heap_prefix moduleName) $ Prelude.concat
459+ [ o_n_space_grouping size
460+ , o_n_space_functor size
461+ , o_n_heap_buffering size
462+ ]
463+ ]
benchmark/Streamly/Benchmark/Data/Stream/Expand.hs → benchmark/Streamly/Benchmark/Prelude/Serial/NestedStream.hsrenamed+156−217
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module : Stream.Expand
2+-- Module : Serial.NestedStream
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,11 +8,6 @@
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
16
11
17#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
18#undef INSPECTION
13#undef INSPECTION
@@ -23,47 +18,33 @@
23{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
24#endif
19#endif
25
20
26−module Stream.Expand (benchmarks) where
21+module Serial.NestedStream (benchmarks) where
22+
23+import Control.Monad.Trans.Class (lift)
24+
25+import qualified Control.Applicative as AP
27
26
28#ifdef INSPECTION
27#ifdef INSPECTION
29import GHC.Types (SPEC(..))
28import GHC.Types (SPEC(..))
30import Test.Inspection
29import Test.Inspection
31
30
32−import qualified Streamly.Internal.Data.Stream as D
31+import qualified Streamly.Internal.Data.Stream.StreamD as D
33#endif
32#endif
34
33
35−import qualified Stream.Common as Common
34+import qualified Streamly.Prelude as S
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−#ifdef USE_PRELUDE
38+import Gauge
39−import qualified Streamly.Internal.Data.Stream.IsStream as S
40−import qualified Streamly.Internal.Data.Stream.IsStream as StreamK
41−import Streamly.Benchmark.Prelude
39+import Streamly.Prelude (SerialT, fromSerial, serial)
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
59import Streamly.Benchmark.Common
40import Streamly.Benchmark.Common
41+import Streamly.Benchmark.Prelude
60import Prelude hiding (concatMap)
42import Prelude hiding (concatMap)
61
43
62-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
63-- Iteration/looping utilities
45-- Iteration/looping utilities
64-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
65
47
66−#ifdef USE_STREAMK
67{-# INLINE iterateN #-}
48{-# INLINE iterateN #-}
68iterateN :: (Int -> a -> a) -> a -> Int -> a
49iterateN :: (Int -> a -> a) -> a -> Int -> a
69iterateN g initial count = f count initial
50iterateN g initial count = f count initial
@@ -75,18 +56,13 @@ iterateN g initial count = f count initial
75
56
76-- Iterate a transformation over a singleton stream
57-- Iterate a transformation over a singleton stream
77{-# INLINE iterateSingleton #-}
58{-# INLINE iterateSingleton #-}
78−iterateSingleton :: Applicative m =>
59+iterateSingleton :: S.MonadAsync m
79− (Int -> CrossStreamK m Int -> CrossStreamK m Int)
60+ => (Int -> SerialT m Int -> SerialT m Int)
80 -> Int
61 -> Int
81 -> Int
62 -> Int
82− -> Stream m Int
63+ -> SerialT m Int
83−iterateSingleton g count n =
64+iterateSingleton g count n = iterateN g (return n) count
84− toStream
85− $ StreamK.unCross
86− $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count
87−#endif
88
65
89−{-
90-- XXX need to check why this is slower than the explicit recursion above, even
66-- XXX need to check why this is slower than the explicit recursion above, even
91-- if the above code is written in a foldr like head recursive way. We also
67-- if the above code is written in a foldr like head recursive way. We also
92-- need to try this with foldlM' once #150 is fixed.
68-- need to try this with foldlM' once #150 is fixed.
@@ -94,13 +70,12 @@ iterateSingleton g count n =
94-- foldrM and any related fusion issues.
70-- foldrM and any related fusion issues.
95{-# INLINE _iterateSingleton #-}
71{-# INLINE _iterateSingleton #-}
96_iterateSingleton ::
72_iterateSingleton ::
97− Monad m
73+ S.MonadAsync m
98− => (Int -> Stream m Int -> Stream m Int)
74+ => (Int -> SerialT m Int -> SerialT m Int)
99 -> Int
75 -> Int
100 -> Int
76 -> Int
101− -> Stream m Int
77+ -> SerialT m Int
102_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
78_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
103−-}
104
79
105-------------------------------------------------------------------------------
80-------------------------------------------------------------------------------
106-- Multi-Stream
81-- Multi-Stream
@@ -113,28 +88,50 @@ _iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
113{-# INLINE serial2 #-}
88{-# INLINE serial2 #-}
114serial2 :: Int -> Int -> IO ()
89serial2 :: Int -> Int -> IO ()
115serial2 count n =
90serial2 count n =
116− drain $ toStream $
91+ S.drain $
117− Common.append
118− (fromStream $ sourceUnfoldrM count n)
119− (fromStream $ sourceUnfoldrM count (n + 1))
92+ S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
120
93
121{-# INLINE serial4 #-}
94{-# INLINE serial4 #-}
122serial4 :: Int -> Int -> IO ()
95serial4 :: Int -> Int -> IO ()
123serial4 count n =
96serial4 count n =
124− drain $ toStream $
97+ S.drain $
125− Common.append
98+ S.serial
126− (Common.append
99+ (S.serial (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1)))
100+ (S.serial
101+ (sourceUnfoldrM count (n + 2))
127− (fromStream $ sourceUnfoldrM count n)
102+ (sourceUnfoldrM count (n + 3)))
103+
104+{-# INLINE append2 #-}
105+append2 :: Int -> Int -> IO ()
106+append2 count n =
107+ S.drain $
128− (fromStream $ sourceUnfoldrM count (n + 1)))
108+ Internal.append (sourceUnfoldrM count n) (sourceUnfoldrM count (n + 1))
109+
110+{-# INLINE append4 #-}
111+append4 :: Int -> Int -> IO ()
112+append4 count n =
113+ S.drain $
114+ Internal.append
129− (Common.append
115+ (Internal.append
116+ (sourceUnfoldrM count n)
130− (fromStream $ sourceUnfoldrM count (n + 2))
117+ (sourceUnfoldrM count (n + 1)))
118+ (Internal.append
119+ (sourceUnfoldrM count (n + 2))
131− (fromStream $ sourceUnfoldrM count (n + 3)))
120+ (sourceUnfoldrM count (n + 3)))
121+
122+#ifdef INSPECTION
123+inspect $ hasNoTypeClasses 'append2
124+inspect $ 'append2 `hasNoType` ''SPEC
125+inspect $ 'append2 `hasNoType` ''D.AppendState
126+#endif
132
127
133o_1_space_joining :: Int -> [Benchmark]
128o_1_space_joining :: Int -> [Benchmark]
134o_1_space_joining value =
129o_1_space_joining value =
135 [ bgroup "joining"
130 [ bgroup "joining"
136 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
131 [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))
132+ , benchIOSrc1 "append (2,x/2)" (append2 (value `div` 2))
137 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
133 , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))
134+ , benchIOSrc1 "append (2,2,x/4)" (append4 (value `div` 4))
138 ]
135 ]
139 ]
136 ]
140
137
@@ -142,24 +139,22 @@ o_1_space_joining value =
142-- Concat Foldable containers
139-- Concat Foldable containers
143-------------------------------------------------------------------------------
140-------------------------------------------------------------------------------
144
141
145−#ifdef USE_PRELUDE
146o_1_space_concatFoldable :: Int -> [Benchmark]
142o_1_space_concatFoldable :: Int -> [Benchmark]
147o_1_space_concatFoldable value =
143o_1_space_concatFoldable value =
148 [ bgroup "concat-foldable"
144 [ bgroup "concat-foldable"
149− [ benchIOSrc "foldMapWith (<>) (List)"
145+ [ benchIOSrc fromSerial "foldMapWith (<>) (List)"
150 (sourceFoldMapWith value)
146 (sourceFoldMapWith value)
151− , benchIOSrc "foldMapWith (<>) (Stream)"
147+ , benchIOSrc fromSerial "foldMapWith (<>) (Stream)"
152 (sourceFoldMapWithStream value)
148 (sourceFoldMapWithStream value)
153− , benchIOSrc "foldMapWithM (<>) (List)"
149+ , benchIOSrc fromSerial "foldMapWithM (<>) (List)"
154 (sourceFoldMapWithM value)
150 (sourceFoldMapWithM value)
155− , benchIOSrc "S.concatFoldableWith (<>) (List)"
151+ , benchIOSrc fromSerial "S.concatFoldableWith (<>) (List)"
156 (concatFoldableWith value)
152 (concatFoldableWith value)
157− , benchIOSrc "S.concatForFoldableWith (<>) (List)"
153+ , benchIOSrc fromSerial "S.concatForFoldableWith (<>) (List)"
158 (concatForFoldableWith value)
154 (concatForFoldableWith value)
159− , benchIOSrc "foldMapM (List)" (sourceFoldMapM value)
155+ , benchIOSrc fromSerial "foldMapM (List)" (sourceFoldMapM value)
160 ]
156 ]
161 ]
157 ]
162−#endif
163
158
164-------------------------------------------------------------------------------
159-------------------------------------------------------------------------------
165-- Concat
160-- Concat
@@ -170,15 +165,14 @@ o_1_space_concatFoldable value =
170{-# INLINE concatMap #-}
165{-# INLINE concatMap #-}
171concatMap :: Int -> Int -> Int -> IO ()
166concatMap :: Int -> Int -> Int -> IO ()
172concatMap outer inner n =
167concatMap outer inner n =
173− drain $ toStream $ StreamK.concatMap
168+ S.drain $ S.concatMap
174− (\_ -> fromStream $ sourceUnfoldrM inner n)
169+ (\_ -> sourceUnfoldrM inner n)
175− (fromStream $ sourceUnfoldrM outer n)
170+ (sourceUnfoldrM outer n)
176
171
177−#ifndef USE_STREAMK
178{-# INLINE concatMapM #-}
172{-# INLINE concatMapM #-}
179concatMapM :: Int -> Int -> Int -> IO ()
173concatMapM :: Int -> Int -> Int -> IO ()
180concatMapM outer inner n =
174concatMapM outer inner n =
181− drain $ S.concatMapM
175+ S.drain $ S.concatMapM
182 (\_ -> return $ sourceUnfoldrM inner n)
176 (\_ -> return $ sourceUnfoldrM inner n)
183 (sourceUnfoldrM outer n)
177 (sourceUnfoldrM outer n)
184
178
@@ -186,23 +180,18 @@ concatMapM outer inner n =
186inspect $ hasNoTypeClasses 'concatMap
180inspect $ hasNoTypeClasses 'concatMap
187inspect $ 'concatMap `hasNoType` ''SPEC
181inspect $ 'concatMap `hasNoType` ''SPEC
188#endif
182#endif
189−#endif
190
183
191-- concatMap unfoldr/unfoldr
184-- concatMap unfoldr/unfoldr
192
185
193{-# INLINE concatMapPure #-}
186{-# INLINE concatMapPure #-}
194concatMapPure :: Int -> Int -> Int -> IO ()
187concatMapPure :: Int -> Int -> Int -> IO ()
195concatMapPure outer inner n =
188concatMapPure outer inner n =
196− drain $ toStream $ StreamK.concatMap
189+ S.drain $ S.concatMap
197− (\_ -> fromStream $ sourceUnfoldr inner n)
190+ (\_ -> sourceUnfoldr inner n)
198− (fromStream $ sourceUnfoldr outer n)
191+ (sourceUnfoldr outer n)
199
192
200#ifdef INSPECTION
193#ifdef INSPECTION
201−#if __GLASGOW_HASKELL__ >= 906
202−inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]
203−#else
204inspect $ hasNoTypeClasses 'concatMapPure
194inspect $ hasNoTypeClasses 'concatMapPure
205−#endif
206inspect $ 'concatMapPure `hasNoType` ''SPEC
195inspect $ 'concatMapPure `hasNoType` ''SPEC
207#endif
196#endif
208
197
@@ -211,53 +200,42 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC
211{-# INLINE concatMapRepl #-}
200{-# INLINE concatMapRepl #-}
212concatMapRepl :: Int -> Int -> Int -> IO ()
201concatMapRepl :: Int -> Int -> Int -> IO ()
213concatMapRepl outer inner n =
202concatMapRepl outer inner n =
214− drain $ toStream $ StreamK.concatMap
215− (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)
203+ S.drain $ S.concatMap (S.replicate inner) (sourceUnfoldrM outer n)
216
204
217#ifdef INSPECTION
205#ifdef INSPECTION
218−#if __GLASGOW_HASKELL__ >= 906
219−inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]
220−#else
221inspect $ hasNoTypeClasses 'concatMapRepl
206inspect $ hasNoTypeClasses 'concatMapRepl
222−#endif
223inspect $ 'concatMapRepl `hasNoType` ''SPEC
207inspect $ 'concatMapRepl `hasNoType` ''SPEC
224#endif
208#endif
225
209
226-- concatMapWith
210-- concatMapWith
227
211
228−#ifdef USE_STREAMK
229{-# INLINE concatMapWithSerial #-}
212{-# INLINE concatMapWithSerial #-}
230concatMapWithSerial :: Int -> Int -> Int -> IO ()
213concatMapWithSerial :: Int -> Int -> Int -> IO ()
231−concatMapWithSerial = concatStreamsWith Common.append
214+concatMapWithSerial = concatStreamsWith S.serial
232
215
233#ifdef INSPECTION
216#ifdef INSPECTION
234inspect $ hasNoTypeClasses 'concatMapWithSerial
217inspect $ hasNoTypeClasses 'concatMapWithSerial
235inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
218inspect $ 'concatMapWithSerial `hasNoType` ''SPEC
236#endif
219#endif
237
220
238−{-
239{-# INLINE concatMapWithAppend #-}
221{-# INLINE concatMapWithAppend #-}
240concatMapWithAppend :: Int -> Int -> Int -> IO ()
222concatMapWithAppend :: Int -> Int -> Int -> IO ()
241−concatMapWithAppend = concatStreamsWith Common.append2
223+concatMapWithAppend = concatStreamsWith Internal.append
242
224
243#ifdef INSPECTION
225#ifdef INSPECTION
244inspect $ hasNoTypeClasses 'concatMapWithAppend
226inspect $ hasNoTypeClasses 'concatMapWithAppend
245inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
227inspect $ 'concatMapWithAppend `hasNoType` ''SPEC
246#endif
228#endif
247−-}
248
229
249−-- mergeMapWith
230+-- concatPairWith
250
231
251−{-# INLINE mergeMapWithSerial #-}
232+{-# INLINE concatPairWithSerial #-}
252−mergeMapWithSerial :: Int -> Int -> Int -> IO ()
233+concatPairWithSerial :: Int -> Int -> Int -> IO ()
253−mergeMapWithSerial = mergeMapWith Common.append
234+concatPairWithSerial = concatPairsWith Internal.serial
254
235
255−{-
236+{-# INLINE concatPairWithAppend #-}
256−{-# INLINE mergeMapWithAppend #-}
237+concatPairWithAppend :: Int -> Int -> Int -> IO ()
257−mergeMapWithAppend :: Int -> Int -> Int -> IO ()
238+concatPairWithAppend = concatPairsWith Internal.append
258−mergeMapWithAppend = mergeMapWith Common.append2
259−-}
260−#endif
261
239
262-- unfoldMany
240-- unfoldMany
263
241
@@ -266,11 +244,10 @@ mergeMapWithAppend = mergeMapWith Common.append2
266{-# INLINE unfoldManyRepl #-}
244{-# INLINE unfoldManyRepl #-}
267unfoldManyRepl :: Int -> Int -> Int -> IO ()
245unfoldManyRepl :: Int -> Int -> Int -> IO ()
268unfoldManyRepl outer inner n =
246unfoldManyRepl outer inner n =
269− drain
247+ S.drain
270 $ S.unfoldMany
248 $ S.unfoldMany
271− UF.replicateM
249+ (UF.lmap return (UF.replicateM inner))
272− (fmap ((inner,) . return) (sourceUnfoldrM outer n))
250+ (sourceUnfoldrM outer n)
273−
274
251
275#ifdef INSPECTION
252#ifdef INSPECTION
276inspect $ hasNoTypeClasses 'unfoldManyRepl
253inspect $ hasNoTypeClasses 'unfoldManyRepl
@@ -288,6 +265,10 @@ o_1_space_concat value = sqrtVal `seq`
288 , benchIOSrc1 "concatMapPure (1 of n)"
265 , benchIOSrc1 "concatMapPure (1 of n)"
289 (concatMapPure 1 value)
266 (concatMapPure 1 value)
290
267
268+ -- This is for comparison with foldMapWith
269+ , benchIOSrc fromSerial "concatMapId (n of 1) (fromFoldable)"
270+ (S.concatMap id . sourceConcatMapId value)
271+
291 , benchIOSrc1 "concatMap (n of 1)"
272 , benchIOSrc1 "concatMap (n of 1)"
292 (concatMap value 1)
273 (concatMap value 1)
293 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
274 , benchIOSrc1 "concatMap (sqrt n of sqrt n)"
@@ -295,25 +276,16 @@ o_1_space_concat value = sqrtVal `seq`
295 , benchIOSrc1 "concatMap (1 of n)"
276 , benchIOSrc1 "concatMap (1 of n)"
296 (concatMap 1 value)
277 (concatMap 1 value)
297
278
298−#ifndef USE_STREAMK
299− -- This is for comparison with foldMapWith
300− , benchIOSrc "concatMapId (n of 1) (fromFoldable)"
301− (S.concatMap id . sourceConcatMapId value)
302−
303 , benchIOSrc1 "concatMapM (n of 1)"
279 , benchIOSrc1 "concatMapM (n of 1)"
304 (concatMapM value 1)
280 (concatMapM value 1)
305 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
281 , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"
306 (concatMapM sqrtVal sqrtVal)
282 (concatMapM sqrtVal sqrtVal)
307 , benchIOSrc1 "concatMapM (1 of n)"
283 , benchIOSrc1 "concatMapM (1 of n)"
308 (concatMapM 1 value)
284 (concatMapM 1 value)
309−#endif
310
285
311−#ifdef USE_STREAMK
312− {-
313 -- This is for comparison with foldMapWith
286 -- This is for comparison with foldMapWith
314− , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"
287+ , benchIOSrc fromSerial "concatMapWithId (n of 1) (fromFoldable)"
315− (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)
288+ (S.concatMapWith serial id . sourceConcatMapId value)
316− -}
317
289
318 , benchIOSrc1 "concatMapWith (n of 1)"
290 , benchIOSrc1 "concatMapWith (n of 1)"
319 (concatMapWithSerial value 1)
291 (concatMapWithSerial value 1)
@@ -322,12 +294,9 @@ o_1_space_concat value = sqrtVal `seq`
322 , benchIOSrc1 "concatMapWith (1 of n)"
294 , benchIOSrc1 "concatMapWith (1 of n)"
323 (concatMapWithSerial 1 value)
295 (concatMapWithSerial 1 value)
324
296
325− {-
326 -- quadratic with number of outer streams
297 -- quadratic with number of outer streams
327 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
298 , benchIOSrc1 "concatMapWithAppend (2 of n/2)"
328 (concatMapWithAppend 2 (value `div` 2))
299 (concatMapWithAppend 2 (value `div` 2))
329− -}
330−#endif
331
300
332 -- concatMap vs unfoldMany
301 -- concatMap vs unfoldMany
333 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
302 , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"
@@ -341,35 +310,31 @@ o_1_space_concat value = sqrtVal `seq`
341
310
342 sqrtVal = round $ sqrt (fromIntegral value :: Double)
311 sqrtVal = round $ sqrt (fromIntegral value :: Double)
343
312
344−#ifdef USE_STREAMK
345−o_n_space_merge :: Int -> [Benchmark]
313+o_n_space_concat :: Int -> [Benchmark]
346−o_n_space_merge value = sqrtVal `seq`
314+o_n_space_concat value = sqrtVal `seq`
347 [ bgroup "concat"
315 [ bgroup "concat"
348 [
316 [
349− -------------------mergeMapWith-----------------
317+ -------------------concatPairsWith-----------------
350
318
351 -- Use large number of streams to check scalability
319 -- Use large number of streams to check scalability
352
320
353− benchIOSrc1 "mergeMapWithSerial (n of 1)"
321+ benchIOSrc1 "concatPairWithSerial (n of 1)"
354− (mergeMapWithSerial value 1)
322+ (concatPairWithSerial value 1)
355− , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"
323+ , benchIOSrc1 "concatPairWithSerial (sqrtVal of sqrtVal)"
356− (mergeMapWithSerial sqrtVal sqrtVal)
324+ (concatPairWithSerial sqrtVal sqrtVal)
357− , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"
325+ , benchIOSrc1 "concatPairWithSerial (2 of n/2)"
358− (mergeMapWithSerial 2 (value `div` 2))
326+ (concatPairWithSerial 2 (value `div` 2))
359−
327+
360− {-
361− , benchIOSrc1 "mergeMapWithAppend (n of 1)"
328+ , benchIOSrc1 "concatPairWithAppend (n of 1)"
362− (mergeMapWithAppend value 1)
329+ (concatPairWithAppend value 1)
363− , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"
330+ , benchIOSrc1 "concatPairWithAppend (sqrtVal of sqrtVal)"
364− (mergeMapWithAppend sqrtVal sqrtVal)
331+ (concatPairWithAppend sqrtVal sqrtVal)
365− -}
366 ]
332 ]
367 ]
333 ]
368
334
369 where
335 where
370
336
371 sqrtVal = round $ sqrt (fromIntegral value :: Double)
337 sqrtVal = round $ sqrt (fromIntegral value :: Double)
372−#endif
373
338
374-------------------------------------------------------------------------------
339-------------------------------------------------------------------------------
375-- Applicative
340-- Applicative
@@ -378,28 +343,26 @@ o_n_space_merge value = sqrtVal `seq`
378o_1_space_applicative :: Int -> [Benchmark]
343o_1_space_applicative :: Int -> [Benchmark]
379o_1_space_applicative value =
344o_1_space_applicative value =
380 [ bgroup "Applicative"
345 [ bgroup "Applicative"
381− [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value
346+ [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value fromSerial
382− , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value
347+ , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value fromSerial
383− , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value
348+ , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value fromSerial
384− , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value
349+ , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value fromSerial
385 ]
350 ]
386 ]
351 ]
387
352
388−#ifdef USE_STREAMK
389o_n_space_applicative :: Int -> [Benchmark]
353o_n_space_applicative :: Int -> [Benchmark]
390o_n_space_applicative value =
354o_n_space_applicative value =
391− [ bgroup "iterated"
355+ [ bgroup "Applicative"
392− [ benchIOSrc "(*>) (n times)" $
356+ [ benchIOSrc fromSerial "(*>) (n times)" $
393 iterateSingleton ((*>) . pure) value
357 iterateSingleton ((*>) . pure) value
394− , benchIOSrc "(<*) (n times)" $
358+ , benchIOSrc fromSerial "(<*) (n times)" $
395 iterateSingleton (\x xs -> xs <* pure x) value
359 iterateSingleton (\x xs -> xs <* pure x) value
396− , benchIOSrc "(<*>) (n times)" $
360+ , benchIOSrc fromSerial "(<*>) (n times)" $
397 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
361 iterateSingleton (\x xs -> pure (+ x) <*> xs) value
398− , benchIOSrc "liftA2 (n times)" $
362+ , benchIOSrc fromSerial "liftA2 (n times)" $
399 iterateSingleton (AP.liftA2 (+) . pure) value
363 iterateSingleton (AP.liftA2 (+) . pure) value
400 ]
364 ]
401 ]
365 ]
402−#endif
403
366
404-------------------------------------------------------------------------------
367-------------------------------------------------------------------------------
405-- Monad
368-- Monad
@@ -408,61 +371,45 @@ o_n_space_applicative value =
408o_1_space_monad :: Int -> [Benchmark]
371o_1_space_monad :: Int -> [Benchmark]
409o_1_space_monad value =
372o_1_space_monad value =
410 [ bgroup "Monad"
373 [ bgroup "Monad"
411− [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value
374+ [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value fromSerial
412− , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value
375+ , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value fromSerial
413 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
376 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $
414− filterAllOutM value
377+ filterAllOutM value fromSerial
415 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
378 , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $
416− filterAllInM value
379+ filterAllInM value fromSerial
417 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
380 , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $
418− filterSome value
381+ filterSome value fromSerial
419 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
382 , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $
420− breakAfterSome value
383+ breakAfterSome value fromSerial
421 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
384 , benchIO "(>>=) (cubert n x cubert n x cubert n)" $
422− toNullM3 value
385+ toNullM3 value fromSerial
423 ]
386 ]
424 ]
387 ]
425
388
426−#ifdef USE_STREAMK
427-- This is a good benchmark but inefficient way to compute primes. As we see a
389-- This is a good benchmark but inefficient way to compute primes. As we see a
428-- new prime we keep appending a division filter for all the future numbers.
390-- new prime we keep appending a division filter for all the future numbers.
429{-# INLINE sieve #-}
391{-# INLINE sieve #-}
430−sieve :: Monad m => StreamK m Int -> StreamK m Int
392+sieve :: Monad m => SerialT m Int -> SerialT m Int
431−sieve s = StreamK.concatEffect $ do
393+sieve s = do
432− r <- StreamK.uncons s
394+ r <- lift $ S.uncons s
433 case r of
395 case r of
434 Just (prime, rest) ->
396 Just (prime, rest) ->
435− -- XXX Use K.filter or rewrite to K.filter
436− let f = S.filter (\n -> n `mod` prime /= 0)
397+ prime `S.cons` sieve (S.filter (\n -> n `mod` prime /= 0) rest)
437− in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest)
438− Nothing -> pure StreamK.nil
398+ Nothing -> S.nil
439−
440−o_n_space_iterated :: Int -> [Benchmark]
441−o_n_space_iterated value =
442− [ bgroup "iterated"
443− [
444− benchIO "concatEffect prime sieve (n/4)"
445− (\n ->
446− S.fold Fold.sum
447− $ toStream
448− $ sieve
449− $ fromStream
450− $ S.enumerateFromTo 2 (value `div` 4 + n))
451− , benchIOSrc "(>>) (n times)" $
452− iterateSingleton ((>>) . pure) value
453− , benchIOSrc "(>>=) (n times)" $
454− iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
455− ]
456− ]
457−#endif
458
399
459o_n_space_monad :: Int -> [Benchmark]
400o_n_space_monad :: Int -> [Benchmark]
460o_n_space_monad value =
401o_n_space_monad value =
461 [ bgroup "Monad"
402 [ bgroup "Monad"
403+ [ benchIOSrc fromSerial "(>>) (n times)" $
404+ iterateSingleton ((>>) . pure) value
405+ , benchIOSrc fromSerial "(>>=) (n times)" $
406+ iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value
462− [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
407+ , benchIO "(>>=) (sqrt n x sqrt n) (toList)" $
463− toListM value
408+ toListM value fromSerial
464 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
409 , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $
465− toListSome value
410+ toListSome value fromSerial
411+ , benchIO "naive prime sieve (n/4)"
412+ (\n -> S.sum $ sieve $ S.enumerateFromTo 2 (value `div` 4 + n))
466 ]
413 ]
467 ]
414 ]
468
415
@@ -470,27 +417,26 @@ o_n_space_monad value =
470-- Joining
417-- Joining
471-------------------------------------------------------------------------------
418-------------------------------------------------------------------------------
472
419
473−{-
474toKv :: Int -> (Int, Int)
420toKv :: Int -> (Int, Int)
475toKv p = (p, p)
421toKv p = (p, p)
476
422
477{-# INLINE joinWith #-}
423{-# INLINE joinWith #-}
478−joinWith :: Common.MonadAsync m =>
424+joinWith :: (S.MonadAsync m) =>
479− ((Int -> Int -> Bool) -> Stream m Int -> Stream m Int -> Stream m b)
425+ ((Int -> Int -> Bool) -> SerialT m Int -> SerialT m Int -> SerialT m b)
480 -> Int
426 -> Int
481 -> Int
427 -> Int
482 -> m ()
428 -> m ()
483joinWith j val i =
429joinWith j val i =
484− drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
430+ S.drain $ j (==) (sourceUnfoldrM val i) (sourceUnfoldrM val (val `div` 2))
485
431
486{-# INLINE joinMapWith #-}
432{-# INLINE joinMapWith #-}
487−joinMapWith :: Common.MonadAsync m =>
433+joinMapWith :: (S.MonadAsync m) =>
488− (Stream m (Int, Int) -> Stream m (Int, Int) -> Stream m b)
434+ (SerialT m (Int, Int) -> SerialT m (Int, Int) -> SerialT m b)
489 -> Int
435 -> Int
490 -> Int
436 -> Int
491 -> m ()
437 -> m ()
492joinMapWith j val i =
438joinMapWith j val i =
493− drain
439+ S.drain
494 $ j
440 $ j
495 (fmap toKv (sourceUnfoldrM val i))
441 (fmap toKv (sourceUnfoldrM val i))
496 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
442 (fmap toKv (sourceUnfoldrM val (val `div` 2)))
@@ -499,22 +445,22 @@ o_n_heap_buffering :: Int -> [Benchmark]
499o_n_heap_buffering value =
445o_n_heap_buffering value =
500 [ bgroup "buffered"
446 [ bgroup "buffered"
501 [
447 [
502− benchIOSrc1 "joinInnerGeneric (sqrtVal)"
448+ benchIOSrc1 "joinInner (sqrtVal)"
503− $ joinWith S.joinInnerGeneric sqrtVal
449+ $ joinWith Internal.joinInner sqrtVal
504− , benchIOSrc1 "joinInner"
450+ , benchIOSrc1 "joinInnerMap"
505− $ joinMapWith S.joinInner halfVal
451+ $ joinMapWith Internal.joinInnerMap halfVal
506− , benchIOSrc1 "joinLeftGeneric (sqrtVal)"
452+ , benchIOSrc1 "joinLeft (sqrtVal)"
507− $ joinWith S.joinLeftGeneric sqrtVal
453+ $ joinWith Internal.joinLeft sqrtVal
508− , benchIOSrc1 "joinLeft "
454+ , benchIOSrc1 "joinLeftMap "
509− $ joinMapWith S.joinLeft halfVal
455+ $ joinMapWith Internal.joinLeftMap halfVal
510− , benchIOSrc1 "joinOuterGeneric (sqrtVal)"
456+ , benchIOSrc1 "joinOuter (sqrtVal)"
511− $ joinWith S.joinOuterGeneric sqrtVal
457+ $ joinWith Internal.joinOuter sqrtVal
512− , benchIOSrc1 "joinOuter"
458+ , benchIOSrc1 "joinOuterMap"
513− $ joinMapWith S.joinOuter halfVal
459+ $ joinMapWith Internal.joinOuterMap halfVal
514− , benchIOSrc1 "filterInStreamGenericBy (sqrtVal)"
460+ , benchIOSrc1 "intersectBy (sqrtVal)"
515− $ joinWith S.filterInStreamGenericBy sqrtVal
461+ $ joinWith Internal.intersectBy sqrtVal
516− , benchIOSrc1 "filterInStreamAscBy"
462+ , benchIOSrc1 "intersectBySorted"
517− $ joinMapWith (S.filterInStreamAscBy compare) halfVal
463+ $ joinMapWith (Internal.intersectBySorted compare) halfVal
518 ]
464 ]
519 ]
465 ]
520
466
@@ -522,7 +468,6 @@ o_n_heap_buffering value =
522
468
523 halfVal = value `div` 2
469 halfVal = value `div` 2
524 sqrtVal = round $ sqrt (fromIntegral value :: Double)
470 sqrtVal = round $ sqrt (fromIntegral value :: Double)
525−-}
526
471
527-------------------------------------------------------------------------------
472-------------------------------------------------------------------------------
528-- Main
473-- Main
@@ -531,33 +476,27 @@ o_n_heap_buffering value =
531-- In addition to gauge options, the number of elements in the stream can be
476-- In addition to gauge options, the number of elements in the stream can be
532-- passed using the --stream-size option.
477-- passed using the --stream-size option.
533--
478--
534−{-# ANN benchmarks "HLint: ignore" #-}
535benchmarks :: String -> Int -> [Benchmark]
479benchmarks :: String -> Int -> [Benchmark]
536benchmarks moduleName size =
480benchmarks moduleName size =
537 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
481 [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat
538 [
482 [
539 -- multi-stream
483 -- multi-stream
540 o_1_space_joining size
484 o_1_space_joining size
541−#ifdef USE_PRELUDE
542 , o_1_space_concatFoldable size
485 , o_1_space_concatFoldable size
543−#endif
544 , o_1_space_concat size
486 , o_1_space_concat size
487+
545 , o_1_space_applicative size
488 , o_1_space_applicative size
546 , o_1_space_monad size
489 , o_1_space_monad size
490+
547 ]
491 ]
548 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
492 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
549 [
493 [
550 -- multi-stream
494 -- multi-stream
495+ o_n_space_applicative size
551− o_n_space_monad size
496+ , o_n_space_monad size
552−#ifdef USE_STREAMK
497+ , o_n_space_concat size
553− , o_n_space_merge size
554− , o_n_space_iterated size
555− , o_n_space_applicative size
556−#endif
557 ]
498 ]
558− {-
559 , bgroup (o_n_heap_prefix moduleName) $
499 , bgroup (o_n_heap_prefix moduleName) $
560 -- multi-stream
500 -- multi-stream
561 o_n_heap_buffering size
501 o_n_heap_buffering size
562− -}
563 ]
502 ]
benchmark/Streamly/Benchmark/Data/Stream/Split.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Split.hsrenamed+12−25
@@ -1,7 +1,5 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4−-- Module : Stream.Split
2+-- Module : Streamly.Benchmark.Prelude.Serial.Split
5-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
6-- License : BSD-3-Clause
4-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
5-- Maintainer : streamly@composewell.com
@@ -20,14 +18,14 @@
20{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
21#endif
19#endif
22
20
23−module Stream.Split (benchmarks) where
21+module Serial.Split (benchmarks) where
24
22
25import Data.Char (ord)
23import Data.Char (ord)
26import Data.Word (Word8)
24import Data.Word (Word8)
27import System.IO (Handle)
25import System.IO (Handle)
28
26
29import qualified Streamly.FileSystem.Handle as FH
27import qualified Streamly.FileSystem.Handle as FH
30−import qualified Streamly.Internal.Data.Array as A
28+import qualified Streamly.Internal.Data.Array.Foreign as A
31import qualified Streamly.Internal.Data.Fold as FL
29import qualified Streamly.Internal.Data.Fold as FL
32import qualified Streamly.Internal.Data.Parser as PR
30import qualified Streamly.Internal.Data.Parser as PR
33import qualified Streamly.Internal.Data.Stream.IsStream as IP
31import qualified Streamly.Internal.Data.Stream.IsStream as IP
@@ -35,15 +33,15 @@ import qualified Streamly.Internal.FileSystem.Handle as IFH
35import qualified Streamly.Internal.Unicode.Stream as IUS
33import qualified Streamly.Internal.Unicode.Stream as IUS
36import qualified Streamly.Prelude as S
34import qualified Streamly.Prelude as S
37
35
38−import Test.Tasty.Bench hiding (env)
36+import Gauge hiding (env)
39import Prelude hiding (last, length)
37import Prelude hiding (last, length)
40import Streamly.Benchmark.Common
38import Streamly.Benchmark.Common
41import Streamly.Benchmark.Common.Handle
39import Streamly.Benchmark.Common.Handle
42
40
43#ifdef INSPECTION
41#ifdef INSPECTION
44−import Streamly.Internal.Data.Stream (Step(..))
42+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
45
43
46−import qualified Streamly.Internal.Data.MutArray as MA
44+import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
47import qualified Streamly.Internal.Data.Unfold as IUF
45import qualified Streamly.Internal.Data.Unfold as IUF
48
46
49import Test.Inspection
47import Test.Inspection
@@ -69,7 +67,7 @@ splitOn inh =
69inspect $ hasNoTypeClasses 'splitOn
67inspect $ hasNoTypeClasses 'splitOn
70inspect $ 'splitOn `hasNoType` ''Step
68inspect $ 'splitOn `hasNoType` ''Step
71inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
69inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
72−inspect $ 'splitOn `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
70+inspect $ 'splitOn `hasNoType` ''MA.ReadUState -- FH.read/A.read
73#endif
71#endif
74
72
75-- | Split suffix on line feed.
73-- | Split suffix on line feed.
@@ -82,7 +80,7 @@ splitOnSuffix inh =
82inspect $ hasNoTypeClasses 'splitOnSuffix
80inspect $ hasNoTypeClasses 'splitOnSuffix
83inspect $ 'splitOnSuffix `hasNoType` ''Step
81inspect $ 'splitOnSuffix `hasNoType` ''Step
84inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
82inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
85−inspect $ 'splitOnSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
83+inspect $ 'splitOnSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
86#endif
84#endif
87
85
88-- | Split suffix with line feed.
86-- | Split suffix with line feed.
@@ -95,7 +93,7 @@ splitWithSuffix inh =
95inspect $ hasNoTypeClasses 'splitWithSuffix
93inspect $ hasNoTypeClasses 'splitWithSuffix
96inspect $ 'splitWithSuffix `hasNoType` ''Step
94inspect $ 'splitWithSuffix `hasNoType` ''Step
97inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
95inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
98−inspect $ 'splitWithSuffix `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
96+inspect $ 'splitWithSuffix `hasNoType` ''MA.ReadUState -- FH.read/A.read
99#endif
97#endif
100
98
101-- | Split on line feed.
99-- | Split on line feed.
@@ -126,7 +124,7 @@ wordsBy inh =
126inspect $ hasNoTypeClasses 'wordsBy
124inspect $ hasNoTypeClasses 'wordsBy
127inspect $ 'wordsBy `hasNoType` ''Step
125inspect $ 'wordsBy `hasNoType` ''Step
128inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
126inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many
129−inspect $ 'wordsBy `hasNoType` ''MA.ArrayUnsafe -- FH.read/A.read
127+inspect $ 'wordsBy `hasNoType` ''MA.ReadUState -- FH.read/A.read
130#endif
128#endif
131
129
132-- | Split on a word8 sequence.
130-- | Split on a word8 sequence.
@@ -143,7 +141,7 @@ splitOnSeq str inh =
143-- | Split on a word8 sequence.
141-- | Split on a word8 sequence.
144splitOnSeq100k :: Handle -> IO Int
142splitOnSeq100k :: Handle -> IO Int
145splitOnSeq100k inh = do
143splitOnSeq100k inh = do
146− arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123
144+ arr <- A.fromStream $ S.replicate 100000 123
147 (S.length $ IP.splitOnSeq arr FL.drain
145 (S.length $ IP.splitOnSeq arr FL.drain
148 $ S.unfold FH.read inh) -- >>= print
146 $ S.unfold FH.read inh) -- >>= print
149
147
@@ -158,12 +156,6 @@ splitOnSuffixSeq str inh =
158-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
156-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step
159#endif
157#endif
160
158
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−
167o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
159o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]
168o_1_space_reduce_read_split env =
160o_1_space_reduce_read_split env =
169 [ bgroup "split"
161 [ bgroup "split"
@@ -193,8 +185,6 @@ o_1_space_reduce_read_split env =
193 splitOnSeq "\r\n" inh
185 splitOnSeq "\r\n" inh
194 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
186 , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
195 splitOnSuffixSeq "\r\n" inh
187 splitOnSuffixSeq "\r\n" inh
196− , mkBench "S.splitWithSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->
197− splitWithSuffixSeq "\r\n" inh
198 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
188 , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->
199 splitOnSeq "aa" inh
189 splitOnSeq "aa" inh
200 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
190 , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->
@@ -211,8 +201,6 @@ o_1_space_reduce_read_split env =
211 env $ \inh _ -> splitOnSeq100k inh
201 env $ \inh _ -> splitOnSeq100k inh
212 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
202 , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
213 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
203 env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
214− , mkBenchSmall "S.splitWithSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"
215− env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh
216 ]
204 ]
217 ]
205 ]
218
206
@@ -220,9 +208,8 @@ o_1_space_reduce_read_split env =
220splitOnSeqUtf8 :: String -> Handle -> IO Int
208splitOnSeqUtf8 :: String -> Handle -> IO Int
221splitOnSeqUtf8 str inh =
209splitOnSeqUtf8 str inh =
222 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
210 (S.length $ IP.splitOnSeq (A.fromList str) FL.drain
223− $ IP.fromStream
224 $ IUS.decodeUtf8Arrays
211 $ IUS.decodeUtf8Arrays
225− $ IFH.readChunks inh) -- >>= print
212+ $ IFH.toChunks inh) -- >>= print
226
213
227o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
214o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]
228o_1_space_reduce_toChunks_split env =
215o_1_space_reduce_toChunks_split env =
benchmark/Streamly/Benchmark/Data/Stream/Transform.hs → benchmark/Streamly/Benchmark/Prelude/Serial/Transformation.hsrenamed+164−284
@@ -1,20 +1,14 @@
1-- |
1-- |
2−-- Module : Stream.Transform
2+-- Module : Serial.Transformation
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 #-}
10{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
12
11
13−{-# OPTIONS_GHC -Wno-orphans #-}
14−#ifdef USE_PRELUDE
15−{-# OPTIONS_GHC -Wno-deprecations #-}
16−#endif
17−
18#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
19#undef INSPECTION
13#undef INSPECTION
20#endif
14#endif
@@ -24,48 +18,30 @@
24{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
25#endif
19#endif
26
20
27−module Stream.Transform (benchmarks) where
21+module Serial.Transformation (benchmarks) where
28
22
23+import Control.DeepSeq (NFData(..))
29import Control.Monad.IO.Class (MonadIO(..))
24import Control.Monad.IO.Class (MonadIO(..))
30−
25+import Data.Functor.Identity (Identity)
26+import Data.IORef (newIORef, modifyIORef')
31import System.Random (randomRIO)
27import System.Random (randomRIO)
32
28
33−import qualified Streamly.Internal.Data.Fold as FL
29+#ifdef INSPECTION
30+import Test.Inspection
31+#endif
34
32
35−import qualified Stream.Common as Common
33+import qualified Streamly.Prelude as S
34+import qualified Streamly.Internal.Data.Stream.IsStream as Internal
35+import qualified Streamly.Internal.Data.Fold as FL
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(..))
54import qualified Prelude
37import qualified Prelude
55−import qualified Streamly.Internal.Data.Fold as Fold
56−import Streamly.Internal.Data.StreamK (StreamK)
57−import qualified Streamly.Internal.Data.StreamK as StreamK
58−#endif
59−#endif
60
38
61−import Test.Tasty.Bench
39+import Gauge
62−import Stream.Common hiding (scanl')
40+import Streamly.Prelude (SerialT, fromSerial, MonadAsync)
63import Streamly.Benchmark.Common
41import Streamly.Benchmark.Common
42+import Streamly.Benchmark.Prelude
43+import Streamly.Internal.Data.Time.Units
64−import Prelude hiding (sequence, mapM)
44+import Prelude hiding (sequence, mapM, fmap)
65−
66−#ifdef USE_PRELUDE
67−type Stream = Stream.SerialT
68−#endif
69
45
70-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
71-- Pipelines (stream-to-stream transformations)
47-- Pipelines (stream-to-stream transformations)
@@ -79,36 +55,28 @@ type Stream = Stream.SerialT
79-- Traversable Instance
55-- Traversable Instance
80-------------------------------------------------------------------------------
56-------------------------------------------------------------------------------
81
57
82−#ifdef USE_STREAMK
83{-# INLINE traversableTraverse #-}
58{-# INLINE traversableTraverse #-}
84−traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)
59+traversableTraverse :: SerialT Identity Int -> IO (SerialT Identity Int)
85traversableTraverse = traverse return
60traversableTraverse = traverse return
86
61
87{-# INLINE traversableSequenceA #-}
62{-# INLINE traversableSequenceA #-}
88−traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)
63+traversableSequenceA :: SerialT Identity Int -> IO (SerialT Identity Int)
89traversableSequenceA = sequenceA . Prelude.fmap return
64traversableSequenceA = sequenceA . Prelude.fmap return
90
65
91{-# INLINE traversableMapM #-}
66{-# INLINE traversableMapM #-}
92−traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)
67+traversableMapM :: SerialT Identity Int -> IO (SerialT Identity Int)
93traversableMapM = Prelude.mapM return
68traversableMapM = Prelude.mapM return
94
69
95{-# INLINE traversableSequence #-}
70{-# INLINE traversableSequence #-}
96−traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)
71+traversableSequence :: SerialT Identity Int -> IO (SerialT Identity Int)
97traversableSequence = Prelude.sequence . Prelude.fmap return
72traversableSequence = Prelude.sequence . Prelude.fmap return
98
73
99{-# INLINE benchPureSinkIO #-}
74{-# INLINE benchPureSinkIO #-}
100benchPureSinkIO
75benchPureSinkIO
101 :: NFData b
76 :: NFData b
102− => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark
77+ => Int -> String -> (SerialT Identity Int -> IO b) -> Benchmark
103benchPureSinkIO value name f =
78benchPureSinkIO value name f =
104− bench name
105− $ nfIO $ randomRIO (1, 1) >>= f . fromStream . sourceUnfoldr value
79+ bench name $ nfIO $ randomRIO (1, 1) >>= f . sourceUnfoldr value
106−
107−instance NFData a => NFData (StreamK Identity a) where
108− {-# INLINE rnf #-}
109− rnf xs =
110− runIdentity
111− $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (toStream xs)
112
80
113o_n_space_traversable :: Int -> [Benchmark]
81o_n_space_traversable :: Int -> [Benchmark]
114o_n_space_traversable value =
82o_n_space_traversable value =
@@ -121,124 +89,113 @@ o_n_space_traversable value =
121 , benchPureSinkIO value "sequence" traversableSequence
89 , benchPureSinkIO value "sequence" traversableSequence
122 ]
90 ]
123 ]
91 ]
124−#endif
125
92
126-------------------------------------------------------------------------------
93-------------------------------------------------------------------------------
127-- maps and scans
94-- maps and scans
128-------------------------------------------------------------------------------
95-------------------------------------------------------------------------------
129
96
130−#ifdef USE_PRELUDE
131{-# INLINE scanl' #-}
97{-# INLINE scanl' #-}
132−scanl' :: MonadIO m => Int -> Stream m Int -> m ()
98+scanl' :: MonadIO m => Int -> SerialT m Int -> m ()
133−scanl' n = composeN n $ Stream.scanl' (+) 0
99+scanl' n = composeN n $ S.scanl' (+) 0
134
100
135{-# INLINE scanlM' #-}
101{-# INLINE scanlM' #-}
136−scanlM' :: MonadIO m => Int -> Stream m Int -> m ()
102+scanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
137−scanlM' n = composeN n $ Stream.scanlM' (\b a -> return $ b + a) (return 0)
103+scanlM' n = composeN n $ S.scanlM' (\b a -> return $ b + a) (return 0)
138
104
139{-# INLINE scanl1' #-}
105{-# INLINE scanl1' #-}
140−scanl1' :: MonadIO m => Int -> Stream m Int -> m ()
106+scanl1' :: MonadIO m => Int -> SerialT m Int -> m ()
141−scanl1' n = composeN n $ Stream.scanl1' (+)
107+scanl1' n = composeN n $ S.scanl1' (+)
142
108
143{-# INLINE scanl1M' #-}
109{-# INLINE scanl1M' #-}
144−scanl1M' :: MonadIO m => Int -> Stream m Int -> m ()
110+scanl1M' :: MonadIO m => Int -> SerialT m Int -> m ()
145−scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a)
111+scanl1M' n = composeN n $ S.scanl1M' (\b a -> return $ b + a)
146−#endif
147
112
148{-# INLINE scan #-}
113{-# INLINE scan #-}
149−scan :: MonadIO m => Int -> Stream m Int -> m ()
114+scan :: MonadIO m => Int -> SerialT m Int -> m ()
150−scan n = composeN n $ Stream.scan FL.sum
115+scan n = composeN n $ S.scan FL.sum
151
116
152−#ifdef USE_PRELUDE
153{-# INLINE postscanl' #-}
117{-# INLINE postscanl' #-}
154−postscanl' :: MonadIO m => Int -> Stream m Int -> m ()
118+postscanl' :: MonadIO m => Int -> SerialT m Int -> m ()
155−postscanl' n = composeN n $ Stream.postscanl' (+) 0
119+postscanl' n = composeN n $ S.postscanl' (+) 0
156
120
157{-# INLINE postscanlM' #-}
121{-# INLINE postscanlM' #-}
158−postscanlM' :: MonadIO m => Int -> Stream m Int -> m ()
122+postscanlM' :: MonadIO m => Int -> SerialT m Int -> m ()
159−postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0)
123+postscanlM' n = composeN n $ S.postscanlM' (\b a -> return $ b + a) (return 0)
160−#endif
161
124
162{-# INLINE postscan #-}
125{-# INLINE postscan #-}
163−postscan :: MonadIO m => Int -> Stream m Int -> m ()
126+postscan :: MonadIO m => Int -> SerialT m Int -> m ()
164−postscan n = composeN n $ Stream.postscan FL.sum
127+postscan n = composeN n $ S.postscan FL.sum
165
128
166{-# INLINE sequence #-}
129{-# INLINE sequence #-}
167−sequence :: MonadAsync m => Stream m (m Int) -> m ()
130+sequence ::
131+ (S.IsStream t, S.MonadAsync m)
132+ => (t m Int -> S.SerialT m Int)
133+ -> t m (m Int)
134+ -> m ()
168−sequence = Common.drain . Stream.sequence
135+sequence t = S.drain . t . S.sequence
169
136
170{-# INLINE tap #-}
137{-# INLINE tap #-}
171−tap :: MonadIO m => Int -> Stream m Int -> m ()
138+tap :: MonadIO m => Int -> SerialT m Int -> m ()
172−tap n = composeN n $ Stream.tap FL.sum
139+tap n = composeN n $ S.tap FL.sum
140+
141+{-# INLINE tapRate #-}
142+tapRate :: Int -> SerialT IO Int -> IO ()
143+tapRate n str = do
144+ cref <- newIORef 0
145+ composeN n (Internal.tapRate 1 (\c -> modifyIORef' cref (c +))) str
173
146
174−#ifdef USE_PRELUDE
175{-# INLINE pollCounts #-}
147{-# INLINE pollCounts #-}
176−pollCounts :: Int -> Stream IO Int -> IO ()
148+pollCounts :: Int -> SerialT IO Int -> IO ()
177pollCounts n =
149pollCounts n =
178− composeN n (Stream.pollCounts (const True) f)
150+ composeN n (Internal.pollCounts (const True) f FL.drain)
179
151
180 where
152 where
181
153
182− f = Stream.drain . Stream.rollingMap2 (-) . Stream.delayPost 1
154+ f = Internal.rollingMap (-) . Internal.delayPost 1
183
155
184{-# INLINE timestamped #-}
156{-# INLINE timestamped #-}
185−timestamped :: (MonadAsync m) => Stream m Int -> m ()
157+timestamped :: (S.MonadAsync m) => SerialT m Int -> m ()
186−timestamped = Stream.drain . Stream.timestamped
158+timestamped = S.drain . Internal.timestamped
187−#endif
188
159
189−#ifdef USE_STREAMK
190{-# INLINE foldrS #-}
160{-# INLINE foldrS #-}
191−foldrS :: MonadIO m => Int -> Stream m Int -> m ()
161+foldrS :: MonadIO m => Int -> SerialT m Int -> m ()
192−foldrS n =
193− composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream)
162+foldrS n = composeN n $ Internal.foldrS S.cons S.nil
194
163
195{-# INLINE foldrSMap #-}
164{-# INLINE foldrSMap #-}
196−foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()
165+foldrSMap :: MonadIO m => Int -> SerialT m Int -> m ()
197−foldrSMap n =
198− composeN n
199− ( toStream
200− . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil
166+foldrSMap n = composeN n $ Internal.foldrS (\x xs -> x + 1 `S.cons` xs) S.nil
201− . fromStream
202− )
203−#endif
204
167
205−{-
206{-# INLINE foldrT #-}
168{-# INLINE foldrT #-}
207−foldrT :: MonadIO m => Int -> Stream m Int -> m ()
169+foldrT :: MonadIO m => Int -> SerialT m Int -> m ()
208−foldrT n = composeN n (unCrossStream . Stream.foldrT cns (CrossStream Stream.nil))
170+foldrT n = composeN n $ Internal.foldrT S.cons S.nil
209−
210− where cns x (CrossStream xs) = CrossStream (Stream.cons x xs)
211
171
212{-# INLINE foldrTMap #-}
172{-# INLINE foldrTMap #-}
213−foldrTMap :: MonadIO m => Int -> Stream m Int -> m ()
173+foldrTMap :: MonadIO m => Int -> SerialT m Int -> m ()
214−foldrTMap n = composeN n $ Stream.foldrT (\x xs -> x + 1 `Stream.cons` xs) Stream.nil
174+foldrTMap n = composeN n $ Internal.foldrT (\x xs -> x + 1 `S.cons` xs) S.nil
215−-}
175+
216
176
217{-# INLINE trace #-}
177{-# INLINE trace #-}
218−trace :: MonadAsync m => Int -> Stream m Int -> m ()
178+trace :: MonadAsync m => Int -> SerialT m Int -> m ()
219−trace n = composeN n $ Stream.trace return
179+trace n = composeN n $ Internal.trace return
220
180
221o_1_space_mapping :: Int -> [Benchmark]
181o_1_space_mapping :: Int -> [Benchmark]
222o_1_space_mapping value =
182o_1_space_mapping value =
223 [ bgroup
183 [ bgroup
224 "mapping"
184 "mapping"
225 [
185 [
226−#ifdef USE_STREAMK
227 -- Right folds
186 -- Right folds
228 benchIOSink value "foldrS" (foldrS 1)
187 benchIOSink value "foldrS" (foldrS 1)
229 , benchIOSink value "foldrSMap" (foldrSMap 1)
188 , benchIOSink value "foldrSMap" (foldrSMap 1)
230− ,
231−#endif
232− -- , benchIOSink value "foldrT" (foldrT 1)
189+ , benchIOSink value "foldrT" (foldrT 1)
233− -- , benchIOSink value "foldrTMap" (foldrTMap 1)
190+ , benchIOSink value "foldrTMap" (foldrTMap 1)
234
191
235 -- Mapping
192 -- Mapping
236− benchIOSink value "map" (mapN 1)
193+ , benchIOSink value "map" (mapN fromSerial 1)
237 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
194 , bench "sequence" $ nfIO $ randomRIO (1, 1000) >>= \n ->
238− sequence (sourceUnfoldrAction value n)
195+ sequence fromSerial (sourceUnfoldrAction value n)
239− , benchIOSink value "mapM" (mapM 1)
196+ , benchIOSink value "mapM" (mapM fromSerial 1)
240 , benchIOSink value "tap" (tap 1)
197 , benchIOSink value "tap" (tap 1)
241−#ifdef USE_PRELUDE
198+ , benchIOSink value "tapRate 1 second" (tapRate 1)
242 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
199 , benchIOSink value "pollCounts 1 second" (pollCounts 1)
243 , benchIOSink value "timestamped" timestamped
200 , benchIOSink value "timestamped" timestamped
244
201
@@ -249,7 +206,7 @@ o_1_space_mapping value =
249 , benchIOSink value "scanl1M'" (scanl1M' 1)
206 , benchIOSink value "scanl1M'" (scanl1M' 1)
250 , benchIOSink value "postscanl'" (postscanl' 1)
207 , benchIOSink value "postscanl'" (postscanl' 1)
251 , benchIOSink value "postscanlM'" (postscanlM' 1)
208 , benchIOSink value "postscanlM'" (postscanlM' 1)
252−#endif
209+
253 , benchIOSink value "scan" (scan 1)
210 , benchIOSink value "scan" (scan 1)
254 , benchIOSink value "postscan" (postscan 1)
211 , benchIOSink value "postscan" (postscan 1)
255 ]
212 ]
@@ -258,37 +215,36 @@ o_1_space_mapping value =
258o_1_space_mappingX4 :: Int -> [Benchmark]
215o_1_space_mappingX4 :: Int -> [Benchmark]
259o_1_space_mappingX4 value =
216o_1_space_mappingX4 value =
260 [ bgroup "mappingX4"
217 [ bgroup "mappingX4"
261− [ benchIOSink value "map" (mapN 4)
218+ [ benchIOSink value "map" (mapN fromSerial 4)
262− , benchIOSink value "mapM" (mapM 4)
219+ , benchIOSink value "mapM" (mapM fromSerial 4)
263 , benchIOSink value "trace" (trace 4)
220 , benchIOSink value "trace" (trace 4)
264
221
265−#ifdef USE_PRELUDE
266 , benchIOSink value "scanl'" (scanl' 4)
222 , benchIOSink value "scanl'" (scanl' 4)
267 , benchIOSink value "scanl1'" (scanl1' 4)
223 , benchIOSink value "scanl1'" (scanl1' 4)
268 , benchIOSink value "scanlM'" (scanlM' 4)
224 , benchIOSink value "scanlM'" (scanlM' 4)
269 , benchIOSink value "scanl1M'" (scanl1M' 4)
225 , benchIOSink value "scanl1M'" (scanl1M' 4)
270 , benchIOSink value "postscanl'" (postscanl' 4)
226 , benchIOSink value "postscanl'" (postscanl' 4)
271 , benchIOSink value "postscanlM'" (postscanlM' 4)
227 , benchIOSink value "postscanlM'" (postscanlM' 4)
272−#endif
228+
273 ]
229 ]
274 ]
230 ]
275
231
276{-# INLINE sieveScan #-}
232{-# INLINE sieveScan #-}
277−sieveScan :: Monad m => Stream m Int -> Stream m Int
233+sieveScan :: Monad m => SerialT m Int -> SerialT m Int
278sieveScan =
234sieveScan =
279− Stream.mapMaybe snd
235+ S.mapMaybe snd
280− . Stream.scan (FL.foldlM' (\(primes, _) n -> do
236+ . S.scanlM' (\(primes, _) n -> do
281 return $
237 return $
282 let ps = takeWhile (\p -> p * p <= n) primes
238 let ps = takeWhile (\p -> p * p <= n) primes
283 in if all (\p -> n `mod` p /= 0) ps
239 in if all (\p -> n `mod` p /= 0) ps
284 then (primes ++ [n], Just n)
240 then (primes ++ [n], Just n)
285− else (primes, Nothing)) (return ([2], Just 2)))
241+ else (primes, Nothing)) (return ([2], Just 2))
286
242
287o_n_space_mapping :: Int -> [Benchmark]
243o_n_space_mapping :: Int -> [Benchmark]
288o_n_space_mapping value =
244o_n_space_mapping value =
289 [ bgroup "mapping"
245 [ bgroup "mapping"
290 [ benchIO "naive prime sieve"
246 [ benchIO "naive prime sieve"
291− (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))
247+ (\n -> S.sum $ sieveScan $ S.enumerateFromTo 2 (value + n))
292 ]
248 ]
293 ]
249 ]
294
250
@@ -299,75 +255,8 @@ o_n_space_mapping value =
299o_1_space_functor :: Int -> [Benchmark]
255o_1_space_functor :: Int -> [Benchmark]
300o_1_space_functor value =
256o_1_space_functor value =
301 [ bgroup "Functor"
257 [ bgroup "Functor"
302− [ benchIOSink value "fmap" (mapN 1)
258+ [ benchIOSink value "fmap" (fmapN fromSerial 1)
303− , benchIOSink value "fmap x 4" (mapN 4)
259+ , benchIOSink value "fmap x 4" (fmapN fromSerial 4)
304− ]
305− ]
306−
307−-------------------------------------------------------------------------------
308−-- Iteration/looping utilities
309−-------------------------------------------------------------------------------
310−
311−{-# INLINE iterateN #-}
312−iterateN :: (Int -> a -> a) -> a -> Int -> a
313−iterateN g initial count = f count initial
314−
315− where
316−
317− f (0 :: Int) x = x
318− f i x = f (i - 1) (g i x)
319−
320−#ifdef USE_STREAMK
321−-- Iterate a transformation over a singleton stream
322−{-# INLINE iterateSingleton #-}
323−iterateSingleton :: Applicative m =>
324− (Int -> StreamK m Int -> StreamK m Int)
325− -> Int
326− -> Int
327− -> Stream m Int
328−iterateSingleton g count n = toStream $ iterateN g (StreamK.fromPure n) count
329−#else
330−-- Iterate a transformation over a singleton stream
331−{-# INLINE iterateSingleton #-}
332−iterateSingleton :: Applicative m =>
333− (Int -> Stream m Int -> Stream m Int)
334− -> Int
335− -> Int
336− -> Stream m Int
337−iterateSingleton g count n = iterateN g (Stream.fromPure n) count
338−#endif
339−
340−{-
341−-- XXX need to check why this is slower than the explicit recursion above, even
342−-- if the above code is written in a foldr like head recursive way. We also
343−-- need to try this with foldlM' once #150 is fixed.
344−-- However, it is perhaps best to keep the iteration benchmarks independent of
345−-- foldrM and any related fusion issues.
346−{-# INLINE _iterateSingleton #-}
347−_iterateSingleton ::
348− Monad m
349− => (Int -> Stream m Int -> Stream m Int)
350− -> Int
351− -> Int
352− -> Stream m Int
353−_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n
354−-}
355−
356−o_n_space_iterated :: Int -> [Benchmark]
357−o_n_space_iterated value =
358− [ bgroup "iterated"
359− [ benchIO "(+) (n times) (baseline)" $ \i0 ->
360− iterateN (\i acc -> acc >>= \n -> return $ i + n) (return i0) value
361− , benchIOSrc "(<$) (n times)" $
362− iterateSingleton (<$) value
363− , benchIOSrc "fmap (n times)" $
364− iterateSingleton (fmap . (+)) value
365− {-
366− , benchIOSrc fromSerial "_(<$) (n times)" $
367− _iterateSingleton (<$) value
368− , benchIOSrc fromSerial "_fmap (n times)" $
369− _iterateSingleton (fmap . (+)) value
370− -}
371 ]
260 ]
372 ]
261 ]
373
262
@@ -376,129 +265,121 @@ o_n_space_iterated value =
376-------------------------------------------------------------------------------
265-------------------------------------------------------------------------------
377
266
378{-# INLINE filterEven #-}
267{-# INLINE filterEven #-}
379−filterEven :: MonadIO m => Int -> Stream m Int -> m ()
268+filterEven :: MonadIO m => Int -> SerialT m Int -> m ()
380−filterEven n = composeN n $ Stream.filter even
269+filterEven n = composeN n $ S.filter even
381
270
382{-# INLINE filterAllOut #-}
271{-# INLINE filterAllOut #-}
383−filterAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
272+filterAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
384−filterAllOut value n = composeN n $ Stream.filter (> (value + 1))
273+filterAllOut value n = composeN n $ S.filter (> (value + 1))
385
274
386{-# INLINE filterAllIn #-}
275{-# INLINE filterAllIn #-}
387−filterAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
276+filterAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
388−filterAllIn value n = composeN n $ Stream.filter (<= (value + 1))
277+filterAllIn value n = composeN n $ S.filter (<= (value + 1))
389
278
390{-# INLINE filterMEven #-}
279{-# INLINE filterMEven #-}
391−filterMEven :: MonadIO m => Int -> Stream m Int -> m ()
280+filterMEven :: MonadIO m => Int -> SerialT m Int -> m ()
392−filterMEven n = composeN n $ Stream.filterM (return . even)
281+filterMEven n = composeN n $ S.filterM (return . even)
393
282
394{-# INLINE filterMAllOut #-}
283{-# INLINE filterMAllOut #-}
395−filterMAllOut :: MonadIO m => Int -> Int -> Stream m Int -> m ()
284+filterMAllOut :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
396−filterMAllOut value n = composeN n $ Stream.filterM (\x -> return $ x > (value + 1))
285+filterMAllOut value n = composeN n $ S.filterM (\x -> return $ x > (value + 1))
397
286
398{-# INLINE filterMAllIn #-}
287{-# INLINE filterMAllIn #-}
399−filterMAllIn :: MonadIO m => Int -> Int -> Stream m Int -> m ()
288+filterMAllIn :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
400−filterMAllIn value n = composeN n $ Stream.filterM (\x -> return $ x <= (value + 1))
289+filterMAllIn value n = composeN n $ S.filterM (\x -> return $ x <= (value + 1))
401
290
402{-# INLINE _takeOne #-}
291{-# INLINE _takeOne #-}
403−_takeOne :: MonadIO m => Int -> Stream m Int -> m ()
292+_takeOne :: MonadIO m => Int -> SerialT m Int -> m ()
404−_takeOne n = composeN n $ Stream.take 1
293+_takeOne n = composeN n $ S.take 1
405
294
406{-# INLINE takeAll #-}
295{-# INLINE takeAll #-}
407−takeAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
296+takeAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
408−takeAll value n = composeN n $ Stream.take (value + 1)
297+takeAll value n = composeN n $ S.take (value + 1)
409
298
410{-# INLINE takeWhileTrue #-}
299{-# INLINE takeWhileTrue #-}
411−takeWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
300+takeWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
412−takeWhileTrue value n = composeN n $ Stream.takeWhile (<= (value + 1))
301+takeWhileTrue value n = composeN n $ S.takeWhile (<= (value + 1))
413
302
414{-# INLINE takeWhileMTrue #-}
303{-# INLINE takeWhileMTrue #-}
415−takeWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
304+takeWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
416−takeWhileMTrue value n = composeN n $ Stream.takeWhileM (return . (<= (value + 1)))
305+takeWhileMTrue value n = composeN n $ S.takeWhileM (return . (<= (value + 1)))
417
306
418−#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
419{-# INLINE takeInterval #-}
307{-# INLINE takeInterval #-}
420−takeInterval :: Double -> Int -> Stream IO Int -> IO ()
308+takeInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
421−takeInterval i n = composeN n (Stream.takeInterval i)
309+takeInterval i n = composeN n (Internal.takeInterval i)
422
310
423−-- Inspection testing is disabled for takeInterval
424−-- Enable it when looking at it throughly
425#ifdef INSPECTION
311#ifdef INSPECTION
426-- inspect $ hasNoType 'takeInterval ''SPEC
312-- inspect $ hasNoType 'takeInterval ''SPEC
427−-- inspect $ hasNoTypeClasses 'takeInterval
313+inspect $ hasNoTypeClasses 'takeInterval
428-- inspect $ 'takeInterval `hasNoType` ''D.Step
314-- inspect $ 'takeInterval `hasNoType` ''D.Step
429#endif
315#endif
430
316
431−{-# INLINE dropInterval #-}
432−dropInterval :: Double -> Int -> Stream IO Int -> IO ()
433−dropInterval i n = composeN n (Stream.dropInterval i)
434−
435−-- Inspection testing is disabled for dropInterval
436−-- Enable it when looking at it throughly
437−#ifdef INSPECTION
438−-- inspect $ hasNoTypeClasses 'dropInterval
439−-- inspect $ 'dropInterval `hasNoType` ''D.Step
440−#endif
441−#endif
442−
443{-# INLINE dropOne #-}
317{-# INLINE dropOne #-}
444−dropOne :: MonadIO m => Int -> Stream m Int -> m ()
318+dropOne :: MonadIO m => Int -> SerialT m Int -> m ()
445−dropOne n = composeN n $ Stream.drop 1
319+dropOne n = composeN n $ S.drop 1
446
320
447{-# INLINE dropAll #-}
321{-# INLINE dropAll #-}
448−dropAll :: MonadIO m => Int -> Int -> Stream m Int -> m ()
322+dropAll :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
449−dropAll value n = composeN n $ Stream.drop (value + 1)
323+dropAll value n = composeN n $ S.drop (value + 1)
450
324
451{-# INLINE dropWhileTrue #-}
325{-# INLINE dropWhileTrue #-}
452−dropWhileTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
326+dropWhileTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
453−dropWhileTrue value n = composeN n $ Stream.dropWhile (<= (value + 1))
327+dropWhileTrue value n = composeN n $ S.dropWhile (<= (value + 1))
454
328
455{-# INLINE dropWhileMTrue #-}
329{-# INLINE dropWhileMTrue #-}
456−dropWhileMTrue :: MonadIO m => Int -> Int -> Stream m Int -> m ()
330+dropWhileMTrue :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
457−dropWhileMTrue value n = composeN n $ Stream.dropWhileM (return . (<= (value + 1)))
331+dropWhileMTrue value n = composeN n $ S.dropWhileM (return . (<= (value + 1)))
458
332
459{-# INLINE dropWhileFalse #-}
333{-# INLINE dropWhileFalse #-}
460−dropWhileFalse :: MonadIO m => Int -> Int -> Stream m Int -> m ()
334+dropWhileFalse :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
461−dropWhileFalse value n = composeN n $ Stream.dropWhile (> (value + 1))
335+dropWhileFalse value n = composeN n $ S.dropWhile (> (value + 1))
462
336
463−#ifdef USE_PRELUDE
464-- XXX Decide on the time interval
337-- XXX Decide on the time interval
465{-# INLINE _intervalsOfSum #-}
338{-# INLINE _intervalsOfSum #-}
466−_intervalsOfSum :: MonadAsync m => Double -> Int -> Stream m Int -> m ()
339+_intervalsOfSum :: MonadAsync m => Double -> Int -> SerialT m Int -> m ()
467−_intervalsOfSum i n = composeN n (Stream.intervalsOf i FL.sum)
340+_intervalsOfSum i n = composeN n (S.intervalsOf i FL.sum)
341+
342+{-# INLINE dropInterval #-}
343+dropInterval :: NanoSecond64 -> Int -> SerialT IO Int -> IO ()
344+dropInterval i n = composeN n (Internal.dropInterval i)
345+
346+#ifdef INSPECTION
347+inspect $ hasNoTypeClasses 'dropInterval
348+-- inspect $ 'dropInterval `hasNoType` ''D.Step
468#endif
349#endif
469
350
470{-# INLINE findIndices #-}
351{-# INLINE findIndices #-}
471−findIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
352+findIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
472−findIndices value n = composeN n $ Stream.findIndices (== (value + 1))
353+findIndices value n = composeN n $ S.findIndices (== (value + 1))
473
354
474{-# INLINE elemIndices #-}
355{-# INLINE elemIndices #-}
475−elemIndices :: MonadIO m => Int -> Int -> Stream m Int -> m ()
356+elemIndices :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
476−elemIndices value n = composeN n $ Stream.elemIndices (value + 1)
357+elemIndices value n = composeN n $ S.elemIndices (value + 1)
477
358
478{-# INLINE deleteBy #-}
359{-# INLINE deleteBy #-}
479−deleteBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
360+deleteBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
480−deleteBy value n = composeN n $ Stream.deleteBy (>=) (value + 1)
361+deleteBy value n = composeN n $ S.deleteBy (>=) (value + 1)
481
362
482-- uniq . uniq == uniq, composeN 2 ~ composeN 1
363-- uniq . uniq == uniq, composeN 2 ~ composeN 1
483{-# INLINE uniq #-}
364{-# INLINE uniq #-}
484−uniq :: MonadIO m => Int -> Stream m Int -> m ()
365+uniq :: MonadIO m => Int -> SerialT m Int -> m ()
485−uniq n = composeN n Stream.uniq
366+uniq n = composeN n S.uniq
486
367
487{-# INLINE mapMaybe #-}
368{-# INLINE mapMaybe #-}
488−mapMaybe :: MonadIO m => Int -> Stream m Int -> m ()
369+mapMaybe :: MonadIO m => Int -> SerialT m Int -> m ()
489mapMaybe n =
370mapMaybe n =
490 composeN n $
371 composeN n $
491− Stream.mapMaybe
372+ S.mapMaybe
492 (\x ->
373 (\x ->
493 if odd x
374 if odd x
494 then Nothing
375 then Nothing
495 else Just x)
376 else Just x)
496
377
497{-# INLINE mapMaybeM #-}
378{-# INLINE mapMaybeM #-}
498−mapMaybeM :: MonadAsync m => Int -> Stream m Int -> m ()
379+mapMaybeM :: S.MonadAsync m => Int -> SerialT m Int -> m ()
499mapMaybeM n =
380mapMaybeM n =
500 composeN n $
381 composeN n $
501− Stream.mapMaybeM
382+ S.mapMaybeM
502 (\x ->
383 (\x ->
503 if odd x
384 if odd x
504 then return Nothing
385 then return Nothing
@@ -517,14 +398,18 @@ o_1_space_filtering value =
517
398
518 -- Trimming
399 -- Trimming
519 , benchIOSink value "take-all" (takeAll value 1)
400 , benchIOSink value "take-all" (takeAll value 1)
401+ , benchIOSink
402+ value
403+ "takeInterval-all"
404+ (takeInterval (NanoSecond64 maxBound) 1)
520 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
405 , benchIOSink value "takeWhile-true" (takeWhileTrue value 1)
521 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
406 -- , benchIOSink value "takeWhileM-true" (_takeWhileMTrue value 1)
522 , benchIOSink value "drop-one" (dropOne 1)
407 , benchIOSink value "drop-one" (dropOne 1)
523 , benchIOSink value "drop-all" (dropAll value 1)
408 , benchIOSink value "drop-all" (dropAll value 1)
524−#if !defined(USE_STREAMLY_CORE) && !defined(USE_PRELUDE)
409+ , benchIOSink
525− , benchIOSink value "takeInterval-all" (takeInterval 10000 1)
410+ value
526− , benchIOSink value "dropInterval-all" (dropInterval 10000 1)
411+ "dropInterval-all"
527−#endif
412+ (dropInterval (NanoSecond64 maxBound) 1)
528 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
413 , benchIOSink value "dropWhile-true" (dropWhileTrue value 1)
529 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
414 -- , benchIOSink value "dropWhileM-true" (_dropWhileMTrue value 1)
530 , benchIOSink
415 , benchIOSink
@@ -587,26 +472,26 @@ o_1_space_filteringX4 value =
587-------------------------------------------------------------------------------
472-------------------------------------------------------------------------------
588
473
589{-# INLINE intersperse #-}
474{-# INLINE intersperse #-}
590−intersperse :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
475+intersperse :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
591−intersperse value n = composeN n $ Stream.intersperse (value + 1)
476+intersperse value n = composeN n $ S.intersperse (value + 1)
592
477
593{-# INLINE intersperseM #-}
478{-# INLINE intersperseM #-}
594−intersperseM :: MonadAsync m => Int -> Int -> Stream m Int -> m ()
479+intersperseM :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
595−intersperseM value n = composeN n $ Stream.intersperseM (return $ value + 1)
480+intersperseM value n = composeN n $ S.intersperseM (return $ value + 1)
596
481
597{-# INLINE insertBy #-}
482{-# INLINE insertBy #-}
598−insertBy :: MonadIO m => Int -> Int -> Stream m Int -> m ()
483+insertBy :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
599−insertBy value n = composeN n $ Stream.insertBy compare (value + 1)
484+insertBy value n = composeN n $ S.insertBy compare (value + 1)
600
485
601{-# INLINE interposeSuffix #-}
486{-# INLINE interposeSuffix #-}
602−interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
487+interposeSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
603interposeSuffix value n =
488interposeSuffix value n =
604− composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity
489+ composeN n $ Internal.interposeSuffix (value + 1) Unfold.identity
605
490
606{-# INLINE intercalateSuffix #-}
491{-# INLINE intercalateSuffix #-}
607−intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m ()
492+intercalateSuffix :: S.MonadAsync m => Int -> Int -> SerialT m Int -> m ()
608intercalateSuffix value n =
493intercalateSuffix value n =
609− composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)
494+ composeN n $ Internal.intercalateSuffix Unfold.identity (value + 1)
610
495
611o_1_space_inserting :: Int -> [Benchmark]
496o_1_space_inserting :: Int -> [Benchmark]
612o_1_space_inserting value =
497o_1_space_inserting value =
@@ -632,12 +517,12 @@ o_1_space_insertingX4 value =
632-------------------------------------------------------------------------------
517-------------------------------------------------------------------------------
633
518
634{-# INLINE indexed #-}
519{-# INLINE indexed #-}
635−indexed :: MonadIO m => Int -> Stream m Int -> m ()
520+indexed :: MonadIO m => Int -> SerialT m Int -> m ()
636−indexed n = composeN n (fmap snd . Stream.indexed)
521+indexed n = composeN n (S.map snd . S.indexed)
637
522
638{-# INLINE indexedR #-}
523{-# INLINE indexedR #-}
639−indexedR :: MonadIO m => Int -> Int -> Stream m Int -> m ()
524+indexedR :: MonadIO m => Int -> Int -> SerialT m Int -> m ()
640−indexedR value n = composeN n (fmap snd . Stream.indexedR value)
525+indexedR value n = composeN n (S.map snd . S.indexedR value)
641
526
642o_1_space_indexing :: Int -> [Benchmark]
527o_1_space_indexing :: Int -> [Benchmark]
643o_1_space_indexing value =
528o_1_space_indexing value =
@@ -676,12 +561,7 @@ benchmarks moduleName size =
676 , o_1_space_indexingX4 size
561 , o_1_space_indexingX4 size
677 ]
562 ]
678 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
563 , bgroup (o_n_space_prefix moduleName) $ Prelude.concat
679− [
680−#ifdef USE_STREAMK
681− o_n_space_traversable size
564+ [ o_n_space_traversable size
682− ,
683−#endif
684− o_n_space_mapping size
565+ , o_n_space_mapping size
685− , o_n_space_iterated size
686 ]
566 ]
687 ]
567 ]
benchmark/Streamly/Benchmark/Prelude/WAsync.hs+1−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
15import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
16import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
17
15
18−import Test.Tasty.Bench
16+import Gauge
19
17
20moduleName :: String
18moduleName :: String
21moduleName = "Prelude.WAsync"
19moduleName = "Prelude.WAsync"
benchmark/Streamly/Benchmark/Prelude/WSerial.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -29,13 +27,13 @@ import qualified Streamly.Internal.Data.Unfold as UF
29import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
30import Streamly.Benchmark.Prelude
28import Streamly.Benchmark.Prelude
31
29
32−import Test.Tasty.Bench
30+import Gauge
33
31
34#ifdef INSPECTION
32#ifdef INSPECTION
35import GHC.Types (SPEC(..))
33import GHC.Types (SPEC(..))
36import Test.Inspection
34import Test.Inspection
37
35
38−import qualified Streamly.Internal.Data.Stream as D
36+import qualified Streamly.Internal.Data.Stream.StreamD as D
39#endif
37#endif
40
38
41moduleName :: String
39moduleName :: String
benchmark/Streamly/Benchmark/Prelude/ZipAsync.hs+2−11
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -15,7 +13,7 @@ import qualified Streamly.Prelude as S
15import Streamly.Benchmark.Common
13import Streamly.Benchmark.Common
16import Streamly.Benchmark.Prelude
14import Streamly.Benchmark.Prelude
17
15
18−import Test.Tasty.Bench
16+import Gauge
19
17
20moduleName :: String
18moduleName :: String
21moduleName = "Prelude.ZipAsync"
19moduleName = "Prelude.ZipAsync"
@@ -58,13 +56,7 @@ o_1_space_joining value =
58 (value `div` 2))
56 (value `div` 2))
59 , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
57 , benchIOSrc fromSerial "zipAsyncAp (2,x/2)" (zipAsyncAp (value `div` 2))
60 , benchIOSink value "fmap zipAsyncly" $ fmapN S.fromZipAsync 1
58 , benchIOSink value "fmap zipAsyncly" $ fmapN S.fromZipAsync 1
61− ]
62− ]
63−
64−o_n_heap_joining :: Int -> [Benchmark]
65−o_n_heap_joining value =
66− [ bgroup "joining"
67− [ fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)
59+ , fromZipAsyncTraverse "ZipAsync Applicative (x/100)" (value `div` 100)
68 ]
60 ]
69 ]
61 ]
70
62
@@ -93,5 +85,4 @@ main = runWithCLIOpts defaultStreamSize allBenchmarks
93 [ o_1_space_joining size
85 [ o_1_space_joining size
94 , o_1_space_outerProduct size
86 , o_1_space_outerProduct size
95 ]
87 ]
96− , bgroup (o_n_heap_prefix moduleName) $ o_n_heap_joining size
97 ]
88 ]
benchmark/Streamly/Benchmark/Prelude/ZipSerial.hs+2−4
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Main
2-- Module : Main
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -29,13 +27,13 @@ import qualified Streamly.Prelude as S
29import Streamly.Benchmark.Common
27import Streamly.Benchmark.Common
30import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
28import Streamly.Benchmark.Prelude hiding (sourceUnfoldrM)
31
29
32−import Test.Tasty.Bench
30+import Gauge
33
31
34#ifdef INSPECTION
32#ifdef INSPECTION
35import GHC.Types (SPEC(..))
33import GHC.Types (SPEC(..))
36import Test.Inspection
34import Test.Inspection
37
35
38−import qualified Streamly.Internal.Data.Stream as D
36+import qualified Streamly.Internal.Data.Stream.StreamD as D
39#endif
37#endif
40
38
41moduleName :: String
39moduleName :: String
benchmark/Streamly/Benchmark/Unicode/Char.hs+10−18
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations -Wno-orphans #-}
2−
3--
1--
4-- Module : Streamly.Unicode.Char
2-- Module : Streamly.Unicode.Char
5-- Copyright : (c) 2021 Composewell Technologies
3-- Copyright : (c) 2021 Composewell Technologies
@@ -12,19 +10,19 @@
12-- Imports
10-- Imports
13--------------------------------------------------------------------------------
11--------------------------------------------------------------------------------
14
12
15−import Control.DeepSeq (NFData(..))
13+import Control.DeepSeq (NFData)
16−import Streamly.Internal.Data.Array (Array)
14+import Streamly.Internal.Data.Array.Foreign (Array)
17import System.FilePath (dropExtensions, takeFileName)
15import System.FilePath (dropExtensions, takeFileName)
18import System.FilePath.Posix ((</>))
16import System.FilePath.Posix ((</>))
19−import Test.Tasty.Bench (Benchmark, bench, bgroup, defaultMain, env, nfIO)
17+import Gauge.Main (Benchmark, bench, bgroup, defaultMain, env, nfIO)
20import Streamly.Internal.Unicode.Char
18import Streamly.Internal.Unicode.Char
21 ( NormalizationMode(NFC, NFD, NFKC, NFKD)
19 ( NormalizationMode(NFC, NFD, NFKC, NFKD)
22 , normalize
20 , normalize
23 )
21 )
24import Streamly.Benchmark.Common (o_1_space_prefix)
22import Streamly.Benchmark.Common (o_1_space_prefix)
25
23
26−import qualified Streamly.Internal.Data.Array as Array
24+import qualified Streamly.Internal.Data.Array.Foreign as Array
27−import qualified Streamly.Internal.Data.Stream as IsStream
25+import qualified Streamly.Internal.Data.Stream.IsStream as IsStream
28import qualified System.Directory as Dir
26import qualified System.Directory as Dir
29
27
30--------------------------------------------------------------------------------
28--------------------------------------------------------------------------------
@@ -43,13 +41,7 @@ dataDir = "benchmark/Streamly/Benchmark/Unicode/data"
43dataSetSize :: Int
41dataSetSize :: Int
44dataSetSize = 1000000
42dataSetSize = 1000000
45
43
46−-- Unboxed arrays are fully evaluated.
47−instance NFData (Array a) where
48− {-# INLINE rnf #-}
49− rnf _ = ()
50−
51−makeBench ::
52− (String, Array Char -> IO ()) -> (String, IO (Array Char)) -> Benchmark
44+makeBench :: (NFData a) => (String, a -> IO ()) -> (String, IO a) -> Benchmark
53makeBench (implName, func) (dataName, setup) =
45makeBench (implName, func) (dataName, setup) =
54 env setup (bench (implName ++ "/" ++ dataName) . nfIO . func)
46 env setup (bench (implName ++ "/" ++ dataName) . nfIO . func)
55
47
@@ -73,10 +65,10 @@ arrInput file = second (fmap Array.fromList) (strInput file)
73
65
74benchFunctions :: [(String, Array Char -> IO ())]
66benchFunctions :: [(String, Array Char -> IO ())]
75benchFunctions =
67benchFunctions =
76− [ ("NFD", IsStream.drain . normalize NFD . Array.read)
68+ [ ("NFD", IsStream.drain . normalize NFD . Array.toStream)
77− , ("NFKD", IsStream.drain . normalize NFKD . Array.read)
69+ , ("NFKD", IsStream.drain . normalize NFKD . Array.toStream)
78− , ("NFC", IsStream.drain . normalize NFC . Array.read)
70+ , ("NFC", IsStream.drain . normalize NFC . Array.toStream)
79− , ("NFKC", IsStream.drain . normalize NFKC . Array.read)
71+ , ("NFKC", IsStream.drain . normalize NFKC . Array.toStream)
80 ]
72 ]
81
73
82main :: IO ()
74main :: IO ()
benchmark/Streamly/Benchmark/Unicode/Parser.hsdeleted−107
@@ -1,107 +0,0 @@
1−-- |
2−-- Module : Streamly.Benchmark.Data.Parser
3−-- Copyright : (c) 2020 Composewell Technologies
4−--
5−-- License : BSD-3-Clause
6−-- Maintainer : streamly@composewell.com
7−
8−{-# LANGUAGE CPP #-}
9−{-# LANGUAGE FlexibleContexts #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# OPTIONS_GHC -Wno-orphans #-}
12−
13−#undef FUSION_CHECK
14−#ifdef FUSION_CHECK
15−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
16−#endif
17−
18−module Main
19− (
20− main
21− ) where
22−
23−import Control.DeepSeq (NFData(..))
24−import Control.Monad (replicateM_)
25−import Streamly.Internal.Data.Parser (ParseError(..))
26−import Streamly.Internal.Data.Stream (Stream)
27−import Prelude hiding
28− (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile)
29−
30−import qualified Streamly.Data.Array as Array
31−import qualified Streamly.Data.Stream as Stream
32−import qualified Streamly.Internal.Unicode.Parser as PRU
33−
34−import Test.Tasty.Bench hiding (env)
35−import Streamly.Benchmark.Common
36−
37−runParser :: Int -> (Stream IO Char -> IO a) -> IO ()
38−runParser count p = do
39− let v = "+123456789.123456789e-123"
40− let !(arr :: Array.Array Char) = Array.fromListN (length v) v
41− let s = Stream.unfold Array.reader arr
42− replicateM_ count (p s)
43−
44−-- | Takes a fold method, and uses it with a default source.
45−{-# INLINE benchIOSink #-}
46−benchIOSink :: Int -> String -> (Stream IO Char -> IO b) -> Benchmark
47−benchIOSink value name f = bench name $ nfIO $ runParser value f
48−
49−{-# INLINE doubleParser #-}
50−doubleParser :: Monad m => Stream m Char -> m (Either ParseError (Int, Int))
51−doubleParser = Stream.parse PRU.doubleParser
52−
53−{-# INLINE number #-}
54−number :: Monad m => Stream m Char -> m (Either ParseError (Integer, Int))
55−number = Stream.parse PRU.number
56−
57−{-# INLINE double #-}
58−double :: Monad m => Stream m Char -> m (Either ParseError Double)
59−double = Stream.parse PRU.double
60−
61−{-# INLINE numberDouble #-}
62−numberDouble :: Monad m => Stream m Char -> m (Either ParseError Double)
63−numberDouble = Stream.parse p
64− where p = uncurry PRU.mkDouble <$> PRU.number
65−
66−-------------------------------------------------------------------------------
67−-- Benchmarks
68−-------------------------------------------------------------------------------
69−
70−moduleName :: String
71−moduleName = "Unicode.Parser"
72−
73−instance NFData ParseError where
74− {-# INLINE rnf #-}
75− rnf (ParseError x) = rnf x
76−
77−o_n_heap_serial :: Int -> [Benchmark]
78−o_n_heap_serial value =
79− [
80− benchIOSink value "doubleParser" doubleParser
81− , benchIOSink value "number" number
82− , benchIOSink value "double (doubleParser)" double
83− , benchIOSink value "double (number)" numberDouble
84− ]
85−
86−-------------------------------------------------------------------------------
87−-- Driver
88−-------------------------------------------------------------------------------
89−
90−main :: IO ()
91−main = do
92−#ifndef FUSION_CHECK
93− runWithCLIOpts defaultStreamSize allBenchmarks
94−
95− where
96−
97− allBenchmarks value =
98− [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
99− ]
100−#else
101− -- Enable FUSION_CHECK macro at the beginning of the file
102− -- Enable one benchmark below, and run the benchmark
103− -- Check the .dump-simpl output
104− let value = 100000
105− runParser value double
106− return ()
107−#endif
benchmark/Streamly/Benchmark/Unicode/Stream.hs+34−60
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3--
1--
4-- Module : Streamly.Unicode.Stream
2-- Module : Streamly.Unicode.Stream
5-- Copyright : (c) 2019 Composewell Technologies
3-- Copyright : (c) 2019 Composewell Technologies
@@ -11,11 +9,6 @@
11{-# LANGUAGE CPP #-}
9{-# LANGUAGE CPP #-}
12{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
13
11
14−#undef FUSION_CHECK
15−#ifdef FUSION_CHECK
16−{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}
17−#endif
18−
19#ifdef __HADDOCK_VERSION__
12#ifdef __HADDOCK_VERSION__
20#undef INSPECTION
13#undef INSPECTION
21#endif
14#endif
@@ -25,30 +18,29 @@
25{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
18{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}
26#endif
19#endif
27
20
28−import Streamly.Data.Stream (Stream)
29−import Streamly.Data.Fold (Fold)
30import Prelude hiding (last, length)
21import Prelude hiding (last, length)
31import System.IO (Handle)
22import System.IO (Handle)
32
23
33−import qualified Streamly.Data.Array as Array
24+import qualified Streamly.Data.Array.Foreign as Array
34import qualified Streamly.Data.Fold as Fold
25import qualified Streamly.Data.Fold as Fold
26+import qualified Streamly.FileSystem.Handle as Handle
35−import qualified Streamly.Internal.Data.Stream as Stream
27+import qualified Streamly.Internal.Data.Stream.IsStream as Stream
36import qualified Streamly.Internal.Data.Unfold as Unfold
28import qualified Streamly.Internal.Data.Unfold as Unfold
37import qualified Streamly.Internal.FileSystem.Handle as Handle
29import qualified Streamly.Internal.FileSystem.Handle as Handle
38−import qualified Streamly.Internal.Unicode.Array as UnicodeArr
30+import qualified Streamly.Internal.Unicode.Array.Char as UnicodeArr
39import qualified Streamly.Internal.Unicode.Stream as Unicode
31import qualified Streamly.Internal.Unicode.Stream as Unicode
40
32
41−import Test.Tasty.Bench hiding (env)
33+import Gauge hiding (env)
42import Streamly.Benchmark.Common
34import Streamly.Benchmark.Common
43import Streamly.Benchmark.Common.Handle
35import Streamly.Benchmark.Common.Handle
44
36
45#ifdef INSPECTION
37#ifdef INSPECTION
46−import Streamly.Internal.Data.MutByteArray (Unbox)
38+import Foreign.Storable (Storable)
47−import Streamly.Internal.Data.Stream (Step(..))
39+import Streamly.Internal.Data.Stream.StreamD.Type (Step(..))
48−import qualified Streamly.Internal.Data.Array as Array
40+import qualified Streamly.Internal.Data.Fold.Type as Fold
49−import qualified Streamly.Internal.Data.MutArray as MutArray
50−import qualified Streamly.Internal.Data.Fold as Fold
51import qualified Streamly.Internal.Data.Tuple.Strict as Strict
41import 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
52
44
53import Test.Inspection
45import Test.Inspection
54#endif
46#endif
@@ -62,8 +54,8 @@ copyCodecUtf8ArraysLenient :: Handle -> Handle -> IO ()
62copyCodecUtf8ArraysLenient inh outh =
54copyCodecUtf8ArraysLenient inh outh =
63 Stream.fold (Handle.write outh)
55 Stream.fold (Handle.write outh)
64 $ Unicode.encodeUtf8'
56 $ Unicode.encodeUtf8'
65− $ Unicode.decodeUtf8Chunks
57+ $ Unicode.decodeUtf8Arrays
66− $ Handle.readChunks inh
58+ $ Handle.toChunks inh
67
59
68#ifdef INSPECTION
60#ifdef INSPECTION
69inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
61inspect $ hasNoTypeClasses 'copyCodecUtf8ArraysLenient
@@ -83,29 +75,23 @@ o_1_space_decode_encode_chunked env =
83-- copy with group/ungroup transformations
75-- copy with group/ungroup transformations
84-------------------------------------------------------------------------------
76-------------------------------------------------------------------------------
85
77
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−
92{-# NOINLINE linesUnlinesCopy #-}
78{-# NOINLINE linesUnlinesCopy #-}
93linesUnlinesCopy :: Handle -> Handle -> IO ()
79linesUnlinesCopy :: Handle -> Handle -> IO ()
94linesUnlinesCopy inh outh =
80linesUnlinesCopy inh outh =
95 Stream.fold (Handle.write outh)
81 Stream.fold (Handle.write outh)
96 $ Unicode.encodeLatin1'
82 $ Unicode.encodeLatin1'
97 $ Unicode.unlines Unfold.fromList
83 $ Unicode.unlines Unfold.fromList
98− $ splitOnSuffix (== '\n') Fold.toList
84+ $ Stream.splitOnSuffix (== '\n') Fold.toList
99 $ Unicode.decodeLatin1
85 $ Unicode.decodeLatin1
100− $ Stream.unfold Handle.reader inh
86+ $ Stream.unfold Handle.read inh
101
87
102{-# NOINLINE linesUnlinesArrayWord8Copy #-}
88{-# NOINLINE linesUnlinesArrayWord8Copy #-}
103linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
89linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO ()
104linesUnlinesArrayWord8Copy inh outh =
90linesUnlinesArrayWord8Copy inh outh =
105 Stream.fold (Handle.write outh)
91 Stream.fold (Handle.write outh)
106− $ Stream.interposeSuffix 10 Array.reader
92+ $ Stream.interposeSuffix 10 Array.read
107− $ splitOnSuffix (== 10) Array.write
93+ $ Stream.splitOnSuffix (== 10) Array.write
108− $ Stream.unfold Handle.reader inh
94+ $ Stream.unfold Handle.read inh
109
95
110-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
96-- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion
111-- | Lines and unlines
97-- | Lines and unlines
@@ -117,10 +103,10 @@ linesUnlinesArrayCharCopy inh outh =
117 $ UnicodeArr.unlines
103 $ UnicodeArr.unlines
118 $ UnicodeArr.lines
104 $ UnicodeArr.lines
119 $ Unicode.decodeLatin1
105 $ Unicode.decodeLatin1
120− $ Stream.unfold Handle.reader inh
106+ $ Stream.unfold Handle.read inh
121
107
122#ifdef INSPECTION
108#ifdef INSPECTION
123−inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Unbox]
109+inspect $ hasNoTypeClassesExcept 'linesUnlinesArrayCharCopy [''Storable]
124-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
110-- inspect $ 'linesUnlinesArrayCharCopy `hasNoType` ''Step
125#endif
111#endif
126
112
@@ -145,7 +131,7 @@ wordsUnwordsCopyWord8 inh outh =
145 Stream.fold (Handle.write outh)
131 Stream.fold (Handle.write outh)
146 $ Stream.interposeSuffix 32 Unfold.fromList
132 $ Stream.interposeSuffix 32 Unfold.fromList
147 $ Stream.wordsBy isSp Fold.toList
133 $ Stream.wordsBy isSp Fold.toList
148− $ Stream.unfold Handle.reader inh
134+ $ Stream.unfold Handle.read inh
149
135
150#ifdef INSPECTION
136#ifdef INSPECTION
151inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
137inspect $ hasNoTypeClasses 'wordsUnwordsCopyWord8
@@ -169,7 +155,7 @@ wordsUnwordsCopy inh outh =
169 $ Stream.wordsBy isSpace Fold.toList
155 $ Stream.wordsBy isSpace Fold.toList
170 -- -- $ Stream.splitOn isSpace Fold.toList
156 -- -- $ Stream.splitOn isSpace Fold.toList
171 $ Unicode.decodeLatin1
157 $ Unicode.decodeLatin1
172− $ Stream.unfold Handle.reader inh
158+ $ Stream.unfold Handle.read inh
173
159
174#ifdef INSPECTION
160#ifdef INSPECTION
175-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
161-- inspect $ hasNoTypeClasses 'wordsUnwordsCopy
@@ -184,7 +170,7 @@ wordsUnwordsCharArrayCopy inh outh =
184 $ UnicodeArr.unwords
170 $ UnicodeArr.unwords
185 $ UnicodeArr.words
171 $ UnicodeArr.words
186 $ Unicode.decodeLatin1
172 $ Unicode.decodeLatin1
187− $ Stream.unfold Handle.reader inh
173+ $ Stream.unfold Handle.read inh
188
174
189o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
175o_1_space_copy_read_group_ungroup :: BenchEnv -> [Benchmark]
190o_1_space_copy_read_group_ungroup env =
176o_1_space_copy_read_group_ungroup env =
@@ -216,16 +202,16 @@ copyStreamLatin1' inh outh =
216 Stream.fold (Handle.write outh)
202 Stream.fold (Handle.write outh)
217 $ Unicode.encodeLatin1'
203 $ Unicode.encodeLatin1'
218 $ Unicode.decodeLatin1
204 $ Unicode.decodeLatin1
219− $ Stream.unfold Handle.reader inh
205+ $ Stream.unfold Handle.read inh
220
206
221#ifdef INSPECTION
207#ifdef INSPECTION
222inspect $ hasNoTypeClasses 'copyStreamLatin1'
208inspect $ hasNoTypeClasses 'copyStreamLatin1'
223inspect $ 'copyStreamLatin1' `hasNoType` ''Step
209inspect $ 'copyStreamLatin1' `hasNoType` ''Step
224inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
210inspect $ 'copyStreamLatin1' `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
211+inspect $ 'copyStreamLatin1' `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
225
212
226inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step
213inspect $ 'copyStreamLatin1' `hasNoType` ''Fold.Step
227−inspect $ 'copyStreamLatin1' `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
214+inspect $ 'copyStreamLatin1' `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
228− -- Handle.read/Array.read
229inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
215inspect $ 'copyStreamLatin1' `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
230#endif
216#endif
231
217
@@ -236,17 +222,17 @@ copyStreamLatin1 inh outh =
236 Stream.fold (Handle.write outh)
222 Stream.fold (Handle.write outh)
237 $ Unicode.encodeLatin1
223 $ Unicode.encodeLatin1
238 $ Unicode.decodeLatin1
224 $ Unicode.decodeLatin1
239− $ Stream.unfold Handle.reader inh
225+ $ Stream.unfold Handle.read inh
240
226
241#ifdef INSPECTION
227#ifdef INSPECTION
242inspect $ hasNoTypeClasses 'copyStreamLatin1
228inspect $ hasNoTypeClasses 'copyStreamLatin1
243inspect $ 'copyStreamLatin1 `hasNoType` ''Step
229inspect $ 'copyStreamLatin1 `hasNoType` ''Step
244inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
230inspect $ 'copyStreamLatin1 `hasNoType` ''Unfold.ConcatState -- Handle.read/UF.many
231+inspect $ 'copyStreamLatin1 `hasNoType` ''MArray.ReadUState -- Handle.read/Array.read
245
232
246inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState
233inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.ManyState
247inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step
234inspect $ 'copyStreamLatin1 `hasNoType` ''Fold.Step
248−inspect $ 'copyStreamLatin1 `hasNoType` ''MutArray.ArrayUnsafe -- Handle.write/writeNUnsafe
235+inspect $ 'copyStreamLatin1 `hasNoType` ''Array.ArrayUnsafe -- Handle.write/writeNUnsafe
249− -- Handle.read/Array.read
250inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
236inspect $ 'copyStreamLatin1 `hasNoType` ''Strict.Tuple3' -- Handle.write/chunksOf
251#endif
237#endif
252
238
@@ -256,7 +242,7 @@ _copyStreamUtf8' inh outh =
256 Stream.fold (Handle.write outh)
242 Stream.fold (Handle.write outh)
257 $ Unicode.encodeUtf8'
243 $ Unicode.encodeUtf8'
258 $ Unicode.decodeUtf8'
244 $ Unicode.decodeUtf8'
259− $ Stream.unfold Handle.reader inh
245+ $ Stream.unfold Handle.read inh
260
246
261#ifdef INSPECTION
247#ifdef INSPECTION
262inspect $ hasNoTypeClasses '_copyStreamUtf8'
248inspect $ hasNoTypeClasses '_copyStreamUtf8'
@@ -272,7 +258,7 @@ copyStreamUtf8 inh outh =
272 Stream.fold (Handle.write outh)
258 Stream.fold (Handle.write outh)
273 $ Unicode.encodeUtf8
259 $ Unicode.encodeUtf8
274 $ Unicode.decodeUtf8
260 $ Unicode.decodeUtf8
275− $ Stream.unfold Handle.reader inh
261+ $ Stream.unfold Handle.read inh
276
262
277#ifdef INSPECTION
263#ifdef INSPECTION
278inspect $ hasNoTypeClasses 'copyStreamUtf8
264inspect $ hasNoTypeClasses 'copyStreamUtf8
@@ -286,18 +272,17 @@ _copyStreamUtf8'Fold :: Handle -> Handle -> IO ()
286_copyStreamUtf8'Fold inh outh =
272_copyStreamUtf8'Fold inh outh =
287 Stream.fold (Handle.write outh)
273 Stream.fold (Handle.write outh)
288 $ Unicode.encodeUtf8
274 $ Unicode.encodeUtf8
289− $ Stream.catRights
290− $ Stream.parseMany Unicode.writeCharUtf8'
275+ $ Stream.foldMany Unicode.writeCharUtf8'
291− $ Stream.unfold Handle.reader inh
276+ $ Stream.unfold Handle.read inh
292
277
293{-# NOINLINE _copyStreamUtf8Parser #-}
278{-# NOINLINE _copyStreamUtf8Parser #-}
294_copyStreamUtf8Parser :: Handle -> Handle -> IO ()
279_copyStreamUtf8Parser :: Handle -> Handle -> IO ()
295_copyStreamUtf8Parser inh outh =
280_copyStreamUtf8Parser inh outh =
296 Stream.fold (Handle.write outh)
281 Stream.fold (Handle.write outh)
297 $ Unicode.encodeUtf8
282 $ Unicode.encodeUtf8
298− $ Stream.catRights $ Stream.parseMany
283+ $ Stream.parseMany
299 (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)
284 (Unicode.parseCharUtf8With Unicode.TransliterateCodingFailure)
300− $ Stream.unfold Handle.reader inh
285+ $ Stream.unfold Handle.read inh
301
286
302o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]
287o_1_space_decode_encode_read :: BenchEnv -> [Benchmark]
303o_1_space_decode_encode_read env =
288o_1_space_decode_encode_read env =
@@ -324,7 +309,6 @@ o_1_space_decode_encode_read env =
324
309
325main :: IO ()
310main :: IO ()
326main = do
311main = do
327−#ifndef FUSION_CHECK
328 env <- mkHandleBenchEnv
312 env <- mkHandleBenchEnv
329 defaultMain (allBenchmarks env)
313 defaultMain (allBenchmarks env)
330
314
@@ -337,13 +321,3 @@ main = do
337 , o_1_space_decode_encode_read env
321 , o_1_space_decode_encode_read env
338 ]
322 ]
339 ]
323 ]
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 Test.Tasty.Bench hiding (env)
16+import Gauge 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" $ whnf pack value
52+ [ bench "pack" $ nf pack value
53− , bench "pack + unpack" $ whnf packUnpack value
53+ , bench "pack + unpack" $ nf packUnpack value
54 ]
54 ]
55 ]
55 ]
benchmark/bench-report/BenchReport.hsnew file+272
@@ -0,0 +1,272 @@
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 System.Environment (getArgs)
14+import Text.Read (readMaybe)
15+
16+import BenchShow
17+
18+------------------------------------------------------------------------------
19+-- Command line parsing
20+------------------------------------------------------------------------------
21+
22+data BenchType
23+ = Compare String
24+ | Standard String
25+ deriving Show
26+
27+data Options = Options
28+ { genGraphs :: Bool
29+ , sortByName :: Bool
30+ , useGauge :: Bool
31+ , benchType :: Maybe BenchType
32+ , fields :: [String]
33+ , diffStyle :: GroupStyle
34+ , cutOffPercent :: Double
35+ } deriving Show
36+
37+defaultOptions :: Options
38+defaultOptions = Options False False False Nothing ["time"] PercentDiff 0
39+
40+setGenGraphs :: Monad m => Bool -> StateT (a, Options) m ()
41+setGenGraphs val = do
42+ (args, opts) <- get
43+ put (args, opts { genGraphs = val })
44+
45+setSortByName :: Monad m => Bool -> StateT (a, Options) m ()
46+setSortByName val = do
47+ (args, opts) <- get
48+ put (args, opts { sortByName = val })
49+
50+setUseGauge :: Monad m => Bool -> StateT (a, Options) m ()
51+setUseGauge val = do
52+ (args, opts) <- get
53+ put (args, opts { useGauge = val })
54+
55+setBenchType :: Monad m => BenchType -> StateT (a, Options) m ()
56+setBenchType val = do
57+ (args, opts) <- get
58+ put (args, opts { benchType = Just val })
59+
60+setFields :: Monad m => [String] -> StateT (a, Options) m ()
61+setFields val = do
62+ (args, opts) <- get
63+ put (args, opts { fields = val })
64+
65+setDiff :: Monad m => String -> StateT (a, Options) m ()
66+setDiff val = do
67+ (args, opts) <- get
68+ let cmpStyle =
69+ case val of
70+ "absolute" -> Absolute
71+ "multiples" -> Multiples
72+ "percent" -> PercentDiff
73+ x -> error $ "Unknown diff option: " ++ show x
74+ in put (args, opts { diffStyle = cmpStyle })
75+
76+setCutOff :: Monad m => String -> StateT (a, Options) m ()
77+setCutOff val = do
78+ (args, opts) <- get
79+ case readMaybe val of
80+ Just x -> put (args, opts { cutOffPercent = x })
81+ Nothing -> error $ "Invalid cutoff value: " ++ show val
82+
83+-- Like the shell "shift" to shift the command line arguments
84+shift :: StateT ([String], Options) (MaybeT IO) (Maybe String)
85+shift = do
86+ s <- get
87+ case s of
88+ ([], _) -> return Nothing
89+ (x : xs, opts) -> put (xs, opts) >> return (Just x)
90+
91+parseBench :: StateT ([String], Options) (MaybeT IO) ()
92+parseBench = do
93+ x <- shift
94+ case x of
95+ Just str | "_cmp" `isSuffixOf` str -> setBenchType (Compare str)
96+ Just str -> setBenchType (Standard str)
97+ Nothing -> do
98+ liftIO $ putStrLn "please provide a benchmark type "
99+ mzero
100+
101+parseFields :: StateT ([String], Options) (MaybeT IO) ()
102+parseFields = do
103+ x <- shift
104+ case x of
105+ Just str -> setFields (words str)
106+ Nothing -> do
107+ liftIO $ putStrLn
108+ "please provide a list of fields after --fields"
109+ mzero
110+
111+parseDiff :: StateT ([String], Options) (MaybeT IO) ()
112+parseDiff = do
113+ x <- shift
114+ case x of
115+ Just str -> setDiff str
116+ Nothing -> do
117+ liftIO $ putStrLn "please provide a diff type"
118+ mzero
119+
120+parseCutOff :: StateT ([String], Options) (MaybeT IO) ()
121+parseCutOff = do
122+ x <- shift
123+ case x of
124+ Just str -> setCutOff str
125+ Nothing -> do
126+ liftIO $ putStrLn "please provide a cutoff percent"
127+ mzero
128+
129+-- totally imperative style option parsing
130+parseOptions :: IO (Maybe Options)
131+parseOptions = do
132+ args <- getArgs
133+ runMaybeT $ flip evalStateT (args, defaultOptions) $ do
134+ parseLoop
135+ fmap snd get
136+
137+ where
138+
139+ parseOpt opt =
140+ case opt of
141+ "--graphs" -> setGenGraphs True
142+ "--sort-by-name" -> setSortByName True
143+ "--use-gauge" -> setUseGauge True
144+ "--benchmark" -> parseBench
145+ "--fields" -> parseFields
146+ "--diff-style" -> parseDiff
147+ "--diff-cutoff-percent" -> parseCutOff
148+ str -> do
149+ liftIO $ putStrLn $ "Unrecognized option " <> str
150+ mzero
151+
152+ parseLoop = do
153+ next <- shift
154+ case next of
155+ Just opt -> parseOpt opt >> parseLoop
156+ Nothing -> return ()
157+
158+ignoringErr :: IO () -> IO ()
159+ignoringErr a = catch a (\(ErrorCall err :: ErrorCall) ->
160+ putStrLn $ "Failed with error:\n" <> err <> "\nSkipping.")
161+
162+------------------------------------------------------------------------------
163+-- Generic
164+------------------------------------------------------------------------------
165+
166+makeGraphs :: String -> Config -> String -> IO ()
167+makeGraphs name cfg inputFile =
168+ ignoringErr $ graph inputFile name cfg
169+
170+------------------------------------------------------------------------------
171+-- Arrays
172+------------------------------------------------------------------------------
173+
174+showComparisons :: Options -> Config -> FilePath -> FilePath -> IO ()
175+showComparisons Options{..} cfg inp out =
176+ let cfg1 = cfg { classifyBenchmark = classifyComparison }
177+ in if genGraphs
178+ then ignoringErr $ graph inp "comparison"
179+ cfg1 { outputDir = Just out
180+ , presentation = Groups Absolute
181+ }
182+ else ignoringErr $ report inp Nothing cfg1
183+
184+ where
185+
186+ separator = if useGauge then '/' else '.'
187+ dropComponent sep = dropWhile (== sep) . dropWhile (/= sep)
188+
189+ -- In case of tasty-bench the names could be like
190+ -- All.Data.Array.Prim.Pinned/o-1-space.generation.show
191+ -- All.Data.Array.Foreign/o-1-space.generation.show
192+ classifyComparison b =
193+ let b1 =
194+ if useGauge
195+ then b
196+ else dropComponent separator b --- drop "All." at the beginning
197+ in Just
198+ ( takeWhile (/= '/') b1
199+ , dropComponent '/' b1 -- for tasty-bench drop up to "/"
200+ )
201+
202+------------------------------------------------------------------------------
203+-- text reports
204+------------------------------------------------------------------------------
205+
206+selectBench
207+ :: Options
208+ -> (SortColumn -> Maybe GroupStyle -> Either String [(String, Double)])
209+ -> [String]
210+selectBench Options{..} f =
211+ -- Apply filterPred only if at least 2 columns exist
212+ let colVals =
213+ case f (ColumnIndex 1) (Just PercentDiff) of
214+ Left _ -> either error id $ f (ColumnIndex 0) (Just PercentDiff)
215+ Right xs -> filter (filterPred . snd) xs
216+ in reverse
217+ $ fmap fst
218+ $ sortFunc colVals
219+
220+ where
221+
222+ sortFunc = if sortByName then sortOn fst else sortOn snd
223+
224+ filterPred x
225+ | isInfinite x = False
226+ | isNaN x = False
227+ | cutOffPercent > 0 = x >= cutOffPercent
228+ | cutOffPercent < 0 = x <= cutOffPercent
229+ | otherwise = True
230+
231+benchShow ::
232+ Options
233+ -> Config
234+ -> (Config -> String -> IO ())
235+ -> String
236+ -> FilePath
237+ -> IO ()
238+benchShow Options{..} cfg func inp out =
239+ if genGraphs
240+ then func cfg {outputDir = Just out} inp
241+ else ignoringErr $ report inp Nothing cfg
242+
243+main :: IO ()
244+main = do
245+ res <- parseOptions
246+ case res of
247+ Nothing -> do
248+ putStrLn "cannot parse options"
249+ return ()
250+ Just opts@Options{fields = fs, benchType = btype} ->
251+ let cfg = defaultConfig
252+ { presentation = Groups (diffStyle opts)
253+ , selectBenchmarks = selectBench opts
254+ , selectFields = filter
255+ ( flip elem (fmap (fmap toLower) fs)
256+ . fmap toLower
257+ )
258+ }
259+ in case btype of
260+ Just (Compare str) ->
261+ showComparisons opts cfg
262+ { title = Just str }
263+ ("charts/" ++ str ++ "/results.csv")
264+ ("charts/" ++ str)
265+ Just (Standard str) ->
266+ benchShow opts cfg
267+ { title = Just str }
268+ (makeGraphs str)
269+ ("charts/" ++ str ++ "/results.csv")
270+ ("charts/" ++ str)
271+ Nothing ->
272+ error "Please specify a benchmark using --benchmark."
benchmark/bench-report/bench-report.cabalnew file+23
@@ -0,0 +1,23 @@
1+cabal-version: 2.2
2+name: bench-report
3+version: 0.0.0
4+synopsis: Benchmark report generation
5+description: Benchmark reporting application is not included in the overall
6+ cabal project so that the dependencies of both can remain independent.
7+ Benchmark reporting has a lot of dependencies that usually lag behind
8+ when new GHC releases arrive.
9+
10+-------------------------------------------------------------------------------
11+-- benchmark comparison and presentation
12+-------------------------------------------------------------------------------
13+
14+executable bench-report
15+ default-language: Haskell2010
16+ ghc-options: -Wall
17+ hs-source-dirs: .
18+ main-is: BenchReport.hs
19+ buildable: True
20+ build-Depends:
21+ base >= 4.9 && < 4.17
22+ , bench-show >= 0.3.2 && < 0.4
23+ , transformers >= 0.4 && < 0.6
benchmark/bench-report/bin/bench-runner.shnew file+685
@@ -0,0 +1,685 @@
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 " [--diff-cutoff-percent <percent-value>]"
25+ echo " [--graphs]"
26+ echo " [--silent]"
27+ echo " [--no-measure]"
28+ echo " [--append]"
29+ echo " [--long]"
30+ echo " [--slow]"
31+ echo " [--quick]"
32+ echo " [--raw]"
33+ echo " [--dev-build]"
34+ echo " [--use-nix]"
35+ echo " [--with-compiler <compiler exe name>]"
36+ echo " [--cabal-build-options <options>]"
37+ echo " [--rtsopts <opts>]"
38+ #echo " [--commit-compare] [--base <commit>] [--candidate <commit>]"
39+ #echo " -- <gauge options or benchmarks>"
40+ echo
41+ echo "--benchmarks: benchmarks to run, use 'help' for list of benchmarks"
42+ echo "--compare: compare the specified benchmarks with each other"
43+
44+ echo "--diff-cutoff-percent: Diff percentage used for benchmark selection."
45+ echo "This applies only to the second column of the report and makes sense"
46+ echo "only while comparing benchmarks."
47+ echo "A positive cutoff value selects only regressions, whereas, a negative"
48+ echo "cutoff value selects only improvements."
49+
50+ echo "--fields: measurement fields to report, use 'help' for a list"
51+ echo "--graphs: Generate graphical reports"
52+ echo "--no-measure: Don't run benchmarks, run reports from previous results"
53+ echo "--append: Don't overwrite previous results, append for comparison"
54+ echo "--long: Use much longer stream size for infinite stream benchmarks"
55+ echo "--slow: Slightly more accurate results at the expense of speed"
56+ echo "--quick: Faster results, useful for longer benchmarks"
57+ echo "--raw: Run the benchmarks but don't report them. This is useful when"
58+ echo " you only want to work with the csv files generated."
59+ echo "--cabal-build-options: Pass any cabal build options to be used for build"
60+ echo " e.g. --cabal-build-options \"--flag dev\""
61+ echo
62+ echo "When specific space complexity group is chosen then (and only then) "
63+ echo "RTS memory restrictions are used accordingly. For example, "
64+ echo "bench.sh --benchmarks Data.Parser -- Data.Parser/o-1-space "
65+ echo "restricts Heap/Stack space for O(1) characterstics"
66+ echo
67+ #echo "When using --commit-compare, by default comparative chart of HEAD^ vs HEAD"
68+ #echo "commit is generated, in the 'charts' directory."
69+ #echo "Use --base and --candidate to select the commits to compare."
70+ #echo
71+ #echo "Any arguments after a '--' are passed directly to gauge"
72+ exit
73+}
74+
75+#-----------------------------------------------------------------------------
76+# Reporting utility functions
77+#-----------------------------------------------------------------------------
78+
79+list_comparisons () {
80+ echo "Comparison groups:"
81+ for i in $COMPARISONS
82+ do
83+ echo -n "$i ["
84+ eval "echo -n \$$i"
85+ echo "]"
86+ done
87+ echo
88+}
89+
90+build_report_prog() {
91+ local prog_path=$BENCH_REPORT_DIR/bin/bench-report
92+
93+ hash -r
94+ if test ! -x "$prog_path" -a "$BUILD_ONCE" = "0"
95+ then
96+ echo "Building bench-report executables"
97+ BUILD_ONCE=1
98+ pushd $BENCH_REPORT_DIR
99+ local cmd
100+ cmd="$CABAL_EXECUTABLE install --installdir bin bench-report"
101+ if test "$USE_NIX" -eq 0
102+ then
103+ $cmd || die "bench-report build failed"
104+ else
105+ nix-shell --run "$cmd" || die "bench-report build failed"
106+ fi
107+ popd
108+ elif test ! -x "$prog_path"
109+ then
110+ return 1
111+ fi
112+ return 0
113+}
114+
115+build_report_progs() {
116+ if test "$RAW" = "0"
117+ then
118+ build_report_prog || exit 1
119+ local prog
120+ prog=$BENCH_REPORT_DIR/bin/bench-report
121+ test -x $prog || die "Cannot find bench-report executable"
122+ echo "Using bench-report executable [$prog]"
123+ fi
124+}
125+
126+# We run the benchmarks in isolation in a separate process so that different
127+# benchmarks do not interfere with other. To enable that we need to pass the
128+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
129+# own path currently.
130+
131+# The path is dependent on the architecture and cabal version.
132+
133+bench_output_file() {
134+ local bench_name=$1
135+ echo "charts/$bench_name/results.csv"
136+}
137+
138+#------------------------------------------------------------------------------
139+# Speed options
140+#------------------------------------------------------------------------------
141+
142+# tasty-bench does not like an option set twice
143+set_super_quick_mode () {
144+ echo -n super_quick
145+}
146+
147+# For certain long benchmarks if the user has not requested super quick
148+# mode we anyway use a slightly quicker mode.
149+use_quicker_mode () {
150+ if test "$QUICK_MODE" -eq 0
151+ then
152+ echo quicker
153+ fi
154+}
155+
156+#------------------------------------------------------------------------------
157+# Determine options from benchmark name
158+#------------------------------------------------------------------------------
159+
160+# Global environment passed:
161+# BENCH_EXEC_PATH: the benchmark executable
162+# RTS_OPTIONS: additional RTS options
163+# QUICK_MODE: whether we are in quick mode
164+# USE_GAUGE: whether to use gauge or tasty-bench
165+# LONG: whether to use a large stream size
166+
167+# $1: bench name
168+bench_exec_one() {
169+ local BENCH_NAME_ORIG
170+ BENCH_NAME_ORIG="$1"
171+ shift
172+
173+ local SUPER_QUICK_OPTIONS
174+ local QUICKER_OPTIONS
175+ if test "$USE_GAUGE" -eq 0
176+ then
177+ SUPER_QUICK_OPTIONS="--stdev 1000000"
178+ QUICKER_OPTIONS="--stdev 100"
179+ else
180+ # Do not keep time limit as 0 otherwise GC stats may remain 0 in some cases.
181+ SUPER_QUICK_OPTIONS="--quick --min-duration 0 --time-limit 0.01 --include-first-iter"
182+ QUICKER_OPTIONS="--min-samples 3 --time-limit 1"
183+ fi
184+
185+ local BENCH_NAME0
186+ local BENCH_NAME1
187+ local BENCH_NAME2
188+ local BENCH_NAME
189+ # XXX this is a hack to make the "/" separated names used in the functions
190+ # determining options based on benchmark name. For tasty-bench the benchmark
191+ # names are separated by "." instead of "/" and are prefixed by "All".
192+ #
193+ # For example, All.Prelude.Serial/x.y.z => Prelude.Serial/x/y/z
194+ if test "$USE_GAUGE" -eq 0
195+ then
196+ # Remove the prefix "All."
197+ BENCH_NAME0=$(echo $BENCH_NAME_ORIG | sed -e s/^All\.//)
198+
199+ # Module names could contain dots e.g. "Prelude.Serial". So we insert
200+ # an explicit "/" to separate the module name part and the rest of
201+ # the benchmark name. For example, Prelude.Serial/elimination.drain
202+ BENCH_NAME1=$(echo $BENCH_NAME0 | cut -f1 -d '/')
203+
204+ if test "$BENCH_NAME1" = "$BENCH_NAME0"
205+ then
206+ # There is no "/" separator
207+ BENCH_NAME1=$(echo $BENCH_NAME0 | sed -e 's/\./\//g')
208+ BENCH_NAME2=""
209+ else
210+ BENCH_NAME2=/$(echo $BENCH_NAME0 | cut -f2- -d '/' | sed -e 's/\./\//g')
211+ fi
212+ BENCH_NAME="${BENCH_NAME1}${BENCH_NAME2}"
213+ else
214+ BENCH_NAME=$BENCH_NAME_ORIG
215+ fi
216+
217+ local RTS_OPTIONS1
218+ RTS_OPTIONS1="\
219++RTS -T \
220+$(bench_rts_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME) \
221+$RTS_OPTIONS \
222+-RTS"
223+
224+ local QUICK_MODE_TYPE
225+ QUICK_MODE_TYPE="\
226+ $(if test "$QUICK_MODE" -ne 0; then set_super_quick_mode; fi) \
227+ $(bench_speed_options $(basename $BENCH_EXEC_PATH) $BENCH_NAME)"
228+
229+ local QUICK_BENCH_OPTIONS
230+ for i in $QUICK_MODE_TYPE
231+ do
232+ case "$i" in
233+ super_quick) QUICK_BENCH_OPTIONS="$SUPER_QUICK_OPTIONS"; break ;;
234+ quicker) QUICK_BENCH_OPTIONS="$QUICKER_OPTIONS"; break ;;
235+ esac
236+ done
237+
238+ local STREAM_SIZE
239+ local STREAM_LEN
240+ local STREAM_SIZE_OPT
241+ if test "$LONG" -ne 0
242+ then
243+ STREAM_SIZE=10000000
244+ STREAM_LEN=$(env LC_ALL=en_US.UTF-8 printf "--stream-size %'.f\n" $STREAM_SIZE)
245+ STREAM_SIZE_OPT="--stream-size $STREAM_SIZE"
246+ fi
247+
248+ echo "$BENCH_NAME_ORIG: \
249+ $RTS_OPTIONS1 \
250+ $STREAM_LEN \
251+ $QUICK_BENCH_OPTIONS" \
252+ "$@"
253+
254+ #------------------------------------------------------------------------------
255+ # Run benchmark with options and collect results
256+ #------------------------------------------------------------------------------
257+
258+ local output_file
259+ output_file=$(bench_output_file $(basename $BENCH_EXEC_PATH))
260+ mkdir -p `dirname $output_file`
261+ rm -f ${output_file}.tmp
262+
263+ local BENCH_NAME_ESC
264+ if test $USE_GAUGE -eq 0
265+ then
266+ # Escape "\" and double quotes in benchmark names
267+ BENCH_NAME_ESC=$(echo "$BENCH_NAME_ORIG" | sed -e 's/\\/\\\\/g' | sed -e 's/"/\\"/g')
268+ $BENCH_EXEC_PATH \
269+ -j 1 \
270+ $RTS_OPTIONS1 \
271+ $STREAM_SIZE_OPT \
272+ $QUICK_BENCH_OPTIONS \
273+ "$@" \
274+ --csv=${output_file}.tmp \
275+ -p '$0 == "'"$BENCH_NAME_ESC"'"' || die "Benchmark execution failed."
276+
277+ # Convert cpuTime field from picoseconds to seconds
278+ awk --version 2>&1 | grep -q "GNU Awk" \
279+ || die "Need GNU awk. [$(which awk)] is not GNU awk."
280+ tail -n +2 ${output_file}.tmp | \
281+ awk 'BEGIN {FPAT = "([^,]+)|(\"[^\"]+\")";OFS=","} {$2=$2/1000000000000;print}' \
282+ >> $output_file
283+ else
284+ $BENCH_EXEC_PATH \
285+ $RTS_OPTIONS1 \
286+ $STREAM_SIZE_OPT \
287+ $QUICK_BENCH_OPTIONS \
288+ "$@" \
289+ --csvraw=${output_file}.tmp \
290+ -m exact "$BENCH_NAME" || die "Benchmark execution failed."
291+ tail -n +2 ${output_file}.tmp \
292+ >> $output_file
293+ fi
294+}
295+
296+invoke_gauge () {
297+ local target_prog="$1"
298+ local target_name="$2"
299+ local output_file="$3"
300+
301+ local MATCH=""
302+ if test "$LONG" -ne 0
303+ then
304+ MATCH="$target_name/o-1-space"
305+ else
306+ MATCH="$BENCH_PREFIX"
307+ fi
308+ echo "name,iters,time,cycles,cpuTime,utime,stime,maxrss,minflt,majflt,nvcsw,nivcsw,allocated,numGcs,bytesCopied,mutatorWallSeconds,mutatorCpuSeconds,gcWallSeconds,gcCpuSeconds" >> $output_file
309+ # keep only benchmark names with shortest prefix e.g. "a/b/c" and "a/b", we
310+ # should only keep "a/b" otherwise benchmarks will run multiple times. why?
311+ $target_prog -l \
312+ | grep "^$MATCH" \
313+ | while read -r name; \
314+ do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
315+ || die "Benchmark execution failed."
316+}
317+
318+invoke_tasty_bench () {
319+ local target_prog="$1"
320+ local target_name="$2"
321+ local output_file="$3"
322+
323+ local MATCH=""
324+ if test "$LONG" -ne 0
325+ then
326+ MATCH="-p /$target_name\/o-1-space/"
327+ else
328+ if test -n "$BENCH_PREFIX"
329+ then
330+ # escape "/"
331+ local escaped_name=$(echo "$BENCH_PREFIX" | sed -e 's/\//\\\//g')
332+ MATCH="-p /$escaped_name/"
333+ fi
334+ fi
335+ echo "Name,cpuTime,2*Stdev (ps),Allocated,bytesCopied,maxrss" >> $output_file
336+ $target_prog -l $MATCH \
337+ | grep "^All" \
338+ | while read -r name; \
339+ do bench_exec_one "$name" "${GAUGE_ARGS[@]}" || exit 1; done \
340+ || die "Benchmark execution failed."
341+}
342+
343+run_bench_target () {
344+ local package_name=$1
345+ local component=$2
346+ local target_name=$3
347+
348+ local target_prog
349+ if test -z "$BENCHMARK_PACKAGE_VERSION"
350+ then
351+ echo "Please set BENCHMARK_PACKAGE_VERSION in bench_config"
352+ exit 1
353+ fi
354+ target_prog=$(cabal_target_prog $package_name-$BENCHMARK_PACKAGE_VERSION $component $target_name) || \
355+ die "Cannot find executable for target $target_name"
356+
357+ echo "Running executable $target_name ..."
358+
359+ # Needed by bench_exec_one
360+ BENCH_EXEC_PATH=$target_prog
361+
362+ local output_file=$(bench_output_file $target_name)
363+ mkdir -p `dirname $output_file`
364+ if test "$USE_GAUGE" -eq 0
365+ then invoke_tasty_bench "$target_prog" "$target_name" "$output_file"
366+ else invoke_gauge "$target_prog" "$target_name" "$output_file"
367+ fi
368+}
369+
370+# $1: package name
371+# $2: component
372+# $3: targets
373+run_bench_targets() {
374+ for i in $3
375+ do
376+ run_bench_target $1 $2 $i
377+ done
378+}
379+
380+run_benches_comparing() {
381+ local bench_list=$1
382+
383+ if test -z "$CANDIDATE"
384+ then
385+ CANDIDATE=$(git rev-parse HEAD)
386+ fi
387+ if test -z "$BASE"
388+ then
389+ # XXX Should be where the current branch is forked from master
390+ BASE="$CANDIDATE^"
391+ fi
392+ echo "Comparing baseline commit [$BASE] with candidate [$CANDIDATE]"
393+ echo "Checking out base commit [$BASE] for benchmarking"
394+ # XXX git checkout will overwrite this script itself and the scripts
395+ # imported/used by this script.
396+ git checkout "$BASE" || die "Checkout of base commit [$BASE] failed"
397+
398+ # $BUILD_BENCH || die "build failed"
399+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
400+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
401+
402+ echo "Checking out candidate commit [$CANDIDATE] for benchmarking"
403+ git checkout "$CANDIDATE" || \
404+ die "Checkout of candidate [$CANDIDATE] commit failed"
405+
406+ # $BUILD_BENCH || die "build failed"
407+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
408+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
409+ # XXX reset back to the original commit
410+}
411+
412+backup_output_file() {
413+ local bench_name=$1
414+ local output_file=$(bench_output_file $bench_name)
415+
416+ if test -e $output_file -a "$APPEND" != 1
417+ then
418+ mv -f -v $output_file ${output_file}.prev
419+ fi
420+}
421+
422+run_measurements() {
423+ local bench_list=$1
424+
425+ for i in $bench_list
426+ do
427+ backup_output_file $i
428+ done
429+
430+ if test "$COMMIT_COMPARE" = "0"
431+ then
432+ run_build "$BUILD_BENCH" $BENCHMARK_PACKAGE_NAME bench "$TARGETS"
433+ run_bench_targets $BENCHMARK_PACKAGE_NAME b "$bench_list" target_exe_extra_args
434+ else
435+ run_benches_comparing "$bench_list"
436+ fi
437+}
438+
439+run_reports() {
440+ local prog
441+ prog=$BENCH_REPORT_DIR/bin/bench-report
442+ test -x $prog || die "Cannot find bench-report executable"
443+ test -z "$SILENT" && echo
444+
445+ for i in $1
446+ do
447+ test -z "$SILENT" && echo "Generating reports for ${i}..."
448+ $prog \
449+ --benchmark $i \
450+ $(test "$USE_GAUGE" = 1 && echo "--use-gauge") \
451+ $(test "$GRAPH" = 1 && echo "--graphs") \
452+ $(test "$SORT_BY_NAME" = 1 && echo "--sort-by-name") \
453+ $(test -n "$BENCH_DIFF_STYLE" && echo "--diff-style $BENCH_DIFF_STYLE") \
454+ $(test -n "$BENCH_CUTOFF_PERCENT" && echo "--diff-cutoff-percent $BENCH_CUTOFF_PERCENT") \
455+ --fields "$FIELDS"
456+ done
457+}
458+
459+#-----------------------------------------------------------------------------
460+# Execution starts here
461+#-----------------------------------------------------------------------------
462+
463+USE_GIT_CABAL=1 # This is used by set_common_vars
464+set_common_vars
465+
466+USE_NIX=0
467+COMPARE=0
468+COMMIT_COMPARE=0
469+BASE=
470+CANDIDATE=
471+
472+APPEND=0
473+LONG=0
474+RAW=0
475+SORT_BY_NAME=0
476+GRAPH=0
477+MEASURE=1
478+
479+GAUGE_ARGS=
480+BUILD_ONCE=0
481+
482+CABAL_BUILD_OPTIONS="--flag fusion-plugin --flag limit-build-mem"
483+
484+#-----------------------------------------------------------------------------
485+# Read command line
486+#-----------------------------------------------------------------------------
487+
488+while test -n "$1"
489+do
490+ case $1 in
491+ -h|--help|help) print_help ;;
492+ # options with arguments
493+ --benchmarks) shift; TARGETS=$1; shift ;;
494+ --targets) shift; TARGETS=$1; shift ;;
495+ --prefix) shift; BENCH_PREFIX="$1"; shift ;;
496+ --fields) shift; FIELDS=$1; shift ;;
497+ --base) shift; BASE=$1; shift ;;
498+ --candidate) shift; CANDIDATE=$1; shift ;;
499+ --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;
500+ --cabal-build-flags) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
501+ --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
502+ --rtsopts) shift; RTS_OPTIONS=$1; shift ;;
503+ --config) shift; BENCH_CONFIG_FILE=$1; shift ;;
504+ --diff-style) shift; BENCH_DIFF_STYLE=$1; shift ;;
505+ --diff-cutoff-percent) shift; BENCH_CUTOFF_PERCENT=$1; shift ;;
506+ # flags
507+ --slow) SLOW=1; shift ;;
508+ --silent) SILENT=1; shift ;;
509+ --quick) QUICK_MODE=1; shift ;;
510+ --compare) COMPARE=1; shift ;;
511+ --commit-compare) COMMIT_COMPARE=1; shift ;;
512+ --raw) RAW=1; shift ;;
513+ --append) APPEND=1; shift ;;
514+ --long) LONG=1; shift ;;
515+ --sort-by-name) SORT_BY_NAME=1; shift ;;
516+ --graphs) GRAPH=1; shift ;;
517+ --no-measure) MEASURE=0; shift ;;
518+ # This is used in build-lib.sh to enable dev_build function which is used
519+ # in targets.sh to enable or disable some targets.
520+ --dev-build) RUNNING_DEVBUILD=1; shift ;;
521+ --use-nix) USE_NIX=1; shift ;;
522+ --use-gauge) USE_GAUGE=1; shift ;;
523+ --) shift; break ;;
524+ *) echo "Unknown flags: $*"; echo; print_help ;;
525+ esac
526+done
527+GAUGE_ARGS=("$@")
528+
529+if test -z "$BENCH_CONFIG_FILE"
530+then
531+ die "Please use --config to specify config file"
532+fi
533+
534+source "$BENCH_CONFIG_FILE" || \
535+ die "Failed to source config file $BENCH_CONFIG_FILE"
536+
537+# Defined in $BENCH_CONFIG_FILE
538+bench_config
539+
540+if test -z "$FIELDS"
541+then
542+ FIELDS=$DEFAULT_FIELDS
543+fi
544+
545+set_derived_vars
546+
547+#-----------------------------------------------------------------------------
548+# Determine targets
549+#-----------------------------------------------------------------------------
550+
551+only_real_benchmarks () {
552+ for i in $TARGETS
553+ do
554+ local SKIP=0
555+ for j in $COMPARISONS
556+ do
557+ if test $i == $j
558+ then
559+ SKIP=1
560+ fi
561+ done
562+ if test "$SKIP" -eq 0
563+ then
564+ echo -n "$i "
565+ fi
566+ done
567+}
568+
569+# defined in $BENCH_CONFIG_FILE
570+bench_targets
571+
572+if test "$(has_item "$TARGETS" help)" = "help"
573+then
574+ list_target_groups
575+ list_comparisons
576+ list_targets
577+ exit
578+fi
579+
580+COMMON_FIELDS="allocated bytescopied cputime maxrss"
581+if test "$USE_GAUGE" -eq 1
582+then
583+ ALL_FIELDS="$COMMON_FIELDS time cycles utime stime minflt majflt nvcsw nivcsw"
584+else
585+ ALL_FIELDS="$COMMON_FIELDS"
586+fi
587+if test "$(has_item "$FIELDS" help)" = "help"
588+then
589+ echo "Supported fields: $ALL_FIELDS"
590+ echo "Default fields: $DEFAULT_FIELDS"
591+ exit
592+fi
593+
594+if test "$LONG" -ne 0
595+then
596+ if test -n "$TARGETS"
597+ then
598+ echo "Cannot specify benchmarks [$TARGETS] with --long"
599+ exit
600+ fi
601+ TARGETS=$infinite_grp
602+fi
603+
604+DEFAULT_TARGETS="$(all_grp)"
605+TARGETS=$(set_targets)
606+
607+TARGETS_ORIG=$TARGETS
608+TARGETS=$(only_real_benchmarks)
609+
610+test -z "$SILENT" && echo "Using benchmark suites [$TARGETS]"
611+
612+#-----------------------------------------------------------------------------
613+# Build reporting utility
614+#-----------------------------------------------------------------------------
615+
616+# We need to build the report progs first at the current (latest) commit before
617+# checking out any other commit for benchmarking.
618+if test -z "$SILENT"
619+then build_report_progs
620+else silently build_report_progs
621+fi
622+
623+#-----------------------------------------------------------------------------
624+# Build and run targets
625+#-----------------------------------------------------------------------------
626+
627+if test "$USE_GAUGE" -eq 1
628+then
629+ BUILD_FLAGS="--flag use-gauge"
630+fi
631+
632+BUILD_BENCH="$CABAL_EXECUTABLE v2-build $BUILD_FLAGS $CABAL_BUILD_OPTIONS --enable-benchmarks"
633+if test "$MEASURE" = "1"
634+then
635+ run_measurements "$TARGETS"
636+fi
637+
638+#-----------------------------------------------------------------------------
639+# Run reports
640+#-----------------------------------------------------------------------------
641+
642+# $1: var name
643+build_comparison_results () {
644+ local name
645+ local constituents
646+
647+ name=$1
648+ constituents=$(eval "echo -n \$${name}")
649+ mkdir -p "charts/$name"
650+ dest_file="charts/$name/results.csv"
651+ : > $dest_file
652+ for j in $constituents
653+ do
654+ cat "charts/$j/results.csv" >> $dest_file
655+ done
656+}
657+
658+if test "$COMPARE" -eq 1
659+then
660+ DYN_CMP_GRP="$(echo "$TARGETS" | sed -e 's/ /_/g')_cmp"
661+ eval "$DYN_CMP_GRP=\"$TARGETS\""
662+ COMPARISON_REPORTS=$DYN_CMP_GRP
663+ build_comparison_results $DYN_CMP_GRP
664+else
665+ COMPARISON_REPORTS=""
666+fi
667+
668+for i in $COMPARISONS
669+do
670+ if test "$(has_item "$TARGETS_ORIG" $i)" = $i
671+ then
672+ COMPARISON_REPORTS="$COMPARISON_REPORTS $i"
673+ build_comparison_results $i
674+ fi
675+done
676+
677+if test "$RAW" = "0"
678+then
679+ run_reports "$TARGETS"
680+ run_reports "$COMPARISON_REPORTS"
681+ if test -n "$DYN_CMP_GRP"
682+ then
683+ rm -rf "charts/$DYN_CMP_GRP"
684+ fi
685+fi
benchmark/bench-report/bin/build-lib.shnew file+218
@@ -0,0 +1,218 @@
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+# $1: command
29+silently () {
30+ eval "$1 &> /dev/null"
31+}
32+
33+#------------------------------------------------------------------------------
34+# target groups
35+#------------------------------------------------------------------------------
36+
37+test_only () {
38+ if test -n "$RUNNING_TESTS"
39+ then
40+ echo $1
41+ fi
42+}
43+
44+bench_only () {
45+ if test -n "$RUNNING_BENCHMARKS"
46+ then
47+ echo $1
48+ fi
49+}
50+
51+dev_build () {
52+ if test -n "$RUNNING_DEVBUILD"
53+ then
54+ echo $1
55+ fi
56+}
57+
58+# A group consisting of all known individual targets
59+all_grp () {
60+ { for i in $GROUP_TARGETS
61+ do
62+ for j in $(eval "echo \$$i")
63+ do
64+ echo $j
65+ done
66+ done
67+ for i in $INDIVIDUAL_TARGETS
68+ do
69+ echo $i
70+ done
71+ } | sort | uniq
72+}
73+
74+# All groups
75+all_target_groups () {
76+ echo $GROUP_TARGETS
77+}
78+
79+# XXX pass as arg
80+list_targets () {
81+ echo "Individual targets:"
82+ for i in $(all_grp)
83+ do
84+ echo "$i"
85+ done
86+ echo
87+}
88+
89+# XXX pass as arg
90+list_target_groups () {
91+ echo "All Targets: all_grp"
92+ echo "Target groups:"
93+ for i in $(all_target_groups)
94+ do
95+ echo -n "$i ["
96+ eval "echo -n \$$i"
97+ echo "]"
98+ done
99+ echo
100+}
101+
102+# XXX pass as arg
103+set_targets() {
104+ if test -z "$TARGETS"
105+ then
106+ echo $DEFAULT_TARGETS
107+ else
108+ for i in $(echo $TARGETS)
109+ do
110+ case $i in
111+ *_grp) eval "echo -n \$${i}" ;;
112+ *_cmp) eval "echo -n \$${i} $i" ;;
113+ *) echo -n $i ;;
114+ esac
115+ echo -n " "
116+ done
117+ fi
118+}
119+
120+# XXX cabal issue "cabal v2-exec which" cannot find benchmark/test executables
121+
122+# $1: builddir
123+# $2: package name with version
124+# $3: component ("" (lib), t (test), b (benchmark), x (executable))
125+# $4: command to find
126+cabal_which_builddir() {
127+ local noopt=""
128+ if test "$TEST_QUICK_MODE" = "1"
129+ then
130+ noopt="/noopt"
131+ fi
132+
133+ local path=$(echo $1/build/*/ghc-${GHC_VERSION}/${2}/$3/$4$noopt/build/$4/$4)
134+ echo "[cabal_which $path]" 1>&2
135+ test -f "$path" && echo $path
136+}
137+
138+# $1: package name with version
139+# $2: component
140+# $3: command to find
141+cabal_which() {
142+ cabal_which_builddir $BUILD_DIR $1 $2 $3
143+}
144+
145+# We run the benchmarks in isolation in a separate process so that different
146+# benchmarks do not interfere with other. To enable that we need to pass the
147+# benchmark exe path to gauge as an argument. Unfortunately it cannot find its
148+# own path currently.
149+
150+# The path is dependent on the architecture and cabal version.
151+
152+# $1: package name with version
153+# $2: component
154+# $3: target
155+cabal_target_prog () {
156+ local target_prog=`cabal_which $1 $2 $3`
157+ if test -x "$target_prog"
158+ then
159+ echo $target_prog
160+ else
161+ return 1
162+ fi
163+}
164+
165+set_common_vars () {
166+ SLOW=0
167+ QUICK_MODE=0
168+
169+ RUNNING_DEVBUILD=
170+
171+ TARGET_EXE_ARGS=
172+ RTS_OPTIONS=
173+
174+ CABAL_BUILD_OPTIONS=""
175+ CABAL_EXECUTABLE=cabal
176+
177+ # Use branch specific builds if git-cabal is present in PATH
178+ BUILD_DIR=dist-newstyle
179+ if test "$USE_GIT_CABAL" -eq 1
180+ then
181+ if which git-cabal 2>/dev/null
182+ then
183+ echo "Using git-cabal for branch specific builds"
184+ CABAL_EXECUTABLE=git-cabal
185+ BUILD_DIR=$(git-cabal show-builddir)
186+ fi
187+ fi
188+}
189+
190+# To be called after parsing CLI arguments
191+set_derived_vars () {
192+ if test -n "$CABAL_WITH_COMPILER"
193+ then
194+ CABAL_BUILD_OPTIONS+=" --with-compiler $CABAL_WITH_COMPILER"
195+ else
196+ CABAL_WITH_COMPILER=ghc
197+ fi
198+
199+ GHC_VERSION=$($CABAL_WITH_COMPILER --numeric-version)
200+}
201+
202+# $1: build program
203+# $2: package name
204+# $3: component prefix
205+# $4: targets
206+run_build () {
207+ local build_prog=$1
208+ local package=$2
209+ local component_prefix=$3
210+ local COMPONENTS
211+ local c
212+
213+ for c in $4
214+ do
215+ COMPONENTS+="$package:$component_prefix:$c "
216+ done
217+ run_verbose $build_prog $COMPONENTS || die "build failed"
218+}
targets/cabal.project → benchmark/bench-report/cabal.projectrenamed

The content is the same.

benchmark/bench-report/default.nixnew file+55
@@ -0,0 +1,55 @@
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+ mkHaskellPackages = inShell:
24+ haskellPackages.override {
25+ overrides = self: super:
26+ with nixpkgs.haskell.lib;
27+ {
28+ bench-show = super.callHackageDirect {
29+ pkg = "bench-show";
30+ ver = "0.3.2";
31+ sha256 = "16b8vyzdp9b5bh34kqmbfwjsyv8wgnxxwl8kjcpgxjsh52xzyaa0";
32+ } { };
33+
34+ bench-report = mkPackage super "bench-report" ./. "" inShell;
35+ };
36+ };
37+
38+ drv = mkHaskellPackages true;
39+
40+ shell = drv.shellFor {
41+ packages = p:
42+ [ p.bench-report
43+ ];
44+ # Use a better prompt
45+ shellHook = ''
46+ export CABAL_DIR="$(pwd)/.cabal.nix"
47+ if test -n "$PS_SHELL"
48+ then
49+ export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
50+ fi
51+ '';
52+ };
53+in if nixpkgs.lib.inNixShell
54+ then shell
55+ else (mkHaskellPackages false).bench-report
benchmark/bench-runner/Main.hsdeleted−183
@@ -1,183 +0,0 @@
1−module Main (main) where
2−
3−import BenchRunner (mainWith)
4−import BuildLib (Quickness(..))
5−import Control.Applicative ((<|>))
6−import Data.List (isInfixOf, isPrefixOf, isSuffixOf)
7−
8−import Targets (targets)
9−
10−rtsOpts :: String -> String -> String
11−rtsOpts exeName benchName0 = unwords [general, exeSpecific, benchSpecific]
12−
13− where
14−
15− -- Drop All.
16− benchName = drop 4 benchName0
17−
18− general
19− -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
20− | "o-1-sp" `isInfixOf` benchName = "-K36K -M32M"
21− | "o-n-h" `isInfixOf` benchName = "-K36K -M32M"
22− -- GHC-9.6 requires 32M heap vs 16M for GHC-9.4
23− | "o-n-st" `isInfixOf` benchName = "-K1M -M32M"
24− | "o-n-sp" `isInfixOf` benchName = "-K1M -M32M"
25− | otherwise = ""
26−
27− exeSpecific
28− | "Prelude.Concurrent" `isSuffixOf` exeName = "-K512K -M384M"
29− | otherwise = ""
30−
31− benchSpecific
32− -- GHC-9.6 requires 64M, earlier it was 16M
33− | "Data.Fold/o-n-heap.key-value.toHashMapIO (max buckets) sum" == benchName =
34− "-M64M"
35−
36− -- This is required only for the --long case because we allocate all
37− -- the arrays upfront. depends on the size of the stream.
38− | "Data.Parser/o-1-space" `isPrefixOf` benchName =
39− "-M128M"
40−
41− -----------------------------------------------------------------------
42−
43− | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName = "-M256M"
44− | "Prelude.Parallel/o-n-heap.monad-outer-product."
45− `isPrefixOf` benchName = "-M256M"
46− | "Prelude.Parallel/o-n-space.monad-outer-product."
47− `isPrefixOf` benchName = "-K2M -M256M"
48− | "Prelude.Rate/o-1-space." `isPrefixOf` benchName = "-K128K"
49− | "Prelude.Rate/o-1-space.asyncly." `isPrefixOf` benchName = "-K128K"
50− | "Prelude.WSerial/o-n-space." `isPrefixOf` benchName = "-K4M"
51− | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
52− "-K4M"
53− | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
54− "-K128K -M32M"
55− | "Prelude.Ahead/o-1-space." `isPrefixOf` benchName = "-K128K"
56− | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
57− "-K4M"
58− | "Prelude.WAsync/o-n-heap.monad-outer-product.toNull3" == benchName =
59− "-M64M"
60− | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
61− "-K4M"
62−
63− -- This module is dev only now, and can be removed at some point
64− | "Data.Stream.StreamDK/o-1-space.grouping.classifySessionsOf"
65− `isPrefixOf` benchName = "-K512K"
66− | "Data.Stream.StreamDK/o-n-space.foldr.foldrM/"
67− `isPrefixOf` benchName = "-K4M"
68− | "Data.Stream.StreamDK/o-n-space.iterated."
69− `isPrefixOf` benchName = "-K4M -M64M"
70− -- GHC 9.4.4 requires 4M
71− | "Data.Stream.StreamDK/o-n-space.traversable."
72− `isPrefixOf` benchName = "-K4M"
73− -- GHC-9.6 requires 64M, earlier it was 32M
74− | "Data.Stream.StreamDK/o-n-heap.buffered.readsPrec pure streams" == benchName =
75− "-M64M"
76− -- GHC-9.6 requires 64M, earlier it was 32M
77− | "Data.Stream.StreamDK/o-n-heap.buffered.showPrec Haskell lists" == benchName =
78− "-M64M"
79−
80− -----------------------------------------------------------------------
81−
82− | "Data.StreamD/o-n-space.elimination.toList" == benchName =
83− "-K2M"
84− | "Data.StreamK/o-n-space.elimination.toList" == benchName =
85− "-K2M"
86−
87− -----------------------------------------------------------------------
88−
89− | "Data.Stream/o-1-space.grouping.classifySessionsOf"
90− `isPrefixOf` benchName = "-K512K"
91− | "Data.Stream/o-n-space.foldr.foldrM/"
92− `isPrefixOf` benchName = "-K4M"
93− | "Data.Stream/o-n-space.iterated."
94− `isPrefixOf` benchName = "-K4M"
95−
96− -- GHC-9.6 requires 64M, earlier it was 32M
97− | "Data.Stream/o-n-heap.buffered.showPrec Haskell lists" == benchName =
98− "-M64M"
99− -- GHC-9.6 requires 64M, earlier it was 32M
100− | "Data.Stream/o-n-heap.buffered.readsPrec pure streams" == benchName =
101− "-M64M"
102−
103− | "Data.Stream.ConcurrentEager/o-n-heap.monad-outer-product.toNullAp"
104− `isPrefixOf` benchName = "-M1024M"
105− | "Data.Stream.ConcurrentEager/o-1-space."
106− `isPrefixOf` benchName = "-M128M"
107−
108− | "Data.Stream.ConcurrentOrdered/o-1-space.concat-foldable.foldMapWith"
109− `isPrefixOf` benchName = "-K128K"
110−
111− ----------------------------------------------------------------------
112−
113− | "Data.Array" `isPrefixOf` benchName
114− && "/o-1-space.generation.read" `isSuffixOf` benchName = "-M32M"
115− -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
116− | "Data.Array" `isPrefixOf` benchName
117− && "/o-1-space.generation.show" `isSuffixOf` benchName = "-M64M"
118− -- XXX GHC 9.6 onwards needs 64M, earlier it was 32M
119− | "Data.Array.Generic/o-1-space.transformationX4.map"
120− `isPrefixOf` benchName = "-M64M"
121−
122− -- XXX For --long option, need to check why so much heap is required.
123− -- Note, if we remove the chunked stream module we need to keep the
124− -- chunked stream benchmarks in the stream module.
125− | "Data.Array.Stream/o-1-space"
126− `isPrefixOf` benchName = "-K4M -M512M"
127− -- XXX Takes up to 160MB heap for --long, we use chunked stream for
128− -- this, so the reason may be related to chunked streams.
129− | "Data.ParserK/o-1-space"
130− `isPrefixOf` benchName = "-K4M -M256M"
131−
132− -----------------------------------------------------------------------
133−
134− | "Unicode.Char/o-1-space." `isPrefixOf` benchName = "-M32M"
135−
136− | otherwise = ""
137−
138−speedOpts :: String -> String -> Maybe Quickness
139−speedOpts exeName benchName0 = exeSpecific <|> benchSpecific
140−
141− where
142−
143− -- slowestOf Quicker _ = Quicker
144− -- slowestOf _ Quicker = Quicker
145− -- slowestOf _ _ = SuperQuick
146−
147− -- Drop All.
148− benchName = drop 4 benchName0
149− exeSpecific
150− | "Prelude.Concurrent" == exeName = Just SuperQuick
151− | "Prelude.Rate" == exeName = Just SuperQuick
152− | "Prelude.Adaptive" == exeName = Just SuperQuick
153− | otherwise = Nothing
154− benchSpecific
155− | "Prelude.Parallel/o-n-heap.mapping.mapM" == benchName =
156− Just SuperQuick
157− | "Prelude.Parallel/o-n-heap.monad-outer-product."
158− `isPrefixOf` benchName = Just SuperQuick
159− | "Prelude.Parallel.o-n-space.monad-outer-product."
160− `isPrefixOf` benchName = Just SuperQuick
161− | "Prelude.Parallel/o-n-heap.generation." `isPrefixOf` benchName =
162− Just Quicker
163− | "Prelude.Parallel/o-n-heap.mapping." `isPrefixOf` benchName =
164− Just Quicker
165− | "Prelude.Parallel/o-n-heap.concat-foldable." `isPrefixOf` benchName =
166− Just Quicker
167− | "Prelude.Async/o-1-space.monad-outer-product." `isPrefixOf` benchName =
168− Just Quicker
169− | "Prelude.Async/o-n-space.monad-outer-product." `isPrefixOf` benchName =
170− Just Quicker
171− | "Prelude.Ahead/o-1-space.monad-outer-product." `isPrefixOf` benchName =
172− Just Quicker
173− | "Prelude.Ahead/o-n-space.monad-outer-product." `isPrefixOf` benchName =
174− Just Quicker
175− | "Prelude.WAsync/o-n-heap.monad-outer-product." `isPrefixOf` benchName =
176− Just Quicker
177− | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =
178− Just Quicker
179− | "FileSystem.Handle." `isPrefixOf` benchName = Just Quicker
180− | otherwise = Nothing
181−
182−main :: IO ()
183−main = mainWith targets speedOpts rtsOpts
benchmark/bench-runner/bench-runner.cabaldeleted−42
@@ -1,42 +0,0 @@
1−cabal-version: 2.4
2−name: bench-runner
3−version: 0.1.0.0
4−
5−-- A short (one-line) description of the package.
6−-- synopsis:
7−
8−-- A longer description of the package.
9−-- description:
10−
11−-- A URL where users can report bugs.
12−-- bug-reports:
13−
14−-- The license under which the package is released.
15−-- license:
16−
17−-- The package author(s).
18−-- author:
19−
20−-- An email address to which users can send suggestions, bug reports, and patches.
21−-- maintainer:
22−
23−-- A copyright notice.
24−-- copyright:
25−-- category:
26−-- extra-source-files: CHANGELOG.md
27−
28−executable bench-runner
29− ghc-options: -Wall
30− main-is: Main.hs
31−
32− -- Modules included in this executable, other than Main.
33− -- other-modules:
34−
35− -- LANGUAGE extensions used by modules in this package.
36− -- other-extensions:
37− build-depends: base
38− , bench-report
39− , containers
40− , streamly-targets
41− hs-source-dirs: .
42− default-language: Haskell2010
benchmark/bench-runner/cabal.projectdeleted−4
@@ -1,4 +0,0 @@
1−packages: . ../../targets
2−
3−package bench-report
4− flags: +no-charts
benchmark/bench-runner/default.nixdeleted−164
@@ -1,164 +0,0 @@
1−let
2− nixpkgsPath_21_11 =
3− "https://github.com/NixOS/nixpkgs/archive/refs/tags/21.11.tar.gz";
4− nixpkgsDefault = import (builtins.fetchTarball nixpkgsPath_21_11) { };
5−in
6−{
7− nixpkgs ? nixpkgsDefault
8−, compiler ? "default"
9−}:
10−let haskellPackages =
11− if compiler == "default"
12− then nixpkgs.haskellPackages
13− else nixpkgs.haskell.packages.${compiler};
14−
15− mkPackage = super: pkg: path: opts: inShell:
16− let orig = super.callCabal2nixWithOptions pkg path opts {};
17− in if inShell
18− # Avoid copying the source directory to nix store by using
19− # src = null.
20− then orig.overrideAttrs (oldAttrs: { src = null; })
21− else orig;
22−
23− mkPkgGit = super: gitSrc: rev: name:
24− let
25− src = builtins.fetchGit {
26− url = gitSrc;
27− rev = rev;
28− };
29− in super.callCabal2nix name src { };
30−
31− mkPkgGitRef = super: gitSrc: rev: ref: name:
32− let
33− src = builtins.fetchGit {
34− url = gitSrc;
35− rev = rev;
36− ref = ref;
37− };
38− in super.callCabal2nix name src { };
39−
40− mkHaskellPackages = inShell:
41− haskellPackages.override {
42− overrides = self: super:
43− with nixpkgs.haskell.lib;
44− {
45− bench-runner = mkPackage super "bench-runner" ./. "" inShell;
46− streamly-targets = mkPackage super "streamly-targets" ../../targets "" false;
47−
48− bench-report =
49− nixpkgs.haskell.lib.overrideCabal
50− (let src = fetchGit {
51− url = "git@github.com:composewell/bench-report.git";
52− rev = "3b50bf0ad06f746bca42f30c8d40a0426e159af3";
53− }; in super.callCabal2nix "bench-report" src {})
54− (old:
55− { enableLibraryProfiling = false;
56− doHaddock = false;
57− });
58−
59− bench-show = super.callHackageDirect {
60− pkg = "bench-show";
61− ver = "0.3.2";
62− sha256 = "16b8vyzdp9b5bh34kqmbfwjsyv8wgnxxwl8kjcpgxjsh52xzyaa0";
63− } { };
64−
65−# streamly-coreutils = let
66−# src = "git@github.com:composewell/streamly-coreutils.git";
67−# rev = "a12756efe24bbf303f2f6d66a95426c7657d297b";
68−# in mkPkgGit super src rev "streamly-coreutils";
69−
70− streamly-coreutils =
71− nixpkgs.haskell.lib.overrideCabal
72− (let src = fetchGit {
73− url = "git@github.com:composewell/streamly-coreutils.git";
74− rev = "b1e6fc37f0e898c54378129750d3ccc1c034f611";
75− }; in super.callCabal2nix "streamly-coreutils" src {})
76− (old:
77− { librarySystemDepends =
78− if builtins.currentSystem == "x86_64-darwin"
79− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
80− else [];
81− #enableLibraryProfiling = false;
82− doHaddock = false;
83− doCheck = false;
84− });
85−
86− streamly-shell = let
87− src = "https://github.com/composewell/streamly-shell.git";
88− rev = "1b3fea3239ebe47963955d81565b9d5e34567ab7";
89− in mkPkgGit super src rev "streamly-shell";
90−
91− streamly-process = let
92− src = "https://github.com/composewell/streamly-process.git";
93− rev = "e310c8a9c6e61515373a2f5f1fb82f6e15fe452b";
94− in nixpkgs.haskell.lib.dontCheck
95− (mkPkgGit super src rev "streamly-process");
96−
97− #streamly-process = nixpkgs.haskell.lib.dontCheck
98− # (super.callHackageDirect {
99− # pkg = "streamly-process";
100− # ver = "0.1.0";
101− # sha256 = "01nxisqfmn29fbirdsx71sfjp2rdqwrf469qyjcql2d11i1bxn94";
102− # } { });
103−
104− # streamly = super.callHackageDirect {
105− # pkg = "streamly";
106− # ver = "0.8.0";
107− # sha256 = "0vy2lkljizlhpbpbybmg9jcmj2g4s1aaqd2dzy5c0y0n4rgwxask";
108− # } { };
109− streamly =
110− nixpkgs.haskell.lib.overrideCabal
111− #(super.callHackageDirect
112− # { pkg = "streamly";
113− # ver = "0.8.2";
114− # sha256 = "sha256-CjFq9SCdbgLZa7NqOE4OtC8OaFg4vK8VmIDjGU5rGko=";
115− # } {})
116− (let src = fetchGit {
117− url = "git@github.com:composewell/streamly.git";
118− rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
119− }; in super.callCabal2nix "streamly" src {})
120− (old:
121− { librarySystemDepends =
122− if builtins.currentSystem == "x86_64-darwin"
123− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
124− else [];
125− #enableLibraryProfiling = false;
126− doHaddock = false;
127− });
128−
129− streamly-core =
130− nixpkgs.haskell.lib.overrideCabal
131− (let src = fetchGit {
132− url = "git@github.com:composewell/streamly.git";
133− rev = "14ee0b70363cf925e9cc067bf1df4ecbd047ac38";
134− }; in super.callCabal2nix "streamly-core" "${src}/core" {})
135− (old:
136− { librarySystemDepends =
137− if builtins.currentSystem == "x86_64-darwin"
138− then [nixpkgs.darwin.apple_sdk.frameworks.Cocoa]
139− else [];
140− #enableLibraryProfiling = false;
141− doHaddock = false;
142− });
143−
144− };
145− };
146−
147− drv = mkHaskellPackages true;
148−
149− shell = drv.shellFor {
150− packages = p:
151− [ p.bench-runner
152− ];
153− # Use a better prompt
154− shellHook = ''
155− export CABAL_DIR="$(pwd)/.cabal.nix"
156− if test -n "$PS_SHELL"
157− then
158− export PS1="$PS_SHELL\[$bldred\](nix)\[$txtrst\] "
159− fi
160− '';
161− };
162−in if nixpkgs.lib.inNixShell
163− then shell
164− else (mkHaskellPackages false).bench-runner
benchmark/lib/Streamly/Benchmark/Common.hs+12−11
@@ -1,5 +1,7 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+#if __GLASGOW_HASKELL__ >= 800
2{-# OPTIONS_GHC -Wno-orphans #-}
3{-# OPTIONS_GHC -Wno-orphans #-}
4+#endif
3
5
4-- |
6-- |
5-- Module : Streamly.Benchmark.Common
7-- Module : Streamly.Benchmark.Common
@@ -53,10 +55,10 @@ import Control.DeepSeq (NFData(..))
53import Data.Functor.Identity (Identity, runIdentity)
55import Data.Functor.Identity (Identity, runIdentity)
54import System.Random (randomRIO)
56import System.Random (randomRIO)
55
57
56−import qualified Streamly.Internal.Data.Fold as Fold
58+import qualified Streamly.Prelude as S
57−import qualified Streamly.Internal.Data.Stream as S
58
59
59−import Test.Tasty.Bench
60+import Streamly.Prelude (SerialT)
61+import Gauge
60
62
61-------------------------------------------------------------------------------
63-------------------------------------------------------------------------------
62-- Benchmark Prefixes
64-- Benchmark Prefixes
@@ -78,6 +80,10 @@ o_n_stack_prefix name = name ++ "/o-n-stack"
78-- Benchmarking utilities
80-- Benchmarking utilities
79-------------------------------------------------------------------------------
81-------------------------------------------------------------------------------
80
82
83+#if !MIN_VERSION_deepseq(1,4,3)
84+instance NFData Ordering where rnf = (`seq` ())
85+#endif
86+
81-- XXX once we convert all the functions to use this we can rename this to
87-- XXX once we convert all the functions to use this we can rename this to
82-- benchIOSink
88-- benchIOSink
83{-# INLINE benchIOSink1 #-}
89{-# INLINE benchIOSink1 #-}
@@ -107,12 +113,8 @@ benchPureSink1 name f =
107 bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
113 bench name $ nfIO $ randomRIO (1,1) >>= return . runIdentity . f
108
114
109{-# INLINE benchPureSrc #-}
115{-# INLINE benchPureSrc #-}
110−benchPureSrc :: String -> (Int -> S.Stream Identity a) -> Benchmark
116+benchPureSrc :: String -> (Int -> SerialT Identity a) -> Benchmark
111−benchPureSrc name src = benchPure name src (runIdentity . drain)
117+benchPureSrc name src = benchPure name src (runIdentity . S.drain)
112−
113− where
114−
115− drain = S.fold Fold.drain
116
118
117-------------------------------------------------------------------------------
119-------------------------------------------------------------------------------
118-- String/List generation for read instances
120-- String/List generation for read instances
@@ -242,9 +244,8 @@ runWithCLIOptsEnv defStreamSize alloc mkBench = do
242 r <- alloc value
244 r <- alloc value
243 value `seq` runMode (mode cfg) cfg benches (mkBench r value)
245 value `seq` runMode (mode cfg) cfg benches (mkBench r value)
244#else
246#else
245− r0 <- alloc 0
246 (value, ingredients) <-
247 (value, ingredients) <-
247− parseCLIOpts defStreamSize $ bgroup "All" (mkBench r0 0)
248+ parseCLIOpts defStreamSize $ bgroup "All" (mkBench undefined 0)
248 r <- alloc value
249 r <- alloc value
249 value `seq` defaultMainWithIngredients ingredients
250 value `seq` defaultMainWithIngredients ingredients
250 $ bgroup "All" (mkBench r value)
251 $ bgroup "All" (mkBench r value)
benchmark/lib/Streamly/Benchmark/Common/Handle.hs+1−12
@@ -30,16 +30,11 @@ module Streamly.Benchmark.Common.Handle
30 , isSpace
30 , isSpace
31 , isSp
31 , isSp
32 , mkHandleBenchEnv
32 , mkHandleBenchEnv
33− , Handles(..)
34− , getHandles
35 )
33 )
36where
34where
37
35
38import Control.DeepSeq (NFData(rnf))
36import Control.DeepSeq (NFData(rnf))
39import Data.Char (ord, chr)
37import Data.Char (ord, chr)
40−#if MIN_VERSION_base(4,17,0)
41−import Data.Char (generalCategory, GeneralCategory(Space))
42−#endif
43import Data.Word (Word8)
38import Data.Word (Word8)
44import System.Directory (getFileSize)
39import System.Directory (getFileSize)
45import System.Environment (lookupEnv)
40import System.Environment (lookupEnv)
@@ -48,7 +43,7 @@ import System.Process (callCommand)
48
43
49import Data.IORef
44import Data.IORef
50import Prelude hiding (last, length)
45import Prelude hiding (last, length)
51−import Test.Tasty.Bench hiding (env)
46+import Gauge hiding (env)
52
47
53
48
54scratchDir :: String
49scratchDir :: String
@@ -145,10 +140,8 @@ mkBenchSmall name env action =
145
140
146 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
141 useSmallH (RefHandles {smallInH = inh, outputH = outh}) = Handles inh outh
147
142
148−#if !MIN_VERSION_base(4,17,0)
149foreign import ccall unsafe "u_iswspace"
143foreign import ccall unsafe "u_iswspace"
150 iswspace :: Int -> Int
144 iswspace :: Int -> Int
151−#endif
152
145
153-- Code copied from base/Data.Char to INLINE it
146-- Code copied from base/Data.Char to INLINE it
154{-# INLINE isSpace #-}
147{-# INLINE isSpace #-}
@@ -161,11 +154,7 @@ isSpace :: Char -> Bool
161-- so we'll do it like this until there's a way around that.
154-- so we'll do it like this until there's a way around that.
162isSpace c
155isSpace c
163 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
156 | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0
164−#if MIN_VERSION_base(4,17,0)
165− | otherwise = generalCategory c == Space
166−#else
167 | otherwise = iswspace (ord c) /= 0
157 | otherwise = iswspace (ord c) /= 0
168−#endif
169 where
158 where
170 uc = fromIntegral (ord c) :: Word
159 uc = fromIntegral (ord c) :: Word
171
160
benchmark/lib/Streamly/Benchmark/Prelude.hs+4−3
@@ -1,5 +1,3 @@
1−{-# OPTIONS_GHC -Wno-deprecations #-}
2−
3-- |
1-- |
4-- Module : Streamly.Benchmark.Prelude
2-- Module : Streamly.Benchmark.Prelude
5-- Copyright : (c) 2018 Composewell Technologies
3-- Copyright : (c) 2018 Composewell Technologies
@@ -70,6 +68,9 @@ import Control.Applicative (liftA2)
70import Control.DeepSeq (NFData(..))
68import Control.DeepSeq (NFData(..))
71import Control.Exception (try)
69import Control.Exception (try)
72import Data.Functor.Identity (Identity)
70import Data.Functor.Identity (Identity)
71+#if !(MIN_VERSION_base(4,11,0))
72+import Data.Semigroup (Semigroup((<>)))
73+#endif
73import GHC.Exception (ErrorCall)
74import GHC.Exception (ErrorCall)
74import Prelude hiding (mapM)
75import Prelude hiding (mapM)
75import System.Random (randomRIO)
76import System.Random (randomRIO)
@@ -82,7 +83,7 @@ import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream
82import qualified Streamly.Internal.Data.Pipe as Pipe
83import qualified Streamly.Internal.Data.Pipe as Pipe
83import qualified Streamly.Internal.Data.Stream.Serial as Serial
84import qualified Streamly.Internal.Data.Stream.Serial as Serial
84
85
85−import Test.Tasty.Bench
86+import Gauge
86import Streamly.Internal.Data.Time.Units
87import Streamly.Internal.Data.Time.Units
87
88
88-- Common polymorphic stream APIs used across multiple stream modules
89-- Common polymorphic stream APIs used across multiple stream modules
benchmark/streamly-benchmarks.cabal+171−404
@@ -54,13 +54,8 @@ flag opt
54 manual: True
54 manual: True
55 default: True
55 default: True
56
56
57−flag use-streamly-core
57+flag use-gauge
58− description: Benchmark only core package
59− manual: True
60− default: False
61−
62−flag use-prelude
63− description: Use Prelude instead of Data.Stream for serial benchmarks
58+ description: Use gauge instead of tasty-bench for benchmarking
64 manual: True
59 manual: True
65 default: False
60 default: False
66
61
@@ -68,49 +63,9 @@ flag use-prelude
68-- Common stanzas
63-- Common stanzas
69-------------------------------------------------------------------------------
64-------------------------------------------------------------------------------
70
65
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−
107common compile-options
66common compile-options
108− import: default-extensions
109 default-language: Haskell2010
67 default-language: Haskell2010
110
68
111− if flag(use-streamly-core)
112− cpp-options: -DUSE_STREAMLY_CORE
113−
114 if flag(dev)
69 if flag(dev)
115 cpp-options: -DDEVBUILD
70 cpp-options: -DDEVBUILD
116
71
@@ -120,29 +75,16 @@ common compile-options
120 if flag(inspection)
75 if flag(inspection)
121 cpp-options: -DINSPECTION
76 cpp-options: -DINSPECTION
122
77
123− ghc-options: -Weverything
78+ ghc-options: -Wall
124− -Wno-implicit-prelude
79+ -Wcompat
125− -Wno-missing-deriving-strategies
80+ -Wunrecognised-warning-flags
126− -Wno-missing-exported-signatures
81+ -Widentities
127− -Wno-missing-import-lists
82+ -Wincomplete-record-updates
128− -Wno-missing-local-signatures
83+ -Wincomplete-uni-patterns
129− -Wno-missing-safe-haskell-mode
84+ -Wredundant-constraints
130− -Wno-missed-specialisations
85+ -Wnoncanonical-monad-instances
131− -Wno-all-missed-specialisations
132− -Wno-monomorphism-restriction
133− -Wno-prepositive-qualified-module
134− -Wno-unsafe
135− -Wno-unused-packages
136− -Rghc-timing
86+ -Rghc-timing
137−
87+ -Wmissing-export-lists
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
146
88
147 if flag(has-llvm)
89 if flag(has-llvm)
148 ghc-options: -fllvm
90 ghc-options: -fllvm
@@ -151,17 +93,15 @@ common compile-options
151 ghc-options: -Wmissed-specialisations
93 ghc-options: -Wmissed-specialisations
152 -Wall-missed-specialisations
94 -Wall-missed-specialisations
153
95
96+ if flag(dev) || flag(debug)
97+ ghc-options: -fno-ignore-asserts
98+
154common optimization-options
99common optimization-options
155 if flag(opt)
100 if flag(opt)
156 ghc-options: -O2
101 ghc-options: -O2
157 -fdicts-strict
102 -fdicts-strict
158 -fspec-constr-recursive=16
103 -fspec-constr-recursive=16
159 -fmax-worker-args=16
104 -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−
165 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
105 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
166 ghc-options: -fplugin Fusion.Plugin
106 ghc-options: -fplugin Fusion.Plugin
167 else
107 else
@@ -175,34 +115,37 @@ common bench-depends
175 -- Core libraries shipped with ghc, the min and max
115 -- Core libraries shipped with ghc, the min and max
176 -- constraints of these libraries should match with
116 -- constraints of these libraries should match with
177 -- the GHC versions we support
117 -- the GHC versions we support
178− base >= 4.9 && < 4.20
118+ base >= 4.9 && < 4.17
179− , deepseq >= 1.4.1 && < 1.6
119+ , deepseq >= 1.4.1 && < 1.5
180− , mtl >= 2.2 && < 2.3.2
120+ , mtl >= 2.2 && < 2.3
181
121
182 -- other libraries
122 -- other libraries
183− , exceptions >= 0.8 && < 0.11
123+ , streamly
184 , random >= 1.0 && < 2.0
124 , random >= 1.0 && < 2.0
185 , transformers >= 0.4 && < 0.7
125 , transformers >= 0.4 && < 0.7
186− , containers >= 0.5 && < 0.8
126+ , containers >= 0.5 && < 0.7
187− , hashable >= 1.3 && < 1.5
188− , unordered-containers >= 0.2 && < 0.3
189 , process >= 1.4 && < 1.7
127 , process >= 1.4 && < 1.7
190 , directory >= 1.2.2 && < 1.4
128 , directory >= 1.2.2 && < 1.4
191− , filepath >= 1.4.1 && < 1.6
129+ , filepath >= 1.4.1 && < 1.5
192− , ghc-prim >= 0.4 && < 0.12
130+ , ghc-prim >= 0.4 && < 0.9
193− , tasty-bench >= 0.3 && < 0.4
194− , tasty >= 1.4.1 && < 1.6
195− , streamly-core
196
131
197− if !flag(use-streamly-core)
132+ if flag(use-gauge)
133+ build-depends: gauge >= 0.2.4 && < 0.3
134+ else
198− build-depends: streamly
135+ build-depends: tasty-bench >= 0.3 && < 0.4
136+ , tasty >= 1.4.1 && < 1.5
137+ mixins: tasty-bench
138+ (Test.Tasty.Bench as Gauge
139+ , Test.Tasty.Bench as Gauge.Main
140+ )
199
141
200 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
142 if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)
201 build-depends:
143 build-depends:
202 fusion-plugin >= 0.2 && < 0.3
144 fusion-plugin >= 0.2 && < 0.3
203 if flag(inspection)
145 if flag(inspection)
204− build-depends: template-haskell >= 2.14 && < 2.22
146+ build-depends: template-haskell >= 2.14 && < 2.17
205− , inspection-testing >= 0.4 && < 0.6
147+ , inspection-testing >= 0.4 && < 0.5
148+ , ghc-prim >= 0.2 && < 0.9
206 -- Array uses a Storable constraint in dev build making several inspection
149 -- Array uses a Storable constraint in dev build making several inspection
207 -- tests fail
150 -- tests fail
208 if flag(dev) && flag(inspection)
151 if flag(dev) && flag(inspection)
@@ -216,10 +159,8 @@ library
216 import: lib-options, bench-depends
159 import: lib-options, bench-depends
217 hs-source-dirs: lib
160 hs-source-dirs: lib
218 exposed-modules: Streamly.Benchmark.Common
161 exposed-modules: Streamly.Benchmark.Common
219− , Streamly.Benchmark.Common.Handle
162+ , Streamly.Benchmark.Common.Handle
220− if flag(use-prelude)
221− exposed-modules: Streamly.Benchmark.Prelude
163+ , Streamly.Benchmark.Prelude
222−
223
164
224-------------------------------------------------------------------------------
165-------------------------------------------------------------------------------
225-- Benchmarks
166-- Benchmarks
@@ -247,142 +188,125 @@ common bench-options-threaded
247-- Serial Streams
188-- Serial Streams
248-------------------------------------------------------------------------------
189-------------------------------------------------------------------------------
249
190
250−benchmark Data.Stream
191+benchmark Prelude.Serial
251 import: bench-options
192 import: bench-options
252 type: exitcode-stdio-1.0
193 type: exitcode-stdio-1.0
253− hs-source-dirs: Streamly/Benchmark/Data
194+ hs-source-dirs: Streamly/Benchmark/Prelude
254− main-is: Stream.hs
195+ main-is: Serial.hs
255 other-modules:
196 other-modules:
256− Stream.Generate
197+ Serial.Generation
257− Stream.Eliminate
198+ , Serial.Elimination
258− Stream.Transform
199+ , Serial.Transformation
259− Stream.Reduce
200+ , Serial.NestedStream
260− Stream.Expand
201+ , Serial.NestedFold
202+ , Serial.Split
203+ , Serial.Exceptions
261− Stream.Lift
204+ , Serial.Lift
262− Stream.Common
205+ if impl(ghcjs)
263− if !flag(use-streamly-core)
206+ buildable: False
264− other-modules:
207+ else
265− Stream.Exceptions
208+ buildable: True
266 if flag(limit-build-mem)
209 if flag(limit-build-mem)
267 if flag(dev)
210 if flag(dev)
268 ghc-options: +RTS -M3500M -RTS
211 ghc-options: +RTS -M3500M -RTS
269 else
212 else
270− ghc-options: +RTS -M2500M -RTS
213+ ghc-options: +RTS -M2000M -RTS
271
214
272−-- Use StreamK functions where possible, converting to StreaK to StreamD
215+
273−benchmark Data.Stream.StreamDK
216+benchmark Prelude.WSerial
274 import: bench-options
217 import: bench-options
275 type: exitcode-stdio-1.0
218 type: exitcode-stdio-1.0
276− hs-source-dirs: Streamly/Benchmark/Data
219+ hs-source-dirs: Streamly/Benchmark/Prelude
277− main-is: Stream.hs
220+ main-is: WSerial.hs
278− other-modules:
221+ if impl(ghcjs)
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)
291 buildable: False
222 buildable: False
292− cpp-options: -DUSE_STREAMK
223+ else
224+ buildable: True
293 if flag(limit-build-mem)
225 if flag(limit-build-mem)
294− if flag(dev)
295− ghc-options: +RTS -M3500M -RTS
226+ ghc-options: +RTS -M750M -RTS
296− else
297− ghc-options: +RTS -M2500M -RTS
298
227
299−benchmark Data.Stream.Concurrent
228+benchmark Prelude.Merge
300− import: bench-options-threaded
229+ import: bench-options
301 type: exitcode-stdio-1.0
230 type: exitcode-stdio-1.0
302− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
231+ hs-source-dirs: Streamly/Benchmark/Prelude
303− main-is: Concurrent.hs
232+ main-is: Merge.hs
304− other-modules:
305− Stream.ConcurrentCommon
306− Stream.Common
307− if flag(use-streamly-core) || impl(ghcjs)
233+ if impl(ghcjs)
308 buildable: False
234 buildable: False
309 else
235 else
310 buildable: True
236 buildable: True
311
237
312−benchmark Data.Stream.ConcurrentInterleaved
238+benchmark Prelude.ZipSerial
313− import: bench-options-threaded
239+ import: bench-options
314 type: exitcode-stdio-1.0
240 type: exitcode-stdio-1.0
315− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
241+ hs-source-dirs: Streamly/Benchmark/Prelude
316− main-is: ConcurrentInterleaved.hs
242+ main-is: ZipSerial.hs
317− other-modules:
318− Stream.ConcurrentCommon
319− Stream.Common
320− if flag(use-streamly-core) || impl(ghcjs)
243+ if impl(ghcjs)
321 buildable: False
244 buildable: False
322 else
245 else
323 buildable: True
246 buildable: True
324
247
325−benchmark Data.Stream.ConcurrentEager
248+benchmark Prelude.ZipAsync
326− import: bench-options-threaded
249+ import: bench-options
327 type: exitcode-stdio-1.0
250 type: exitcode-stdio-1.0
328− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
251+ hs-source-dirs: Streamly/Benchmark/Prelude
329− main-is: ConcurrentEager.hs
252+ main-is: ZipAsync.hs
330− other-modules:
331− Stream.ConcurrentCommon
332− Stream.Common
333− if flag(use-streamly-core) || impl(ghcjs)
253+ if impl(ghcjs)
334 buildable: False
254 buildable: False
335 else
255 else
336 buildable: True
256 buildable: True
257+ if flag(limit-build-mem)
258+ ghc-options: +RTS -M1000M -RTS
259+
337
260
338−benchmark Data.Stream.ConcurrentOrdered
261+benchmark Prelude.Ahead
339 import: bench-options-threaded
262 import: bench-options-threaded
340 type: exitcode-stdio-1.0
263 type: exitcode-stdio-1.0
341− hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/
264+ hs-source-dirs: Streamly/Benchmark/Prelude
342− main-is: ConcurrentOrdered.hs
265+ main-is: Ahead.hs
343− other-modules:
344− Stream.ConcurrentCommon
345− Stream.Common
346− if flag(use-streamly-core) || impl(ghcjs)
266+ if impl(ghcjs)
347 buildable: False
267 buildable: False
348 else
268 else
349 buildable: True
269 buildable: True
350
270
351−benchmark Data.Unbox
271+benchmark Prelude.Async
352− import: bench-options
272+ import: bench-options-threaded
353 type: exitcode-stdio-1.0
273 type: exitcode-stdio-1.0
354− hs-source-dirs: .
274+ hs-source-dirs: Streamly/Benchmark/Prelude
355− cpp-options: -DUSE_UNBOX
275+ main-is: Async.hs
356− main-is: Streamly/Benchmark/Data/Serialize.hs
276+ if impl(ghcjs)
277+ buildable: False
278+ else
279+ buildable: True
357
280
358−benchmark Data.Unbox.Derive.TH
281+benchmark Prelude.WAsync
359− import: bench-options
282+ import: bench-options-threaded
360 type: exitcode-stdio-1.0
283 type: exitcode-stdio-1.0
361− hs-source-dirs: .
284+ hs-source-dirs: Streamly/Benchmark/Prelude
362− cpp-options: -DUSE_UNBOX
285+ main-is: WAsync.hs
363− cpp-options: -DUSE_TH
286+ if impl(ghcjs)
364− main-is: Streamly/Benchmark/Data/Serialize.hs
287+ buildable: False
288+ else
289+ buildable: True
365
290
366−benchmark Data.Serialize
291+benchmark Prelude.Parallel
367− import: bench-options
292+ import: bench-options-threaded
368 type: exitcode-stdio-1.0
293 type: exitcode-stdio-1.0
369− hs-source-dirs: .
294+ hs-source-dirs: Streamly/Benchmark/Prelude
370− cpp-options: -DUSE_TH
295+ main-is: Parallel.hs
371− main-is: Streamly/Benchmark/Data/Serialize.hs
296+ if impl(ghcjs)
372− build-depends: QuickCheck, template-haskell
297+ buildable: False
373− other-modules:
298+ else
374− Streamly.Benchmark.Data.Serialize.TH
299+ buildable: True
375− Streamly.Benchmark.Data.Serialize.RecCompatible
376− Streamly.Benchmark.Data.Serialize.RecNonCompatible
377 if flag(limit-build-mem)
300 if flag(limit-build-mem)
378− ghc-options: +RTS -M1000M -RTS
301+ ghc-options: +RTS -M2000M -RTS
302+
379
303
380benchmark Data.Unfold
304benchmark Data.Unfold
381 import: bench-options
305 import: bench-options
382 type: exitcode-stdio-1.0
306 type: exitcode-stdio-1.0
383 hs-source-dirs: .
307 hs-source-dirs: .
384 main-is: Streamly/Benchmark/Data/Unfold.hs
308 main-is: Streamly/Benchmark/Data/Unfold.hs
385− if flag(use-streamly-core) || impl(ghcjs)
309+ if impl(ghcjs)
386 buildable: False
310 buildable: False
387 else
311 else
388 buildable: True
312 buildable: True
@@ -392,26 +316,16 @@ benchmark Data.Fold
392 type: exitcode-stdio-1.0
316 type: exitcode-stdio-1.0
393 hs-source-dirs: Streamly/Benchmark/Data
317 hs-source-dirs: Streamly/Benchmark/Data
394 main-is: Fold.hs
318 main-is: Fold.hs
395− if flag(use-streamly-core) || impl(ghcjs)
319+ if 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)
406 buildable: False
320 buildable: False
407 else
321 else
408 buildable: True
322 buildable: True
409
323
410−benchmark Data.Parser
324+benchmark Data.Parser.ParserD
411 import: bench-options
325 import: bench-options
412 type: exitcode-stdio-1.0
326 type: exitcode-stdio-1.0
413− hs-source-dirs: Streamly/Benchmark/Data
327+ hs-source-dirs: Streamly/Benchmark/Data/Parser
414− main-is: Parser.hs
328+ main-is: ParserD.hs
415 if impl(ghcjs)
329 if impl(ghcjs)
416 buildable: False
330 buildable: False
417 else
331 else
@@ -421,13 +335,12 @@ benchmark Data.Parser
421 if flag(dev)
335 if flag(dev)
422 ghc-options: +RTS -M3000M -RTS
336 ghc-options: +RTS -M3000M -RTS
423 else
337 else
424− ghc-options: +RTS -M2000M -RTS
338+ ghc-options: +RTS -M750M -RTS
425
339
426−benchmark Data.ParserK
340+benchmark Data.Parser.ParserK
427 import: bench-options
341 import: bench-options
428 type: exitcode-stdio-1.0
342 type: exitcode-stdio-1.0
429− hs-source-dirs: Streamly/Benchmark/Data
343+ hs-source-dirs: Streamly/Benchmark/Data/Parser
430− cpp-options: -DBENCH_SINGULAR
431 main-is: ParserK.hs
344 main-is: ParserK.hs
432 if impl(ghcjs)
345 if impl(ghcjs)
433 buildable: False
346 buildable: False
@@ -435,11 +348,15 @@ benchmark Data.ParserK
435 buildable: True
348 buildable: True
436 build-depends: exceptions >= 0.8 && < 0.11
349 build-depends: exceptions >= 0.8 && < 0.11
437
350
438−benchmark Data.ParserK.Chunked
351+-- Note: to use this we have to set DISABLE_FUSION in ParserD.hs so that
352+-- the rewrite rules are disabled. We can also use the "no-fusion" build
353+-- flag but we need to keep in mind that it disables fusion for streams
354+-- as well.
355+benchmark Data.Parser.FromParserK
439 import: bench-options
356 import: bench-options
440 type: exitcode-stdio-1.0
357 type: exitcode-stdio-1.0
441− hs-source-dirs: Streamly/Benchmark/Data
358+ hs-source-dirs: Streamly/Benchmark/Data/Parser
442− cpp-options: -DBENCH_CHUNKED
359+ cpp-options: -DFROM_PARSERK
443 main-is: ParserK.hs
360 main-is: ParserK.hs
444 if impl(ghcjs)
361 if impl(ghcjs)
445 buildable: False
362 buildable: False
@@ -447,166 +364,64 @@ benchmark Data.ParserK.Chunked
447 buildable: True
364 buildable: True
448 build-depends: exceptions >= 0.8 && < 0.11
365 build-depends: exceptions >= 0.8 && < 0.11
449
366
450−benchmark Data.ParserK.Chunked.Generic
367+benchmark Data.Parser
451 import: bench-options
368 import: bench-options
452 type: exitcode-stdio-1.0
369 type: exitcode-stdio-1.0
453 hs-source-dirs: Streamly/Benchmark/Data
370 hs-source-dirs: Streamly/Benchmark/Data
454− cpp-options: -DBENCH_CHUNKED_GENERIC
371+ main-is: Parser.hs
455− main-is: ParserK.hs
456 if impl(ghcjs)
372 if impl(ghcjs)
457 buildable: False
373 buildable: False
458 else
374 else
459 buildable: True
375 buildable: True
460 build-depends: exceptions >= 0.8 && < 0.11
376 build-depends: exceptions >= 0.8 && < 0.11
377+ if flag(limit-build-mem)
378+ if flag(dev)
379+ ghc-options: +RTS -M3000M -RTS
380+ else
381+ ghc-options: +RTS -M1000M -RTS
461
382
462-------------------------------------------------------------------------------
383-------------------------------------------------------------------------------
463-- Raw Streams
384-- Raw Streams
464-------------------------------------------------------------------------------
385-------------------------------------------------------------------------------
465
386
466−benchmark Data.StreamD
387+benchmark Data.Stream.StreamD
467 import: bench-options
388 import: bench-options
468 type: exitcode-stdio-1.0
389 type: exitcode-stdio-1.0
469 hs-source-dirs: Streamly/Benchmark/Data/Stream
390 hs-source-dirs: Streamly/Benchmark/Data/Stream
470 main-is: StreamD.hs
391 main-is: StreamD.hs
471 if impl(ghcjs)
392 if impl(ghcjs)
472 buildable: False
393 buildable: False
394+ else
395+ buildable: True
473
396
474−benchmark Data.StreamK
397+benchmark Data.Stream.StreamK
475 import: bench-options
398 import: bench-options
476 type: exitcode-stdio-1.0
399 type: exitcode-stdio-1.0
477 hs-source-dirs: Streamly/Benchmark/Data/Stream
400 hs-source-dirs: Streamly/Benchmark/Data/Stream
478 main-is: StreamK.hs
401 main-is: StreamK.hs
479 if impl(ghcjs)
402 if impl(ghcjs)
480 buildable: False
403 buildable: False
404+ else
405+ buildable: True
481
406
482−benchmark Data.Stream.ToStreamK
407+benchmark Data.Stream.StreamDK
483− import: bench-options
484− type: exitcode-stdio-1.0
485− hs-source-dirs: Streamly/Benchmark/Data/Stream
486− main-is: ToStreamK.hs
487− if !flag(dev) || impl(ghcjs)
488− buildable: False
489−
490−benchmark Data.StreamK.Alt
491 import: bench-options
408 import: bench-options
492 type: exitcode-stdio-1.0
409 type: exitcode-stdio-1.0
493 hs-source-dirs: Streamly/Benchmark/Data/Stream
410 hs-source-dirs: Streamly/Benchmark/Data/Stream
494− main-is: StreamKAlt.hs
411+ main-is: StreamDK.hs
495− if !flag(dev) || impl(ghcjs)
412+ if impl(ghcjs)
496 buildable: False
413 buildable: False
414+ else
415+ buildable: True
497
416
498executable nano-bench
417executable nano-bench
499 import: bench-options
418 import: bench-options
500 hs-source-dirs: .
419 hs-source-dirs: .
501 main-is: NanoBenchmarks.hs
420 main-is: NanoBenchmarks.hs
502− if !flag(dev)
421+ if flag(dev)
503− buildable: False
422+ buildable: True
504−
423+ else
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
424 buildable: False
608− if flag(limit-build-mem)
609− ghc-options: +RTS -M2000M -RTS
610
425
611-------------------------------------------------------------------------------
426-------------------------------------------------------------------------------
612-- Concurrent Streams
427-- Concurrent Streams
@@ -617,101 +432,75 @@ benchmark Prelude.Concurrent
617 type: exitcode-stdio-1.0
432 type: exitcode-stdio-1.0
618 hs-source-dirs: Streamly/Benchmark/Prelude
433 hs-source-dirs: Streamly/Benchmark/Prelude
619 main-is: Concurrent.hs
434 main-is: Concurrent.hs
620− cpp-options: -DUSE_PRELUDE
621− if !flag(use-prelude)
622− buildable: False
623
435
624benchmark Prelude.Adaptive
436benchmark Prelude.Adaptive
625 import: bench-options-threaded
437 import: bench-options-threaded
626 type: exitcode-stdio-1.0
438 type: exitcode-stdio-1.0
627 hs-source-dirs: Streamly/Benchmark/Prelude
439 hs-source-dirs: Streamly/Benchmark/Prelude
628 main-is: Adaptive.hs
440 main-is: Adaptive.hs
629− cpp-options: -DUSE_PRELUDE
441+ if impl(ghcjs)
630− if !flag(use-prelude)
631 buildable: False
442 buildable: False
443+ else
444+ buildable: True
632
445
633benchmark Prelude.Rate
446benchmark Prelude.Rate
634 import: bench-options-threaded
447 import: bench-options-threaded
635 type: exitcode-stdio-1.0
448 type: exitcode-stdio-1.0
636 hs-source-dirs: Streamly/Benchmark/Prelude
449 hs-source-dirs: Streamly/Benchmark/Prelude
637 main-is: Rate.hs
450 main-is: Rate.hs
638− cpp-options: -DUSE_PRELUDE
451+ if impl(ghcjs)
639− if !flag(use-prelude)
640 buildable: False
452 buildable: False
453+ else
454+ buildable: True
641
455
642-------------------------------------------------------------------------------
456-------------------------------------------------------------------------------
643-- Array Benchmarks
457-- Array Benchmarks
644-------------------------------------------------------------------------------
458-------------------------------------------------------------------------------
645
459
646−benchmark Data.Array.Generic
460+benchmark Data.Array
461+ import: bench-options
462+ type: exitcode-stdio-1.0
463+ hs-source-dirs: .
464+ main-is: Streamly/Benchmark/Data/Array.hs
465+
466+benchmark Data.Array.Prim
647 import: bench-options
467 import: bench-options
648 type: exitcode-stdio-1.0
468 type: exitcode-stdio-1.0
649− hs-source-dirs: ., Streamly/Benchmark/Data
469+ main-is: Streamly/Benchmark/Data/Array/Prim.hs
650− main-is: Streamly/Benchmark/Data/Array/Generic.hs
470+ build-depends: primitive
651− other-modules:
652− Stream.Common
653− if flag(use-streamly-core)
654− buildable: False
655− else
656− buildable: True
657− if flag(limit-build-mem)
658− ghc-options: +RTS -M1000M -RTS
659
471
660benchmark Data.SmallArray
472benchmark Data.SmallArray
661 import: bench-options
473 import: bench-options
662 type: exitcode-stdio-1.0
474 type: exitcode-stdio-1.0
663 main-is: Streamly/Benchmark/Data/Array/SmallArray.hs
475 main-is: Streamly/Benchmark/Data/Array/SmallArray.hs
664− if flag(dev) && !flag(use-streamly-core)
665− buildable: True
666− else
667− buildable: False
668
476
669−benchmark Data.Array
477+benchmark Data.Array.Prim.Pinned
670 import: bench-options
478 import: bench-options
671 type: exitcode-stdio-1.0
479 type: exitcode-stdio-1.0
672− hs-source-dirs: ., Streamly/Benchmark/Data
480+ main-is: Streamly/Benchmark/Data/Array/Prim/Pinned.hs
673− main-is: Streamly/Benchmark/Data/Array.hs
674− other-modules:
675− Stream.Common
676− if flag(use-streamly-core)
677− buildable: False
678− else
679− buildable: True
680− if flag(limit-build-mem)
681− ghc-options: +RTS -M1500M -RTS
682
481
683−benchmark Data.MutArray
482+benchmark Data.Array.Foreign
684 import: bench-options
483 import: bench-options
685 type: exitcode-stdio-1.0
484 type: exitcode-stdio-1.0
686− main-is: Streamly/Benchmark/Data/MutArray.hs
485+ main-is: Streamly/Benchmark/Data/Array/Foreign.hs
687 if flag(limit-build-mem)
486 if flag(limit-build-mem)
688− ghc-options: +RTS -M1500M -RTS
487+ ghc-options: +RTS -M1000M -RTS
689− if flag(use-streamly-core)
690− buildable: False
691− else
692− buildable: True
693−
694−-------------------------------------------------------------------------------
695−-- Ring Benchmarks
696−-------------------------------------------------------------------------------
697
488
698−benchmark Data.Ring.Unboxed
489+benchmark Data.Array.Foreign.Mut
699 import: bench-options
490 import: bench-options
700 type: exitcode-stdio-1.0
491 type: exitcode-stdio-1.0
701− main-is: Streamly/Benchmark/Data/Ring/Unboxed.hs
492+ main-is: Streamly/Benchmark/Data/Array/Foreign/Mut.hs
702− if flag(limit-build-mem)
703− ghc-options: +RTS -M1500M -RTS
704
493
705-------------------------------------------------------------------------------
494-------------------------------------------------------------------------------
706-- Array Stream Benchmarks
495-- Array Stream Benchmarks
707-------------------------------------------------------------------------------
496-------------------------------------------------------------------------------
708
497
709−benchmark Data.Array.Stream
498+benchmark Data.Array.Stream.Foreign
710 import: bench-options
499 import: bench-options
711 type: exitcode-stdio-1.0
500 type: exitcode-stdio-1.0
712− hs-source-dirs: Streamly/Benchmark/Data/Array
501+ hs-source-dirs: Streamly/Benchmark/Data/Array/Stream
713− main-is: Stream.hs
502+ main-is: Foreign.hs
714− if flag(use-streamly-core) || impl(ghcjs)
503+ if impl(ghcjs)
715 buildable: False
504 buildable: False
716 else
505 else
717 buildable: True
506 buildable: True
@@ -729,12 +518,6 @@ benchmark FileSystem.Handle
729 other-modules:
518 other-modules:
730 Handle.Read
519 Handle.Read
731 , Handle.ReadWrite
520 , 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
738
521
739-------------------------------------------------------------------------------
522-------------------------------------------------------------------------------
740-- Unicode Benchmarks
523-- Unicode Benchmarks
@@ -745,12 +528,6 @@ benchmark Unicode.Stream
745 type: exitcode-stdio-1.0
528 type: exitcode-stdio-1.0
746 hs-source-dirs: Streamly/Benchmark/Unicode
529 hs-source-dirs: Streamly/Benchmark/Unicode
747 main-is: Stream.hs
530 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
754
531
755benchmark Unicode.Char
532benchmark Unicode.Char
756 import: bench-options
533 import: bench-options
@@ -758,7 +535,7 @@ benchmark Unicode.Char
758 hs-source-dirs: Streamly/Benchmark/Unicode
535 hs-source-dirs: Streamly/Benchmark/Unicode
759 main-is: Char.hs
536 main-is: Char.hs
760 -- Takes too much memory for ghcjs
537 -- Takes too much memory for ghcjs
761− if flag(use-streamly-core) || impl(ghcjs)
538+ if impl(ghcjs)
762 buildable: False
539 buildable: False
763
540
764benchmark Unicode.Utf8
541benchmark Unicode.Utf8
@@ -766,13 +543,3 @@ benchmark Unicode.Utf8
766 type: exitcode-stdio-1.0
543 type: exitcode-stdio-1.0
767 hs-source-dirs: Streamly/Benchmark/Unicode
544 hs-source-dirs: Streamly/Benchmark/Unicode
768 main-is: Utf8.hs
545 main-is: Utf8.hs
769− if flag(use-streamly-core)
770− buildable: False
771− else
772− buildable: True
773−
774−benchmark Unicode.Parser
775− import: bench-options
776− type: exitcode-stdio-1.0
777− hs-source-dirs: Streamly/Benchmark/Unicode
778− main-is: Parser.hs
bin/bench-config.shnew file+160
@@ -0,0 +1,160 @@
1+#!/usr/bin/env bash
2+
3+BENCH_CONFIG_DIR="$(cd "$(dirname "${BASH_SOURCE[0]}")" &> /dev/null && pwd)"
4+source $BENCH_CONFIG_DIR/targets.sh \
5+ || { echo "Cannot source $BENCH_CONFIG_DIR/targets.sh"; exit 1; }
6+
7+# Customization options
8+bench_config () {
9+ BENCH_REPORT_DIR=benchmark/bench-report
10+ BENCHMARK_PACKAGE_NAME=streamly-benchmarks
11+ BENCHMARK_PACKAGE_VERSION=0.0.0
12+
13+ USE_GAUGE=0
14+ DEFAULT_FIELDS="allocated cputime bytescopied"
15+}
16+
17+#------------------------------------------------------------------------------
18+# benchmark groups
19+#------------------------------------------------------------------------------
20+
21+bench_targets () {
22+ targets
23+}
24+
25+#------------------------------------------------------------------------------
26+# RTS options based on the benchmark executable name and benchmark name
27+#------------------------------------------------------------------------------
28+
29+bench_rts_options () {
30+ local exe_name
31+ local bench_name
32+
33+ exe_name="$1"
34+ bench_name="$2"
35+
36+ # Based on benchmark class
37+ case "$bench_name" in
38+ */o-1-sp*) echo -n "-K36K -M16M" ;;
39+ */o-n-h*) echo -n "-K36K -M32M" ;;
40+ */o-n-st*) echo -n "-K1M -M16M" ;;
41+ */o-n-sp*) echo -n "-K1M -M32M" ;;
42+ *) echo -n "" ;;
43+ esac
44+
45+ echo -n " "
46+ case "$exe_name" in
47+ Prelude.Concurrent*) echo -n "-K256K -M384M" ;;
48+ *) echo -n "" ;;
49+ esac
50+
51+ echo -n " "
52+ # Based on specific benchmark
53+ # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
54+ # with "/" for matching with this. It may not work reliably if the benchmark
55+ # name already contains ".".
56+ case "$bench_name" in
57+ Data.Stream.StreamD/o-n-space/elimination/toList) echo -n "-K2M" ;;
58+ Data.Stream.StreamK/o-n-space/elimination/toList) echo -n "-K2M" ;;
59+
60+ Prelude.Parallel/o-n-heap/mapping/mapM) echo -n "-M256M" ;;
61+ Prelude.Parallel/o-n-heap/monad-outer-product/*) echo -n "-M256M" ;;
62+ Prelude.Parallel/o-n-space/monad-outer-product/*) echo -n "-K4M -M256M" ;;
63+
64+ Prelude.Rate/o-1-space/*) echo -n "-K128K" ;;
65+ Prelude.Rate/o-1-space/asyncly/*) echo -n "-K128K" ;;
66+
67+ # XXX For GHC-9.0
68+ Prelude.Serial/o-1-space/mixed/sum-product-fold) echo -n "-K64M" ;;
69+
70+ # XXX These should be moved to o-n-space?
71+ Prelude.Serial/o-n-heap/grouping/classifySessionsOf) echo -n "-K1M -M32M" ;;
72+ Prelude.Serial/o-n-heap/Functor/*) echo -n "-K4M -M32M" ;;
73+ Prelude.Serial/o-n-heap/transformer/*) echo -n "-K8M -M64M" ;;
74+
75+ Prelude.Serial/o-n-space/Functor/*) echo -n "-K4M -M64M" ;;
76+ Prelude.Serial/o-n-space/Applicative/*) echo -n "-K8M -M128M" ;;
77+ Prelude.Serial/o-n-space/Monad/*) echo -n "-K8M -M64M" ;;
78+
79+ # Use -K4M for o-n-space except for grouping
80+ Prelude.Serial/o-n-space/grouping/*) echo -n "" ;;
81+ Prelude.Serial/o-n-space/*) echo -n "-K4M" ;;
82+
83+ Prelude.WSerial/o-n-space/*) echo -n "-K4M" ;;
84+
85+ Prelude.Async/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
86+ Prelude.Ahead/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
87+ Prelude.Ahead/o-1-space/*) echo -n "-K128K" ;;
88+
89+ Prelude.WAsync/o-n-heap/monad-outer-product/toNull3) echo -n "-M64M" ;;
90+ Prelude.WAsync/o-n-space/monad-outer-product/*) echo -n "-K4M" ;;
91+
92+ # XXX need to investigate these, taking too much stack
93+ Data.Parser.ParserD/o-1-space/some) echo -n "-K8M" ;;
94+ Data.Parser/o-1-space/some) echo -n "-K8M" ;;
95+ Data.Parser.ParserD/o-1-space/manyTill) echo -n "-K4M" ;;
96+ Data.Parser/o-1-space/manyTill) echo -n "-K4M" ;;
97+ Data.Parser/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
98+ Data.Parser/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
99+ Data.Parser/o-n-heap/choice) echo -n "-K16M -M32M" ;;
100+ Data.Parser.ParserK/o-n-heap/manyAlt) echo -n "-K4M -M128M" ;;
101+ Data.Parser.ParserK/o-n-heap/someAlt) echo -n "-K4M -M128M" ;;
102+ Data.Parser.ParserK/o-n-heap/sequence) echo -n "-M64M";;
103+ Data.Parser.ParserK/o-n-heap/sequenceA) echo -n "-M64M";;
104+
105+ Data.SmallArray/o-1-sp*) echo -n "-K128K" ;;
106+ # For tasty-bench
107+ Data.Array*/o-1-space/generation/show) echo -n "-M32M" ;;
108+ # XXX For GHC-8.10
109+ Data.Array/o-1-space/transformationX4/map) echo -n "-M32M" ;;
110+ # DEVBUILD only benchmarks - array foldable instance
111+ Data.Array.Foreign/o-1-space/elimination/foldable/foldl*) echo -n "-K8M" ;;
112+ Data.Array.Foreign/o-1-space/elimination/foldable/sum) echo -n "-K8M" ;;
113+ *) echo -n "" ;;
114+ esac
115+}
116+
117+#------------------------------------------------------------------------------
118+# Speed options
119+#------------------------------------------------------------------------------
120+
121+bench_speed_options () {
122+ local exe_name
123+ local bench_name
124+
125+ exe_name="$1"
126+ bench_name="$2"
127+
128+ case "$exe_name" in
129+ Prelude.Concurrent) set_super_quick_mode ;;
130+ Prelude.Rate) set_super_quick_mode ;;
131+ Prelude.Adaptive) set_super_quick_mode;;
132+ *) echo -n "" ;;
133+ esac
134+
135+ # XXX Note: for tasty-bench we replace the "." separator in the benchmark names
136+ # with "/" for matching with this. It may not work reliably if the benchmark
137+ # name already contains ".".
138+
139+ # Use quick options for benchmarks that take too long
140+ case "$bench_name" in
141+ Prelude.Parallel/o-n-heap/mapping/mapM) set_super_quick_mode ;;
142+ Prelude.Parallel/o-n-heap/monad-outer-product/*) set_super_quick_mode ;;
143+ Prelude.Parallel/o-n-space/monad-outer-product/*) set_super_quick_mode ;;
144+ Prelude.Parallel/o-n-heap/generation/*) use_quicker_mode ;;
145+ Prelude.Parallel/o-n-heap/mapping/*) use_quicker_mode ;;
146+ Prelude.Parallel/o-n-heap/concat-foldable/*) use_quicker_mode ;;
147+
148+ Prelude.Async/o-1-space/monad-outer-product/*) use_quicker_mode ;;
149+ Prelude.Async/o-n-space/monad-outer-product/*) use_quicker_mode ;;
150+
151+ Prelude.Ahead/o-1-space/monad-outer-product/*) use_quicker_mode ;;
152+ Prelude.Ahead/o-n-space/monad-outer-product/*) use_quicker_mode ;;
153+
154+ Prelude.WAsync/o-n-heap/monad-outer-product/*) use_quicker_mode ;;
155+ Prelude.WAsync/o-n-space/monad-outer-product/*) use_quicker_mode ;;
156+
157+ FileSystem.Handle/*) use_quicker_mode ;;
158+ *) echo -n "" ;;
159+ esac
160+}
bin/bench.shnew file+15
@@ -0,0 +1,15 @@
1+#!/usr/bin/env bash
2+
3+SCRIPT_DIR=$(cd `dirname $0`; pwd)
4+source $SCRIPT_DIR/bench-config.sh \
5+ || { echo "Cannot source $SCRIPT_DIR/bench-config.sh"; exit 1; }
6+
7+bench_config
8+if test -z "$BENCH_REPORT_DIR"
9+then
10+ echo "BENCH_REPORT_DIR variable not defined by bench-config() in $SCRIPT_DIR/bench-config.sh"
11+ exit 1
12+fi
13+
14+cd $SCRIPT_DIR/..
15+$BENCH_REPORT_DIR/bin/bench-runner.sh --config $SCRIPT_DIR/bench-config.sh "$@"
bin/mk-hscope.sh+1−1
@@ -1,7 +1,7 @@
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.9.0
4+STREAMLY_VERSION=0.8.2
5
5
6case `uname` in
6case `uname` in
7 Darwin) SYSTEM=x86_64-osx;;
7 Darwin) SYSTEM=x86_64-osx;;
bin/repldeleted−3
@@ -1,3 +0,0 @@
1−#!/bin/bash
2−
3−cabal repl --project-file cabal.project.O0
bin/run-ci.sh+28−28
@@ -10,6 +10,7 @@
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"
13
14
14CABAL_BUILD_OPTIONS="--flag limit-build-mem"
15CABAL_BUILD_OPTIONS="--flag limit-build-mem"
15
16
@@ -18,8 +19,8 @@ CABAL_BUILD_OPTIONS="--flag limit-build-mem"
18#------------------------------------------------------------------------------
19#------------------------------------------------------------------------------
19
20
20# XXX take these from command line
21# XXX take these from command line
21−GHC_PRIME_NIX="ghc922"
22+GHC_PRIME_NIX="ghc8104"
22−GHC_PRIME_VER="9.2.2"
23+GHC_PRIME_VER="8.10"
23JOBS=1
24JOBS=1
24
25
25# Without cabal project file, it will not run any tests
26# Without cabal project file, it will not run any tests
@@ -72,9 +73,9 @@ ghc_prime_perf () {
72 --argstr compiler "$GHC_PRIME_NIX" \
73 --argstr compiler "$GHC_PRIME_NIX" \
73 --argstr c2nix "--flag inspection" \
74 --argstr c2nix "--flag inspection" \
74 --run "\
75 --run "\
75− bin/test-runner --cabal-build-options \
76+ bin/test.sh --cabal-build-options \
76 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\";\
77 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\";\
77− bin/bench-runner --cabal-build-options \
78+ bin/bench.sh --cabal-build-options \
78 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\" \
79 \"--jobs=$JOBS --project-file cabal.project.Werror $PERF_FLAGS\" \
79 --quick --raw;"
80 --quick --raw;"
80}
81}
@@ -83,7 +84,7 @@ ghc_prime_O0 () {
83 nix-shell \
84 nix-shell \
84 --argstr compiler "$GHC_PRIME_NIX" \
85 --argstr compiler "$GHC_PRIME_NIX" \
85 --run "\
86 --run "\
86− bin/test-runner --cabal-build-options \
87+ bin/test.sh --cabal-build-options \
87 \"--jobs=$JOBS --project-file cabal.project.O0\""
88 \"--jobs=$JOBS --project-file cabal.project.O0\""
88}
89}
89
90
@@ -108,7 +109,7 @@ werror () {
108ghc_prime_Werror () {
109ghc_prime_Werror () {
109 nix-shell \
110 nix-shell \
110 --argstr compiler "$GHC_PRIME_NIX" \
111 --argstr compiler "$GHC_PRIME_NIX" \
111− --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror --enable-tests --enable-benchmarks all"
112+ --run "cabal build $CABAL_BUILD_OPTIONS --jobs=$JOBS --project-file cabal.project.Werror all"
112}
113}
113
114
114ghc_prime_doctests () {
115ghc_prime_doctests () {
@@ -127,7 +128,7 @@ ghc_prime_doctests () {
127ghc_prime_coverage () {
128ghc_prime_coverage () {
128 nix-shell \
129 nix-shell \
129 --argstr compiler "$GHC_PRIME_NIX" \
130 --argstr compiler "$GHC_PRIME_NIX" \
130− --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS\" --coverage"
131+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS\" --coverage"
131}
132}
132
133
133#------------------------------------------------------------------------------
134#------------------------------------------------------------------------------
@@ -138,7 +139,7 @@ ghc_prime_dev_test () {
138 nix-shell \
139 nix-shell \
139 --argstr compiler "$GHC_PRIME_NIX" \
140 --argstr compiler "$GHC_PRIME_NIX" \
140 --run "\
141 --run "\
141− bin/test-runner --cabal-build-options \
142+ bin/test.sh --cabal-build-options \
142 \"--jobs=$JOBS --flag dev\""
143 \"--jobs=$JOBS --flag dev\""
143}
144}
144
145
@@ -146,14 +147,26 @@ ghc_prime_dev_perf () {
146 nix-shell \
147 nix-shell \
147 --argstr compiler "$GHC_PRIME_NIX" \
148 --argstr compiler "$GHC_PRIME_NIX" \
148 --run "\
149 --run "\
149− bin/bench-runner --cabal-build-options \
150+ bin/bench.sh --cabal-build-options \
150 \"--jobs=$JOBS --flag dev $PERF_FLAGS\" --quick --raw"
151 \"--jobs=$JOBS --flag dev $PERF_FLAGS\" --quick --raw"
151}
152}
152
153
154+ghc_prime_c_malloc () {
155+ nix-shell \
156+ --argstr compiler "$GHC_PRIME_NIX" \
157+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag use-c-malloc\""
158+}
159+
153ghc_prime_debug () {
160ghc_prime_debug () {
154 nix-shell \
161 nix-shell \
155 --argstr compiler "$GHC_PRIME_NIX" \
162 --argstr compiler "$GHC_PRIME_NIX" \
156− --run "bin/test-runner --cabal-build-options \"--jobs=$JOBS --flag debug\""
163+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag debug\""
164+}
165+
166+ghc_prime_streamk () {
167+ nix-shell \
168+ --argstr compiler "$GHC_PRIME_NIX" \
169+ --run "bin/test.sh --cabal-build-options \"--jobs=$JOBS --flag streamk\""
157}
170}
158
171
159#------------------------------------------------------------------------------
172#------------------------------------------------------------------------------
@@ -200,15 +213,11 @@ ghcHEAD () {
200# ghcjs
213# ghcjs
201#------------------------------------------------------------------------------
214#------------------------------------------------------------------------------
202
215
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
205ghcjs () {
216ghcjs () {
206− # We don't pass 'CABAL_BUILD_OPTIONS="--flag limit-build-mem"' here as
217+ export PATH=~/.local/bin:/opt/ghc/bin:/opt/ghcjs/bin:/usr/local/bin:/usr/bin:/bin:/usr/sbin:/sbin:$PATH
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 \
218 packcheck.sh cabal-v2 \
210− GHCVER=8.10.7 \
219+ GHCVER=8.4.0 \
211− CABAL_BUILD_OPTIONS="--jobs=$JOBS" \
220+ CABAL_BUILD_OPTIONS="$CABAL_BUILD_OPTIONS --jobs=$JOBS" \
212 CABAL_CHECK_RELAX=y \
221 CABAL_CHECK_RELAX=y \
213 DISABLE_SDIST_BUILD=y \
222 DISABLE_SDIST_BUILD=y \
214 DISABLE_TEST=y \
223 DISABLE_TEST=y \
@@ -229,7 +238,9 @@ ghc_prime_O0 \
229ghc_prime_Werror \
238ghc_prime_Werror \
230ghc_prime_doctests \
239ghc_prime_doctests \
231ghc_prime_coverage \
240ghc_prime_coverage \
241+ghc_prime_c_malloc \
232ghc_prime_debug \
242ghc_prime_debug \
243+ghc_prime_streamk \
233ghc901 \
244ghc901 \
234ghc884 \
245ghc884 \
235ghcjs \
246ghcjs \
@@ -288,17 +299,6 @@ else
288 fi
299 fi
289fi
300fi
290
301
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−
302for i in $TARGETS
302for i in $TARGETS
303do
303do
304 if test "$(has_item "$ALL_TARGETS" "$i")" != "$i"
304 if test "$(has_item "$ALL_TARGETS" "$i")" != "$i"
bin/run-repl-quick.sh+1−1
@@ -13,7 +13,7 @@ set -e
13
13
14SCRIPT_DIR=$(dirname $0)
14SCRIPT_DIR=$(dirname $0)
15
15
16−STREAMLY_VERSION=0.9.0
16+STREAMLY_VERSION=0.8.2
17BENCH_REPORT_DIR=benchmark/bench-report
17BENCH_REPORT_DIR=benchmark/bench-report
18source $SCRIPT_DIR/targets.sh
18source $SCRIPT_DIR/targets.sh
19
19
bin/targets.shnew file+120
@@ -0,0 +1,120 @@
1+#------------------------------------------------------------------------------
2+# test and benchmark groups
3+#------------------------------------------------------------------------------
4+
5+# Depends on RUNNING_TESTS, RUNNING_BENCHMARKS, RUNNING_DEVBUILD variables
6+# being set for dev_build, test_only, bench_only functions to work. So the
7+# "targets" fucntion should be called only after these are set.
8+
9+# IMPORTANT NOTE: the names "_grp" and "_cmp" suffixes are special, do
10+# not rename them to something else.
11+
12+targets () {
13+ base_stream_grp="\
14+ `bench_only Data.Stream.StreamD` \
15+ `bench_only Data.Stream.StreamK` \
16+ `bench_only Data.Stream.StreamDK`"
17+
18+ prelude_serial_grp="\
19+ Prelude.Serial \
20+ Prelude.WSerial \
21+ Prelude.ZipSerial"
22+
23+ prelude_concurrent_grp="\
24+ Prelude.Async \
25+ Prelude.WAsync \
26+ Prelude.Ahead \
27+ Prelude.Parallel \
28+ Prelude.ZipAsync"
29+
30+ prelude_other_grp="\
31+ `test_only Prelude` \
32+ $(test_only $(dev_build Prelude.Rate)) \
33+ `bench_only Prelude.Rate` \
34+ `test_only Prelude.Fold` \
35+ `test_only Prelude.Concurrent` \
36+ $(bench_only $(dev_build Prelude.Concurrent)) \
37+ `bench_only Prelude.Adaptive`"
38+
39+ array_grp="\
40+ Data.Array \
41+ Data.Array.Foreign \
42+ Data.Array.Prim \
43+ Data.SmallArray \
44+ Data.Array.Prim.Pinned"
45+
46+ base_parser_grp="\
47+ Data.Parser.ParserD \
48+ `bench_only Data.Parser.ParserK`"
49+
50+ parser_grp="\
51+ Data.Fold \
52+ Data.Parser"
53+
54+ list_grp="\
55+ `test_only Data.List.Base` \
56+ `test_only Data.List`"
57+
58+ #------------------------------------------------------------------------------
59+ # Streaming vs non-streaming
60+ #------------------------------------------------------------------------------
61+ # The "o-1-space" groups of these benchmarks are run with long stream
62+ # sizes when --long option is used.
63+
64+ infinite_grp="\
65+ $prelude_serial_grp \
66+ $prelude_concurrent_grp \
67+ `bench_only Prelude.Rate`"
68+
69+ #------------------------------------------------------------------------------
70+ # Benchmark comparison groups
71+ #------------------------------------------------------------------------------
72+
73+ # *_cmp denotes a comparison benchmark, the benchmarks provided in *_cmp
74+ # variables are compared with each other
75+ base_stream_cmp="Data.Stream.StreamD Data.Stream.StreamK"
76+ serial_wserial_cmp="Prelude.Serial Prelude.WSerial"
77+ serial_async_cmp="Prelude.Serial Prelude.Async"
78+ concurrent_cmp="Prelude.Async Prelude.WAsync Prelude.Ahead Prelude.Parallel"
79+ array_cmp="Data.Array.Foreign Data.Array.Prim Data.Array Data.Array.Prim.Pinned"
80+ pinned_array_cmp="Data.Array.Foreign Data.Array.Prim.Pinned"
81+ base_parser_cmp=$base_parser_grp
82+
83+ COMPARISONS="\
84+ base_stream_cmp \
85+ serial_wserial_cmp \
86+ serial_async_cmp \
87+ concurrent_cmp \
88+ array_cmp \
89+ pinned_array_cmp \
90+ base_parser_cmp"
91+
92+ #------------------------------------------------------------------------------
93+ # All test/benchmark modules must be in at least one of these
94+ #------------------------------------------------------------------------------
95+
96+ # All groups
97+ GROUP_TARGETS="\
98+ base_stream_grp \
99+ prelude_serial_grp \
100+ prelude_concurrent_grp \
101+ prelude_other_grp \
102+ array_grp \
103+ base_parser_grp \
104+ parser_grp \
105+ list_grp \
106+ infinite_grp"
107+
108+ # Not in any groups
109+ INDIVIDUAL_TARGETS="\
110+ Data.Unfold \
111+ Unicode.Stream \
112+ $(test_only $(dev_build Unicode.Char)) \
113+ `bench_only Unicode.Char` \
114+ `bench_only Unicode.Utf8` \
115+ FileSystem.Handle \
116+ `test_only FileSystem.Event` \
117+ `test_only Network.Socket` \
118+ `test_only Network.Inet.TCP` \
119+ `test_only version-bounds`"
120+}
bin/test.shnew file+247
@@ -0,0 +1,247 @@
1+#!/usr/bin/env bash
2+
3+SCRIPT_DIR=$(dirname $0)
4+
5+STREAMLY_VERSION=0.8.2
6+BENCH_REPORT_DIR=benchmark/bench-report
7+source $SCRIPT_DIR/targets.sh
8+
9+#------------------------------------------------------------------------------
10+# Script
11+#------------------------------------------------------------------------------
12+
13+print_help () {
14+ echo "Usage: $0 "
15+ echo " [--targets <"target1 target2 ..." | help>]"
16+ echo
17+ echo " [--quick]"
18+ echo " [--with-compiler <compiler exe name>]"
19+ echo " [--cabal-build-options <option>]"
20+ echo " [--dev-build]"
21+ echo
22+ echo " [--coverage]"
23+ echo " [--hpc-report-options <option>]"
24+ echo " [--no-measure]"
25+ echo " [--raw]"
26+ echo
27+ echo " [--rtsopts <option>]"
28+ echo " -- <hspec options or test names>"
29+ echo
30+ echo "--targets: targets to run, use 'help' for list of targets"
31+ echo
32+ echo "--quick: disable optimizations to build quickly"
33+ echo "--cabal-build-options: Pass any cabal build options to be used for build"
34+ echo "--dev-build: runs some additional tests"
35+ echo
36+ echo "--coverage: enable coverage and report coverage info"
37+ echo "--hpc-report-options: option for 'hpc report'"
38+ echo "--no-measure: with --coverage, do not run tests, only show coverage info"
39+ echo "--raw: with --coverage, do not run hpc"
40+ echo
41+ echo "--rtsopts: pass GHC RTS options to the test executable"
42+ echo "Any arguments after a '--' are passed directly to hspec"
43+ exit
44+}
45+
46+#-----------------------------------------------------------------------------
47+# Read command line
48+#-----------------------------------------------------------------------------
49+
50+RUNNING_TESTS=y
51+source $BENCH_REPORT_DIR/bin/build-lib.sh
52+
53+USE_GIT_CABAL=1
54+set_common_vars
55+COVERAGE=0
56+MEASURE=1
57+HPC_REPORT_OPTIONS=
58+RAW=0
59+CABAL_BUILD_OPTIONS="--flag limit-build-mem"
60+TEST_QUICK_MODE=0
61+
62+# XXX add a bisect option
63+while test -n "$1"
64+do
65+ case $1 in
66+ -h|--help|help) print_help ;;
67+ # options with arguments
68+ --targets) shift; TARGETS=$1; shift ;;
69+ --with-compiler) shift; CABAL_WITH_COMPILER=$1; shift ;;
70+ --cabal-build-options) shift; CABAL_BUILD_OPTIONS+=" $1"; shift ;;
71+ --hpc-report-options) shift; HPC_REPORT_OPTIONS="$1"; shift ;;
72+ --rtsopts) shift; RTS_OPTIONS="$1"; shift ;;
73+ # flags
74+ --raw) RAW=1; shift ;;
75+ #--slow) SLOW=1; shift ;; # not implemented
76+ --quick) TEST_QUICK_MODE=1; shift ;;
77+ --dev-build) RUNNING_DEVBUILD=1 CABAL_BUILD_OPTIONS+=" --flag dev"; shift ;;
78+ --coverage) COVERAGE=1; shift ;;
79+ --no-measure) MEASURE=0; shift ;;
80+ --) shift; break ;;
81+ -*|--*) echo "Unknown flags: $*"; echo; print_help ;;
82+ *) break ;;
83+ esac
84+done
85+TARGET_EXE_ARGS=$*
86+
87+set_derived_vars
88+
89+if test $TEST_QUICK_MODE -eq 1
90+then
91+ CABAL_BUILD_OPTIONS+=" --disable-optimization --flags -opt"
92+fi
93+
94+#-----------------------------------------------------------------------------
95+# Determine targets
96+#-----------------------------------------------------------------------------
97+
98+# Defined in targets.sh
99+targets
100+
101+if test "$(has_item "$TARGETS" help)" = "help"
102+then
103+ list_target_groups
104+ list_targets
105+ exit
106+fi
107+
108+DEFAULT_TARGETS="$(all_grp)"
109+TARGETS=$(set_targets)
110+
111+echo "Using targets [$TARGETS]"
112+
113+#-----------------------------------------------------------------------------
114+# Build targets
115+#-----------------------------------------------------------------------------
116+
117+test_exe_rts_opts () {
118+ case "$1" in
119+ # XXX Data.Array.* heap requirement increased for GHC-8.10
120+ Data.Array.Foreign) echo -n "-M128M" ;;
121+ Data.Array.Prim) echo -n "-M128M" ;;
122+ Data.Array.Prim.Pinned) echo -n "-M128M" ;;
123+ Prelude.Rate) echo -n "-M512M" ;;
124+ # For -O0 case writeChunks test fails, maybe we should have a separate flag
125+ # for O0 case?
126+ FileSystem.Handle) echo -n "-K16M" ;;
127+ *) if test "$COVERAGE" -eq "1"
128+ then
129+ echo -n "-K8M -M1024M"
130+ else
131+ echo -n "-K8M -M64M"
132+ fi ;;
133+ esac
134+}
135+
136+# $1: bench name
137+# $2: bench executable
138+target_exe_extra_args () {
139+ local bench_name=$1
140+ local bench_prog=$2
141+
142+ echo "+RTS \
143+ $(test_exe_rts_opts $(basename $bench_prog)) \
144+ $RTS_OPTIONS \
145+ -RTS"
146+}
147+
148+if test "$COVERAGE" -eq "1"
149+then
150+ # Used to determine the hpc tix dir
151+ PACKAGE_FULL_NAME=streamly-$STREAMLY_VERSION
152+ case `uname` in
153+ Linux) SYSTEM=x86_64-linux ;;
154+ *) echo "Unsupported system"; exit 1 ;;
155+ esac
156+
157+ # With the --enable-coverage option the tests as well as the library get
158+ # compiled with -fhpc, and we get coverage for tests as well. But we want to
159+ # exclude that, so a project file is needed.
160+ CABAL_BUILD_OPTIONS+=" --project-file cabal.project.coverage"
161+ mkdir -p $BUILD_DIR/hpc
162+fi
163+BUILD_TEST="$CABAL_EXECUTABLE v2-build $CABAL_BUILD_OPTIONS --enable-tests"
164+
165+if test "$MEASURE" -eq "1"
166+then
167+run_build "$BUILD_TEST" streamly-tests test "$TARGETS"
168+fi
169+
170+#-----------------------------------------------------------------------------
171+# Run targets
172+#-----------------------------------------------------------------------------
173+
174+# $1: target name
175+get_tix_file () {
176+ echo $BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_FULL_NAME/hpc/vanilla/tix/$1/$1.tix
177+}
178+
179+# $1: package name
180+# $2: component
181+# $3: target
182+# $4: args generator func
183+run_target () {
184+ local package_name=$1
185+ local component=$2
186+ local target_name=$3
187+ local extra_args=$4
188+
189+ local target_prog
190+
191+ target_prog=$(cabal_target_prog $package_name $component $target_name) || \
192+ die "Cannot find executable for target $target_name"
193+
194+ echo "Running executable $target_name ..."
195+
196+ mkdir -p $(dirname $(get_tix_file $target_name))
197+ export HPCTIXFILE=$(get_tix_file $target_name)
198+
199+ run_verbose $target_prog $($extra_args $target_name $target_prog) \
200+ || die "Target exe failed"
201+
202+ # hpc-coveralls fails if there is an empty dir and no .tix file generated
203+ rmdir $(dirname $(get_tix_file $target_name)) 2>/dev/null || true
204+}
205+
206+# $1: package name with version
207+# $2: component
208+# $3: targets
209+# $4: args generator func
210+run_targets() {
211+ for i in $3
212+ do
213+ run_target $1 $2 $i $4
214+ done
215+}
216+
217+if test "$MEASURE" -eq "1"
218+then
219+run_targets "streamly-tests-0.0.0" t "$TARGETS" target_exe_extra_args
220+fi
221+
222+#-----------------------------------------------------------------------------
223+# Run coverage reports
224+#-----------------------------------------------------------------------------
225+
226+PACKAGE_NAME=streamly-$STREAMLY_VERSION
227+MIX_DIR=$BUILD_DIR/build/$SYSTEM/ghc-${GHC_VERSION}/$PACKAGE_NAME/hpc/vanilla/mix/$PACKAGE_NAME/
228+ALLTIX=$BUILD_DIR/hpc/all.tix
229+
230+if test "$COVERAGE" -eq "1" -a "$RAW" -eq 0
231+then
232+ TIXFILES=
233+ for i in $TARGETS
234+ do
235+ tixfile="$(get_tix_file ${i})"
236+ if test -f "$tixfile"
237+ then
238+ TIXFILES+="$tixfile "
239+ fi
240+ done
241+
242+ #echo "Combining tix files:"
243+ #echo $TIXFILES | tr ' ' '\n'
244+ hpc sum --union --output=$ALLTIX $TIXFILES
245+ run_verbose hpc markup $ALLTIX --hpcdir $MIX_DIR
246+ run_verbose hpc report $ALLTIX $HPC_REPORT_OPTIONS --hpcdir $MIX_DIR
247+fi
cabal.project−1
@@ -1,5 +1,4 @@
1packages: streamly.cabal
1packages: streamly.cabal
2− , core/streamly-core.cabal
3 , test/streamly-tests.cabal
2 , test/streamly-tests.cabal
4 , benchmark/streamly-benchmarks.cabal
3 , benchmark/streamly-benchmarks.cabal
5 , docs/streamly-docs.cabal
4 , docs/streamly-docs.cabal
cabal.project.O0+3−8
@@ -2,23 +2,18 @@ packages:
2 ./
2 ./
3 test
3 test
4 benchmark
4 benchmark
5− core
6
5
7-- Keep the flags same as cabal.project.doctest because we utilize the
6-- Keep the flags same as cabal.project.doctest because we utilize the
8-- same build for doctests in CI.
7-- same build for doctests in CI.
9
8
10package streamly
9package streamly
11 flags: -opt
10 flags: -opt
12− ghc-options: -O0
11+ ghc-options: -O0 -Werror
13−
14−package streamly-core
15− flags: -opt
16− ghc-options: -O0
17
12
18package streamly-tests
13package streamly-tests
19 flags: -opt
14 flags: -opt
20− ghc-options: -O0
15+ ghc-options: -O0 -Werror
21
16
22package streamly-benchmarks
17package streamly-benchmarks
23 flags: -opt
18 flags: -opt
24− ghc-options: -O0
19+ ghc-options: -O0 -Werror
cabal.project.Werror−4
@@ -2,14 +2,10 @@ packages:
2 ./
2 ./
3 benchmark
3 benchmark
4 test
4 test
5− core
6
5
7package streamly
6package streamly
8 ghc-options: -Werror
7 ghc-options: -Werror
9
8
10−package streamly-core
11− ghc-options: -Werror
12−
13package streamly-benchmarks
9package streamly-benchmarks
14 ghc-options: -Werror
10 ghc-options: -Werror
15
11
cabal.project.Werror-nocode−8
@@ -2,20 +2,12 @@ packages:
2 ./
2 ./
3 benchmark
3 benchmark
4 test
4 test
5− core
6−
7−package streamly-core
8− flags: -opt
9− ghc-options: -Werror -O0
10
5
11package streamly
6package streamly
12− flags: -opt
13 ghc-options: -Werror -fno-code
7 ghc-options: -Werror -fno-code
14
8
15package streamly-benchmarks
9package streamly-benchmarks
16− flags: -opt
17 ghc-options: -Werror -fno-code
10 ghc-options: -Werror -fno-code
18
11
19package streamly-tests
12package streamly-tests
20− flags: -opt
21 ghc-options: -Werror -fno-code
13 ghc-options: -Werror -fno-code
cabal.project.coverage−4
@@ -1,14 +1,10 @@
1packages:
1packages:
2 ./
2 ./
3 test
3 test
4− core
5
4
6package streamly
5package streamly
7 coverage: true
6 coverage: true
8
7
9−package streamly-core
10− coverage: true
11−
12-- package streamly-tests
8-- package streamly-tests
13 -- A few percent lesss coverage for some build speedup
9 -- A few percent lesss coverage for some build speedup
14 -- -DCOVERAGE_BUILD
10 -- -DCOVERAGE_BUILD
cabal.project.doctest+3−14
@@ -1,24 +1,13 @@
1packages: streamly.cabal
1packages: streamly.cabal
2− , core/streamly-core.cabal
2+ , docs/streamly-docs.cabal
3− -- , docs/streamly-docs.cabal
4− -- for QuickCheck in property doctests
5− , test/streamly-tests.cabal
6
3
7-- Keep the flags same as cabal.project.O0 because we utilize the same build
4-- Keep the flags same as cabal.project.O0 because we utilize the same build
8-- for doctest in CI.
5-- for doctest in CI.
9
6
10package streamly
7package streamly
11 flags: -opt
8 flags: -opt
12− ghc-options: -O0
9+ ghc-options: -O0 -Werror
13−
14−package streamly-core
15− flags: -opt
16− ghc-options: -O0
17
10
18package streamly-docs
11package streamly-docs
19 flags: -opt
12 flags: -opt
20− ghc-options: -O0
13+ ghc-options: -O0 -Werror
21−
22−package streamly-tests
23− flags: -opt
24− ghc-options: -O0
cabal.project.ghc-head+1−10
@@ -3,7 +3,6 @@
3-- source at https://gitlab.haskell.org/ghc/head.hackage/
3-- source at https://gitlab.haskell.org/ghc/head.hackage/
4
4
5packages: streamly.cabal
5packages: streamly.cabal
6− , core/streamly-core.cabal
7 , test/streamly-tests.cabal
6 , test/streamly-tests.cabal
8 , benchmark/streamly-benchmarks.cabal
7 , benchmark/streamly-benchmarks.cabal
9 , docs/streamly-docs.cabal
8 , docs/streamly-docs.cabal
@@ -24,12 +23,4 @@ active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override
24source-repository-package
23source-repository-package
25 type: git
24 type: git
26 location: https://github.com/composewell/fusion-plugin
25 location: https://github.com/composewell/fusion-plugin
27− tag: 3c6535a7027d60d88c37b9a601cb180b805e7431
26+ tag: 5fc7a38c9106e643b5ebde61400d54813a071d7b
28−
29−source-repository-package
30− type: git
31− location: https://github.com/rrnewton/haskell-lockfree
32− tag: 00a70cfe74994b41eb3627c752170d1e82118a8e
33− subdir: lockfree-queue
34−
35−allow-newer: all
cabal.project.packdiffdeleted−9
@@ -1,9 +0,0 @@
1−source-repository-package
2− type: git
3− location: https://github.com/composewell/packdiff.git
4− tag: b11a50c9c0523382a19eebc0b12efdae194406a9
5−
6−source-repository-package
7− type: git
8− location: https://github.com/composewell/streamly-process.git
9− tag: d80b860d9d8ea98e4f7f63390442b3155c34dd08
cabal.project.reportdeleted−30
@@ -1,30 +0,0 @@
1−packages:
2− targets/streamly-targets.cabal
3− benchmark/bench-runner/bench-runner.cabal
4− test/test-runner/test-runner.cabal
5−
6−package bench-report
7− flags: +no-charts
8−
9−package bench-show
10− flags: +no-charts
11−
12−source-repository-package
13− type: git
14− location: https://github.com/composewell/bench-report.git
15− tag: 3b50bf0ad06f746bca42f30c8d40a0426e159af3
16−
17−source-repository-package
18− type: git
19− location: https://github.com/composewell/streamly-coreutils.git
20− tag: 5dbb8bcefac3aefd5eb298dc410b11e36e79f35a
21−
22−source-repository-package
23− type: git
24− location: https://github.com/composewell/streamly-shell.git
25− tag: b0c6318119d1cc5e2106343f17b5cff2ad94417f
26−
27−source-repository-package
28− type: git
29− location: https://github.com/composewell/streamly-process.git
30− tag: d80b860d9d8ea98e4f7f63390442b3155c34dd08
cabal.project.streamlydeleted−10
@@ -1,10 +0,0 @@
1−packages: streamly.cabal
2− , test/streamly-tests.cabal
3− , benchmark/streamly-benchmarks.cabal
4− , docs/streamly-docs.cabal
5−
6−source-repository-package
7− type: git
8− location: https://github.com/composewell/streamly
9− tag: master
10− subdir: core
configure+237−9
@@ -1,6 +1,6 @@
1#! /bin/sh
1#! /bin/sh
2# Guess values for system-dependent variables and create Makefiles.
2# Guess values for system-dependent variables and create Makefiles.
3−# Generated by GNU Autoconf 2.71 for streamly 0.10.1.
3+# Generated by GNU Autoconf 2.71 for streamly 0.8.2.
4#
4#
5# Report bugs to <streamly@composewell.com>.
5# Report bugs to <streamly@composewell.com>.
6#
6#
@@ -610,11 +610,43 @@ MAKEFLAGS=
610# Identity of this package.
610# Identity of this package.
611PACKAGE_NAME='streamly'
611PACKAGE_NAME='streamly'
612PACKAGE_TARNAME='streamly'
612PACKAGE_TARNAME='streamly'
613−PACKAGE_VERSION='0.10.1'
613+PACKAGE_VERSION='0.8.2'
614−PACKAGE_STRING='streamly 0.10.1'
614+PACKAGE_STRING='streamly 0.8.2'
615PACKAGE_BUGREPORT='streamly@composewell.com'
615PACKAGE_BUGREPORT='streamly@composewell.com'
616PACKAGE_URL='https://streamly.composewell.com'
616PACKAGE_URL='https://streamly.composewell.com'
617
617
618+# Factoring default headers for most tests.
619+ac_includes_default="\
620+#include <stddef.h>
621+#ifdef HAVE_STDIO_H
622+# include <stdio.h>
623+#endif
624+#ifdef HAVE_STDLIB_H
625+# include <stdlib.h>
626+#endif
627+#ifdef HAVE_STRING_H
628+# include <string.h>
629+#endif
630+#ifdef HAVE_INTTYPES_H
631+# include <inttypes.h>
632+#endif
633+#ifdef HAVE_STDINT_H
634+# include <stdint.h>
635+#endif
636+#ifdef HAVE_STRINGS_H
637+# include <strings.h>
638+#endif
639+#ifdef HAVE_SYS_TYPES_H
640+# include <sys/types.h>
641+#endif
642+#ifdef HAVE_SYS_STAT_H
643+# include <sys/stat.h>
644+#endif
645+#ifdef HAVE_UNISTD_H
646+# include <unistd.h>
647+#endif"
648+
649+ac_header_c_list=
618ac_subst_vars='LTLIBOBJS
650ac_subst_vars='LTLIBOBJS
619LIBOBJS
651LIBOBJS
620OBJEXT
652OBJEXT
@@ -1224,7 +1256,7 @@ if test "$ac_init_help" = "long"; then
1224 # Omit some internal or obsolete options to make the list less imposing.
1256 # Omit some internal or obsolete options to make the list less imposing.
1225 # This message is too long to be a string in the A/UX 3.1 sh.
1257 # This message is too long to be a string in the A/UX 3.1 sh.
1226 cat <<_ACEOF
1258 cat <<_ACEOF
1227−\`configure' configures streamly 0.10.1 to adapt to many kinds of systems.
1259+\`configure' configures streamly 0.8.2 to adapt to many kinds of systems.
1228
1260
1229Usage: $0 [OPTION]... [VAR=VALUE]...
1261Usage: $0 [OPTION]... [VAR=VALUE]...
1230
1262
@@ -1286,7 +1318,7 @@ fi
1286
1318
1287if test -n "$ac_init_help"; then
1319if test -n "$ac_init_help"; then
1288 case $ac_init_help in
1320 case $ac_init_help in
1289− short | recursive ) echo "Configuration of streamly 0.10.1:";;
1321+ short | recursive ) echo "Configuration of streamly 0.8.2:";;
1290 esac
1322 esac
1291 cat <<\_ACEOF
1323 cat <<\_ACEOF
1292
1324
@@ -1372,7 +1404,7 @@ fi
1372test -n "$ac_init_help" && exit $ac_status
1404test -n "$ac_init_help" && exit $ac_status
1373if $ac_init_version; then
1405if $ac_init_version; then
1374 cat <<\_ACEOF
1406 cat <<\_ACEOF
1375−streamly configure 0.10.1
1407+streamly configure 0.8.2
1376generated by GNU Autoconf 2.71
1408generated by GNU Autoconf 2.71
1377
1409
1378Copyright (C) 2021 Free Software Foundation, Inc.
1410Copyright (C) 2021 Free Software Foundation, Inc.
@@ -1476,6 +1508,148 @@ printf "%s\n" "$ac_res" >&6; }
1476 eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
1508 eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
1477
1509
1478} # ac_fn_check_decl
1510} # ac_fn_check_decl
1511+
1512+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
1513+# -------------------------------------------------------
1514+# Tests whether HEADER exists and can be compiled using the include files in
1515+# INCLUDES, setting the cache variable VAR accordingly.
1516+ac_fn_c_check_header_compile ()
1517+{
1518+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
1519+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
1520+printf %s "checking for $2... " >&6; }
1521+if eval test \${$3+y}
1522+then :
1523+ printf %s "(cached) " >&6
1524+else $as_nop
1525+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
1526+/* end confdefs.h. */
1527+$4
1528+#include <$2>
1529+_ACEOF
1530+if ac_fn_c_try_compile "$LINENO"
1531+then :
1532+ eval "$3=yes"
1533+else $as_nop
1534+ eval "$3=no"
1535+fi
1536+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext
1537+fi
1538+eval ac_res=\$$3
1539+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
1540+printf "%s\n" "$ac_res" >&6; }
1541+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
1542+
1543+} # ac_fn_c_check_header_compile
1544+
1545+# ac_fn_c_try_link LINENO
1546+# -----------------------
1547+# Try to link conftest.$ac_ext, and return whether this succeeded.
1548+ac_fn_c_try_link ()
1549+{
1550+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
1551+ rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext
1552+ if { { ac_try="$ac_link"
1553+case "(($ac_try" in
1554+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
1555+ *) ac_try_echo=$ac_try;;
1556+esac
1557+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
1558+printf "%s\n" "$ac_try_echo"; } >&5
1559+ (eval "$ac_link") 2>conftest.err
1560+ ac_status=$?
1561+ if test -s conftest.err; then
1562+ grep -v '^ *+' conftest.err >conftest.er1
1563+ cat conftest.er1 >&5
1564+ mv -f conftest.er1 conftest.err
1565+ fi
1566+ printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
1567+ test $ac_status = 0; } && {
1568+ test -z "$ac_c_werror_flag" ||
1569+ test ! -s conftest.err
1570+ } && test -s conftest$ac_exeext && {
1571+ test "$cross_compiling" = yes ||
1572+ test -x conftest$ac_exeext
1573+ }
1574+then :
1575+ ac_retval=0
1576+else $as_nop
1577+ printf "%s\n" "$as_me: failed program was:" >&5
1578+sed 's/^/| /' conftest.$ac_ext >&5
1579+
1580+ ac_retval=1
1581+fi
1582+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
1583+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
1584+ # interfere with the next link command; also delete a directory that is
1585+ # left behind by Apple's compiler. We do this before executing the actions.
1586+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
1587+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
1588+ as_fn_set_status $ac_retval
1589+
1590+} # ac_fn_c_try_link
1591+
1592+# ac_fn_c_check_func LINENO FUNC VAR
1593+# ----------------------------------
1594+# Tests whether FUNC exists, setting the cache variable VAR accordingly
1595+ac_fn_c_check_func ()
1596+{
1597+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
1598+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
1599+printf %s "checking for $2... " >&6; }
1600+if eval test \${$3+y}
1601+then :
1602+ printf %s "(cached) " >&6
1603+else $as_nop
1604+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
1605+/* end confdefs.h. */
1606+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
1607+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
1608+#define $2 innocuous_$2
1609+
1610+/* System header to define __stub macros and hopefully few prototypes,
1611+ which can conflict with char $2 (); below. */
1612+
1613+#include <limits.h>
1614+#undef $2
1615+
1616+/* Override any GCC internal prototype to avoid an error.
1617+ Use char because int might match the return type of a GCC
1618+ builtin and then its argument prototype would still apply. */
1619+#ifdef __cplusplus
1620+extern "C"
1621+#endif
1622+char $2 ();
1623+/* The GNU C library defines this for functions which it implements
1624+ to always fail with ENOSYS. Some functions are actually named
1625+ something starting with __ and the normal name is an alias. */
1626+#if defined __stub_$2 || defined __stub___$2
1627+choke me
1628+#endif
1629+
1630+int
1631+main (void)
1632+{
1633+return $2 ();
1634+ ;
1635+ return 0;
1636+}
1637+_ACEOF
1638+if ac_fn_c_try_link "$LINENO"
1639+then :
1640+ eval "$3=yes"
1641+else $as_nop
1642+ eval "$3=no"
1643+fi
1644+rm -f core conftest.err conftest.$ac_objext conftest.beam \
1645+ conftest$ac_exeext conftest.$ac_ext
1646+fi
1647+eval ac_res=\$$3
1648+ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
1649+printf "%s\n" "$ac_res" >&6; }
1650+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
1651+
1652+} # ac_fn_c_check_func
1479ac_configure_args_raw=
1653ac_configure_args_raw=
1480for ac_arg
1654for ac_arg
1481do
1655do
@@ -1500,7 +1674,7 @@ cat >config.log <<_ACEOF
1500This file contains any messages produced by compilers while
1674This file contains any messages produced by compilers while
1501running configure, to aid debugging if configure makes a mistake.
1675running configure, to aid debugging if configure makes a mistake.
1502
1676
1503−It was created by streamly $as_me 0.10.1, which was
1677+It was created by streamly $as_me 0.8.2, which was
1504generated by GNU Autoconf 2.71. Invocation command line was
1678generated by GNU Autoconf 2.71. Invocation command line was
1505
1679
1506 $ $0$ac_configure_args_raw
1680 $ $0$ac_configure_args_raw
@@ -2079,6 +2253,15 @@ main (int argc, char **argv)
2079}
2253}
2080"
2254"
2081
2255
2256+as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H"
2257+as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H"
2258+as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H"
2259+as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H"
2260+as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H"
2261+as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H"
2262+as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H"
2263+as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H"
2264+as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H"
2082# Check that the precious variables saved in the cache have kept the same
2265# Check that the precious variables saved in the cache have kept the same
2083# value.
2266# value.
2084ac_cache_corrupted=false
2267ac_cache_corrupted=false
@@ -3298,6 +3481,51 @@ fi
3298printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK $ac_have_decl" >>confdefs.h
3481printf "%s\n" "#define HAVE_DECL_KFSEVENTSTREAMEVENTFLAGITEMISHARDLINK $ac_have_decl" >>confdefs.h
3299
3482
3300
3483
3484+# Check headers and functions required
3485+ac_header= ac_cache=
3486+for ac_item in $ac_header_c_list
3487+do
3488+ if test $ac_cache; then
3489+ ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default"
3490+ if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then
3491+ printf "%s\n" "#define $ac_item 1" >> confdefs.h
3492+ fi
3493+ ac_header= ac_cache=
3494+ elif test $ac_header; then
3495+ ac_cache=$ac_item
3496+ else
3497+ ac_header=$ac_item
3498+ fi
3499+done
3500+
3501+
3502+
3503+
3504+
3505+
3506+
3507+
3508+if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes
3509+then :
3510+
3511+printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h
3512+
3513+fi
3514+ac_fn_c_check_header_compile "$LINENO" "time.h" "ac_cv_header_time_h" "$ac_includes_default"
3515+if test "x$ac_cv_header_time_h" = xyes
3516+then :
3517+ printf "%s\n" "#define HAVE_TIME_H 1" >>confdefs.h
3518+
3519+fi
3520+
3521+ac_fn_c_check_func "$LINENO" "clock_gettime" "ac_cv_func_clock_gettime"
3522+if test "x$ac_cv_func_clock_gettime" = xyes
3523+then :
3524+ printf "%s\n" "#define HAVE_CLOCK_GETTIME 1" >>confdefs.h
3525+
3526+fi
3527+
3528+
3301# Output
3529# Output
3302ac_config_headers="$ac_config_headers src/config.h"
3530ac_config_headers="$ac_config_headers src/config.h"
3303
3531
@@ -3800,7 +4028,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
3800# report actual input values of CONFIG_FILES etc. instead of their
4028# report actual input values of CONFIG_FILES etc. instead of their
3801# values after options handling.
4029# values after options handling.
3802ac_log="
4030ac_log="
3803−This file was extended by streamly $as_me 0.10.1, which was
4031+This file was extended by streamly $as_me 0.8.2, which was
3804generated by GNU Autoconf 2.71. Invocation command line was
4032generated by GNU Autoconf 2.71. Invocation command line was
3805
4033
3806 CONFIG_FILES = $CONFIG_FILES
4034 CONFIG_FILES = $CONFIG_FILES
@@ -3856,7 +4084,7 @@ ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\
3856cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
4084cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
3857ac_cs_config='$ac_cs_config_escaped'
4085ac_cs_config='$ac_cs_config_escaped'
3858ac_cs_version="\\
4086ac_cs_version="\\
3859−streamly config.status 0.10.1
4087+streamly config.status 0.8.2
3860configured by $0, generated by GNU Autoconf 2.71,
4088configured by $0, generated by GNU Autoconf 2.71,
3861 with options \\"\$ac_cs_config\\"
4089 with options \\"\$ac_cs_config\\"
3862
4090
configure.ac+5−1
@@ -3,7 +3,7 @@
3# See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on
3# See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on
4# the macros used in this file.
4# the macros used in this file.
5
5
6−AC_INIT([streamly], [0.10.1], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])
6+AC_INIT([streamly], [0.8.2], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])
7
7
8# To suppress "WARNING: unrecognized options: --with-compiler"
8# To suppress "WARNING: unrecognized options: --with-compiler"
9AC_ARG_WITH([compiler], [GHC])
9AC_ARG_WITH([compiler], [GHC])
@@ -18,6 +18,10 @@ AC_CHECK_DECLS([kFSEventStreamCreateFlagFullHistory],[],[],[#include <CoreServic
18AC_CHECK_DECLS([kFSEventStreamEventFlagItemCloned],[],[],[#include <CoreServices/CoreServices.h>])
18AC_CHECK_DECLS([kFSEventStreamEventFlagItemCloned],[],[],[#include <CoreServices/CoreServices.h>])
19AC_CHECK_DECLS([kFSEventStreamEventFlagItemIsHardlink],[],[],[#include <CoreServices/CoreServices.h>])
19AC_CHECK_DECLS([kFSEventStreamEventFlagItemIsHardlink],[],[],[#include <CoreServices/CoreServices.h>])
20
20
21+# Check headers and functions required
22+AC_CHECK_HEADERS([time.h])
23+AC_CHECK_FUNCS([clock_gettime])
24+
21# Output
25# Output
22AC_CONFIG_HEADERS([src/config.h])
26AC_CONFIG_HEADERS([src/config.h])
23AC_OUTPUT
27AC_OUTPUT
core/Changelog.mddeleted−1
@@ -1 +0,0 @@
1−docs/Changelog.md
core/LICENSEdeleted−322
@@ -1,322 +0,0 @@
1−Copyright (c) 2017, Composewell Technologies
2−All rights reserved.
3−
4−Redistribution and use in source and binary forms, with or without
5−modification, are permitted provided that the following conditions are met:
6−
7−1. Redistributions of source code must retain the above copyright notice, this
8−list of conditions and the following disclaimer.
9−
10−2. Redistributions in binary form must reproduce the above copyright notice,
11−this list of conditions and the following disclaimer in the documentation
12−and/or other materials provided with the distribution.
13−
14−3. Neither the name of the copyright holder nor the names of its contributors
15−may be used to endorse or promote products derived from this software without
16−specific prior written permission.
17−
18−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
19−ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20−WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
21−DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
22−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
24−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
25−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
26−OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
27−OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
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−-------------------------------------------------------------------------------
196−primitive-0.7.0.0 (https://hackage.haskell.org/package/primitive-0.7.0.0)
197−-------------------------------------------------------------------------------
198−Copyright (c) 2008-2009, Roman Leshchinskiy
199−All rights reserved.
200−
201−Redistribution and use in source and binary forms, with or without
202−modification, are permitted provided that the following conditions are met:
203−
204−- Redistributions of source code must retain the above copyright notice,
205−this list of conditions and the following disclaimer.
206−
207−- Redistributions in binary form must reproduce the above copyright notice,
208−this list of conditions and the following disclaimer in the documentation
209−and/or other materials provided with the distribution.
210−
211−- Neither name of the University nor the names of its contributors may be
212−used to endorse or promote products derived from this software without
213−specific prior written permission.
214−
215−THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
216−GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
217−INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
218−FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
219−UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
220−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
221−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
222−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
223−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
224−LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
225−OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
226−DAMAGE.
227−
228−-------------------------------------------------------------------------------
229−transient-0.5.5 (http://hackage.haskell.org/package/transient-0.5.5)
230−-------------------------------------------------------------------------------
231−Copyright © 2014-2016 Alberto G. Corona <https://github.com/agocorona>
232−
233−Permission is hereby granted, free of charge, to any person obtaining a copy of
234−this software and associated documentation files (the "Software"), to deal in
235−the Software without restriction, including without limitation the rights to
236−use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
237−the Software, and to permit persons to whom the Software is furnished to do so,
238−subject to the following conditions:
239−
240−The above copyright notice and this permission notice shall be included in all
241−copies or substantial portions of the Software.
242−
243−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
244−IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
245−FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
246−COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
247−IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
248−CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
249−
250−-------------------------------------------------------------------------------
251−vector-0.12.0.2 (http://hackage.haskell.org/package/vector-0.12.0.2)
252−-------------------------------------------------------------------------------
253−Copyright (c) 2008-2012, Roman Leshchinskiy
254−All rights reserved.
255−
256−Redistribution and use in source and binary forms, with or without
257−modification, are permitted provided that the following conditions are met:
258−
259−- Redistributions of source code must retain the above copyright notice,
260−this list of conditions and the following disclaimer.
261−
262−- Redistributions in binary form must reproduce the above copyright notice,
263−this list of conditions and the following disclaimer in the documentation
264−and/or other materials provided with the distribution.
265−
266−- Neither name of the University nor the names of its contributors may be
267−used to endorse or promote products derived from this software without
268−specific prior written permission.
269−
270−THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
271−GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
272−INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
273−FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
274−UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
275−FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
276−DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
277−SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
278−CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
279−LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
280−OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
281−DAMAGE.
282−
283−-------------------------------------------------------------------------------
284−th-utilities-0.2.5.0 (https://hackage.haskell.org/package/th-utilities)
285−-------------------------------------------------------------------------------
286−Copyright (c) 2016 FP Complete Corporation.
287−
288−Permission is hereby granted, free of charge, to any person obtaining
289−a copy of this software and associated documentation files (the
290−"Software"), to deal in the Software without restriction, including
291−without limitation the rights to use, copy, modify, merge, publish,
292−distribute, sublicense, and/or sell copies of the Software, and to
293−permit persons to whom the Software is furnished to do so, subject to
294−the following conditions:
295−
296−The above copyright notice and this permission notice shall be
297−included in all copies or substantial portions of the Software.
298−
299−THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
300−EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
301−MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
302−NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
303−LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
304−OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
305−WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
306−
307−-------------------------------------------------------------------------------
308−th-abstraction-0.5.0.0 (https://hackage.haskell.org/package/th-abstraction)
309−-------------------------------------------------------------------------------
310−Copyright (c) 2017-2020 Eric Mertens
311−
312−Permission to use, copy, modify, and/or distribute this software for any purpose
313−with or without fee is hereby granted, provided that the above copyright notice
314−and this permission notice appear in all copies.
315−
316−THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
317−REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
318−FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
319−INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
320−OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
321−TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
322−THIS SOFTWARE.
core/Setup.hsdeleted−6
@@ -1,6 +0,0 @@
1−module Main (main) where
2−
3−import Distribution.Simple
4−
5−main :: IO ()
6−main = defaultMainWithHooks autoconfUserHooks
core/configuredeleted−4349

This diff is too big to show here.

core/configure.acdeleted−17

This diff is too big to show here.

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

This diff is too big to show here.

core/docs/ApiChangelogs/0.1.0.txtdeleted−405

This diff is too big to show here.

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

This diff is too big to show here.

core/docs/Changelog.mddeleted−97

This diff is too big to show here.

core/docs/Readme.mddeleted−1

This diff is too big to show here.

core/src/DocTestDataArray.hsdeleted−22

This diff is too big to show here.

core/src/DocTestDataFold.hsdeleted−27

This diff is too big to show here.

core/src/DocTestDataMutArray.hsdeleted−10

This diff is too big to show here.

core/src/DocTestDataMutArrayGeneric.hsdeleted−10

This diff is too big to show here.

core/src/DocTestDataParser.hsdeleted−20

This diff is too big to show here.

core/src/DocTestDataParserK.hsdeleted−15

This diff is too big to show here.

core/src/DocTestDataStream.hsdeleted−39

This diff is too big to show here.

core/src/DocTestDataStreamK.hsdeleted−21

This diff is too big to show here.

core/src/DocTestDataUnfold.hsdeleted−12

This diff is too big to show here.

core/src/DocTestFileSystemHandle.hsdeleted−15

This diff is too big to show here.

core/src/DocTestUnicodeParser.hsdeleted−9

This diff is too big to show here.

core/src/DocTestUnicodeStream.hsdeleted−12

This diff is too big to show here.

core/src/DocTestUnicodeString.hsdeleted−5

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/assert.hsdeleted−6

This diff is too big to show here.

core/src/config.h.indeleted−57

This diff is too big to show here.

core/src/inline.hsdeleted−27

This diff is too big to show here.

core/streamly-core.cabaldeleted−534

This diff is too big to show here.

default.nix+7−19

This diff is too big to show here.

docs/Developer/MAINTAINING.md → dev/MAINTAINING.mdrenamed+18−42

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

Binary file not shown.

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

Binary file not shown.

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

Binary file not shown.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

docs/User/Project/Changelog.md → docs/Changelog.mdrenamed+3−126

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

docs/Developer/Benchmarks.mddeleted−342

This diff is too big to show here.

docs/Developer/Contributing.mddeleted−271

This diff is too big to show here.

docs/Developer/Github.linkdeleted−1

This diff is too big to show here.

docs/Developer/Tests.mddeleted−139

This diff is too big to show here.

docs/Documentation.mddeleted−5

This diff is too big to show here.

docs/Introduction.mdnew file+651

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

docs/User/Explanatory/design.mddeleted−42

This diff is too big to show here.

docs/User/HowTo/Examples.linkdeleted−1

This diff is too big to show here.

docs/User/HowTo/faq.mddeleted−94

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

docs/User/Project/Github.linkdeleted−1

This diff is too big to show here.

docs/User/Project/README.mddeleted−141

This diff is too big to show here.

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

This diff is too big to show here.

docs/User/Tutorials/Examples.linkdeleted−1

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

docs/faq.mdnew file+70

This diff is too big to show here.

docs/getting-started.mdnew file+296

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

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

The content is the same.

docs/streamly-docs.cabal+7−22

This diff is too big to show here.

docs/User/HowTo/streamly-vs-async.md → docs/streamly-vs-async.mdrenamed−2

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

hie.yaml+38−81

This diff is too big to show here.

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

The content is the same.

src/Streamly.hsnew file+690

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Data/Array/Foreign.hs+3−44

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Data/Fold/Tee.hs+28−3

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Control/Concurrent.hs+12−1

This diff is too big to show here.

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

This diff is too big to show here.

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

The content is the same.

src/Streamly/Internal/Control/ForkLifted.hs+4−17

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Array/ArrayMacros.hnew file+27

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/Async.hs+7−21

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Fold/SVar.hs+7−8

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Maybe/Strict.hs → src/Streamly/Internal/Data/Maybe/Strict.hsrenamed−9

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Parser/Type.hs → src/Streamly/Internal/Data/Parser/ParserD/Type.hsrenamed+335−609

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Ring.hs → src/Streamly/Internal/Data/Ring/Foreign.hsrenamed+69−130

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Ahead.hs+12−37

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Async.hs+16−50

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Instances.hs+16−9

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Common.hs+53−82

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Exception.hs+15−29

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Expand.hs+90−79

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+308−344

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Top.hs+47−109

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/IsStream/Type.hs+82−166

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Parallel.hs+32−60

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/SVar/Generate.hs+10−13

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Stream/Nesting.hs → src/Streamly/Internal/Data/Stream/StreamD/Nesting.hsrenamed+358−914

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/Zip.hs+8−47

This diff is too big to show here.

src/Streamly/Internal/Data/Stream/ZipAsync.hs+11−14

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Data/Time/Clock.hs → src/Streamly/Internal/Data/Time/Clock.hsrenamed+16−16

This diff is too big to show here.

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

The content is the same.

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

This diff is too big to show here.

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

The content is the same.

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

The content is the same.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/Dir.hs → src/Streamly/Internal/FileSystem/Dir.hsrenamed+83−190

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Darwin.hs+76−69

This diff is too big to show here.

src/Streamly/Internal/FileSystem/Event/Linux.hs+132−105

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/FileSystem/FD.hs+62−70

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/FileSystem/File.hs → src/Streamly/Internal/FileSystem/File.hsrenamed+141−210

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/Network/Inet/TCP.hs+124−161

This diff is too big to show here.

src/Streamly/Internal/Network/Socket.hs+248−183

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Internal/System/IOVec.hs+7−13

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

core/src/Streamly/Internal/Unicode/Stream.hs → src/Streamly/Internal/Unicode/Stream.hsrenamed+227−268

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

src/Streamly/Prelude.hs+8−14

This diff is too big to show here.

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

This diff is too big to show here.

src/assert.hsdeleted−6

This diff is too big to show here.

src/config.h.in+38

This diff is too big to show here.

src/inline.hs+2−2

This diff is too big to show here.

stack.yaml+2−3

This diff is too big to show here.

streamly.cabal+323−257

This diff is too big to show here.

targets/Targets.hsdeleted−213

This diff is too big to show here.

targets/default.nixdeleted−163

This diff is too big to show here.

targets/streamly-targets.cabaldeleted−12

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/Array.hs+5−231

This diff is too big to show here.

test/Streamly/Test/Data/Array/Common.hs+23−15

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/Array/Stream/Foreign.hsnew file+72

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/List.hs+27−20

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/Parser.hs+193−763

This diff is too big to show here.

test/Streamly/Test/Data/ParserK.hs → test/Streamly/Test/Data/Parser/ParserD.hsrenamed+91−155

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/SmallArray.hs−2

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Data/Unfold.hs+35−38

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Prelude/Fold.hs−2

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Prelude/Rate.hs−2

This diff is too big to show here.

test/Streamly/Test/Prelude/Serial.hs+119−158

This diff is too big to show here.

test/Streamly/Test/Prelude/Top.hs+10−13

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Prelude/ZipAsync.hs−2

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Unicode/Char.hs+16−13

This diff is too big to show here.

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

This diff is too big to show here.

test/Streamly/Test/Unicode/Stream.hs+30−34

This diff is too big to show here.

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

This diff is too big to show here.

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

This diff is too big to show here.

test/streamly-tests.cabal+40−196

This diff is too big to show here.

test/test-runner/Main.hsdeleted−33

This diff is too big to show here.

test/test-runner/cabal.projectdeleted−4

This diff is too big to show here.

test/test-runner/default.nixdeleted−164

This diff is too big to show here.

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

This diff is too big to show here.